183 lines
8.3 KiB
Plaintext
183 lines
8.3 KiB
Plaintext
' Windows Installer utility to list component composition of an MSI database
|
|
' For use with Windows Scripting Host, CScript.exe or WScript.exe
|
|
' Copyright (c) Microsoft Corporation. All rights reserved.
|
|
' Demonstrates the various tables having foreign keys to the Component table
|
|
'
|
|
Option Explicit
|
|
Public isGUI, installer, database, message, compParam 'global variables access across functions
|
|
|
|
Const msiOpenDatabaseModeReadOnly = 0
|
|
|
|
' Check if run from GUI script host, in order to modify display
|
|
If UCase(Mid(Wscript.FullName, Len(Wscript.Path) + 2, 1)) = "W" Then isGUI = True
|
|
|
|
' Show help if no arguments or if argument contains ?
|
|
Dim argCount:argCount = Wscript.Arguments.Count
|
|
If argCount > 0 Then If InStr(1, Wscript.Arguments(0), "?", vbTextCompare) > 0 Then argCount = 0
|
|
If argCount = 0 Then
|
|
Wscript.Echo "Windows Installer utility to list component composition in an install database." &_
|
|
vbLf & " The 1st argument is the path to an install database, relative or complete path" &_
|
|
vbLf & " The 2nd argument is the name of the component (primary key of Component table)" &_
|
|
vbLf & " If the 2nd argument is not present, the names of all components will be listed" &_
|
|
vbLf & " If the 2nd argument is a ""*"", the composition of all components will be listed" &_
|
|
vbLf & " Large databases or components are better displayed using CScript than WScript." &_
|
|
vbLf & " Note: The name of the component, if provided, is case-sensitive" &_
|
|
vbNewLine &_
|
|
vbNewLine & "Copyright (C) Microsoft Corporation. All rights reserved."
|
|
Wscript.Quit 1
|
|
End If
|
|
|
|
' Connect to Windows Installer object
|
|
On Error Resume Next
|
|
Set installer = Nothing
|
|
Set installer = Wscript.CreateObject("WindowsInstaller.Installer") : CheckError
|
|
|
|
' Open database
|
|
Dim databasePath:databasePath = Wscript.Arguments(0)
|
|
Set database = installer.OpenDatabase(databasePath, msiOpenDatabaseModeReadOnly) : CheckError
|
|
|
|
If argCount = 1 Then 'If no component specified, then simply list components
|
|
ListComponents False
|
|
ShowOutput "Components for " & databasePath, message
|
|
ElseIf Left(Wscript.Arguments(1), 1) = "*" Then 'List all components
|
|
ListComponents True
|
|
Else
|
|
QueryComponent Wscript.Arguments(1)
|
|
End If
|
|
Wscript.Quit 0
|
|
|
|
' List all table rows referencing a given component
|
|
Function QueryComponent(component)
|
|
' Get component info and format output header
|
|
Dim view, record, header, componentId
|
|
Set view = database.OpenView("SELECT `ComponentId` FROM `Component` WHERE `Component` = ?") : CheckError
|
|
Set compParam = installer.CreateRecord(1)
|
|
compParam.StringData(1) = component
|
|
view.Execute compParam : CheckError
|
|
Set record = view.Fetch : CheckError
|
|
Set view = Nothing
|
|
If record Is Nothing Then Fail "Component not in database: " & component
|
|
componentId = record.StringData(1)
|
|
header = "Component: "& component & " ComponentId = " & componentId
|
|
|
|
' List of tables with foreign keys to Component table - with subsets of columns to display
|
|
DoQuery "FeatureComponents","Feature_" '
|
|
DoQuery "PublishComponent", "ComponentId,Qualifier" 'AppData,Feature
|
|
DoQuery "File", "File,Sequence,FileName,Version" 'FileSize,Language,Attributes
|
|
DoQuery "SelfReg,File", "File_" 'Cost
|
|
DoQuery "BindImage,File", "File_" 'Path
|
|
DoQuery "Font,File", "File_,FontTitle" '
|
|
DoQuery "Patch,File", "File_" 'Sequence,PatchSize,Attributes,Header
|
|
DoQuery "DuplicateFile", "FileKey,File_,DestName" 'DestFolder
|
|
DoQuery "MoveFile", "FileKey,SourceName,DestName" 'SourceFolder,DestFolder,Options
|
|
DoQuery "RemoveFile", "FileKey,FileName,DirProperty" 'InstallMode
|
|
DoQuery "IniFile", "IniFile,FileName,Section,Key" 'Value,Action
|
|
DoQuery "RemoveIniFile", "RemoveIniFile,FileName,Section,Key" 'Value,Action
|
|
DoQuery "Registry", "Registry,Root,Key,Name" 'Value
|
|
DoQuery "RemoveRegistry", "RemoveRegistry,Root,Key,Name" '
|
|
DoQuery "Shortcut", "Shortcut,Directory_,Name,Target" 'Arguments,Description,Hotkey,Icon_,IconIndex,ShowCmd,WkDir
|
|
DoQuery "Class", "CLSID,Description" 'Context,ProgId_Default,AppId_,FileType,Mask,Icon_,IconIndex,DefInprocHandler,Argument,Feature_
|
|
DoQuery "ProgId,Class", "Class_,ProgId,Description" 'ProgId_Parent,Icon_IconIndex,Insertable
|
|
DoQuery "Extension", "Extension,ProgId_" 'MIME_,Feature_
|
|
DoQuery "Verb,Extension", "Extension_,Verb" 'Sequence,Command.Argument
|
|
DoQuery "MIME,Extension", "Extension_,ContentType" 'CLSID
|
|
DoQuery "TypeLib", "LibID,Language,Version,Description" 'Directory_,Feature_,Cost
|
|
DoQuery "CreateFolder", "Directory_" '
|
|
DoQuery "Environment", "Environment,Name" 'Value
|
|
DoQuery "ODBCDriver", "Driver,Description" 'File_,File_Setup
|
|
DoQuery "ODBCAttribute,ODBCDriver", "Driver_,Attribute,Value" '
|
|
DoQuery "ODBCTranslator", "Translator,Description" 'File_,File_Setup
|
|
DoQuery "ODBCDataSource", "DataSource,Description,DriverDescription" 'Registration
|
|
DoQuery "ODBCSourceAttribute,ODBCDataSource", "DataSource_,Attribute,Value" '
|
|
DoQuery "ServiceControl", "ServiceControl,Name,Event" 'Arguments,Wait
|
|
DoQuery "ServiceInstall", "ServiceInstall,Name,DisplayName" 'ServiceType,StartType,ErrorControl,LoadOrderGroup,Dependencies,StartName,Password
|
|
DoQuery "ReserveCost", "ReserveKey,ReserveFolder" 'ReserveLocal,ReserveSource
|
|
|
|
QueryComponent = ShowOutput(header, message)
|
|
message = Empty
|
|
End Function
|
|
|
|
' List all components in database
|
|
Sub ListComponents(queryAll)
|
|
Dim view, record, component
|
|
Set view = database.OpenView("SELECT `Component`,`ComponentId` FROM `Component`") : CheckError
|
|
view.Execute : CheckError
|
|
Do
|
|
Set record = view.Fetch : CheckError
|
|
If record Is Nothing Then Exit Do
|
|
component = record.StringData(1)
|
|
If queryAll Then
|
|
If QueryComponent(component) = vbCancel Then Exit Sub
|
|
Else
|
|
If Not IsEmpty(message) Then message = message & vbLf
|
|
message = message & component
|
|
End If
|
|
Loop
|
|
End Sub
|
|
|
|
' Perform a join to query table rows linked to a given component, delimiting and qualifying names to prevent conflicts
|
|
Sub DoQuery(table, columns)
|
|
Dim view, record, columnCount, column, output, header, delim, columnList, tableList, tableDelim, query, joinTable, primaryKey, foreignKey, columnDelim
|
|
On Error Resume Next
|
|
tableList = Replace(table, ",", "`,`")
|
|
tableDelim = InStr(1, table, ",", vbTextCompare)
|
|
If tableDelim Then ' need a 3-table join
|
|
joinTable = Right(table, Len(table)-tableDelim)
|
|
table = Left(table, tableDelim-1)
|
|
foreignKey = columns
|
|
Set record = database.PrimaryKeys(joinTable)
|
|
primaryKey = record.StringData(1)
|
|
columnDelim = InStr(1, columns, ",", vbTextCompare)
|
|
If columnDelim Then foreignKey = Left(columns, columnDelim - 1)
|
|
query = " AND `" & foreignKey & "` = `" & primaryKey & "`"
|
|
End If
|
|
columnList = table & "`." & Replace(columns, ",", "`,`" & table & "`.`")
|
|
query = "SELECT `" & columnList & "` FROM `" & tableList & "` WHERE `Component_` = ?" & query
|
|
If database.TablePersistent(table) <> 1 Then Exit Sub
|
|
Set view = database.OpenView(query) : CheckError
|
|
view.Execute compParam : CheckError
|
|
Do
|
|
Set record = view.Fetch : CheckError
|
|
If record Is Nothing Then Exit Do
|
|
If IsEmpty(output) Then
|
|
If Not IsEmpty(message) Then message = message & vbLf
|
|
message = message & "----" & table & " Table---- (" & columns & ")" & vbLf
|
|
End If
|
|
output = Empty
|
|
columnCount = record.FieldCount
|
|
delim = " "
|
|
For column = 1 To columnCount
|
|
If column = columnCount Then delim = vbLf
|
|
output = output & record.StringData(column) & delim
|
|
Next
|
|
message = message & output
|
|
Loop
|
|
End Sub
|
|
|
|
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 & vbLf & errRec.FormatText
|
|
End If
|
|
Fail message
|
|
End Sub
|
|
|
|
Function ShowOutput(header, message)
|
|
ShowOutput = vbOK
|
|
If IsEmpty(message) Then Exit Function
|
|
If isGUI Then
|
|
ShowOutput = MsgBox(message, vbOKCancel, header)
|
|
Else
|
|
Wscript.Echo "> " & header
|
|
Wscript.Echo message
|
|
End If
|
|
End Function
|
|
|
|
Sub Fail(message)
|
|
Wscript.Echo message
|
|
Wscript.Quit 2
|
|
End Sub
|