Domino Code Fragment

Code Name*
How do you find out what Roles a user has in the current database?		Date*
05/14/2024		Source (or email address if you prefer)*
Rlatulippe@romac.com
IP address:.18.116.62.239
Description*
This function will give you a list of all roles a user is in, even if the user is in nested groups which are listed in the ACL.		Type*
LotusScript		Categories*
(Misc)
Implementation:
Required Client:
Server:
Limitations:
Comments:
Files/Graphics attachments (if applicable): Code:

' Roles(UserName$) :
' It checks for roles of UserName$ (could be both abbreviate or hierarchical) in current database
' If no exact ACL found it checks all group recursively
' If UserName$ is member of two or more groups it returns the roles of all of them
' If nothing found, it returns "-Default-" roles
' It doesn't check duplicate roles (but this is not a problem)
' Return value: array of roles (strings)
'
' IsaMemberOf(UserName$, GroupName$) :
' Check if UserName$ is a member of GroupName$
' It searchs group recursively
' It searchs first public address book
' Return value: boolean
'
' NameSimple$(Name$) :
' Just acts like formula @Name( [Abbreviate] ; Name )
' Return value: string
'
' Marco Beri
' marcob@equalis.it

Function Roles(UserName$) As Variant
Dim AllRoles As Variant
Dim session As New NotesSession
Dim db As NotesDatabase
Dim acl As NotesACL
Dim entry As NotesACLEntry
Dim FirstGroupFound%

Set db = session.CurrentDatabase
Set acl = db.ACL
Set entry = acl.GetEntry( UserName$ )
If entry Is Nothing Then
Set entry = acl.GetEntry( NameSimple$(UserName$) )
End If
If Not entry Is Nothing Then
AllRoles = entry.Roles
Else
Set entry = acl.GetFirstEntry
Do While Not entry Is Nothing
'Default roles (survives only if no other found)
If Trim$(Ucase$(entry.name)) = Ucase$("-Default-") Then
AllRoles = entry.roles
Else
If IsaMemberOf(UserName$, entry.name) Then
If FirstGroupFound% Then
Redim Preserve AllRoles(Ubound(AllRoles)+Ubound(entry.roles)+1)
For Cont%=0 To Ubound(entry.roles)
AllRoles(Ubound(AllRoles)-Cont%) = entry.roles(Cont%)
Next
Else
FirstGroupFound% =True
AllRoles=entry.roles
End If
End If
End If
Set entry = acl.GetNextEntry( entry )
Loop
End If
Roles = AllRoles
End Function

Function IsaMemberOf(UserName$, GroupName$)
On Error Goto IsaMemberOfError

Dim doc As NotesDocument
Static ViewGroup As NotesView

If (ViewGroup Is Nothing) Then
Dim PublicBook As Variant
Dim session As New NotesSession

Set PublicBook=Nothing
Forall Book In session.AddressBooks
If (Book.IsPublicAddressBook) Then
Set PublicBook=Book
Exit Forall
End If
End Forall
If PublicBook Is Nothing Then
Forall Book In session.AddressBooks
Set PublicBook=Book
Exit Forall
End Forall
End If
If Not (PublicBook Is Nothing) Then
Call PublicBook.Open("", "")
Set ViewGroup=PublicBook.GetView("Groups")
If ViewGroup Is Nothing Then
Messagebox "No group view found"
End If
Else
Messagebox "No address book found"
Exit Function
End If
End If

Set doc=ViewGroup.GetDocumentByKey(GroupName$)
If doc Is Nothing Then
IsaMemberOf = False
Else
If Not (doc Is Nothing) Then
Forall Member In doc.Members
If Trim$(Ucase$(Member)) = Trim$(Ucase$(UserName$)) Or Trim$(Ucase$(Member)) = Trim$(Ucase$(NameSimple(UserName$))) Then
IsaMemberOf = True
Exit Forall
Else
If IsaMemberOf(UserName$, Cstr(Member)) Then
IsaMemberOf = True
Exit Forall
End If
End If
End Forall
End If
End If

Exit Function

IsaMemberOfError:
Messagebox "IsaMemberOf"+Str$(Err)+": "+Error$
Exit Function
End Function

Function NameSimple$(Byval NameToConvert$)
Dim InstrUguale%,Cont%,NameResto$
Do
InstrUguale%=Instr(NameToConvert$,"=")
If InstrUguale%=0 Then
Exit Do
End If
NameResto$=Mid$(NameToConvert$,InstrUguale%+1)
For Cont%=InstrUguale%-1 To 0 Step -1
If Cont%=0 Then
NameToConvert$=""
Elseif Mid$(NameToConvert$,Cont%,1)="/" Then
NameToConvert$=Left$(NameToConvert$,Cont%)
Exit For
End If
Next
NameToConvert$=NameToConvert$+NameResto$
Loop
NameSimple$=NameToConvert$
End Function