Source code of Windows XP (NT5)
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

106 lines
3.4 KiB

  1. ' Windows Installer database utility to merge data from another database
  2. ' For use with Windows Scripting Host, CScript.exe or WScript.exe
  3. ' Copyright (c) 1999, Microsoft Corporation
  4. '
  5. Option Explicit
  6. 'BUGBUG Make the debug level set by commandline
  7. ' DebugOut works much better run from cscript
  8. Dim DebugMode:DebugMode = 999
  9. Const msiOpenDatabaseModeReadOnly = 0
  10. Const msiOpenDatabaseModeTransact = 1
  11. Const msiOpenDatabaseModeCreate = 3
  12. Const ForAppending = 8
  13. Const ForReading = 1
  14. Const ForWriting = 2
  15. Const TristateTrue = -1
  16. Dim argCount:argCount = Wscript.Arguments.Count
  17. Dim iArg:iArg = 0
  18. If (argCount < 5) Then
  19. Wscript.Echo "Windows Installer database merge utility" &_
  20. vbNewLine & " 1st argument is the path to MSI database (installer package)" &_
  21. vbNewLine & " 2nd argument is the path to database containing data to merge" &_
  22. vbNewLine & " 3rd argument is the Feature name to merge" &_
  23. vbNewLine & " 4th argument is the Directory rebase" &_
  24. vbNewLine & " 5th argument is name of the error log"
  25. Wscript.Quit 1
  26. End If
  27. DebugOut 0, "Target Database : " & WScript.Arguments(0)
  28. DebugOut 0, "Merge Module : " & WScript.Arguments(1)
  29. DebugOut 0, "Feature to Merge : " & WScript.Arguments(2)
  30. DebugOut 0, "Directory Rebase : " & WScript.Arguments(3)
  31. DebugOut 0, "Error Log : " & WScript.Arguments(4) & vbNewLine
  32. ' Connect to Windows Installer object
  33. On Error Resume Next
  34. Dim IMsmMerge : Set IMsmMerge = Nothing
  35. DebugOut 0, "Instantiate Msm.Merge object"
  36. Set IMsmMerge = Wscript.CreateObject("Msm.Merge")
  37. ' Dim IMsmErrors : Set IMsmErrors = Nothing
  38. ' Set IMsmErrors = IMsmMerge.Errors
  39. ' Open MSI database and MSI merge module
  40. DebugOut 0, "Open Database " & WScript.Arguments(0)
  41. Dim MSIDatabase : Set MSIDatabase = IMsmMerge.OpenDatabase(WScript.Arguments(0)) : CheckError
  42. DebugOut 0, "Open MergeModule " & WScript.Arguments(1)
  43. Dim MergeMod : Set MergeMod = IMsmMerge.OpenModule(WScript.Arguments(1), 0) : CheckError
  44. ' Set the log
  45. DebugOut 0, "Open Log " & WScript.Arguments(4)
  46. IMsmMerge.OpenLog(WScript.Arguments(4)) : CheckError
  47. ' Do the merge
  48. DebugOut 0, "Call Msm.Merge"
  49. IMsmMerge.Merge WScript.Arguments(2), WScript.Arguments(3) : CheckError
  50. ' Commit and cleanup
  51. DebugOut 0, "Close and cleanup"
  52. IMsmMerge.CloseModule() : CheckError
  53. IMsmMerge.CloseDatabase(TRUE) : CheckError
  54. IMsmMerge.CloseLog : CheckError
  55. Quit 0
  56. ' ---------------------------------------------------
  57. ' Sub CheckError()
  58. ' ---------------------------------------------------
  59. Sub CheckError
  60. Dim message, errRec
  61. If Err = 0 Then Exit Sub
  62. message = "ERROR: " & Err.Source & " " & Hex(Err) & ": " & Err.Description
  63. If Not installer Is Nothing Then
  64. Set errRec = installer.LastErrorRecord
  65. If Not errRec Is Nothing Then message = message & vbNewLine & errRec.FormatText
  66. End If
  67. Fail message
  68. End Sub
  69. ' ---------------------------------------------------
  70. ' Sub Fail()
  71. ' ---------------------------------------------------
  72. Sub Fail(message)
  73. Wscript.Echo message
  74. Wscript.Quit 2
  75. End Sub
  76. ' ---------------------------------------------------
  77. ' Sub DebugOut()
  78. '
  79. 'BUGBUG General DebugOut, how to pipe it to the debug monitor?
  80. ' ---------------------------------------------------
  81. Sub DebugOut(DebugLevel, _
  82. DebugString)
  83. if DebugLevel >= DebugMode then
  84. Wscript.Echo DebugString
  85. end if
  86. End Sub