Software installed on the servers using LDAP query to retrive server details-VBscript

on error resume next

 ' Determine DNS domain name from RootDSE object.
 Set objRootDSE = GetObject("LDAP://RootDSE")
 strDNSDomain = objRootDSE.Get("defaultNamingContext")
 'wscript.echo "defaultNamingContext (Domain Name System)" & strDNSDomain
 ' Use ADO to search Active Directory for all computers.
 Set adoCommand = CreateObject("ADODB.Command")
 Set adoConnection = CreateObject("ADODB.Connection")
 adoConnection.Provider = "ADsDSOObject"
 adoConnection.Open "ADs Provider"
 adoCommand.ActiveConnection = adoConnection


 ' Search entire domain.
 strBase = "<LDAP://" & strDNSDomain & ">"
 ' Filter on computer objects with server operating system.
 strFilter = "(&(objectCategory=computer)(operatingSystem=*server*))"
 ' Comma delimited list of attribute values to retrieve.
 strAttributes = "cn"
 ' Construct the LDAP syntax query.
 strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
 adoCommand.CommandText = strQuery
 'adoCommand.Properties("Page Size") = 100
 'adoCommand.Properties("Timeout") = 30
 'adoCommand.Properties("Cache Results") = False
 Set adoRecordset = adoCommand.Execute
 strComputerDN = Array()
 'arrSortOut = Array()
' cnsd = Array()
Dim cnsdstring
 counter = 0
 'step = 0
 count = 0
 ' Enumerate computer objects with server operating systems.
 Do Until adoRecordset.EOF
 ReDim Preserve strComputerDN(counter)
 strComputerDN(counter) = adoRecordset.Fields("cn").value
 Wscript.Echo "ServerName:" & strComputerDN(counter)

Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
'strComputer = "."
strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
strEntry1a = "DisplayName"
strEntry1b = "QuietDisplayName"
strEntry2 = "InstallDate"
strEntry3 = "VersionMajor"
strEntry4 = "VersionMinor"
strEntry5 = "EstimatedSize"


Set objReg = GetObject("winmgmts://" & strComputerDN(counter) & _
 "/root/default:StdRegProv")
objReg.EnumKey HKLM, strKey, arrSubkeys
WScript.Echo "Installed Applications" & VbCrLf
For Each strSubkey In arrSubkeys
  intRet1 = objReg.GetStringValue(HKLM, strKey & strSubkey, _
   strEntry1a, strValue1)
  If intRet1 <> 0 Then
    objReg.GetStringValue HKLM, strKey & strSubkey, _
     strEntry1b, strValue1
  End If
  'WScript.Echo VbCrLf & "Service Display Name: "
  If strValue1 <> "" Then
    Wscript.Echo strValue1
  End If
  objReg.GetStringValue HKLM, strKey & strSubkey, _
   strEntry2, strValue2
  If strValue2 <> "" Then
    'WScript.Echo "Install Date: " & strValue2
  End If
  objReg.GetDWORDValue HKLM, strKey & strSubkey, _
   strEntry3, intValue3
  objReg.GetDWORDValue HKLM, strKey & strSubkey, _
   strEntry4, intValue4
  If intValue3 <> "" Then
     'WScript.Echo "Version: " & intValue3 & "." & intValue4
  End If
  objReg.GetDWORDValue HKLM, strKey & strSubkey, _
   strEntry5, intValue5
  If intValue5 <> "" Then
    'WScript.Echo "Estimated Size: " & Round(intValue5/1024, 3) & " megabytes"
  End If
Next

 adoRecordset.MoveNext
 counter = counter + 1
 Loop
 'wscript.echo "defaultNamingContext" & strDNSDomain
 'wscript.echo counter


 'Clean up.
 adoRecordset.Close
 adoConnection.Close