Manage Learn to apply best practices and optimize your operations.

ACL manager

Save ACL, stop Access to DB, Reload ACL

Save ACL, stop Access to DB, Reload ACL

 ***** DECLARATIONS ================== 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" ***** SUB INITIALIZE ================ Sub 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 e piu 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 End Sub ***** FUNCTION EXPLODEMULTIVALUES ================================ 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 PREPARAVARIABILI ======================== 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 GESTIONERIGA ==================== 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 2

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