vbs获取软件列表

功能：获取本地安装列表，并以“计算机名+IP”命名输出txt文件

?

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79

on error resume Next Const HKLM         = &H80000002   Const HKCU         = &H80000001 Const strKeyPath   = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\" Const strKeyPathwin  ="SOFTWARE\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall\" Const ForReading   = 1   Const ForAppending = 8      '定义输出路径 Const FilePath     ="Y:\123\"   Set Wshell         = CreateObject("Wscript.Shell")   Set objFSO         = CreateObject("Scripting.FileSystemobject")     Dim WshNetwork Set WshNetwork = WScript.CreateObject("WScript.Network") strComputer = WshNetwork.ComputerName      if (objFSO.FileExits(FilePath & WshNetwork.ComputerName & "(" & GetIP() & ")" & ".txt")) then Set MyFile = objFSO.GetFile(FilePath & WshNetwork.ComputerName & "(" & GetIP() & ")" & ".txt") MyFile.Delete End If   Set textWriteFile  = objFSO.OpenTextFile(FilePath & WshNetwork.ComputerName & "(" & GetIP() & ")" & ".txt",forappending,True)       Set objReg  = GetObject("winmgmts://" & strComputer & "/root/default:StdRegProv")   objReg.EnumKey HKCU, strKeyPath,arrSubKeys        For Each strSubKey In arrSubKeys            intRet = objReg.GetStringValue(HKCU, strKeyPath & strSubKey,"DisplayName",strValue)                                                             If strValue <> "" And intRet = 0 And Left(strSubKey, 2) <> "KB" Then                 textWriteFile.WriteLine(strValue)         End If  Next       Set objReglm  = GetObject("winmgmts://" & strComputer & "/root/default:StdRegProv")   objReg.EnumKey HKLM, strKeyPath,arrSubKeys        For Each strSubKey In arrSubKeys            intRet = objReg.GetStringValue(HKLM, strKeyPath & strSubKey,"DisplayName",strValue)                                                            If strValue <> "" And intRet = 0 And Left(strSubKey, 2) <> "KB" Then                 textWriteFile.WriteLine(strValue)         End If  Next   Set objReg  = GetObject("winmgmts://" & strComputer & "/root/default:StdRegProv")   objReg.EnumKey HKLM, strKeyPathwin,arrSubKeys        For Each strSubKey In arrSubKeys            intRet = objReg.GetStringValue(HKLM, strKeyPathwin & strSubKey,"DisplayName",strValue)                                                          If strValue <> "" And intRet = 0 And Left(strSubKey, 2) <> "KB" Then                 textWriteFile.WriteLine(strValue)         End If  Next dim wsnet set wsnet=wscript.createobject("wscript.network") textWriteFile.WriteLine(wsnet.username) textWriteFile.Close     '获取本机IP 'owner DeViL 'return 本机的IP地址 Public Function GetIP    ComputerName="."     Dim objWMIService,colItems,objItem,objAddress     Set objWMIService = GetObject("winmgmts:\\" & ComputerName & "\root\cimv2")     Set colItems = objWMIService.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")     For Each objItem in colItems         For Each objAddress in objItem.IPAddress             If objAddress <> "" then                 GetIP = objAddress                 Exit Function             End If         Next     Next End Function