'*** 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 )