'*** 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 ) '*** v13.1 *** www.dieseyer.de ****************************** Function PCimAD( AD, PCname ) '*********************************************************** ' On Error Resume Next PCName = UCase( PCName ) AD = UCase( AD ) ' Trace32Log "223 :: Function PCimAD( " & AD & ", " & PCname & " )", 1 Dim objConnection, objCommand, objRecordSet, errTst ' Trace32Log "227 :: Function PCimAD( " & AD & ", " & PCname & " )", 1 On Error Resume Next Set objCommand = CreateObject("ADODB.Command") errTst = err.Number & " - " & err.Description On Error GoTo 0 If Len( errTst ) > 4 Then PCimAD = "Fehler: 'ADODB.Command' nicht ansprechbar - " & errTst ' Trace32Log "235 :: " & PCimAD, 3 Exit Function Else ' Trace32Log "238 :: 'ADODB.Command' ansprechbar.", 1 End If On Error Resume Next Set objConnection = CreateObject("ADODB.Connection") errTst = err.Number & " - " & err.Description On Error GoTo 0 If Len( errTst ) > 4 Then PCimAD = "Fehler: 'ADODB.Command' nicht ansprechbar - " & errTst ' Trace32Log "247 :: " & PCimAD, 3 Exit Function Else ' Trace32Log "250 :: 'ADODB.Command' ansprechbar.", 1 End If On Error Resume Next objConnection.Provider = "ADsDSOObject" errTst = err.Number & " - " & err.Description On Error GoTo 0 If Len( errTst ) > 4 Then PCimAD = "Fehler: 'objConnection.Provider' nicht ansprechbar - " & errTst ' Trace32Log "260 :: " & PCimAD, 3 Exit Function Else ' Trace32Log "263 :: 'objConnection.Provider' ansprechbar.", 1 End If On Error Resume Next objConnection.Open "Active Directory Provider" errTst = err.Number & " - " & err.Description On Error GoTo 0 If Len( errTst ) > 4 Then PCimAD = "Fehler: 'objConnection.Open' nicht ansprechbar - " & errTst ' Trace32Log "272 :: " & PCimAD, 3 Exit Function Else ' Trace32Log "275 :: 'objConnection.Open' ansprechbar.", 1 End If On Error Resume Next Set objCommand.ActiveConnection = objConnection errTst = err.Number & " - " & err.Description On Error GoTo 0 If Len( errTst ) > 4 Then PCimAD = "Fehler: 'objCommand.ActiveConnection' nicht ansprechbar - " & errTst ' Trace32Log "284 :: " & PCimAD, 3 Exit Function Else ' Trace32Log "287 :: 'oobjCommand.ActiveConnection' ansprechbar.", 1 End If objCommand.Properties( "Page Size" ) = 1000 objCommand.Properties( "Searchscope" ) = 2 ' Const ADS_SCOPE_SUBTREE = 2 objCommand.Properties( "Timeout" ) = 30 objCommand.Properties( "Cache Results" ) = False objCommand.CommandText = "SELECT distinguishedName FROM '" & AD & "' WHERE objectClass='Computer' AND Name='" & PCname & "'" objCommand.CommandText = "SELECT distinguishedName FROM '" & AD & "' WHERE Name='" & PCname & "'" objCommand.CommandText = "SELECT distinguishedName FROM '" & AD & "' WHERE sAMAccountName='" & PCname & "'" objCommand.CommandText = "SELECT distinguishedName FROM '" & AD & "' WHERE sAMAccountName='" & PCname & "' OR Name='" & PCname & "'" On Error Resume Next Set objRecordSet = objCommand.Execute errTst = err.Number & " - " & err.Description On Error GoTo 0 If Len( errTst ) > 4 Then If InStr( errTst, "2147217865" ) > 1 Then errTst = errTst & " (Typischer Fehler beim Remote-Ausführen unter Win x64.)" ' Trace32Log "303 :: " & objCommand.CommandText, 1 PCimAD = "Fehler: 'objCommand.Execute' nicht ansprechbar - " & errTst ' Trace32Log "305 :: " & PCimAD, 3 Exit Function Else ' Trace32Log "308 :: 'distinguishedName' ansprechbar.", 1 End If PCimAD = PCname & " ist nicht im AD vorhanden." On Error Resume Next PCimAD = objRecordSet.Fields("distinguishedName").Value errTst = err.Number & " - " & err.Description On Error GoTo 0 If Len( errTst ) > 4 Then PCimAD = "Fehler: 'distinguishedName' nicht ansprechbar - " & errTst ' Trace32Log "319 :: " & PCimAD, 3 Else ' Trace32Log "321 :: 'distinguishedName' ansprechbar.", 1 End If ' MsgBox "i = " & i & vbCRLF & "n = " & n & vbCRLF & "Dauer: " & Timer() - StartZeit & vbCRLF & objRecordSet.Fields("distinguishedName").Value , , "324 :: " ' : WScript.Quit Set objRecordSet = nothing Set objCommand.ActiveConnection = nothing Set objCommand = nothing objConnection.Close Set objConnection = nothing End Function ' PCimAD( AD, PCname )