Domino Code Fragment

Code Name*
Add Roles To ACL
Date*
04/28/2024
Source (or email address if you prefer)*
Rlatulippe@romac.com
IP address:.18.191.132.194
Description*
This formula uses LotusScript to add roles to the ACL of a database. Event = "Initialize". No other subroutines are used.
Type*
LotusScript
Categories*
(Misc)
Implementation:
Required Client:
Server:
Limitations:
Comments:
This is the Notes field
Files/Graphics attachments (if applicable): Code:
Sub Initialize
Dim S As New NOTESSESSION
Dim Db As NotesDatabase
Dim ACL As NOTESACL
Dim Entry As NOTESACLEntry
Dim TotalEditors As Integer
Dim TotalAuthors As Integer
Dim Roles (7) As String
Roles(0) = "UserCreator"
Roles(1) = "UserModifier"
Roles(2) = "GroupCreator"
Roles(3) = "GroupModifier"
Roles(4) = "NetCreator"
Roles(5) = "NetModifier"
Roles(6) = "ServerCreator"
Roles(7) = "ServerModifier"
Set DB = S.CurrentDatabase
If Not DB.IsOpen Then
Print "Error Not open"
Goto endit
End If

Set ACL=DB.ACL
Forall i In Roles
ACL.AddRole(i)
End Forall
ACL.Save

Set Entry=ACL.GetFirstEntry
TotalEditors = 0
TotalAuthors = 0
Do Until Entry Is Nothing
If (Entry.level > 3) Then
TotalEditors = TotalEditors + 1
Forall i In Roles
Entry.EnableRole(i)
End Forall
Elseif( Entry.level = 3) Then
If Entry.CANCREATEDOCUMENTS Then
TotalAuthors = TotalAuthors + 1
Entry.EnableRole("UserCreator")
Entry.EnableRole("GroupCreator")
Entry.EnableRole("NetCreator")
Entry.EnableRole("ServerCreator")
End If
End If
ACL.Save
Set Entry = ACL.GetNextEntry(Entry)
Loop
ACL.Save
Dim Message As String
Dim BoxType As Long
BoxType=MB_OK + MB_ICONINFORMATION
Message = "Gave all new roles to " + Cstr(TotalEditors) + " entry(s) who have Editor access or above. Gave create-only roles to " + Cstr(TotalAuthors) + " entry(s) who have Author with Create access."
Messagebox Message, BoxType, "Applied Roles"

endit:

End Sub