如何用VBS脚本收集远程计算机或本地计算机安装的软件

方案1：收集本地计算机软件（基础版）

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile("InstalledSoftware.txt", True)

' 通过注册表获取已安装软件
strComputer = "."
Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")

' 64位系统查看32位软件（WOW6432Node）
strKeyPath1 = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
strKeyPath2 = "SOFTWARE\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall"

objFile.WriteLine "=== 本地计算机已安装软件列表 ===" & vbCrLf
objFile.WriteLine "收集时间: " & Now & vbCrLf

' 检查两个注册表路径
arrPaths = Array(strKeyPath1, strKeyPath2)
For Each strPath in arrPaths
    objRegistry.EnumKey HKEY_LOCAL_MACHINE, strPath, arrSubKeys
    If IsArray(arrSubKeys) Then
        For Each strSubKey In arrSubKeys
            strFullPath = strPath & "\" & strSubKey
            GetSoftwareInfo strFullPath, "本地"
        Next
    End If
Next

objFile.Close
WScript.Echo "软件列表已保存到 InstalledSoftware.txt"

Sub GetSoftwareInfo(strKey, strComputerName)
    On Error Resume Next

    Dim strDisplayName, strDisplayVersion, strPublisher, strInstallDate

    ' 读取软件信息
    objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKey, "DisplayName", strDisplayName
    objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKey, "DisplayVersion", strDisplayVersion
    objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKey, "Publisher", strPublisher
    objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKey, "InstallDate", strInstallDate

    If Not IsNull(strDisplayName) Then
        objFile.WriteLine "软件名称: " & strDisplayName
        If Not IsNull(strDisplayVersion) Then
            objFile.WriteLine "版本: " & strDisplayVersion
        End If
        If Not IsNull(strPublisher) Then
            objFile.WriteLine "发布者: " & strPublisher
        End If
        If Not IsNull(strInstallDate) Then
            objFile.WriteLine "安装日期: " & strInstallDate
        End If
        objFile.WriteLine "注册表路径: " & strKey
        objFile.WriteLine "计算机: " & strComputerName
        objFile.WriteLine "----------------------------------------"
    End If
End Sub

方案2：收集远程计算机软件（需要管理员权限）

' 远程计算机信息
strRemoteComputer = "远程计算机名或IP地址"
strUsername = "管理员用户名"    ' 可选，如果当前账户有权限可留空
strPassword = "密码"           ' 可选

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile("RemoteSoftware.txt", True)

objFile.WriteLine "=== 远程计算机已安装软件列表 ===" & vbCrLf
objFile.WriteLine "目标计算机: " & strRemoteComputer
objFile.WriteLine "收集时间: " & Now & vbCrLf

' 连接到远程计算机的WMI服务
If strUsername = "" Then
    ' 使用当前凭据
    strConnection = "winmgmts:\\" & strRemoteComputer & "\root\cimv2"
Else
    ' 使用指定凭据
    strAuthority = "kerberos:" & strRemoteComputer
    Set objLocator = CreateObject("WbemScripting.SWbemLocator")
    Set objWMIService = objLocator.ConnectServer(strRemoteComputer, "root\cimv2", strUsername, strPassword)
    strConnection = objWMIService
End If

On Error Resume Next
Set objWMIService = GetObject(strConnection)

If Err.Number <> 0 Then
    objFile.WriteLine "错误: 无法连接到远程计算机 " & strRemoteComputer
    objFile.WriteLine "错误信息: " & Err.Description
    objFile.Close
    WScript.Echo "连接失败: " & Err.Description
    WScript.Quit
End If

' 通过WMI查询已安装软件
Set colSoftware = objWMIService.ExecQuery("SELECT * FROM Win32_Product")

i = 0
For Each objSoftware in colSoftware
    i = i + 1
    objFile.WriteLine i & ". 软件名称: " & objSoftware.Name
    objFile.WriteLine "   版本: " & objSoftware.Version
    objFile.WriteLine "   发布者: " & objSoftware.Vendor
    objFile.WriteLine "   安装日期: " & objSoftware.InstallDate
    objFile.WriteLine "   安装位置: " & objSoftware.InstallLocation
    objFile.WriteLine "----------------------------------------"
Next

If i = 0 Then
    objFile.WriteLine "未找到任何软件或WMI查询被限制"
End If

objFile.Close
WScript.Echo "远程计算机软件列表已保存到 RemoteSoftware.txt，共找到 " & i & " 个软件"

方案3：增强版 - 同时支持本地和远程（带参数）

' 用法示例：
' 本地收集：cscript GetSoftware.vbs local
' 远程收集：cscript GetSoftware.vbs remote 计算机名 用户名 密码

Set objArgs = WScript.Arguments

If objArgs.Count = 0 Then
    WScript.Echo "使用方法：" & vbCrLf & _
                 "本地收集: GetSoftware.vbs local" & vbCrLf & _
                 "远程收集: GetSoftware.vbs remote 计算机名 [用户名] [密码]"
    WScript.Quit
End If

strMode = objArgs(0)
strOutputFile = "SoftwareReport_" & Replace(Replace(Now, "/", "_"), ":", "_") & ".csv"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile(strOutputFile, True)

' 写入CSV标题
objFile.WriteLine "计算机名,软件名称,版本,发布者,安装日期,安装位置"

Select Case LCase(strMode)
    Case "local"
        CollectLocalSoftware "."
    Case "remote"
        If objArgs.Count < 2 Then
            WScript.Echo "请指定远程计算机名"
            WScript.Quit
        End If
        strComputer = objArgs(1)
        If objArgs.Count >= 4 Then
            strUser = objArgs(2)
            strPass = objArgs(3)
            CollectRemoteSoftware strComputer, strUser, strPass
        Else
            CollectRemoteSoftware strComputer
        End If
    Case Else
        WScript.Echo "无效的模式，请使用 'local' 或 'remote'"
End Select

objFile.Close
WScript.Echo "报告已生成: " & strOutputFile

' 收集本地软件函数
Sub CollectLocalSoftware(strComputer)
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set colSoftware = objWMIService.ExecQuery("SELECT * FROM Win32_Product")

    For Each objSoftware in colSoftware
        WriteToCSV strComputer, objSoftware
    Next
End Sub

' 收集远程软件函数
Sub CollectRemoteSoftware(strComputer, strUser, strPass)
    On Error Resume Next

    Set objLocator = CreateObject("WbemScripting.SWbemLocator")

    If IsEmpty(strUser) Then
        Set objWMIService = objLocator.ConnectServer(strComputer, "root\cimv2")
    Else
        Set objWMIService = objLocator.ConnectServer(strComputer, "root\cimv2", strUser, strPass)
    End If

    If Err.Number <> 0 Then
        WScript.Echo "连接错误: " & Err.Description
        Exit Sub
    End If

    Set colSoftware = objWMIService.ExecQuery("SELECT * FROM Win32_Product")

    For Each objSoftware in colSoftware
        WriteToCSV strComputer, objSoftware
    Next
End Sub

' 写入CSV函数
Sub WriteToCSV(strComputer, objSoftware)
    strLine = """" & strComputer & """,""" & _
                       Replace(objSoftware.Name, """", "'""") & """,""" & _
                       objSoftware.Version & """,""" & _
                       Replace(objSoftware.Vendor, """", "'""") & """,""" & _
                       objSoftware.InstallDate & """,""" & _
                       Replace(objSoftware.InstallLocation, """", "'""") & """"
    objFile.WriteLine strLine
End Sub

使用说明：

保存脚本：将代码保存为 .vbs 文件（如 GetSoftware.vbs）

执行方式：

• 双击运行（本地收集）
• 命令行运行：cscript GetSoftware.vbs

权限要求：

• 本地收集：需要管理员权限获取完整列表
• 远程收集：需要域管理员权限或远程计算机的本地管理员权限

注意事项：

• 远程收集可能受防火墙、UAC、WMI设置影响
• 某些软件可能不会在标准位置注册
• Win32_Product查询可能会触发软件修复（已知WMI特性）

方案4：快速查询特定软件是否存在

' 检查特定软件是否安装
strSoftwareName = "Microsoft Office"  ' 修改为要查找的软件名

strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colSoftware = objWMIService.ExecQuery("SELECT * FROM Win32_Product WHERE Name LIKE '%" & strSoftwareName & "%'")

If colSoftware.Count > 0 Then
    WScript.Echo "找到以下相关软件："
    For Each objSoftware in colSoftware
        WScript.Echo "名称: " & objSoftware.Name & " 版本: " & objSoftware.Version
    Next
Else
    WScript.Echo "未找到包含 '" & strSoftwareName & "' 的软件"
End If

选择适合您需求的方案，如果需要进一步调整或有特殊需求，请告诉我！