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

解決


なお  2004-05-07 01:20:34  No: 113020

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-07 01:27:47  No: 113021

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

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

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


特攻隊長まるるう  2004-05-07 22:53:14  No: 113022

[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 23:01:16  No: 113023

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


なお  2004-05-14 22:29:40  No: 113024

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

Dim Group   As IADsGroup
Dim A()     As Variant

A = Group.Get("memberOf")

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

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


※返信する前に利用規約をご確認ください。




  


  このエントリーをはてなブックマークに追加