Takenoff Labs

@UserNamesList はとっても便利な関数ですが、ログインしているユーザーしか対象にできないという難点があります。他のユーザーの権限を確認したい場合は、ACLの「有効なアクセス権」機能で確認はできるものの、リスト欄が小さくて見づらかったり、リストを書き出すことができなかったりと、ちょっと不便なところがあります。

今回、これらの問題を解消すべく、@UserNamesList と同じ（と思われる）値を返す LotusScript の処理を作ってみました。ログインしているユーザー以外のユーザーも対象にできますので、参考にしてみてください。

UserNamesList 関数

ソースコード

Function UserNamesList(dbTgt As NotesDatabase, Byval strId As String) As Variant
    Dim dbNab As New NotesDatabase("", "")
    Dim vwNab As NotesView
    Dim nm    As NotesName
    
    Dim varRetAry   As Variant
    Dim varRoleAry  As Variant
    Dim strRetAry() As String
    
    UserNamesList = varRetAry
    
    'エラーチェック
    If dbTgt Is Nothing Then
        Exit Function
    End If
    If dbTgt.Server = "" Then
        Exit Function
    End If
    If dbNab.Open(dbTgt.Server, "names.nsf") = False Then
        Exit Function
    End If
    
    'ビュー取得
    Set vwNab = dbNab.GetView("($ServerAccess)")
    
    '基準書式で検索
    Set nm = New NotesName(strId)
    strId = nm.Canonical
    Call GetGroupList(vwNab, strId, strRetAry)
    
    'OU～Cまで検索
    Do Until Instr(strId, "/") = 0
        strId = "*/" & Strright(strId, "/")
        Call GetGroupList(vwNab, strId, strRetAry)
        strId = Strright(strId, "/")
    Loop
    
    '*で検索
    Call GetGroupList(vwNab, "*", strRetAry)
    
    'CNで検索
    Call GetGroupList(vwNab, nm.Common, strRetAry)
    
    'ソートなど
    varRetAry = Arrayunique(strRetAry) '念のため
    varRetAry = ArySort(varRetAry) 'ソートが必要なければ、この行は不要
    
    'ロールがあれば追加
    varRoleAry = dbTgt.QueryAccessRoles(nm.Canonical)
    If varRoleAry(0) <> "" Then
        varRetAry = Arrayappend(varRetAry, varRoleAry)
    End If
    
    UserNamesList = varRetAry
End Function

Sub GetGroupList(vwDir As NotesView, Byval strKey As String, strRetAry() As String)
    Dim nav    As NotesViewNavigator
    Dim entry  As NotesViewEntry
    Dim strVal As String
    
    Call AryPush(strRetAry, strKey)
    
    Set nav = vwDir.CreateViewNavFromCategory(Lcase(strKey))
    If nav.Count > 0 Then
        Set entry = nav.GetFirst()
        Do Until entry Is Nothing
            strVal = Cstr(entry.ColumnValues(1))
            If Isnull(Arraygetindex(strRetAry, strVal)) = True Then
                Call AryPush(strRetAry, strVal)
                Call GetGroupList(vwDir, strVal, strRetAry) '再帰
            End If
            Set entry = nav.GetNext(entry)
        Loop
    End If
End Sub

Sub AryPush(varAry As Variant, varVal As Variant)
    Dim intMax As Integer
    
    If Isarray(varAry) = False Then
        Exit Sub
    End If
    
    On Error Goto ERR_INIT
    intMax = Ubound(varAry) + 1
    On Error Goto 0
    
    Redim Preserve varAry(intMax)
    varAry(intMax) = varVal
    Exit Sub
    
ERR_INIT:
    intMax = 0
    Redim varAry(0)
    Resume Next
End Sub

Function ArySort(varAry As Variant) As Variant
    Const COMBGAP = 1.3
    
    Dim varRetAry As Variant
    Dim varTmp    As Variant
    Dim lngMin    As Long
    Dim lngMax    As Long
    Dim i         As Long
    Dim j         As Long
    Dim lngGap    As Long
    Dim blnEnd    As Boolean
    
    varRetAry = varAry
    
    lngMin = Lbound(varRetAry)
    lngMax = Ubound(varRetAry)
    
    lngGap = lngMax - lngMin
    
    blnEnd = False
    
    Do While lngGap > 1 Or blnEnd = False
        lngGap = Int(lngGap / COMBGAP)
        
        If lngGap = 9 Or lngGap = 10 Then lngGap = 11
        
        If lngGap < 1 Then lngGap = 1
        
        blnEnd = True
        For i = lngMin To lngMax - lngGap
            j = i + lngGap
            If varRetAry(i) > varRetAry(j) Then
                varTmp = varRetAry(i)
                varRetAry(i) = varRetAry(j)
                varRetAry(j) = varTmp
                blnEnd = False
            End If
        Next
    Loop
    
    ArySort = varRetAry
End Function

例文

v = UserNamesList(db, "Test01 User/TEST")
If Isempty(v) Then
    Msgbox ""
Else
    Msgbox Join(v, Chr(10))
End If

使用上の注意事項

• この関数の処理は @UserNamesList をシミュレートしますが、あくまで管理人が @UserNamesList の処理を推測して作ったものであり、100% 同じ結果になるかどうかは保証いたしかねます。
• @UserNamesList はキャッシュ機能があるためローカルでも動作させることは可能ですが、この関数ではそのようなことはできないので、調査対象のDBがローカルの場合、Emptyを返します。
• グループが多い環境では、ユーザーが所属するグループの数に比例して、処理速度が遅くなります。グループが多い環境では、権限チェックなどに使わないでください。（どうしても使いたい場合は、結果をどこかにキャッシュしておくなど、工夫してみてください。）
• グループのメンバに共通名や「*」などを使わない規約がある場合は、これらの処理を削除すると速度が多少速くなります。また、ロールが必要ない場合は、引数の dbTgt は要らないです。パフォーマンスが最適になるよう、適当に改変してみてください。

• 検証バージョン: R6.5.4

(No Ratings Yet)

読み込み中...

トラックバックURL :