如何通過vbs腳本檢測已安裝的軟件和版本

這篇文章給大家分享的是有關如何通過vbs腳本檢測已安裝的軟件和版本的內容。小編覺得挺實用的，因此分享給大家做個參考，一起跟隨小編過來看看吧。

' ////////////////////////////////////////////////////////////////////  
' FileName: SoftwareMeteringCLS.vbs  
' ////////////////////////////////////////////////////////////////////  
If (WScript.ScriptName = "SoftwareMeteringCLS.vbs") Then Call demo_SoftwareMeteringCLS()

' ====================================================================  
Function getSoftwareList(sHost)  
' Callable by *.wsf; will return list (safe array) of installed  
' software on the sHost system (sHost is ComputerName or IP address).  
'   
' The assumption is that sHost is available and has WMI installed.

 Set oSoftMeter = new SoftwareMeteringCLS  
 sProgsAry = oSoftMeter.getList(sHost)  
 Set oSpftMeter = Nothing  
 getSoftwareList = sProgsAry  
End Function  
' ====================== CLASS =======================================  
Class SoftwareMeteringCLS  
' Author:  Branimir Petrovic  
' Date:  6 Sept 2002  
' Version: 1.0.3  
'  
' Revision History:  
'  30 March 2002    V 1.0.0  
'  
'  08 April 2002    V 1.0.1  
'    Added error handling - if the target system is not present,  
'    or does not have WMI, getList(sHost) will return empty list.  
'  
'    Added global function getSoftwareList(sHost) to be used  
'    from *.wsf scripts when caller script is JScript (since  
'    JScript can not instantiate VBS classes directly).  
'  
'  21 April 2002    V 1.0.2  
'    Replacing "[" with "(" and "]" with ")" in "DisplayName"  
'    Some strings like: [See Q311401 for more information]  
'    can cause troubles, therefore replacement.  
'  
'  6 Sept 2002     V 1.0.3  
'    Win2K's SP3 for Windows 2000 introduced slight (but silent)  
'    'improvement' in a way registry provder's EnumValues method  
'    deals with empty keys. EnumValues method called against  
'    keys without any values (except the Default, empty value)  
'    will now return Null value (previously array of size 0 was  
'    returned). Added (previously unneeded) type checking...  
'  
'   
' Dependancies:  
'  WSH 5.6  
'  
' Methods:  
'  - getClassName()  
'  - getVersion()  
'  - getList(sHost) sHost parameter can be computer name or IP address  
'   Enumerates all subkeys in:  
'    "Software\Microsoft\Windows\CurrentVersion\Uninstall"  
'   Returns array of strings, each string item containing:  
'    "DisplayNameKeyValue[ --Version: DisplayVersionKeyValue]"  
'  
'   If sHost parameter is empty string or non-string value,  
'   function returns list of installed software on this host.  
'   Otherwise it will connect to host pointed to by sHost string  
'   (provided sufficient level of permissions)  
'  
'  - getHostString() Returns name of the system or IP address

 ' --- Private data members  
 Private HKLM   ' Points to HKEY_LOCAL_MACHINE hive  
 Private UNINSTALL_ROOT  ' Software\Microsoft\Windows\CurrentVersion\Uninstall  
 Private SUPRESS_HOTFIX_ENTRIES ' By default is TRUE (set in Class_Initialize)  
     ' (supressess listing of installed hotfixes)  
 Private CLASS_NAME  
 Private VERSION  
 Private REG_SZ  
 Private oReg  
 Private sComputerName

 ' --- Public  
 Public Function getClassName()  
  getClassName = CLASS_NAME  
 End Function

 Public Function getVersion()  
  getVersion = VERSION  
 End Function

 Public Function getList(sHost)  
  If TypeName(sHost)="String" AND sHost<>"" Then  
   sComputerName = sHost  
  Else  
   sComputerName = WScript.CreateObject("WScript.Network").ComputerName  
  End If

  On Error Resume Next  
  Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}//" &_  
  sComputerName & "/root/default:StdRegProv")  
  If Err.Number<>0 Then  
   ' Computer is not accessable or does not have WMI, return empty array  
   getList = Array()  
  Else  
   ' Computer is on the network and does have working WMI,  
   ' return the list (safe array) of installed software  
   getList = listInstalledProgs(oReg)  
  End If  
  On Error GoTo 0  
 End Function

 Public Function getHostString()  
  getHostString = sComputerName  
 End Function

 ' --- Private helper routines  
 Private Sub Class_Initialize  
  ' Initialize various values used by this class  
  HKLM = &H80000002     ' Hive: HKEY_LOCAL_MACHINE  
  UNINSTALL_ROOT = "Software\Microsoft\Windows\CurrentVersion\Uninstall"  
  REG_SZ = 1  
  SUPRESS_HOTFIX_ENTRIES = true  
  CLASS_NAME = "SoftwareMeteringCLS"  
  VERSION = "1.0.3"  
 End Sub

 Private Function listInstalledProgs(oReg)  
  ' returns array of strings DisplayName & " " & DisplayVersion  
  Dim oRegX, nCnt, sSubKeysAry, sProgName  
  Dim sProgsAry(): ReDim sProgsAry(1)  
  sSubKeysAry = getKeys(oReg, HKLM, UNINSTALL_ROOT)

  If SUPRESS_HOTFIX_ENTRIES Then  
   ' Supress looking into all hot fix related sub keys (like Q252795, etc...)  
   Set oRegX = new RegExp  
   oRegX.Pattern = "^Q\d+$" ' will detect patterns like: Q252795  
   oRegX.IgnoreCase = true

   For nCnt = 0 To UBound(sSubKeysAry)  
    If NOT oRegX.Test(sSubKeysAry(nCnt)) Then  
     sProgName = getProgNameAndVersion(oReg, HKLM, _  
     UNINSTALL_ROOT & "\" & sSubKeysAry(nCnt))

     If NOT (IsEmpty(sProgName) OR sProgName="") Then  
      If NOT IsEmpty(sProgsAry(UBound(sProgsAry) - 1)) Then  
       ReDim Preserve sProgsAry(UBound(sProgsAry)+1)  
      End If  
      sProgsAry(UBound(sProgsAry)-1) = sProgName  
     End If  
    End If  
   Next  
  Else  
   ' List all sub keys including hotfix related ones (like Q252795, etc...)  
   For nCnt = 0 To UBound(sSubKeysAry)  
    sProgName = getProgNameAndVersion(oReg, HKLM, _  
    UNINSTALL_ROOT & "\" & sSubKeysAry(nCnt))

    If NOT (IsEmpty(sProgName) OR sProgName="") Then  
     If NOT IsEmpty(sProgsAry(UBound(sProgsAry) - 1)) Then  
      ReDim Preserve sProgsAry(UBound(sProgsAry)+1)  
     End If  
     sProgsAry(UBound(sProgsAry)-1) = sProgName  
    End If  
   Next  
  End If

  listInstalledProgs = sProgsAry  
 End Function

 Private Function getKeys(oReg, HIVE, sKeyRoot)  
  ' Returns array of strings of subkey names  
  Dim vKeysAry  
  Call oReg.EnumKey(HIVE, sKeyRoot, vKeysAry)  
  getKeys = vKeysAry     ' >>>  
 End Function

 Private Function getProgNameAndVersion(oReg, HIVE, sKeyRoot)  
  ' If both values "DisplayName" and "DisplayVersion" exist in sKeyRoot, return:  
  '  "DisplayNameKeyValue --Version: DisplayVersionKeyValue"  
  '  
  ' If only "DisplayName" exists, return:  
  '  "DisplayNameKeyValue"  
  '  
  ' Otherwise EMPTY is returned

  Dim sKeyValuesAry, iKeyTypesAry, nCnt, sValue, sDisplayName, sDisplayVersion  
  oReg.EnumValues HIVE, sKeyRoot, sKeyValuesAry, iKeyTypesAry 'fill the arrays

  ' 6 Sept 2002  
  ' SP3 for Win2K altered behavior of registry provider's EnumValues method!  
  ' EnumValues method after SP3 does not return empty array any more for all  
  ' those registry keys that have only empty Default value.  
  ' Therefore sKeyValuesAry must be tested to see if it is an array or not.  
  If NOT IsArray(sKeyValuesAry) Then  
   Exit Function  '                           '   >>>  
  End If

  For nCnt = 0 To UBound(sKeyValuesAry)  
   If InStr(1, sKeyValuesAry(nCnt), "DisplayName", vbTextCompare) Then  
    If iKeyTypesAry(nCnt) = REG_SZ Then  
     oReg.GetStringValue HIVE, sKeyRoot, sKeyValuesAry(nCnt), sValue  
     If sValue<>"" Then  
      sDisplayName = sValue  
      sDisplayName = Replace(sDisplayName, "[", "(")  
      sDisplayName = Replace(sDisplayName, "]", ")")  
     End If  
    End If  
   ElseIf InStr(1, sKeyValuesAry(nCnt), "DisplayVersion", vbTextCompare) Then  
    If iKeyTypesAry(nCnt) = REG_SZ Then  
     oReg.GetStringValue HIVE, sKeyRoot, sKeyValuesAry(nCnt), sValue  
     If sValue<>"" Then sDisplayVersion = sValue  
    End If  
   End If

   If (sDisplayName<>"") AND (sDisplayVersion<>"") Then  
    getProgNameAndVersion = sDisplayName & " --Version: " & sDisplayVersion  
    Exit Function    ' >>>  
   End If  
  Next

  If sDisplayName<>"" Then  
   getProgNameAndVersion = sDisplayName  
   Exit Function     ' >>>  
  End If  
 End Function

End Class  
' ====================== END OF CLASS ================================

Function demo_SoftwareMeteringCLS()  
 Dim oSoftMeter, sProgsAry, sComputer

 'sComputer = "W-BRANIMIR-666"  
 'sComputer = "W-Branimir-079"  
 sComputer = "" ' query local host

 sProgsAry = getSoftwareList(sComputer)  
 Call WScript.Echo(Join(sProgsAry, vbCrLf))  
End Function

把上面的代碼存為vbs文件執行即可  

感謝各位的閱讀！關于“如何通過vbs腳本檢測已安裝的軟件和版本”這篇文章就分享到這里了，希望以上內容可以對大家有一定的幫助，讓大家可以學到更多知識，如果覺得文章不錯，可以把它分享出去讓更多的人看到吧！