Lotus用VB如何发现一个用户拥有的角色？

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

另一个方法：
Dim UserRoles As Variant
UserRoles = Evaluate("@UserRoles")