190 lines
7.3 KiB
Plaintext
190 lines
7.3 KiB
Plaintext
' 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
|