mbromb
asked on
vbscript change from parsing groups to OUs
I've got a vbscript (below) that parses AD groups. For each member it tries to ping, if successful it tries to connect to the WMI DB, if successful it quieries for NIC properties. It works very well, but I'm having trouble adapting it to look at an OU (and sub OUs) rather than a group.
Thanks!
-------------------------- ---------- ---------- ---------- ---------- ---------- ----
on error resume next
Const ForAppending = 8
Set objFSO = CreateObject("Scripting.Fi leSystemOb ject")
Set objTextFile = objFSO.OpenTextFile _
("D:\Data\Tools\Scripts\WM I-Reports\ Reports\Ad apterRepor t3-23-10.c sv", ForAppending, True)
Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connec tion")
Set objCommand = CreateObject("ADODB.Comman d")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCOmmand.ActiveConnectio n = objConnection
Set objGroup = GetObject _
("LDAP://CN=Comp-All,OU=Gr oups,DC=ou rdomain,DC =domain,DC =com")
strName = objGroup.Get("name")
arrMemberOf = objGroup.GetEx("member")
objTextFile.WriteLine "Date,Time,Hostname,MAC,IP ,Adapter,D river Version"
objTextFile.WriteLine Date & "," & TIME & VbCrLf
For Each strMember in arrMemberOf
strMember = Mid(strMember, 4, 330)
arrGroup = Split(strMember, "," )
Set objShell = CreateObject("WScript.Shel l")
Set objScriptExec = objShell.Exec( _
"ping -n 2 -w 500 " & arrgroup(0))
strPingResults = LCase(objScriptExec.StdOut .ReadAll)
If InStr(strPingResults, "reply from") Then
If InStr(strPingResults, "destination net unreachable") Then
objTextFile.Write vbcrlf & "," & TIME & "," & arrgroup(0) & "," & "NO RESPONSE"
Else
'objTextFile.Write vbcrlf & "," & TIME & "," & arrgroup(0) & "," & "RESPONDED"
Err.Clear
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=imper sonate}!\\ " & arrgroup(0) & "\root\cimv2")
If Err.Number <> 0 Then
objTextFile.Write vbcrlf & "," & TIME & "," & arrgroup(0) & "," & "WMI FAILED"
Else
Set colAdapters = objWMIService.ExecQuery _
("Select * from Win32_NetworkAdapterConfig uration Where IPEnabled = True and DHCPEnabled=False")
For Each objAdapter in colAdapters
If Not IsNull(objAdapter.IPAddres s) Then
For i = LBound(objAdapter.IPAddres s) To UBound(objAdapter.IPAddres s)
objTextFile.Write vbcrlf & "," & TIME & "," & arrgroup(0) & "," & objAdapter.MACAddress & "," & objAdapter.IPAddress(i) & "," & objAdapter.Description & "," & GetDriverVersion(objAdapte r.Descript ion)
'adapter = adapter & objAdapter.Description & vbCrLf & " MAC address: " & objAdapter.MACAddress & vbCrLf & " IP Address: " & objAdapter.IPAddress(i) & vbCrLf & " Driver Version: " & GetDriverVersion(objAdapte r.Descript ion) & vbCrLf & vbCrLf
Next
End If
Next
End If
End If
Else
objTextFile.Write vbcrlf & "," & TIME & "," & arrgroup(0) & "," & "NO PING RESPONSE"
End If
Next
objTextFile.WriteLine VBcrlf & Date & "," & TIME
objTextFile.Write VBcrlf
Function GetDriverVersion(myAdapter )
ON ERROR RESUME NEXT
Set colDrivers = objWMIService.ExecQuery _
("select * from Win32_PnPSignedDriver where DeviceClass='NET'")
For Each objDriver in colDrivers
If left(myAdapter,len(objDriv er.Descrip tion))=obj Driver.Des cription then
drv=objDriver.DriverVersio n
End If
Next
GetDriverVersion=drv
End Function
-------------------------- ---------- ---------- ---------- ---------- ---------- ----
Thanks!
--------------------------
on error resume next
Const ForAppending = 8
Set objFSO = CreateObject("Scripting.Fi
Set objTextFile = objFSO.OpenTextFile _
("D:\Data\Tools\Scripts\WM
Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connec
Set objCommand = CreateObject("ADODB.Comman
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCOmmand.ActiveConnectio
Set objGroup = GetObject _
("LDAP://CN=Comp-All,OU=Gr
strName = objGroup.Get("name")
arrMemberOf = objGroup.GetEx("member")
objTextFile.WriteLine "Date,Time,Hostname,MAC,IP
objTextFile.WriteLine Date & "," & TIME & VbCrLf
For Each strMember in arrMemberOf
strMember = Mid(strMember, 4, 330)
arrGroup = Split(strMember, "," )
Set objShell = CreateObject("WScript.Shel
Set objScriptExec = objShell.Exec( _
"ping -n 2 -w 500 " & arrgroup(0))
strPingResults = LCase(objScriptExec.StdOut
If InStr(strPingResults, "reply from") Then
If InStr(strPingResults, "destination net unreachable") Then
objTextFile.Write vbcrlf & "," & TIME & "," & arrgroup(0) & "," & "NO RESPONSE"
Else
'objTextFile.Write vbcrlf & "," & TIME & "," & arrgroup(0) & "," & "RESPONDED"
Err.Clear
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=imper
If Err.Number <> 0 Then
objTextFile.Write vbcrlf & "," & TIME & "," & arrgroup(0) & "," & "WMI FAILED"
Else
Set colAdapters = objWMIService.ExecQuery _
("Select * from Win32_NetworkAdapterConfig
For Each objAdapter in colAdapters
If Not IsNull(objAdapter.IPAddres
For i = LBound(objAdapter.IPAddres
objTextFile.Write vbcrlf & "," & TIME & "," & arrgroup(0) & "," & objAdapter.MACAddress & "," & objAdapter.IPAddress(i) & "," & objAdapter.Description & "," & GetDriverVersion(objAdapte
'adapter = adapter & objAdapter.Description & vbCrLf & " MAC address: " & objAdapter.MACAddress & vbCrLf & " IP Address: " & objAdapter.IPAddress(i) & vbCrLf & " Driver Version: " & GetDriverVersion(objAdapte
Next
End If
Next
End If
End If
Else
objTextFile.Write vbcrlf & "," & TIME & "," & arrgroup(0) & "," & "NO PING RESPONSE"
End If
Next
objTextFile.WriteLine VBcrlf & Date & "," & TIME
objTextFile.Write VBcrlf
Function GetDriverVersion(myAdapter
ON ERROR RESUME NEXT
Set colDrivers = objWMIService.ExecQuery _
("select * from Win32_PnPSignedDriver where DeviceClass='NET'")
For Each objDriver in colDrivers
If left(myAdapter,len(objDriv
drv=objDriver.DriverVersio
End If
Next
GetDriverVersion=drv
End Function
--------------------------
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER