Domino Code Fragment

Code Name*
Role and Group Membership routines
Date*
9/3/98
Source (or email address if you prefer)*
Marcus Laubli
IP address:.3.131.110.169
Description*
Adds persons to roles, checks membership in Groups
Type*
LotusScript
Categories*
Design Configuration, Diagnostics/Analysis/Debugging, Security
Implementation:
None (plug and play)
Required Client:
Server:
Limitations:
Comments:
Files/Graphics attachments (if applicable): Code:
'General_Library:

Option Public
'General_Library:



Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim dbView As NotesView
Dim View As NotesView
Dim uiView As NotesUIView


Dim Doc As NotesDocument
Dim uiDoc As NotesUIDocument


Dim ACL As NotesACL
Dim ACLEntry As NotesACLEntry



Dim dbProfileDoc As NotesDocument ' This database Profile
Dim UserProfileDoc As NotesDocument ' UserProfile in this database
Dim uiProfileDoc As NotesUIDocument


Dim ProfileDoc As NotesDocument
Dim theAgent As NotesAgent


' newline = Chr(13) & Chr(10)
Dim howLong As Single, howManyBeeps As Integer




Function AtIsMember%(aclRole As String)
' Developers Note : Due to a limitation in the way LotusScript
' accesses ACLEntries, this routine only works for roles of direct ACL entries.
' Therefore, checking the role of members Server or Person groups does
' not work with this routine. I use it to add developers (whom I
' always put directly into the ACL during development phase) into
' Developer and Debug roles.
Dim session As New NotesSession
Dim entry As NotesACLEntry


Set db = session.CurrentDatabase
Set acl = db.ACL
Set entry = acl.GetEntry( session.UserName )
Forall r In entry.roles
If r = aclrole Then
AtIsMember = True
Exit Forall
Else
AtIsMember = False
End If
End Forall
End Function
Function GetGroupMembers (AddressBookType$ , _
GroupViewName$ , GroupName$) As Variant
' AddressBookType can be either Public or Private
' GroupViewName and GroupName$ allow flexibility
' in the usage of this function.


Dim Session As New NotesSession
Dim GroupView As Notesview
Dim GroupDoc As NotesDocument


AddressBooks = session.AddressBooks
On Error Resume Next
Forall book In AddressBooks
Select Case AddressBookType$
Case "Public" :
If book.IsPublicAddressBook And (Not done) Then
Call book.Open("","")
Set GroupView = book.GetView(GroupViewName$)
Set GroupDoc = GroupView.GetDocumentByKey(GroupName$)
If Not GroupDoc Is Nothing Then
done = True
End If
End If
Case "Private" :
If book.IsPrivateAddressBook And (Not done) Then
Call book.Open("","")
Set GroupView = book.GetView(GroupViewname$)
Set GroupDoc = GroupView.GetDocumentByKey(GroupName$)
If Not GroupDoc Is Nothing Then
done = True
End If
End If
Case Else :
If AtIsMember("[Debug]") Then
Print "ERROR in GetGroupMembers. Only GroupType$ Public or Private are valid"
End If
End Select
End Forall
If done Then
GetGroupMembers = Evaluate("@Name([CN];Members)",GroupDoc)
End If


End Function



Function IsUserMemberOfGroup!( GroupMembers)
Dim session As New Notessession


Forall person In GroupMembers
If Person = Session.CommonUserName Then
IsUserMemberofGroup! = True
Exit Forall
Else
IsUserMemberofGroup! = False
End If
End Forall
End Function
Function Chirp (Iterations!) As Integer
' Usually 3 iterations is sufficient to "chirp"
For i = 1 To Iterations
Beep
Next
End Function
Function DynamicFill ( FieldContents As String , _
FailMessage As String , Focus As String) As Integer
Dim Workspace As New NotesUIWorkspace


Set uiDoc = Workspace.CurrentDocument

If FieldContents = Null Then
theRest$ = ". Would you like to edit the field before saving?"
Select Case Msgbox( FailMessage + theRest$ , 4 + 48 , "Field Validation") ' 4 is Y/N and 48 is !
Case 6 : ' this is the "Yes, I want to edit" case
Call uiDoc.ExpandAllSections
uiDoc.GotoField(Focus)
DynamicFill = False ' Don't forget, it's a double negative!!
Case 7 : ' this is the "No" case
DynamicFill = True
Case Else :
DynamicFill = True ' let it go...the user probably hit escape!!
End Select
End If
' This Function will always return True. It is just used for information purposes
End Function
Function MustFill ( FieldContents As String , _
Message As String , Focus As String ) As Integer
Dim Workspace As New NotesUIWorkspace


Set uiDoc = Workspace.CurrentDocument


If FieldContents = "" Then
If uiDoc.EditMode Then
Call uiDoc.ExpandAllSections
Msgbox Message , 16 , "Field Validation"
uiDoc.GotoField(Focus)
MustFill = False
End If
Else
MustFill = True
End If


End Function