List Products, Properties, Features, and Components

' Windows Installer utility to list registered products and product info
' For use with Windows Scripting Host, CScript.exe or WScript.exe
' Copyright (c) Microsoft Corporation. All rights reserved.
' Demonstrates the use of the product enumeration and ProductInfo methods and underlying APIs
'
Option Explicit

Const msiInstallStateNotUsed      = -7
Const msiInstallStateBadConfig    = -6
Const msiInstallStateIncomplete   = -5
Const msiInstallStateSourceAbsent = -4
Const msiInstallStateInvalidArg   = -2
Const msiInstallStateUnknown      = -1
Const msiInstallStateBroken       =  0
Const msiInstallStateAdvertised   =  1
Const msiInstallStateRemoved      =  1
Const msiInstallStateAbsent       =  2
Const msiInstallStateLocal        =  3
Const msiInstallStateSource       =  4
Const msiInstallStateDefault      =  5

' Connect to Windows Installer object
On Error Resume Next
Dim installer : Set installer = Nothing
Set installer = Wscript.CreateObject("WindowsInstaller.Installer") : CheckError

' If no arguments supplied, then list all installed or advertised products
Dim argCount:argCount = Wscript.Arguments.Count
If (argCount = 0) Then
    Dim product, products, info, productList, version
    On Error Resume Next
    Set products = installer.Products : CheckError
    For Each product In products
        version = DecodeVersion(installer.ProductInfo(product, "Version")) : CheckError
        info = product & " = " & installer.ProductInfo(product, "ProductName") & " " & version : CheckError
        If productList <> Empty Then productList = productList & vbNewLine & info Else productList = info
    Next
    If productList = Empty Then productList = "No products installed or advertised"
    Wscript.Echo productList
    Set products = Nothing
    Wscript.Quit 0
End If

' Check for ?, and show help message if found
Dim productName:productName = Wscript.Arguments(0)
If InStr(1, productName, "?", vbTextCompare) > 0 Then
    Wscript.Echo "Windows Installer utility to list registered products and product information" &_
        vbNewLine & " Lists all installed and advertised products if no arguments are specified" &_
        vbNewLine & " Else 1st argument is a product name (case-insensitive) or product ID (GUID)" &_
        vbNewLine & " If 2nd argument is missing or contains 'p', then product properties are listed" &_
        vbNewLine & " If 2nd argument contains 'f', features, parents, & installed states are listed" &_
        vbNewLine & " If 2nd argument contains 'c', installed components for that product are listed" &_
        vbNewLine & " If 2nd argument contains 'd', HKLM ""SharedDlls"" count for key files are listed" &_
        vbNewLine &_
        vbNewLine & "Copyright (C) Microsoft Corporation.  All rights reserved."
    Wscript.Quit 1
End If

' If Product name supplied, need to search for product code
Dim productCode, property, value, message
If Left(productName, 1) = "{" And Right(productName, 1) = "}" Then
    If installer.ProductState(productName) <> msiInstallStateUnknown Then productCode = UCase(productName)
Else
    For Each productCode In installer.Products : CheckError
        If LCase(installer.ProductInfo(productCode, "ProductName")) = LCase(productName) Then Exit For
    Next
End If
If IsEmpty(productCode) Then Wscript.Echo "Product is not registered: " & productName : Wscript.Quit 2

' Check option argument for type of information to display, default is properties
Dim optionFlag : If argcount > 1 Then optionFlag = LCase(Wscript.Arguments(1)) Else optionFlag = "p"
If InStr(1, optionFlag, "*", vbTextCompare) > 0 Then optionFlag = "pfcd"

If InStr(1, optionFlag, "p", vbTextCompare) > 0 Then
    message = "ProductCode = " & productCode
    For Each property In Array(_
            "Language",_
            "ProductName",_
            "PackageCode",_
            "Transforms",_
            "AssignmentType",_
            "PackageName",_
            "InstalledProductName",_
            "VersionString",_
            "RegCompany",_
            "RegOwner",_
            "ProductID",_
            "ProductIcon",_
            "InstallLocation",_
            "InstallSource",_
            "InstallDate",_
            "Publisher",_
            "LocalPackage",_
            "HelpLink",_
            "HelpTelephone",_
            "URLInfoAbout",_
            "URLUpdateInfo") : CheckError
        value = installer.ProductInfo(productCode, property) ': CheckError
        If Err <> 0 Then Err.Clear : value = Empty
        If (property = "Version") Then value = DecodeVersion(value)
        If value <> Empty Then message = message & vbNewLine & property & " = " & value
    Next
    Wscript.Echo message
End If

If InStr(1, optionFlag, "f", vbTextCompare) > 0 Then
    Dim feature, features, parent, state, featureInfo
    Set features = installer.Features(productCode)
    message = "---Features in product " & productCode & "---"
    For Each feature In features
        parent = installer.FeatureParent(productCode, feature) : CheckError
        If Len(parent) Then parent = " {" & parent & "}"
        state = installer.FeatureState(productCode, feature)
        Select Case(state)
            Case msiInstallStateBadConfig:    state = "Corrupt"
            Case msiInstallStateIncomplete:   state = "InProgress"
            Case msiInstallStateSourceAbsent: state = "SourceAbsent"
            Case msiInstallStateBroken:       state = "Broken"
            Case msiInstallStateAdvertised:   state = "Advertised"
            Case msiInstallStateAbsent:       state = "Uninstalled"
            Case msiInstallStateLocal:        state = "Local"
            Case msiInstallStateSource:       state = "Source"
            Case msiInstallStateDefault:      state = "Default"
            Case Else:                        state = "Unknown"
        End Select
        message = message & vbNewLine & feature & parent & " = " & state
    Next
    Set features = Nothing
    Wscript.Echo message
End If 

If InStr(1, optionFlag, "c", vbTextCompare) > 0 Then
    Dim component, components, client, clients, path
    Set components = installer.Components : CheckError
    message = "---Components in product " & productCode & "---"
    For Each component In components
        Set clients = installer.ComponentClients(component) : CheckError
        For Each client In Clients
            If client = productCode Then
                path = installer.ComponentPath(productCode, component) : CheckError
                message = message & vbNewLine & component & " = " & path
                Exit For
            End If
        Next
        Set clients = Nothing
    Next
    Set components = Nothing
    Wscript.Echo message
End If

If InStr(1, optionFlag, "d", vbTextCompare) > 0 Then
    Set components = installer.Components : CheckError
    message = "---Shared DLL counts for key files of " & productCode & "---"
    For Each component In components
        Set clients = installer.ComponentClients(component) : CheckError
        For Each client In Clients
            If client = productCode Then
                path = installer.ComponentPath(productCode, component) : CheckError
                If Len(path) = 0 Then path = "0"
                If AscW(path) >= 65 Then  ' ignore registry key paths
                    value = installer.RegistryValue(2, "SOFTWARE\Microsoft\Windows\CurrentVersion\SharedDlls", path)
                    If Err <> 0 Then value = 0 : Err.Clear
                    message = message & vbNewLine & value & " = " & path
                End If
                Exit For
            End If
        Next
        Set clients = Nothing
    Next
    Set components = Nothing
    Wscript.Echo message
End If

Function DecodeVersion(version)
    version = CLng(version)
    DecodeVersion = version\65536\256 & "." & (version\65535 MOD 256) & "." & (version Mod 65536)
End Function

Sub CheckError
    Dim message, errRec
    If Err = 0 Then Exit Sub
    message = Err.Source & " " & Hex(Err) & ": " & Err.Description
    If Not installer Is Nothing Then
        Set errRec = installer.LastErrorRecord
        If Not errRec Is Nothing Then message = message & vbNewLine & errRec.FormatText
    End If
    Wscript.Echo message
    Wscript.Quit 2
End Sub