All of the program code and information presented in the OpenNTF.org Code Bin are provided "as-is", and should be used at your own risk. OpenNTF.org make no express or implied warranty about anything in the Code Bin, and OpenNTF.org will not be responsible or liable for any damage caused by the use or misuse of anything from this site. OpenNTF.org makes no guarantees about anything. Please thoroughly test all of the knowledge and code you find here before you attempt to use them in your production environment.

'ag.i-Seven.DominoDirectory.MemberOf:

Option Declare
'ag.i-Seven.DominoDirectory.MemberOf:

Public Class I7DirectorySession
Private mvSession As NotesSession
Private mvCurrentNAB As NotesDatabase
Private mvDirectories List As I7DominoDirectory
Private mvSimulateToFilePath As String
Private mvSimulateForNotesName As NotesName
Private mvPersonDocument As NotesDocument

Public Property Set SimulateToFilePath As String
mvSimulateToFilePath = SimulateToFilePath
End Property

Public Property Set SimulateForNotesName As NotesName
Set mvSimulateForNotesName = SimulateForNotesName
End Property

Public Property Set PersonDocument As NotesDocument
If PersonDocument.IsValid And Not PersonDocument.IsDeleted Then
If Lcase$(PersonDocument.GetItemValue("Form")(0)) = "person" Then
Set mvPersonDocument = PersonDocument
End If
End If
End Property

Public Sub New
Set mvSession = New NotesSession
If mvSession.CurrentDatabase.IsPublicAddressBook Then
Set mvCurrentNAB=mvSession.CurrentDatabase
Set mvDirectories(GetDirectoryListIndex(mvCurrentNAB)) = New I7DominoDirectory (mvCurrentNAB)
End If

Forall DB In mvSession.AddressBooks
If DB.IsPublicAddressBook Then
If Not Iselement(mvDirectories(GetDirectoryListIndex(DB))) Then
Set mvDirectories(GetDirectoryListIndex(DB)) = New I7DominoDirectory (DB)
End If
End If
End Forall

End Sub

Public Sub UpdateAttribute_MemberOf
Dim FullName As NotesName
Dim ListNames As Variant
Dim FF As Integer
Dim ListNamesAsString As String
Dim ListNameAsArray As Variant

If Not mvSimulateForNotesName Is Nothing Then
Set FullName = mvSimulateForNotesName
Elseif Not mvPersonDocument Is Nothing Then
Set FullName = New NotesName (mvPersonDocument.GetItemValue("FullName")(0))
End If

If Not FullName Is Nothing Then
ListNames = GetListNamesByName(FullName)
If Not Isempty(ListNames) Then
Redim ListNameAsArray(0) As String
Forall LN In ListNames
If ListNameAsArray(Ubound(ListNameAsArray)) <> "" Then
Redim Preserve ListNameAsArray(Ubound(ListNameAsArray)+1) As String
End If
ListNameAsArray(Ubound(ListNameAsArray)) = Listtag(LN)
If mvSimulateToFilePath<> "" Then
ListNamesAsString = ListNamesAsString + Listtag(LN) + ","
End If
End Forall
If mvSimulateToFilePath= "" Then
If Not mvPersonDocument Is Nothing Then
'TODO, sort at check ListNameAsArray against memberOf before updating and saving document to avoid saves
Call mvPersonDocument.ReplaceItemValue("memberOf", ListNameAsArray)
Call mvPersonDocument.Save(True,False,False)
End If
Else
FF = Freefile
Open mvSimulateToFilePath For Append As #FF
Write #1, FullName.Canonical, ListNamesAsString
Close #FF
End If
End If
End If
End Sub

Private Function GetListNamesByName (aoName As NotesName) As Variant
Dim ListDocuments As NotesDocumentCollection
Dim ListNames List As NotesName
Dim ListDoc As NotesDocument
Dim NewListName As NotesName
Forall Directory In mvDirectories
Forall ListIndex In Directory.ListIndexes
Set ListDocuments = ListIndex .GetAllDocumentsByKey(Lcase$(aoName.Canonical),True)
If ListDocuments.Count > 0 Then
Set ListDoc = ListDocuments.GetFirstDocument
Do While Not ListDoc Is Nothing
If ListDoc.IsValid And Not ListDoc.IsDeleted Then
Set NewListName = New NotesName(ListDoc.GetItemValue("ListName")(0))
If Not Iselement(ListNames(Lcase$(NewListName.Canonical))) Then
Set ListNames(Lcase$(NewListName.Canonical)) = NewListName
Forall NN In GetListNamesByName(NewListName)
If Not Iselement(ListNames(Lcase$(NN.Canonical))) Then
Set ListNames(Lcase$(NN.Canonical)) = NN
End If
End Forall
End If
End If
Set ListDoc = ListDocuments.GetNextDocument(ListDoc)
Loop
End If
End Forall
End Forall
GetListNamesByName = ListNames
End Function

Private Function GetDirectoryListIndex (aoDB As Variant) As String
GetDirectoryListIndex=Lcase$(aoDB.Server+"!!"+aoDB.FilePath)
End Function
End Class

Public Class I7DominoDirectory
Private mvDatabase As NotesDatabase
Private mvServerAccess As NotesView
Private mvMailGroups As NotesView
Private mvListIndexes List As NotesView

Public Property Get ListIndexes As Variant
ListIndexes = mvListIndexes
End Property

Public Sub New (aoDB As Variant)
If aoDB.IsPublicAddressBook Then
If Not aoDB.IsOpen Then
Call aoDB.Open("","")
End If
If aoDB.isOpen Then
Set mvDatabase = aoDB
Set mvServerAccess =mvDatabase.GetView("($ServerAccess)")
Set mvMailGroups =mvDatabase.GetView("($MailGroups)")
mvServerAccess.AutoUpdate=False
mvMailGroups.AutoUpdate=False
Set mvListIndexes("($ServerAccess)") = mvServerAccess
Set mvListIndexes("($MailGroups)") = mvMailGroups
End If
End If
End Sub
Sub Delete
mvServerAccess.AutoUpdate=True
mvMailGroups.AutoUpdate=True
Delete mvServerAccess
Delete mvMailGroups
End Sub
End Class


Sub Initialize
REM Example 1 test the result by passing a specific notes name and saving to file
'Dim Session As NotesSession
'Dim DirectorySession As I7DirectorySession

'Set Session = New NotesSession
'Set DirectorySession = New I7DirectorySession
'DirectorySession.SimulateToFilePath = "c:\out.txt"
'Dim NN As NotesName
'Set NN= New NotesName(Session.UserName)
'Set DirectorySession.SimulateForNotesName = NN
'Call DirectorySession.UpdateAttribute_MemberOf


REM Example 1 schedule this agent to run on modified documents. It will update automatically the documents traversing all directories used on the server
Dim Session As NotesSession
Dim DirectorySession As I7DirectorySession
Dim Database As NotesDatabase
Dim DC As NotesDocumentCollection
Dim Doc As NotesDocument

Set Session = New NotesSession
Set DirectorySession = New I7DirectorySession
Set Database = Session.CurrentDatabase
Set DC = Database.UnprocessedDocuments
If DC.Count > 0 Then
Set Doc = DC.GetFirstDocument
Do While Not Doc Is Nothing
Set DirectorySession.PersonDocument = Doc
Call DirectorySession.UpdateAttribute_MemberOf
Set Doc = Dc.GetNextDocument(Doc)
Loop
Call DC.UpdateAll
End If
End Sub

This lss file can be used to create an agent that maintain the notes item memberOf on a person document. When this agent is run, this field will be updated with en exploded list of all groups the users is member of (across all directories recognized by the current session)

The need arised trying to optimizing performance when Domino is used as LDAP server for a WebSphere Portal server.
Creating this memberOf field and re-configuring portal to take advantage of ii can reduce login time by a factor 20 and also improve performance on pages that heavily use groups for access control.