http://dieseyer.de • all rights reserved • © 2011 v11.4

'*** v8.2 *** www.dieseyer.de *******************************
'
' Datei: MemberOfADGroup.vbs
' Autor: dieseyer@gmx.de
' Auf: www.dieseyer.de
'
' Microsoft: The Portable Script Center - v3.0, Nov. 2004
' "List the Active Directory Groups a User Belongs To"
'
'************************************************************

Option Explicit ' Siehe http://dieseyer.de/dse-wsh-lernen.html#OptionExpl

Dim Tst

Dim AD
AD = "LDAP://ou=HR,dc=NA,dc=fabrikam,dc=com"
AD = "LDAP://dc=fabrikam,dc=com"

Tst = "pc-dieseyer"
Tst = "LDAP://" & PCimAD( AD, Tst )
MsgBox Tst, , "16 :: "
Tst = MemberOfGroup( Tst )
MsgBox Tst, , "18 :: "

Wscript.Quit


'*** v8.2 *** www.dieseyer.de ****************************
Function MemberOfGroup( PCObjAD )
'*********************************************************
' On Error Resume Next
Dim objUser, intPrimaryGroupID, arrMemberOf, Group
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D

Set objUser = GetObject ( PCObjAD )

intPrimaryGroupID = objUser.Get( "primaryGroupID" )

arrMemberOf = objUser.GetEx("memberOf")

If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
MemberOfGroup = ""
Else
For Each Group in arrMemberOf
MemberOfGroup = Group
Next
End If

' MemberOfGroup = Replace( MemberOfGroup, ",", vbCRLF )
' MsgBox MemberOfGroup, , "45 :: "

End Function ' MemberOfGroup( PCObjAD )



'*** v8.2 *** www.dieseyer.de ****************************
Function PCimAD( AD, PCname )
'*********************************************************
' On Error Resume Next

Const ADS_SCOPE_SUBTREE = 2
Dim objConnection, objCommand, objRecordSet
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

objCommand.CommandText = "SELECT distinguishedName FROM '" & AD & "' WHERE objectCategory='Computer' AND Name='" & PCname & "'"
Set objRecordSet = objCommand.Execute

PCimAD = PCname & " ist nicht im AD vorhanden."
On Error Resume Next
PCimAD = objRecordSet.Fields("distinguishedName").Value
On Error GoTo 0
' MsgBox "i = " & i & vbCRLF & "n = " & n & vbCRLF & "Dauer: " & Timer() - StartZeit & vbCRLF & objRecordSet.Fields("distinguishedName").Value , , "76 :: " ' : WScript.Quit

Set objRecordSet = nothing
Set objCommand.ActiveConnection = nothing
Set objCommand = nothing
objConnection.Close
Set objConnection = nothing

End Function ' PCimAD( AD, PCname )


http://dieseyer.de • all rights reserved • © 2011 v11.4