' 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