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