SoftwareMetering

List installed software on a computer

This script is small but vital piece of a much larger set of scripts that collectively make up solution for software accounting/metering on "poverty stricken" LANs.
This script is part of the Poor Man's SMS project that you can download here, or get more info there.

Usage :
Dim oSoftMeter, sProgsAry, sHost
sHost = "" '<<< if "" -> scan local system
Set oSoftMeter = new SoftwareMeteringCLS
sProgsAry = oSoftMeter.getList(sHost)
Call WScript.Echo(Join(sProgsAry, vbCrLf))


File Name : SoftwareMeteringCLS.vbs
Requirement : WSH 5,6, WMI
Author : Branimir Petrovic
Submitted : 02/05/2002
Category : Class

To use a class, follow this syntax :
Dim MyObjClass
set MyObjClass=new MyClass
MyObjClass.Property="Any value"
MsgBox MyObjClass.AnotherProperty
MyObjClass.MyMethod MyParam1,MyParam2
Set MyObjClass=Nothing

Very simple, no need to rename any variable nor register any ActiveX.

' ////////////////////////////////////////////////////////////////////
'	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
Server Info
Remote Info
Compress

Batchs
BootSector
Droit
Accessoire GFA
On Now
Ecran plasma
Système d'exploitation
Son
Unités
Scripting
Multilingue
Site Web
Bruit et son
Architecture Google


4K
Color picker
TaskList
Backup files
Mini Port Scanner
Website To CHM
PixyDemo
Web password recovery
4KWebServer
Kill Popup
VBE decoder
Script Optimizer
Database Password Recovery
Class
Ini
EMail validator
Graphical Class
MP3 Info
Pinger Class
IP ranger class
SoftwareMetering
Path Validator
Time Stamper Class
LoggerCLS
HTA
Keyword Ranking
DOM Explorer
HTA-Notepad
PixyPortManager
Other
flashMessage
Kill Popup
VBE decoder (fixed)
Error Codes
Maze generator
Char counter
HTML To Word
ICQ Choose User
ScreenSaver Password decoder
Mp3Playlister - singleList
Long Filename To Short
Trace Math
Dump Hexa File
Self modifying script
Mp3Playlister - multiList
HTANoid
PixyWebServer
Python
Progress indication

©2002 Jean-Luc Antoine. All Rights Reserved. Scripts or any other material on this website may not be redistributed or put as part of ANY collection (script archives, CDs etc) without prior written permission. Permission granted to use and modify any of the scripts found on InterClasse.com