|
|
' Windows Installer utility to manage binary streams in an installer package ' For use with Windows Scripting Host, CScript.exe or WScript.exe ' Copyright (c) 1999, Microsoft Corporation ' Demonstrates the use of the database _Streams table ' Used for entering non-database binary streams such as compressed file cabinets ' Streams that persist database binary values should be managed with table views ' Streams that persist database tables and system data are invisible in _Streams ' Option Explicit
Const msiOpenDatabaseModeReadOnly = 0 Const msiOpenDatabaseModeTransact = 1 Const msiOpenDatabaseModeCreate = 3
Const msiViewModifyInsert = 1 Const msiViewModifyUpdate = 2 Const msiViewModifyAssign = 3 Const msiViewModifyReplace = 4 Const msiViewModifyDelete = 6
Const ForAppending = 8 Const ForReading = 1 Const ForWriting = 2 Const TristateTrue = -1
' Check arg count, and display help if argument not present or 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 database stream import utility" &_ vbNewLine & " 1st argument is the path to MSI database (installer package)" &_ vbNewLine & " 2nd argument is the path to a file containing the stream data" &_ vbNewLine & " If the 2nd argument is missing, streams will be listed" &_ vbNewLine & " 3rd argument is optional, the name used for the stream" &_ vbNewLine & " If the 3rd arugment is missing, the file name is used" &_ vbNewLine & " To remove a stream, use /D or -D as the 2nd argument" &_ vbNewLine & " followed by the name of the stream in the 3rd argument" 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
' Evaluate command-line arguments and set open and update modes Dim databasePath:databasePath = Wscript.Arguments(0) Dim openMode : If argCount = 1 Then openMode = msiOpenDatabaseModeReadOnly Else openMode = msiOpenDatabaseModeTransact Dim updateMode : If argCount > 1 Then updateMode = msiViewModifyAssign 'Either insert or replace existing row Dim importPath : If argCount > 1 Then importPath = Wscript.Arguments(1) Dim streamName : If argCount > 2 Then streamName = Wscript.Arguments(2) If streamName = Empty And importPath <> Empty Then streamName = Right(importPath, Len(importPath) - InStrRev(importPath, "\",-1,vbTextCompare)) If UCase(importPath) = "/D" Or UCase(importPath) = "-D" Then updateMode = msiViewModifyDelete : importPath = Empty 'Stream will be deleted if no input data
' Open database and create a view on the _Streams table Dim sqlQuery : Select Case updateMode Case msiOpenDatabaseModeReadOnly: sqlQuery = "SELECT `Name` FROM Binary" Case msiViewModifyAssign: sqlQuery = "SELECT `Name`,`Data` FROM Binary" Case msiViewModifyDelete: sqlQuery = "SELECT `Name` FROM Binary WHERE `Name` = ?" End Select Dim database : Set database = installer.OpenDatabase(databasePath, openMode) : CheckError Dim view : Set view = database.OpenView(sqlQuery) Dim record
If openMode = msiOpenDatabaseModeReadOnly Then 'If listing streams, simply fetch all records Dim message, name view.Execute : CheckError Do Set record = view.Fetch If record Is Nothing Then Exit Do name = record.StringData(1) If message = Empty Then message = name Else message = message & vbNewLine & name Loop Wscript.Echo message Else 'If adding a stream, insert a row, else if removing a stream, delete the row Set record = installer.CreateRecord(2) record.StringData(1) = streamName view.Execute record : CheckError If importPath <> Empty Then 'Insert stream - copy data into stream record.SetStream 2, importPath : CheckError Else 'Delete stream, fetch first to provide better error message if missing Set record = view.Fetch If record Is Nothing Then Wscript.Echo "Stream not present:", streamName : Wscript.Quit 2 End If view.Modify updateMode, record : CheckError database.Commit : CheckError Set view = Nothing Set database = Nothing CheckError End If
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
|