Option Explicit

Const HKEY_LOCAL_MACHINE = &H80000002

Dim arrSubKeys, blnFilter, i, intValid
Dim colPings, objReg, objStatus, objWMIService
Dim strComputer, strDate, strFilter, strHive, strKey, strKeyPath
Dim strMsg, strName, strPrg, strQuery, strQuietUnst, strUninstall, strVersion

blnFilter  = False
strHive    = HKEY_LOCAL_MACHINE
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
strMsg     = ""

With WScript.Arguments
	If .Unnamed.Count > 1 Then Syntax
	intValid = 0
	If .Named.Exists( "F" ) Then
		strFilter = .Named.Item( "F" )
		If strFilter = "" Then Syntax
		intValid  = intValid + 1
		blnFilter = True
	End If
	If .Named.Exists( "M" ) Then
		intValid    = intValid + 1
		strComputer = Trim( .Named.Item( "M" ) )
		If strComputer = "" Then Syntax
	Else
		strComputer = "."
	End If
	If .Named.Count <> intValid Then Syntax
End With

' Use custom error handling, just in case the remote computer
' won't respond or this script runs on a Windows 2000 computer
On Error Resume Next

If strComputer <> "." Then
	strQuery = "SELECT * FROM Win32_PingStatus WHERE Address='" & strComputer & "'"
	Set objWMIService = GetObject( "winmgmts://./root/cimv2" )
	Set colPings      = objWMIService.ExecQuery( strQuery )
	For Each objStatus in colPings
		If IsNull( objStatus.StatusCode ) Or objStatus.StatusCode <> 0 Then
			strMsg = "Computer " & strComputer & " did not respond." & vbCrLf
			Syntax
		End If
	Next
	Set colPings      = Nothing
	Set objWMIService = Nothing
End If

Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//" & strComputer & "/root/default:StdRegProv" )
If Err Then
	If strComputer = "." Then
		strMsg = "Error connecting to the local WMI Standard Registry Provider." & vbCrLf
	Else
		strMsg = "Error connecting to " & strComputer & "'s WMI StdReg Provider." & vbCrLf
	End If
	Syntax
End If

On Error Goto 0

objReg.EnumKey strHive, strKeyPath, arrSubKeys

For i = 0 To UBound( arrSubKeys )
	strDate      = ""
	strName      = ""
	strQuietUnst = ""
	strUninstall = ""
	strVersion   = ""
	strKey = strKeyPath & "\" & arrSubKeys(i)
	objReg.GetStringValue         strHive, strKey, "DisplayName",          strName
	objReg.GetStringValue         strHive, strKey, "DisplayVersion",       strVersion
	objReg.GetStringValue         strHive, strKey, "InstallDate",          strDate
	objReg.GetExpandedStringValue strHive, strKey, "UninstallString",      strUninstall
	objReg.GetExpandedStringValue strHive, strKey, "QuietUninstallString", strQuietUnst
	If Trim( strQuietUnst ) <> "" Then strUninstall = strQuietUnst
	strPrg = "Program Name      = " & strName       & vbCrLf _
	       & "Program Version   = " & strVersion    & vbCrLf _
	       & "Install Date      = " & strDate       & vbCrLf _
	       & "Unique Identifier = " & arrSubKeys(i) & vbCrLf _ 
	       & "Uninstall String  = " & strUninstall  & vbCrLf & vbCrLf
	If Trim( strName ) <> "" Then
		If blnFilter Then
			If InStr( 1, strName, strFilter, vbTextCompare ) Then
					strMsg = strMsg & strPrg
			End If
		Else
			strMsg = strMsg & strPrg
		End If
	End If
Next

Set objReg = Nothing

WScript.Echo strMsg


Sub Syntax
	strMsg = strMsg & vbCrLf _
	       & UCase( WScript.ScriptName ) & ",  Version 1.21" _
	       & vbCrLf _
	       & "List or search uninstall command lines" _
	       & vbCrLf & vbCrLf _
	       & "Usage: CSCRIPT.EXE //NoLogo " & UCase( WScript.ScriptName ) _
	       & " [/M:""remote_computer""] [/F:""filter""]" _
	       & vbCrLf & vbCrLf _
	       & "Where: /M:""remote_computer"" specifies a remote computer to be queried" _
	       & vbCrLf _
	       & "                            (default is the local computer)" _
	       & vbCrLf _
	       & "       /F:""filter""          narrows down the search result to programs whose" _
	       & vbCrLf _
	       & "                            descriptive name contains the string ""filter""" _
	       & vbCrLf _
	       & "                            (default is no filtering, just list all programs)" _
	       & vbCrLf & vbCrLf _
	       & "The result will look like this:" _
	       & vbCrLf & vbCrLf _
	       & "       Program Name      = Microsoft .NET Framework 1.1" _
	       & vbCrLf _
	       & "       Program Version   = 1.1.4322" _
	       & vbCrLf _
	       & "       Install Date      = 20080106" _
	       & vbCrLf _
	       & "       Unique Identifier = {CB2F7EDD-9D1F-43C1-90FC-4F52EAE172A1}" _
	       & vbCrLf _
	       & "       Uninstall String  = MsiExec.exe /X{CB2F7EDD-9D1F-43C1-90FC-4F52EAE172A1}" _
	       & vbCrLf & vbCrLf _
	       & "Written by Rob van der Woude" _
	       & vbCrLf _
	       & "http://www.robvanderwoude.com"
	WScript.Echo strMsg
	WScript.Quit 1
End Sub