检测域中电脑所安装软件清单

strDomainName = InputBox ("Please enter the internal Domain Name:","Enter the Internal Domain Name","Sitename.local")
arrDomLevels = Split(strDomainName, ".")
strADsPath = "dc=" & Join(arrDomLevels, ",dc=")


Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE

strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
strEntry1a = "DisplayName"
strEntry1b = "QuietDisplayName"
strEntry3 = "VersionMajor"
strEntry4 = "VersionMinor"
 
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
objCommand.CommandText = _
    "Select Name, Location from 'LDAP://"&strADsPath&"' " _
        & "Where objectClass='computer'"  
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set of = oFSO.CreateTextFile("c:\scripts\pcsoft.txt", True, True)

Do Until objRecordSet.EOF
    On Error Resume Next
    sPC = objRecordSet.Fields("Name").Value
    Set objReg = GetObject("winmgmts://" & sPC & _
  "/root/default:StdRegProv")
 objReg.EnumKey HKLM, strKey, arrSubkeys
 of.writeline " "
 of.writeline "### "&sPC&" ###"
 of.writeline " "
 For Each strSubkey In arrSubkeys
   sName = ""
   intRet1 = objReg.GetStringValue(HKLM, strKey & strSubkey, _
    strEntry1a, strValue1)
   If intRet1 <> 0 Then
     objReg.GetStringValue HKLM, strKey & strSubkey, _
     strEntry1b, strValue1
   End If
   If strValue1 <> "" Then
      If InStr(strValue1,"Hotfix") <> 0 Or InStr(strValue1,"Update for Windows")<> 0  Then 
     Else  
        
      sName = strValue1
    objReg.GetDWORDValue HKLM, strKey & strSubkey, _
      strEntry3, intValue3
     objReg.GetDWORDValue HKLM, strKey & strSubkey, _
     strEntry4, intValue4
    If intValue3 <> "" Then
       sName =  sName&" (Version: "& intValue3 & "." & intValue4&")"
      End If  
         of.writeline sName
      
  End If  
    End If
    
Next
objRecordSet.MoveNext
Loop

of.close
MsgBox "Done!"

Bookmark this post: