IT Blog

There are times when you need to programmatically query Active Directory for a list of computers. This can be handy for scripting/auditing purposes.

The below source will query each computer in the specified OU and then perform a WMI query against each computer to extract our information. Save teh file as .vbs extension and run it!

Dim strOu

' Active Directory Domain Controller is ad_dc_server
' OU is "Test OU" in domain domain.com.au

strOU = "<LDAP://ad_dc_server/OU=Test OU,DC=domain,DC=com,DC=au>"

Dim objRoot, objConnection, objCommand, objRecordset, sDomain

sFile = "c:\servers.csv" ' destination file to write output to

' create the necessary objects
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.CreateTextFile(sFile, True)
Set objRoot = GetObject("LDAP://rootDSE")
'sDomain = objRoot.Get("defaultNamingContext")

' Make the connection to AD
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection

' List of attributes to query
strAttributes = "cn"

' our built command to run against the DC
objCommand.CommandText = ou & ";(&(objectClass=computer));" & strAttributes & ";subtree"
 
' run the command and loop through all the found entries, query each entry for WMI information
' writing them to our output file

file.writeline "Server Name, OS, Install Date, Version Number, Product Key"

Set objRecordSet = objCommand.Execute
While Not objRecordset.EOF
   strRes = objRecordset.Fields("cn")
   file.writeline GetOSDetails(strRes)
   objRecordset.MoveNext
Wend

' let's clean up

file.Close
set fso = Nothing
objRecordset.Close
Set objRoot = nothing
Set objConnection = nothing
Set objCommand = nothing
Set objRecordset = nothing


' Function to get the OS Information

Function GetOSDetails(hostname)
  Set dtmConvertedDate = CreateObject("WbemScripting.SWbemDateTime")

  strComputer = hostname
  'wscript.echo hostname
  Set objWMIService = GetObject("winmgmts:" _
      & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

  Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
 
  dim strOutput
  strOutput = strComputer
  dim blExists
  blExists = false

' Returns csv style line as follows:
' Server Name, Build Type,Caption, Install Date, Version

  For Each objOperatingSystem in colOperatingSystems
    strOutput = strOutput &  "," & Replace(objOperatingSystem.Caption,","," -")
    dtmConvertedDate.Value = objOperatingSystem.InstallDate
    dtmInstallDate = dtmConvertedDate.GetVarDate
    strOutput = strOutput &  "," & dtmInstallDate
    strOutput = strOutput &  "," & objOperatingSystem.Version
    blExists = true
  Next
 
  If blExists = true Then
     strOutput = strOutput & "," & GetProductKey(strComputer)
  End If

  GetOSDetails = strOutput

End Function


' Function to get the product key
Function GetProductKey(hostname)

  const HKEY_LOCAL_MACHINE = &H80000002
  strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
  strValueName = "DigitalProductId"

  strComputer = hostname

  dim iValues()

  Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
     strComputer & "\root\default:StdRegProv")

  oReg.GetBinaryValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,iValues

  Dim arrDPID
  arrDPID = Array()

  For i = 52 to 66
     ReDim Preserve arrDPID( UBound(arrDPID) + 1 )
     arrDPID( UBound(arrDPID) ) = iValues(i)
  Next
 
  Dim arrChars
  arrChars = Array("B","C","D","F","G","H","J","K","M","P","Q","R","T","V","W","X","Y","2","3","4","6","7","8","9")

  ' Decrypt the base24 encoded binary data
  For i = 24 To 0 Step -1
      k = 0
      For j = 14 To 0 Step -1
         k = k * 256 Xor arrDPID(j)
         arrDPID(j) = Int(k / 24)
          k = k Mod 24
      Next
      strProductKey = arrChars(k) & strProductKey

      ' <------- add the "-" between the groups of 5 Char -------->
      If i Mod 5 = 0 And i <> 0 Then
         strProductKey = "-" & strProductKey
      End If
  Next

  GetProductKey= strProductKey

End Function

 

' our built command to run against the DC
objCommand.CommandText = ou & ";(&(objectClass=computer));" & strAttributes & ";subtree"
 
' run the command and loop through all the found entries writing them to our output file
Set objRecordSet = objCommand.Execute
While Not objRecordset.EOF
   file.writeline objRecordset.Fields("cn")
   objRecordset.MoveNext
Wend

' let's clean up

file.Close
set fso = Nothing
objRecordset.Close
Set objRoot = nothing
Set objConnection = nothing
Set objCommand = nothing
Set objRecordset = nothing