Windows-Server-2003/tools/wimsmmerge.vbs

107 lines
3.4 KiB
Plaintext
Raw Normal View History

2024-08-04 01:28:15 +02:00
' Windows Installer database utility to merge data from another database
' For use with Windows Scripting Host, CScript.exe or WScript.exe
' Copyright (c) 1999, Microsoft Corporation
'
Option Explicit
'BUGBUG Make the debug level set by commandline
' DebugOut works much better run from cscript
Dim DebugMode:DebugMode = 999
Const msiOpenDatabaseModeReadOnly = 0
Const msiOpenDatabaseModeTransact = 1
Const msiOpenDatabaseModeCreate = 3
Const ForAppending = 8
Const ForReading = 1
Const ForWriting = 2
Const TristateTrue = -1
Dim argCount:argCount = Wscript.Arguments.Count
Dim iArg:iArg = 0
If (argCount < 5) Then
Wscript.Echo "Windows Installer database merge utility" &_
vbNewLine & " 1st argument is the path to MSI database (installer package)" &_
vbNewLine & " 2nd argument is the path to database containing data to merge" &_
vbNewLine & " 3rd argument is the Feature name to merge" &_
vbNewLine & " 4th argument is the Directory rebase" &_
vbNewLine & " 5th argument is name of the error log"
Wscript.Quit 1
End If
DebugOut 0, "Target Database : " & WScript.Arguments(0)
DebugOut 0, "Merge Module : " & WScript.Arguments(1)
DebugOut 0, "Feature to Merge : " & WScript.Arguments(2)
DebugOut 0, "Directory Rebase : " & WScript.Arguments(3)
DebugOut 0, "Error Log : " & WScript.Arguments(4) & vbNewLine
' Connect to Windows Installer object
On Error Resume Next
Dim IMsmMerge : Set IMsmMerge = Nothing
DebugOut 0, "Instantiate Msm.Merge object"
Set IMsmMerge = Wscript.CreateObject("Msm.Merge")
' Dim IMsmErrors : Set IMsmErrors = Nothing
' Set IMsmErrors = IMsmMerge.Errors
' Open MSI database and MSI merge module
DebugOut 0, "Open Database " & WScript.Arguments(0)
Dim MSIDatabase : Set MSIDatabase = IMsmMerge.OpenDatabase(WScript.Arguments(0)) : CheckError
DebugOut 0, "Open MergeModule " & WScript.Arguments(1)
Dim MergeMod : Set MergeMod = IMsmMerge.OpenModule(WScript.Arguments(1), 0) : CheckError
' Set the log
DebugOut 0, "Open Log " & WScript.Arguments(4)
IMsmMerge.OpenLog(WScript.Arguments(4)) : CheckError
' Do the merge
DebugOut 0, "Call Msm.Merge"
IMsmMerge.Merge WScript.Arguments(2), WScript.Arguments(3) : CheckError
' Commit and cleanup
DebugOut 0, "Close and cleanup"
IMsmMerge.CloseModule() : CheckError
IMsmMerge.CloseDatabase(TRUE) : CheckError
IMsmMerge.CloseLog : CheckError
Quit 0
' ---------------------------------------------------
' Sub CheckError()
' ---------------------------------------------------
Sub CheckError
Dim message, errRec
If Err = 0 Then Exit Sub
message = "ERROR: " & 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
Fail message
End Sub
' ---------------------------------------------------
' Sub Fail()
' ---------------------------------------------------
Sub Fail(message)
Wscript.Echo message
Wscript.Quit 2
End Sub
' ---------------------------------------------------
' Sub DebugOut()
'
'BUGBUG General DebugOut, how to pipe it to the debug monitor?
' ---------------------------------------------------
Sub DebugOut(DebugLevel, _
DebugString)
if DebugLevel >= DebugMode then
Wscript.Echo DebugString
end if
End Sub