脚本查看远程计算机的安装软件的情况

本人有该脚本，可以查看ad里面所有计算机的安装软件的情况，
请问如何修改成查看指定计算机的软件的安装情况。脚本如下：
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!" 

 

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
strKey = "SOFTWARE/Microsoft/Windows/CurrentVersion/Uninstall/"
strEntry1a = "DisplayName"
strEntry1b = "QuietDisplayName"
strEntry3 = "VersionMajor"
strEntry4 = "VersionMinor"

strComputer = "."

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set of = oFSO.CreateTextFile("c:/scripts/pcsoft.txt", True, True)
    On Error Resume Next
    sPC = strComputer
    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
of.close
MsgBox "Done!"