Expanding a Names List
Category Show-n-Tell Thursday LotusScriptHere is an old helper function I've had laying about in my toolkit for a while. It gets the unique members of a list of names or groups. Anyway, here is the code:
'/**
' * function expandNamesList
' * @author: Devin S. Olson
' * @licence: Apache License, Version 2.0
' **/
' * function expandNamesList
' * @author: Devin S. Olson
' * @licence: Apache License, Version 2.0
' **/
%REM
Function expandNamesList
Gets the unique members for a list of names and groups.
Conditionally recurses to get all individual members of all sub-groups.
@param directory: Source Address Book database within which to search for groups.
@param source: String or Array of Strings containing the members to expand.
@return Variant: Array of Strings containing the expanded unique members of source. Empty String ("") on error.
%END REM
Gets the unique members for a list of names and groups.
Conditionally recurses to get all individual members of all sub-groups.
@param directory: Source Address Book database within which to search for groups.
@param source: String or Array of Strings containing the members to expand.
@return Variant: Array of Strings containing the expanded unique members of source. Empty String ("") on error.
Dim extendedInfo As String
Dim result As Variant
On Error GoTo ErrorTrap
Const VIEWNAME = |($VIMGroups)|
Static cachedb As NotesDatabase
Static groupsview As NotesView
Static recursions As Integer
Dim nvent As NotesViewEntry
Dim group As NotesDocument
Dim nongroupnames List As String
Dim subgroupmembers List As Variant
Dim subgroupnongroupnames List As Variant
Dim workingset As Variant
Dim membername As String
Dim sourcetype As String
Dim tag As String
Dim idx As Integer
Dim isRecursive As Boolean
isRecursive = (GetThreadInfo(LIB_LSI_THREAD_PROC) = GetThreadInfo(LIB_LSI_THREAD_CALLPROC))
If isRecursive Then incValue recursions%, 1
If (directory Is Nothing) Then Error ERR_PARAMETER_BLANK,MSG_PARAMETER_BLANK
sourcetype$ = TypeName(source)
extendedInfo$ = |Source Type: | & sourcetype$
Select Case sourcetype$
End Select ' Case sourcetype$
If (cachedb Is Nothing) Then
If (groupsview Is Nothing) Then
If IsScalar(workingset) Then workingset = toArray(workingset)
For idx% = LBound(workingset) To UBound(workingset)
' recursively expand all subgroups
ForAll subgroup In subgroupmembers
' combine all the sub group members
ForAll subgroupnames In subgroupnongroupnames
result = atUnique(StringListToStringArray(nongroupnames))
ExitPoint:
ErrorTrap:
Dim result As Variant
On Error GoTo ErrorTrap
Const VIEWNAME = |($VIMGroups)|
Static cachedb As NotesDatabase
Static groupsview As NotesView
Static recursions As Integer
Dim nvent As NotesViewEntry
Dim group As NotesDocument
Dim nongroupnames List As String
Dim subgroupmembers List As Variant
Dim subgroupnongroupnames List As Variant
Dim workingset As Variant
Dim membername As String
Dim sourcetype As String
Dim tag As String
Dim idx As Integer
Dim isRecursive As Boolean
isRecursive = (GetThreadInfo(LIB_LSI_THREAD_PROC) = GetThreadInfo(LIB_LSI_THREAD_CALLPROC))
If isRecursive Then incValue recursions%, 1
If (directory Is Nothing) Then Error ERR_PARAMETER_BLANK,MSG_PARAMETER_BLANK
sourcetype$ = TypeName(source)
extendedInfo$ = |Source Type: | & sourcetype$
Select Case sourcetype$
Case "STRING", "STRING LIST", "STRING( )"
Case "STRINGLIST"
Case Else
workingset = toArray(source)
If (Not isArrayEmpty(workingset)) Then
If (Not isArrayEmpty(workingset)) Then
workingset = atUnique(workingset)
End If
Case "STRINGLIST"
workingset = toArray(source.content)
If (Not isArrayEmpty(workingset)) Then
If (Not isArrayEmpty(workingset)) Then
workingset = atUnique(workingset)
End If
Case Else
Error ERR_PARAMETER_INVALID,MSG_PARAMETER_INVALID
End Select ' Case sourcetype$
If (cachedb Is Nothing) Then
Set cachedb = directory
Set groupsview = Nothing
ElseIf (getDatabaseKey(cachedb) <> getDatabaseKey(directory)) Then
Set groupsview = Nothing
Set cachedb = directory
Set groupsview = Nothing
End If ' (cachedb Is Nothing)
Set groupsview = Nothing
If (groupsview Is Nothing) Then
extendedInfo$ = |View: | & VIEWNAME
Set groupsview = cachedb.GetView(VIEWNAME)
If (groupsview Is Nothing) Then Error ERR_MISSING_VIEW,MSG_MISSING_VIEW
End If ' groupsview Is Nothing
Set groupsview = cachedb.GetView(VIEWNAME)
If (groupsview Is Nothing) Then Error ERR_MISSING_VIEW,MSG_MISSING_VIEW
If IsScalar(workingset) Then workingset = toArray(workingset)
For idx% = LBound(workingset) To UBound(workingset)
extendedInfo$ = |Idx: | & CStr(idx%)
membername$ = Trim$(workingset(idx%))
extendedInfo$ = extendedInfo$ & Chr(10) & |Member Name: | & membername$
tag$ = UCase$(membername$)
If (Len(membername$) > 0) Then
Next idx%
membername$ = Trim$(workingset(idx%))
extendedInfo$ = extendedInfo$ & Chr(10) & |Member Name: | & membername$
tag$ = UCase$(membername$)
If (Len(membername$) > 0) Then
If (Len IsElement(nongroupnames(tag$))) Then
End If ' (Len(membername$) > 0)
If (Len IsElement(subgroupmembers(tag$))) Then
End If ' (IsElement(nongroupnames(tag$)))
Set nvent = groupsview.GetEntryByKey(membername$, True)
If (nvent Is Nothing) Then
Else
End If ' (IsElement(subgroupmembers(tag$)))
If (nvent Is Nothing) Then
' membername is NOT a group
nongroupnames(tag$) = membername$
nongroupnames(tag$) = membername$
Else
' membername IS a group
Set group = nvent.Document
subgroupmembers(tag$) = getDocItemValue(group, "Members")
End If ' (nvent Is Nothing)
Set group = nvent.Document
subgroupmembers(tag$) = getDocItemValue(group, "Members")
' recursively expand all subgroups
ForAll subgroup In subgroupmembers
tag$ = ListTag(subgroup)
subgroupnongroupnames(tag$) = expandNamesList(directory, subgroup)
End Forall ' subgroup In subgroupmembers
subgroupnongroupnames(tag$) = expandNamesList(directory, subgroup)
' combine all the sub group members
ForAll subgroupnames In subgroupnongroupnames
If IsScalar(subgroupnames) Then
Else
End Forall ' subgroupnames In subgroupnongroupnames
membername$ = Trim$(CStr(subgroupnames))
If (Len(membername$) > 0) Then nongroupnames(UCase$(membername$)) = membername$
If (Len(membername$) > 0) Then nongroupnames(UCase$(membername$)) = membername$
Else
ForAll element In subgroupnames
End If ' IsScalar(subgroupnames)
membername$ = Trim$(CStr(element))
If (Len(membername$) > 0) Then nongroupnames(UCase$(membername$)) = membername$
End Forall ' element In subgroupnames
If (Len(membername$) > 0) Then nongroupnames(UCase$(membername$)) = membername$
result = atUnique(StringListToStringArray(nongroupnames))
ExitPoint:
If isRecursive Then incValue recursions%, -1
expandNamesList = result
Exit Function
expandNamesList = result
Exit Function
ErrorTrap:
On Error GoTo 0
If isRecursive Then extendedInfo$ = extendedInfo$ & Chr(10) & |Recursion Level: | & Format(recursions%, FORMAT_WHOLE_THOUSANDS)
enhLogException LIB_PREFIX, extendedInfo$
result = ""
Resume ExitPoint
If isRecursive Then extendedInfo$ = extendedInfo$ & Chr(10) & |Recursion Level: | & Format(recursions%, FORMAT_WHOLE_THOUSANDS)
enhLogException LIB_PREFIX, extendedInfo$
result = ""
Resume ExitPoint
End Function ' expandNamesList
Hope this helps!
-Devin
The Pridelands
Chris Byrne
Show n' Tell Thursdays
Maddox
Comments
If (Len IsElement(nongroupnames(tag$))) Then
If (Len IsElement(subgroupmembers(tag$))) Then
There seem to be some extra )'s...
Also some CONST's seem to be missing, the one's in red capitals in the code.
Fred
Posted by Fred Janssen At 10:20:01 AM On 10/20/2012 | - Website - |
Just in case you need and for posterity sake I have a Java version of this on XSnippets...
{ Link }
Posted by Toby Samples At 09:06:59 PM On 10/20/2012 | - Website - |
@Toby - thanks, that will be helpful for Java development.
Although I still believe there is a TON of LotusScript development still being done -much of which will remain for a very long time -simply because it is cheaper to maintain working code than to redevelop / redesign using a new architecture / language.
Posted by Devin Olson At 09:55:47 AM On 10/22/2012 | - Website - |