193 lines
7.9 KiB
Plaintext
193 lines
7.9 KiB
Plaintext
' Windows Installer utility to list feature composition in an MSI database
|
|
' For use with Windows Scripting Host, CScript.exe or WScript.exe
|
|
' Copyright (c) Microsoft Corporation. All rights reserved.
|
|
' Demonstrates the use of adding temporary columns to a read-only database
|
|
'
|
|
Option Explicit
|
|
Public isGUI, installer, database, message, featureParam, nextSequence 'global variables accessed across functions
|
|
|
|
Const msiOpenDatabaseModeReadOnly = 0
|
|
Const msiDbNullInteger = &h80000000
|
|
Const msiViewModifyUpdate = 2
|
|
|
|
' 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 feature composition in an installer 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 feature (the primary key of Feature table)" &_
|
|
vbLf & " If the 2nd argument is not present, all feature names will be listed as a tree" &_
|
|
vbLf & " If the 2nd argument is ""*"" then the composition of all features will be listed" &_
|
|
vbLf & " Large databases or features are better displayed by using CScript than WScript" &_
|
|
vbLf & " Note: The name of the feature, 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
|
|
REM Set database = installer.OpenDatabase(databasePath, 1) : CheckError
|
|
|
|
If argCount = 1 Then 'If no feature specified, then simply list features
|
|
ListFeatures False
|
|
ShowOutput "Features for " & databasePath, message
|
|
ElseIf Left(Wscript.Arguments(1), 1) = "*" Then 'List all features
|
|
ListFeatures True
|
|
Else
|
|
QueryFeature Wscript.Arguments(1)
|
|
End If
|
|
Wscript.Quit 0
|
|
|
|
' List all table rows referencing a given feature
|
|
Function QueryFeature(feature)
|
|
' Get feature info and format output header
|
|
Dim view, record, header, parent
|
|
Set view = database.OpenView("SELECT `Feature_Parent` FROM `Feature` WHERE `Feature` = ?") : CheckError
|
|
Set featureParam = installer.CreateRecord(1)
|
|
featureParam.StringData(1) = feature
|
|
view.Execute featureParam : CheckError
|
|
Set record = view.Fetch : CheckError
|
|
Set view = Nothing
|
|
If record Is Nothing Then Fail "Feature not in database: " & feature
|
|
parent = record.StringData(1)
|
|
header = "Feature: "& feature & " Parent: " & parent
|
|
|
|
' List of tables with foreign keys to Feature table - with subsets of columns to display
|
|
DoQuery "FeatureComponents","Component_" '
|
|
DoQuery "Condition", "Level,Condition" '
|
|
DoQuery "Billboard", "Billboard,Action" 'Ordering
|
|
|
|
QueryFeature = ShowOutput(header, message)
|
|
message = Empty
|
|
End Function
|
|
|
|
' Query used for sorting and corresponding record field indices
|
|
const irecParent = 1 'put first in order to use as query parameter
|
|
const irecChild = 2 'primary key of Feature table
|
|
const irecSequence = 3 'temporary column added for sorting
|
|
const sqlSort = "SELECT `Feature_Parent`,`Feature`,`Sequence` FROM `Feature`"
|
|
|
|
' Recursive function to resolve parent feature chain, return tree level (low order 8 bits of sequence number)
|
|
Function LinkParent(childView)
|
|
Dim view, record, level
|
|
On Error Resume Next
|
|
Set record = childView.Fetch
|
|
If record Is Nothing Then Exit Function 'return Empty if no record found
|
|
If Not record.IsNull(irecSequence) Then LinkParent = (record.IntegerData(irecSequence) And 255) + 1 : Exit Function 'Already resolved
|
|
If record.IsNull(irecParent) Or record.StringData(irecParent) = record.StringData(irecChild) Then 'Root node
|
|
level = 0
|
|
Else 'child node, need to get level from parent
|
|
Set view = database.OpenView(sqlSort & " WHERE `Feature` = ?") : CheckError
|
|
view.Execute record : CheckError '1st param is parent feature
|
|
level = LinkParent(view)
|
|
If IsEmpty(level) Then Fail "Feature parent does not exist: " & record.StringData(irecParent)
|
|
End If
|
|
record.IntegerData(irecSequence) = nextSequence + level
|
|
nextSequence = nextSequence + 256
|
|
childView.Modify msiViewModifyUpdate, record : CheckError
|
|
LinkParent = level + 1
|
|
End Function
|
|
|
|
' List all features in database, sorted hierarchically
|
|
Sub ListFeatures(queryAll)
|
|
Dim viewSchema, view, record, feature, level
|
|
On Error Resume Next
|
|
Set viewSchema = database.OpenView("ALTER TABLE Feature ADD Sequence LONG TEMPORARY") : CheckError
|
|
viewSchema.Execute : CheckError 'Add ordering column, keep view open to hold temp columns
|
|
Set view = database.OpenView(sqlSort) : CheckError
|
|
view.Execute : CheckError
|
|
nextSequence = 0
|
|
While LinkParent(view) : Wend 'Loop to link rows hierachically
|
|
Set view = database.OpenView("SELECT `Feature`,`Title`, `Sequence` FROM `Feature` ORDER BY Sequence") : CheckError
|
|
view.Execute : CheckError
|
|
Do
|
|
Set record = view.Fetch : CheckError
|
|
If record Is Nothing Then Exit Do
|
|
feature = record.StringData(1)
|
|
level = record.IntegerData(3) And 255
|
|
If queryAll Then
|
|
If QueryFeature(feature) = vbCancel Then Exit Sub
|
|
Else
|
|
If Not IsEmpty(message) Then message = message & vbLf
|
|
message = message & Space(level * 2) & feature & " (" & record.StringData(2) & ")"
|
|
End If
|
|
Loop
|
|
End Sub
|
|
|
|
' Perform a join to query table rows linked to a given feature, 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 `Feature_` = ?" & query
|
|
If database.TablePersistent(table) <> 1 Then Exit Sub
|
|
Set view = database.OpenView(query) : CheckError
|
|
view.Execute featureParam : 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
|