Dim var1
Dim var2
Dim strComputer
Dim dicCompOS
'on error resume next
Set dicCompOS = CreateObject("Scripting.Dictionary")
GetOSs() '# Load Dictionary with all Domain Computers' Operating Systems
Set fso = CreateObject("Scripting.FileSystemObject")
Set tf = fso.OpenTextFile("PC_Info.txt",2,true)
'### Set Computer Here ###
strComputer = "YOUR_SRV"
tf.write("Server;IP Address;OS Name;OS Service Pack;Group(s);Member(s);Display Name;")
tf.writeline("AdsPath")
Set objComputer = GetObject("WinNT://" & strComputer)
objComputer.Filter = Array("group")
strIPAddress = fResolveIP(strComputer)
For Each objGroup In objComputer
For Each objMember in objGroup.Members
var1 = objMember.Name
If objMember.Class <> "Group" And Err.Number = 0 Then
var2 = ""
On Error Resume Next
var2 = objMember.FullName
On Error Goto 0
OSName = Split(dicCompOS(UCase(strComputer)), "¶")(0)
OSSP = Split(dicCompOS(UCase(strComputer)), "¶")(1)
tf.writeline(strComputer & ";" & strIPAddress & ";" & OSName & ";" & OSSP & ";" & objGroup.Name & ";" & var1 & ";" & chr(34) & var2 & chr(34) & ";" & objMember.AdsPath)
Else
tf.writeline(strComputer & ";" & strIPAddress & ";" & OSName & ";" & OSSP & ";" & objGroup.Name & ";" & var1 & ";" & Chr(34) & chr(34) & ";" & objMember.AdsPath)
Err.Clear
End If
var1 = ""
var2 = ""
Next
Next
tf.close()
MsgBox "Done!"
Wscript.quit
Sub GetOSs()
'# ADO Init
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strConfig = objRootDSE.Get("configurationNamingContext")
Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open = "ADProvider"
objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 100
objCommand.Properties("Timeout") = 900
'#
'### LDAP Filter ###
strFilter = "(&(objectClass=computer))"
'### Attributes to retrieve ###
strAttributes = "sAMAccountName,operatingSystem,operatingSystemServicePack"
'### Execute LDAP Query ###
strBase = "<LDAP://" & strDNSDomain & ">"'
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
objCommand.CommandText = strQuery
'On Error Resume Next
Set objRecordSet = objCommand.Execute
'### Go through records returned and store info ###
Do Until objRecordSet.EOF
dicCompOS(UCase(Replace(objRecordSet.Fields("sAMAccountName"), "$", ""))) = objRecordSet.Fields("operatingSystem") & "¶" & objRecordSet.Fields("operatingSystemServicePack")
'MsgBox dicCompOS(objRecordSet.Fields("sAMAccountName")),,objRecordSet.Fields("sAMAccountName")
objRecordSet.MoveNext
Loop
End Sub
Function fResolveIP(strComputer)
Dim wmiQuery, objWMIService, objPing, objStatus
wmiQuery = "Select * From Win32_PingStatus Where " & _
"Address = '" & strComputer & "'"
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set objPing = objWMIService.ExecQuery(wmiQuery)
For Each objStatus in objPing
If IsNull(objStatus.StatusCode) Or objStatus.Statuscode<>0 Then
fResolveIP = "Unknown"
Else
fResolveIP = objStatus.ProtocolAddress
End If
Next
End Function
|