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")