Manage Learn to apply best practices and optimize your operations.

Save, Stop & Reload ACL

When I manage my DBs, with some activity (Agents) that touch a lot of documents, I can't risk to create many Replication Conflicts, if some user work within this docs. So, I save ACL in external File, stop users activity, disabling ACL; I can run my Agents; when finished I reload original ACL (saved in File).

All of this, with one intelligent Agent!


-----DECLARATION
Dim db As NotesDatabase
Dim acl As NotesACL
Dim entry As NotesACLEntry

Dim TabVal As Variant
Dim TabKey As Variant
Dim TabRoles As Variant
Dim TabColonne(9) As String

Const Txt1DB = "ACL DB"
Const Sep1 = "%"
Const File1 = "C:NOTMACROACL.TXT"
Const File2 = "C:NOTMACROACLTRC.TXT"

----- INITIALIZE
Dim ws As New NotesUIWorkspace
	Dim uidoc As NotesUidocument
	Dim session As New NotesSession
	Dim RigaTitoli As String
	Dim RigaValori As String
	Set db = session.CurrentDatabase
	If session.CommonUserName <> "Lisa Fioretti" And _
	session.CommonUserName<>"Mirko Malaguti" And session.CommonUserName<>"Alberto Forni" Then
		Exit Sub
	End If
	f1 = Freefile
	Call PreparaVariabili
	Set acl = db.ACL
	a1 = Messagebox("premere YES x salvare la ACL del DB sul file " & File1 & Chr(13) & _
	"premere NO x ripristinare la ACL precedentemente memorizzata sul file " & File1 & Chr(13) & _
	"CANCEL per ulteriori funzioni", 35, "Gestione ACL")
	If a1 = 6 Then ' YES = download ACL
		Open File1 For Output As #1
		Print # 1 , Txt1DB & Sep1 & db.FilePath & Sep1 & Now
		Set entry = acl.GetFirstEntry
		Call GestioneRiga("TITOLI", RigaTitoli)
		Print # 1 , RigaTitoli
		Do While Not entry Is Nothing
			Call GestioneRiga("Dati", RigaValori)
			Print # 1 , RigaValori
			Set entry = acl.GetNextEntry(entry)
		Loop
		Print # 1 , Txt1DB & Sep1 & db.FilePath & Sep1 & Now
		Close # 1
		Messagebox "ACL scritta sul file " & File1
	End If
	If a1 = 7 Then ' NO = Reload ACL
		Open File1 For Input As #1
		Open File2 For Output As #2
		Print # 2 , Txt1DB & Sep1 & db.FilePath & Sep1 & Now
		Line Input # 1 , Riga1$
		Print # 2 , "read line 1=" & Riga1$
		numV = ExplodeMultiValues(Riga1$, TabVal, Sep1)
		If TabVal(0) <> Txt1DB Then
			Mex = "il file di input " & File1 & " non inizia con la stringa chiave [" & Txt1DB & "] (" & Riga1$ & ")"
			Print # 2 , Mex
			Messagebox Mex
			Exit Sub
		End If
		Mex = "DB is " & TabVal(1)
		Print # 2 , Mex
		If TabVal(1) <> db.FilePath Then
			Mex = "Attenzione: il DB relativo alla ACL scaricata sul file " & File1 & " (" & TabVal(1) & ")" & _
			" non corrisponde con il DB attualmente aperto (" & db.FilePath & ")"
			Print # 2 , Mex
			a2 = Messagebox (Mex & Chr(13) & "premere OK x eseguire ugualmente il ripristino della ACL", 49, "Gestione ACL")
			If a2 <> 1 Then ' non premuto OK
				Exit Sub				
			End If
		End If
		Mex = "premere OK x ripristinare l'ACL scaricata dal DB " & TabVal(1) & " il giorno " & TabVal(2)
		Print # 2 , Mex
		a3 = Messagebox (Mex, 65, "Gestione ACL")
		If a3 <> 1 Then ' non premuto OK
			Exit Sub				
		End If
		Line Input # 1 , Riga2$
		Print # 2 , "read line 2=" & Riga2$
		numV = ExplodeMultiValues(Riga2$, TabKey, Sep1)
		cnt3 = 2
		Do Until Eof(1)
			cnt3 = cnt3 + 1		
			Line Input #1, Riga3$
			Print # 2 , "read line " & cnt3 & "=" & Riga3$
			numV = ExplodeMultiValues(Riga3$, TabVal, Sep1)
			If TabVal(0) = Txt1DB Then
				Exit Do
			End If
			Mex = "run on UT=" & TabVal(1)
			Print # 2 , Mex
			Set entry = acl.GetEntry(TabVal(1))
			If entry Is Nothing Then
				Mex = "Attenzione: l'utenza " & TabVal(1) & " non h piy presente nella ACL di questo DB"
				Print # 2 , Mex
				a4 = Messagebox (Mex & Chr(13) & " premere YES x inserirla" & Chr(13) & _
				" premere NO x bypassare questa utenza; CANCEL x interrompere l'elaborazione", 51, "Gestione ACL")
				If a4 = 2 Then ' premuto CANCEL
					Exit Sub				
				End If
				If a4 = 7 Then ' NO
					Goto Lettura
				End If
				Set Entry = acl.CreateACLEntry( TabVal(1), 0)
				Mex = "Inserita utenza " & TabVal(1)
				Print # 2 , Mex
			End If
			Call GestioneRiga("UPD", RigaTitoli)
Lettura:
		Loop
		Print # 2 , "save ACL"
		Call acl.save
		Print # 2 , "fine elaborazione RELOAD"
	End If
	If a1 = 2 Then ' CANCEL = altre opzioni
		a4 = Messagebox("premere OK x disabilitare tutti gli utenti dalla ACL, ad esclusione dei Manager", 33, "Gestione ACL")
		If a4 = 1 Then ' premuto OK
			Open File2 For Output As #2
			Print # 2 , Txt1DB & Sep1 & db.FilePath & Sep1 & Now
			Set entry = acl.GetFirstEntry
			Do While Not entry Is Nothing
				Print # 2 , "Run on UT=" entry.name
				If entry.level > 0 And entry.level < 6 Then
					entry.level = 0
					Print # 2 , "No Access for UT=" entry.name
				End If
				Set entry = acl.GetNextEntry(entry)
			Loop	
			Print # 2 , "save ACL"
			Call acl.save
			Print # 2 , "fine elaborazione NO ACCESS"
		End If
	End If

------ FUNCTION
Function ExplodeMultiValues(buffer$, vArr, delim$) As Long 
	
     'This function returns a variant string array representing the 
     'multi-values in the string buffer delimited by 'delim'. 
	
	Const funcName = "ExplodeMultiValues" 
	ExplodeMultiValues = 1 
	Dim tmpV() As Variant 
	Dim beg&, nxt&, idx& 
	
     '----- Set up the default value 
	Dim defV(0 To 0) As Variant 
	defV(0) = buffer 
	vArr = defV 
	
     '----- No delimiter, no multi-values 
	If Trim$(delim) = "" Or Trim$(buffer) = "" Then Goto TheEnd 
	
     '----- Parse the values 
	idx = 0 
	beg = 1 
	nxt = 1 
	Do While nxt > 0 
		
          '----- Look for the next delimiter 
		nxt = Instr(beg, buffer, delim) 
		
          '----- Expand the values array by one (expect at least 
          '      one value at this point) 
		Redim Preserve tmpV(0 To idx) 
		
          '----- If we found a delimiter 
		If nxt > 0 Then 
			tmpV(idx) = Mid$(buffer, beg, nxt-beg) 
			
          '----- This is the last value 
		Elseif nxt = 0 And beg <= Len(buffer) Then 
			tmpV(idx) = Mid$(buffer, beg)               
		End If 
		idx = idx + 1 
		beg = nxt + Len(delim) 
	Loop 
	ExplodeMultiValues = Ubound(tmpV)+1 
	vArr = tmpV 
	
TheEnd: 
	Exit Function 
	
Errors: 
	Print funcName & ": ERROR: " & Error$ 
	Resume TheEnd 
	
End Function

------ SUB
Sub PreparaVariabili
	TabColonne(0) = "DB"
	TabColonne(1) = "Name"
	TabColonne(2) = "Level"
	TabColonne(3) = "Roles"
	TabColonne(4) = "CanCreateDoc"
	TabColonne(5) = "CanCreateAgent"
	TabColonne(6) = "CanCreateFolder"
	TabColonne(7) = "CanDelDoc"
	TabColonne(8) = "PubRead"
	TabColonne(9) = "PubWrite"
End Sub

-------- SUB
Sub GestioneRiga (tipo As String, RigaOut As String)
	Dim Valore As String
	Dim ValUPD As Variant
	RigaOut = ""
	Select Case Ucase(tipo)
	Case "TITOLI"
		j1 = -1
		Forall C1 In TabColonne
			j1 = j1 +1
			If j1 = 0 Then
				RigaOut = C1
			Else
				RigaOut = RigaOut & Sep1 & C1
			End If
		End Forall
	Case "DATI"
		j1 = -1
		Forall C1 In TabColonne
			j1 = j1 +1
			Select Case C1
			Case "DB"
				Valore = db.FilePath
			Case "Name"
				Valore = entry.name
			Case "Level"
				Valore = entry.Level
			Case "Roles"
				TabRuoli = ""
				Forall R1 In entry.roles
					If TabRuoli = "" Then
						TabRuoli = R1
					Else
						TabRuoli = TabRuoli & ";" & R1
					End If
				End Forall
				Valore = TabRuoli
			Case "CanCreateDoc"
				Valore = entry.CanCreateDocuments
			Case "CanCreateAgent"
				Valore = entry.CanCreatePersonalAgent
			Case "CanCreateFolder"
				Valore = entry.CanCreatePersonalFolder
			Case "CanDelDoc"
				Valore = entry.CanDeleteDocuments
			Case "PubRead"
				Valore = entry.IsPublicReader
			Case "PubWrite"
				Valore = entry.IsPublicWriter
			Case Else
				Valore = "???"
			End Select
			If j1 = 0 Then
				RigaOut = Valore
			Else
				RigaOut = RigaOut & Sep1 & Valore
			End If
		End Forall
	Case "UPD"
		j1 = -1
		Print #2, "Reload ACL for " & TabVal(1)
		Forall C2 In TabKey
			j1 = j1 +1
			Valore = TabVal(j1)
			If Ucase(Valore) = "TRUE" Then
				ValUPD = True
			Else
				If Ucase(Valore) = "FALSE" Then
					ValUPD = False
				Else
					If Instr(Valore, ";") > 0 Then
						numV = ExplodeMultiValues(Valore, ValUPD, ";")
					Else
						ValUPD = Valore
					End If
				End If
			End If
			Select Case C2
			Case "Level"
				entry.Level = ValUpd
			Case "Roles"
				If Isarray(ValUPD) Then
					Forall R1 In ValUPD
						Call Entry.EnableRole( R1 )
					End Forall
				End If
			Case "CanCreateDoc"
				entry.CanCreateDocuments = ValUPD
			Case "CanCreateAgent"
				entry.CanCreatePersonalAgent = ValUPD
			Case "CanCreateFolder"
				entry.CanCreatePersonalFolder = ValUPD
			Case "CanDelDoc"
				entry.CanDeleteDocuments = ValUPD
			Case "PubRead"
				entry.IsPublicReader = ValUPD
			Case "PubWrite"
				entry.IsPublicWriter = ValUPD
			Case Else
			End Select
		End Forall
	End Select
End Sub

Dig Deeper on Domino Resources - Part 6

Start the conversation

Send me notifications when other members comment.

Please create a username to comment.

-ADS BY GOOGLE

SearchWindowsServer

Search400

  • iSeries tutorials

    Search400.com's tutorials provide in-depth information on the iSeries. Our iSeries tutorials address areas you need to know about...

  • V6R1 upgrade planning checklist

    When upgrading to V6R1, make sure your software will be supported, your programs will function and the correct PTFs have been ...

  • Connecting multiple iSeries systems through DDM

    Working with databases over multiple iSeries systems can be simple when remotely connecting logical partitions with distributed ...

SearchDataCenter

SearchContentManagement

Close