Wednesday, April 15, 2009

List all Groups on All Computers in a Domain, Caffeine Free version

This code consists of two main sections and a third section which is run at the very end. The first section simply queries Active Directory to fetch computer accounts. It then builds and populates a dictionary object with the "name" and "operatingSystem" values. The second portion sorts the dictionary object by the "name" key and then iterates the sorted list to query each computer for the groups it has.


Option Explicit

Const ADS_SCOPE_SUBTREE = 2
Const dictKey = 1
Const dictItem = 2

Dim srvcount : srvcount = 0
Dim objRootDSE, strLDAP, computerName, computerOS
Dim d, i, strQuery, objConnection, objCommand, objRecordSet

Set objRootDSE = GetObject("LDAP://rootDSE")
strLDAP = objRootDSE.Get("defaultNamingContext")

Set d = CreateObject("Scripting.Dictionary")

strQuery = "Select Name, operatingSystem from 'LDAP://" & strLDAP & "' Where objectClass='computer'"

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

Set objCOmmand.ActiveConnection = objConnection
objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst

Do Until objRecordSet.EOF
computerName = Ucase(objRecordSet("Name").value)
computerOS = objRecordSet("operatingSystem").value
srvcount = srvcount + 1
d.Add computerName, computerOS
objRecordSet.MoveNext
Loop

'----------------------------------------------------------------
' comment: request dictionary sort and display results
'----------------------------------------------------------------

SortDictionary d, dictKey

For Each i In d
computerName = i
computerOS = d(i)
Wscript.Echo computerName & vbTab & computerOS
If PingOnline(computerName) Then
ListGroups computerName
Else
Wscript.Echo vbTab & "(offline)"
End If
Next

'----------------------------------------------------------------
' function: sort dictionary object
'----------------------------------------------------------------

Function SortDictionary(objDict,intSort)
Dim strDict()
Dim objKey, strKey, strItem, X, Y, Z
Z = objDict.Count
If Z > 1 Then
ReDim strDict(Z,2)
X = 0
For Each objKey In objDict
strDict(X,dictKey) = CStr(objKey)
strDict(X,dictItem) = CStr(objDict(objKey))
X = X + 1
Next

For X = 0 to (Z - 2)
For Y = X to (Z - 1)
If StrComp(strDict(X,intSort),strDict(Y,intSort),vbTextCompare) > 0 Then
strKey = strDict(X,dictKey)
strItem = strDict(X,dictItem)
strDict(X,dictKey) = strDict(Y,dictKey)
strDict(X,dictItem) = strDict(Y,dictItem)
strDict(Y,dictKey) = strKey
strDict(Y,dictItem) = strItem
End If
Next
Next
objDict.RemoveAll
For X = 0 to (Z - 1)
objDict.Add strDict(X,dictKey), strDict(X,dictItem)
Next
End If
End Function

'----------------------------------------------------------------
' function: query groups on remote computer
'----------------------------------------------------------------

Sub ListGroups(strComputer)
On Error Resume Next
Dim objComputer, objX
Set objComputer = GetObject("WinNT://" & strComputer)
If err.Number <> 0 Then
Wscript.Echo vbTab & "*** unable to query qroups ***"
Exit Sub
Else
For each objX in objComputer
If Lcase(objX.Class) = "group" Then
Wscript.Echo vbTab & objX.Name
End If
Next
End If
Set objComputer = Nothing
End Sub

'----------------------------------------------------------------
' function: attempt ping to verify availability of computer
'----------------------------------------------------------------

Function PingOnline(strComputer)
Dim objPing, objStatus
Set objPing = GetObject("winmgmts:")._
ExecQuery("select * from Win32_PingStatus where address = '" & strComputer & "'")
For Each objStatus In objPing
If IsNull(objStatus.StatusCode) Or (objStatus.StatusCode <> 0) Then
Exit Function
End If
PingOnline = True
Exit Function
Next
End Function
Post a Comment