[VB]Active Directoryで,ユーザよりグループを取得し、さらにそのグループのグループを取得するには？

解決

なお 2004-05-06 16:20:34 No: 113020 IP: [192.*.*.*]

Dim sUsrLDAP        As String
Dim User            As IADsUser
Dim Group           As IADsGroup

    sUsrLDAP = "LDAP://DOMAIN/CN=テストユーザ,OU=ユーザ,DC=DOMAIN,DC=com"

    Set User = GetObject(sUsrLDAP)

    For Each Group In User.Groups
        Debug.Print Group.Name

    Next

編集削除

なお 2004-05-06 16:27:47 No: 113021 IP: [192.*.*.*]

すいません。書き込みの途中で送信してしまいました。

改めまして、上記のようにユーザオブジェクトよりそのユーザの属するグループは取得できるのですが、さらにそのグループが属するグループを取得したいのですが、やり方がわかりません。よろしくお願いいたします。

感覚的には For Each の中でグループオブジェクト（Group）からグループを取得できそうなんですが・・・。

編集削除

特攻隊長まるるう 2004-05-07 13:53:14 No: 113022 IP: [192.*.*.*]

[VB.NET]では DirectoryServices を使って同様のドメイン検索を実現してた
ですが、VB6.0 では初めて作ったので十分動作確認して下さいね？
かなり適当な部分がありますので…。

[VB6.0]
Option Explicit

Private Const Star As String = "*"
Private Const LayerMax As Integer = 10
Private Const LdapTop As String = "LDAP://DOMAIN/"

Private Sub Command1_Click()
    Dim sUsrLDAP        As String
    Dim User            As IADsUser
    Dim Group           As IADsGroup

    sUsrLDAP = LdapTop & "CN=テストユーザ,OU=ユーザ,DC=DOMAIN,DC=com"

    Set User = GetObject(sUsrLDAP)

    Debug.Print "****************************************"
    Debug.Print Now
    For Each Group In User.Groups
        Debug.Print ""
        Debug.Print "* " & Group.Name
        Call memberOfSearch(Group.ADsPath, 2)
    Next
    Debug.Print "****************************************"

End Sub

Private Function memberOfSearch(ByVal LDAP As String, ByVal Layer As Integer) As Boolean
    Dim User       As IADs
    Dim wStars     As String
    Dim wStringX   As String
    If Layer > LayerMax Then Exit Function
    wStars = MakeStars(Layer)
    On Error GoTo ErrTrap

    Set User = GetObject(LDAP)
    wStringX = User.memberOf

    If Len(wStringX) = 0 Then Exit Function

    Debug.Print wStars & " " & wStringX
    If Not StartsWith(wStringX, LdapTop) Then
        wStringX = LdapTop & wStringX
    End If

    Call memberOfSearch(wStringX, Layer + 1)

ErrTrap:
    Debug.Print Err.Description
End Function

Private Function MakeStars(ByVal Length As Integer) As String
    Dim i As Integer
    Dim wStringX As String
    For i = 1 To Length
        wStringX = wStringX & Star
    Next
    MakeStars = wStringX
End Function

Private Function StartsWith(ByVal StringX As String, ByVal SeekString As String) As Boolean
    Dim wAns As Integer

    wAns = StrComp(Mid(StringX, 1, Len(SeekString)), SeekString)
    If wAns = 0 Then
        StartsWith = True
    Else
        StartsWith = False
    End If

End Function

編集削除

特攻隊長まるるう 2004-05-07 14:01:16 No: 113023 IP: [192.*.*.*]

あ、
ErrTrap:
の前の Exit Function を入れ忘れてます(汗)。

編集削除

なお 2004-05-14 13:29:40 No: 113024 IP: [192.*.*.*]

memberOfSearch関数内の
wStringX = User.memberOf
で、エラーになってしまいました。
そこの個所でいろいろ試しているうちに

Dim Group As IADsGroup
Dim A() As Variant

A = Group.Get("memberOf")

でグループのアドレスを取得した後のGetObjectでGroupオブジェクトを継承することにより実現できました。

ご協力ありがとうございました。

編集削除