101 lines
4.1 KiB
Plaintext
101 lines
4.1 KiB
Plaintext
' Windows Installer utility to preview dialogs from a install database
|
|
' For use with Windows Scripting Host, CScript.exe or WScript.exe
|
|
' Copyright (c) Microsoft Corporation. All rights reserved.
|
|
' Demonstrates the use of preview APIs
|
|
'
|
|
Option Explicit
|
|
|
|
Const msiOpenDatabaseModeReadOnly = 0
|
|
|
|
' 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 preview dialogs from an install database." &_
|
|
vbLf & " The 1st argument is the path to an install database, relative or complete path" &_
|
|
vbLf & " Subsequent arguments are dialogs to display (primary key of Dialog table)" &_
|
|
vbLf & " To show a billboard, append the Control name (Control table key) and Billboard" &_
|
|
vbLf & " name (Billboard table key) to the Dialog name, separated with colons." &_
|
|
vbLf & " If no dialogs specified, all dialogs in Dialog table are displayed sequentially" &_
|
|
vbLf & " Note: The name of the dialog, if provided, is case-sensitive" &_
|
|
vblf &_
|
|
vblf & "Copyright (C) Microsoft Corporation. All rights reserved."
|
|
Wscript.Quit 1
|
|
End If
|
|
|
|
' Connect to Windows Installer object
|
|
On Error Resume Next
|
|
Dim installer : Set installer = Nothing
|
|
Set installer = Wscript.CreateObject("WindowsInstaller.Installer") : CheckError
|
|
|
|
' Open database
|
|
Dim databasePath : databasePath = Wscript.Arguments(0)
|
|
Dim database : Set database = installer.OpenDatabase(databasePath, msiOpenDatabaseModeReadOnly) : CheckError
|
|
|
|
' Create preview object
|
|
Dim preview : Set preview = Database.EnableUIpreview : CheckError
|
|
|
|
' Get properties from Property table and put into preview object
|
|
Dim record, view : Set view = database.OpenView("SELECT `Property`,`Value` FROM `Property`") : CheckError
|
|
view.Execute : CheckError
|
|
Do
|
|
Set record = view.Fetch : CheckError
|
|
If record Is Nothing Then Exit Do
|
|
preview.Property(record.StringData(1)) = record.StringData(2) : CheckError
|
|
Loop
|
|
|
|
' Loop through list of dialog names and display each one
|
|
If argCount = 1 Then ' No dialog name, loop through all dialogs
|
|
Set view = database.OpenView("SELECT `Dialog` FROM `Dialog`") : CheckError
|
|
view.Execute : CheckError
|
|
Do
|
|
Set record = view.Fetch : CheckError
|
|
If record Is Nothing Then Exit Do
|
|
preview.ViewDialog(record.StringData(1)) : CheckError
|
|
Wait
|
|
Loop
|
|
Else ' explicit dialog names supplied
|
|
Set view = database.OpenView("SELECT `Dialog` FROM `Dialog` WHERE `Dialog`=?") : CheckError
|
|
Dim paramRecord, argNum, argArray, dialogName, controlName, billboardName
|
|
Set paramRecord = installer.CreateRecord(1)
|
|
For argNum = 1 To argCount-1
|
|
dialogName = Wscript.Arguments(argNum)
|
|
argArray = Split(dialogName,":",-1,vbTextCompare)
|
|
If UBound(argArray) <> 0 Then ' billboard to add to dialog
|
|
If UBound(argArray) <> 2 Then Fail "Incorrect billboard syntax, must specify 3 values"
|
|
dialogName = argArray(0)
|
|
controlName = argArray(1) ' we could validate that controlName is in the Control table
|
|
billboardName = argArray(2) ' we could validate that billboard is in the Billboard table
|
|
End If
|
|
paramRecord.StringData(1) = dialogName
|
|
view.Execute paramRecord : CheckError
|
|
If view.Fetch Is Nothing Then Fail "Dialog not found: " & dialogName
|
|
preview.ViewDialog(dialogName) : CheckError
|
|
If UBound(argArray) = 2 Then preview.ViewBillboard controlName, billboardName : CheckError
|
|
Wait
|
|
Next
|
|
End If
|
|
preview.ViewDialog "" ' clear dialog, must do this to release object deadlock
|
|
|
|
' Wait until user input to clear dialog. Too bad there's no function to wait for keyboard input
|
|
Sub Wait
|
|
Dim shell : Set shell = Wscript.CreateObject("Wscript.Shell")
|
|
MsgBox "Next",0,"Drag me away"
|
|
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
|
|
|
|
Sub Fail(message)
|
|
Wscript.Echo message
|
|
Wscript.Quit 2
|
|
End Sub
|