vbs获取软件列表

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

    
on error resume Next
Const HKLM         = &H80000002   
Const HKCU         = &H80000001
Const strKeyPath   = "SOFTWAREMicrosoftWindowsCurrentVersionUninstall"
Const strKeyPathwin  ="SOFTWAREWOW6432NodeMicrosoftWindowsCurrentVersionUninstall"
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 & "
ootcimv2")
    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