' Listing 6: The getADServerList Function

Private Function getADServerList(strFNDate)
  Dim dicData, objRootDSE, strDNSDomain, strDN, strSubDomain
  Dim strRootDomain, strDomain, outFileName, objFSO, outFile
  Dim objConnection, objCommand, strQuery, objRecordSet, DataList
  Dim strOS, strComputer, strComputerDN strOU, strOSVer, strHostData, i
  Const ForWriting = 2

  Set dicData = CreateObject("Scripting.Dictionary")

  Set objRootDSE = GetObject("LDAP://RootDSE")
  strDNSDomain = objRootDSE.Get("defaultNamingContext")
  strDN = Split(strDNSDomain,",")
  strSubDomain = Mid(strDN(0),InStr(strDN(0),"=") + 1)
  strRootDomain = Mid(strDN(1),InStr(strDN(1),"=") + 1)
  strDomain = strSubDomain & "." & strRootDomain
  outFileName = strDomain & "_Domain_Servers_" & strFNDate & ".xls"

  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set outFile = objFSO.OpenTextFile(outFileName, ForWriting, True)
  WScript.Echo
  WScript.Echo Space(3) & "Querying server list from the " & _
    strDomain & " domain. Please wait. . ."
  WScript.Echo

' ******* BEGIN CALLOUT A *******
  Const ADS_SCOPE_SUBTREE = 2
  Set objConnection = CreateObject("ADODB.Connection")
  Set objCommand = CreateObject("ADODB.Command")
  objConnection.Provider = "ADsDSOObject"
  objConnection.Open "Active Directory Provider"
  Set objCommand.ActiveConnection = objConnection
  strQuery = "<LDAP://" & strDNSDomain _
    & ">;(&(objectCategory=Computer));" _
    & "Name,distinguishedName,operatingSystem;Subtree"
  objCommand.CommandText = strQuery
  objCommand.Properties("Page Size") = 1000
  objCommand.Properties("Timeout") = 30
  objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
  objCommand.Properties("Cache Results") = False
  Set objRecordSet = objCommand.Execute
' ******* END CALLOUT A *******

' ******* BEGIN CALLOUT B *******
  Set DataList = CreateObject("ADODB.Connection")
' ******* END CALLOUT B *******
  DataList.Fields.Append "strHostName", 200, 255 ' adVarChar
  DataList.Fields.Append "strOUName", 200, 255 ' adVarChar
  DataList.Fields.Append "strOSVersion", 200, 255 ' adVarChar
  DataList.Open

  ' Iterate through query's results and add only the server records to
  ' DataList.
  objRecordSet.MoveFirst
  Do Until objRecordSet.EOF
    strOS = objRecordSet.Fields("operatingSystem").Value
    If InStr(LCase(strOS),"server") > 0 Then
      DataList.AddNew
      strComputer = UCase(objRecordSet.Fields("Name").Value)
      strComputerDN = objRecordSet.Fields("distinguishedName").Value
      strOU = getReverseOU(strComputerDN)
      strOSVer = objRecordSet.Fields("operatingSystem").Value
      DataList("strHostName") = strComputer
      DataList("strOUName") = strOU
      DataList("strOSVersion") = strOSVer
      DataList.Update
    End If
      objRecordSet.MoveNext
  Loop

  ' Sort the records by OU name, then server name.
  DataList.Sort = "strOUName,strHostName"

  ' Fill the dicData array and write the server data to the log file.
  DataList.MoveFirst
  Do Until DataList.EOF
    i = i + 1
    strComputer = DataList.Fields.Item("strHostName")
    strOU = DataList.Fields.Item("strOUName")
    strOSVer = DataList.Fields.Item("strOSVersion")
    strHostData = i & vbTab & strComputer & vbTab & strOU & _
      vbTab & strOSVer
    If i = 1 Then outFile.WriteLine "No." & vbTab & "Host Name" _
      & vbTab & "OU Container" & vbTab & "Operating System"
    outFile.WriteLine i & vbTab & strComputer & vbTab & strOU _
      & vbTab & strOSVer
    dicData.Add dicData.Count, strHostData
  DataList.MoveNext
  Loop
  getADServerList = dicData.Items

  ' Clean up the variables.
  Set dicData = Nothing : Set objRootDSE = Nothing
  Set objFSO = Nothing : Set outFile = Nothing
  Set objConnection = Nothing: Set objCommand = Nothing
  Set objRecordSet = Nothing: Set DataList = Nothing
End Function