Ответ:
Следующая функция позволяет получить список общего и канонического имен пользователя, общих имен всех подразделений, организации и страны пользователя,
плюс в рамках текущего сервера - всех его групп,
плюс в рамках текущей базы данных - список всех ролей, которые пользователю назначены индивидуально или через группы (для получения ролей флаг b_include_roles установить в True)
Проверяется соответствие спискам "Access Server" и "Not Access Server"
Примечание: Код не тестировался для Web
[codebox]
Function get_names_list(Byval s_user$,
Byval b_include_roles As Boolean) As Variant
' Created by Elena Nefedova, Fors-Banking Systems
On Error Goto ErrLab
Dim FR As Variant, ar_org As Variant
Dim s_country$
' получение объекта NotesName
+ всех шаблонов подразделений, шаблона организации и общего шаблона:
*/DEPARTMENT01/FORS; */FORS; *
Redim FR(1)
Dim nnm As New NotesName(s_user)
FR(0) = nnm.Canonical
FR(1) = nnm.Common
Redim ar_org(20) ' возьмем побольше
ar_org(0) = "*"
s_country = nnm.Country
If s_country <> "" Then
s_country = "/C=" + s_country
ar_org(1) = "*" + s_country
End If
ar_org(2) = "*/O=" + nnm.Organization + s_country
If nnm.OrgUnit1 <> "" Then ar_org(3) =
"*/OU=" + nnm.OrgUnit1 + "/O=" + nnm.Organization + s_country
If nnm.OrgUnit2 <> "" Then ar_org(4) =
"*/OU=" + nnm.OrgUnit2 + "/OU=" + nnm.OrgUnit1 + "/O=" + nnm.Organization + s_country
If nnm.OrgUnit3 <> "" Then ar_org(5) =
"*/OU=" + nnm.OrgUnit3 + "/OU=" + nnm.OrgUnit2 + "/OU=" + nnm.OrgUnit1 + "/O=" + nnm.Organization + s_country
If nnm.OrgUnit4 <> "" Then ar_org(6) =
"*/OU=" + nnm.OrgUnit4 + "/OU=
" + nnm.OrgUnit3 + "/OU=" + nnm.OrgUnit2 + "/OU=" + nnm.OrgUnit1 + "/O=" + nnm.Organization + s_country
ar_org = Fulltrim(ar_org) ' массив хранит все иерархические организационные уровни
FR = Arrayunique(Arrayappend(FR, ar_org))
' Получение текущей директории Domino
Dim sess As New NotesSession, curdb As NotesDatabase, doc As NotesDocument
Set curdb = sess.CurrentDatabase
Dim s_server$, s_filename$
If sess.IsOnServer Then
s_server = curdb.Server
Else
Dim v_server As Variant
Set doc = New NotesDocument(curdb)
v_server = Evaluate({@MailDbName}, doc)
s_server = v_server(0)
End If
s_filename = "names.nsf"
Dim dbnames As NotesDatabase, view As NotesView, grcol As NotesDocumentCollection
Dim gr%, s_gr$, ar_group As Variant
Set dbnames = New NotesDatabase(s_server, s_filename)
If Not dbnames.IsOpen Then Call dbnames.Open("", "")
If dbnames.IsOpen Then
' получение всех групп пользователя в данной директории домино
Set view = dbnames.GetView("($ServerAccess)")
If view Is Nothing Then
Goto Result_Lab ' результат - только организация и подразделения
Set grcol = view.GetAllDocumentsByKey(Lcase(s_user))
Redim ar_group(0)
For gr = grcol.Count To 1 Step -1
Set doc = grcol.GetNthDocument(gr)
If Not (doc Is Nothing) Then
ar_group = Arrayappend(ar_group, doc.GetItemValue("ListName"))
End If
Next gr
ar_group = Arrayunique(Fulltrim(ar_group))
'НЕ ИСКЛЮЧЕН ЛИ ПОЛЬЗОВАТЕЛЬ ИЛИ ГРУППА ИЗ ДОСТУПА К СЕРВЕРУ ???
Set view = dbnames.GetView("($Servers)")
If view Is Nothing Then Goto Result_Lab
' результат - только организация и подразделения (не рассмотрены ограничения доступа к текущему серверу)
Set doc = view.GetDocumentByKey(s_server, True)
If doc Is Nothing Then Goto Result_Lab ' результат - только организация и подразделения
' Пользователь ИЛИ его группа должны быть явно включены в поле AllowAccess ЛИБО это поле должно быть пустым
Dim v_0 As Variant, v_1 As Variant, v_2 As Variant, v_3 As Variant
v_0 = Arrayappend(FR, ar_group) ' временно для сравнений - список имен/групп пользователя
v_1 = doc.AllowAccess
If Not Isarray(v_1) Then Redim v_1(0)
If v_1(0) <> "" Then
v_2 = Fulltrim(Arrayreplace(v_0, v_1, ""))
' список имен/групп пользователя, не вошедших в список доступа к серверу
v_3 = Fulltrim(Arrayreplace(v_0, v_2, ""))
' пересечение списка доступа к серверу и списка имен/групп пользователя
If v_3(0) = "" Then
Redim FR(0)
Goto Result_Lab ' Выходим с пустым списком имен, так как пользователь не имеет доступа к серверу
End If
End If
' Пользователь И все его группы должны отсутствовать в поле DenyAccess
v_1 = doc.DenyAccess
If Not Isarray(v_1) Then Redim v_1(0)
v_2 = Fulltrim(Arrayreplace(v_0, v_1, "")) ' список имен/групп пользователя, не вошедших в список запрета доступа к серверу
v_3 = Fulltrim(Arrayreplace(v_0, v_2, "")) ' пересечение списка запрета доступа к серверу и списка имен/групп пользователя
If v_3(0) <> "" Then ' пользователю s_user запрещен доступ к серверу явно или через группу!!
Redim FR(0)
Goto Result_Lab ' Выходим с пустым списком имен, так как пользователь не имеет доступа к серверу
End If
Erase FR
FR = v_0 ' Чтоб дважды не рассчитывать
End If
' получение всех ролей данного пользователя или его групп в рамках текущей базы
Dim cur_acl As NotesACL, aclentry As NotesACLEntry, ar_entry As Variant
Dim n_type%, m%
Dim ar_roles As Variant
Set view = dbnames.GetView("($Users)")
If view Is Nothing Then Goto Result_Lab
Set grcol = view.GetAllDocumentsByKey(Lcase(s_user))
If grcol.Count = 0 Then
n_type = -1 ' это Anonymous
Redim FR(0) ' следовательно, он не принадлежит ни к подразделениям, ни к группам
Else
n_type = 0 ' начнем последовательно искать имена пользователя в ACL
End If
If b_include_roles Then ' анализируем ACL, если включен флаг
Set cur_acl = curdb.ACL
Do While n_type < 4
Select Case n_type
Case -1 ' Anonymous
ar_entry = Split("Anonymous", ";")
Case 0 'canonical
ar_entry = Split(nnm.Canonical, ";")
Case 1 ' common
ar_entry = Split(nnm.Common, ";")
Case 2 ' все группы (объединенный доступ); группа "*" не встречается самостоятельно в ACL, вместо нее добавляется пользователь -Default- (см. далее)
ar_entry = Arrayappend(ar_org, ar_group)
Case 3 ' -Default-
ar_entry = Split("-Default-", ";")
Case Else
Exit Do
End Select
Redim ar_roles(0)
For m = Ubound(ar_entry) To 0 Step -1
Set aclentry = cur_acl.GetEntry(ar_entry(m))
If Not aclentry Is Nothing Then
n_type = 99 ' признак того, что в ACL найдена соотв. запись
ar_roles = Arrayappend(ar_roles, aclentry.Roles )
End If
Next m
If n_type = 99 Then
ar_roles = Arrayunique(Fulltrim(ar_roles))
FR = Arrayappend(FR, ar_roles)
End If
If n_type = -1 Then
n_type = 77 ' чтобы выйти после обработки Anonymous
Else
n_type = n_type + 1
End If
Loop
End If
Result_Lab:
' результат
get_names_list = Fulltrim(FR)
' КОНЕЦ ПОДПРОГРАММЫ
EndLab:
Exit Function
ErrLab:
On Error Resume Next
Goto EndLab ' вернется пустое значение Variant (не массив)
End Function[/codebox]
PS: Спасибо Oshmianski за помощь в тестировании
29.12.06 PPS: Дополнительное спасибо Oshmianski за замеченную в коде помарку
09.12.07 : Уточнен расчет доступа к текущему серверу