S
Sub Initialize
'** Determine the groups that the current user is in, including
'** all nested groups
On Error Goto processError
Dim session As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim serverName As String
Dim userName As String
Dim groupList As Variant
serverName = "MyNABServer" ' сюда впиши сервер, на котором лежит names.nsf
userName = session.UserName ' сюда в принципе можно любого вписать :)
Set db = session.GetDatabase( serverName, "names.nsf" )
Set view = db.GetView( "Groups" )
'** create a text file for output
fileNum% = Freefile()
fileName$ = "C:\UserGroupInfo.txt"
Open fileName$ For Output As fileNum%
Print #fileNum%, "User Group Info for " & userName & " on " & serverName
Print #fileNum%, ""
'** get the group information
Call GetGroups( userName, view, "", 0, fileNum% )
'** close the file and exit
Close fileNum%
Exit Sub
processError:
Messagebox "Error " & Cstr(Err) & ": " & Error$
Reset
Exit Sub
End Sub
Function GetGroups (lookupName As String, groupView As NotesView, alreadyUsed As String, _
indentLevel As Integer, fileNum As Integer)
'** This sub will recursively iterate through all the groups in the NAB,
'** figuring out which ones the given user or group is in.
On Error Goto processError
Dim doc As NotesDocument
Dim memberItem As NotesItem
Dim groupName As String
Dim tabString As String
'** use tabString to indent the entry, indicating that a group is a
'** member of the group below it
For i% = 1 To indentLevel
tabString = tabString & Chr(9)
Next
'** step through the group documents in the NAB that we're looking at
Set doc = groupView.GetFirstDocument
Do While Not (doc Is Nothing)
Set memberItem = doc.GetFirstItem( "Members" )
groupName = doc.ListName(0)
'** Check for direct inclusion in a group. If the lookup name is
'** in the Members text list and we haven't already used the group
'** (if we did, it will be in the alreadyUsed string, and would
'** represent a circular reference), output the group name to our
'** file and recurse
If (memberItem.Contains( lookupName )) And (Instr(1, alreadyUsed, "~" & groupName & "~", 5) < 1) Then
Print #fileNum%, tabString & groupName
'** recursion will find other groups that this group is
'** a member of
Call GetGroups( groupName, groupView, alreadyUsed & "~" & groupName & "~", indentLevel + 1, fileNum )
End If
Set doc = groupView.GetNextDocument( doc )
Loop
Exit Function
processError:
Print #fileNum%, "Error " & Cstr(Err) & ": " & Error$
Exit Function
End Function
Sub Initialize
'** определить группы пользователя путем поиска в names.nsf
'** инфа по группам и их описаниям выводится в файл
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim db As NotesDatabase
Dim view As NotesView
Dim doc As NotesDocument
Dim userName As NotesName
Dim searchName As Variant
Dim groupList As Variant
Dim d As Long
Dim stream As NotesStream
searchName = ws.PickListStrings(PICKLIST_NAMES, False) ' тут можно и True поставить
' и тогда можно в цикле по нескольким юзерам собирать
'** если выбор есть - исчем, перебираем, собираем
If Not Isempty(searchName) Then
Set userName = session.CreateName(searchName(0))
searchName = userName.Common
Set db = session.GetDatabase( serverName, "names.nsf" ) ' serverName - константа с имененм сервера где лежит база
Set view = db.GetView( "Groups" )
d = view.FTSearch({[members]=} + searchName)
Set doc = view.GetFirstDocument
While Not doc Is Nothing
groupList = groupList + doc.ListName(0) + Chr(9) + doc.ListDescription(0) + Chr(13) ' можно и еще полей добавить
Set doc = view.GetNextDocument(doc)
Wend
End If
'** пишем в файл
Set stream = session.CreateStream
If stream.Open("C:\" + searchName + "_groups.txt") Then
Call stream.Truncate
Call stream.WriteText(groupList)
Call stream.Close
End If
End Sub
Взломай свой первый сервер и прокачай скилл — Начни игру на HackerLab