Function GetUserGroup(UserNameText As String, UseCache As Boolean) As Variant
On Error Goto ErrH
Const SEP = "~"
Static UserGroupsList List As String
Static cnt As Integer
Dim rv As Variant
Redim Init(0) As String
GetUserGroup = Init
If Len(UserNameText) = 0 Then Exit Function
Dim UserName As New NotesName(UserNameText)
If UseCache Then
If Iselement(UserGroupsList(UserNameText)) Then
rv = Split(UserGroupsList(UserNameText), SEP)
Goto Final
End If
End If
If cnt = 0 Then
Dim session As New NotesSession
Static AbDbs() As NotesDatabase
Static AbViews() As NotesView
Redim Preserve AbDbs(cnt)
Redim Preserve AbViews(cnt)
Dim AbView As NotesView
Forall dbn In session.AddressBooks
If dbn.IsPublicAddressBook Then
If Not dbn.IsOpen Then Call dbn.Open("","")
If dbn.IsOpen Then
Set AbView = dbn.GetView("($ServerAccess)")
If Not AbView Is Nothing Then
Redim Preserve AbDbs(cnt)
Redim Preserve AbViews(cnt)
Set AbDbs(cnt) = dbn
Set AbViews(cnt) = AbView
cnt = cnt + 1
End If
End If
End If
End Forall
End If
Dim k As Integer
Dim GroupCount As Integer
Dim Coll As NotesDocumentCollection
Dim Doc As NotesDocument
Redim UserGroup(0) As String
UserGroup(0) = UserName.Canonical
Dim GroupName As String
Do
For k = 0 To Ubound(AbViews)
Set Coll = AbViews(k).GetAllDocumentsByKey(Lcase(UserGroup(GroupCount)), True)
If Coll.Count > 0 Then
Set Doc = Coll.GetFirstDocument
Do While Not Doc Is Nothing
GroupName = Doc.GetItemValue("ListName")(0)
If Isnull(Arraygetindex(UserGroup, GroupName, 5)) Then
If UserGroup(Ubound(UserGroup)) <> "" Then Redim Preserve UserGroup(Ubound(UserGroup) + 1)
UserGroup(Ubound(UserGroup)) = GroupName
End If
Set Doc = Coll.GetNextDocument(Doc)
Loop
End If
Next
GroupCount = GroupCount + 1
Loop While GroupCount <= Ubound(UserGroup)
UserGroup(0) = ""
rv = Fulltrim(UserGroup)
UserGroupsList(UserNameText) = Implode(rv, SEP)
Final:
GetUserGroup = rv
Exit Function
ErrH:
Msgbox Error & | in line | & Erl(), 64, |Lotus Notes (| & Lsi_info(2) & |)|
Exit Function
End Function
- яркий пример победы маркетинга над здравым смыслом.
