Leaked source code of windows server 2003
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.

94 lines
3.3 KiB

  1. ' Windows Installer database table import for use with Windows Scripting Host
  2. ' Copyright (c) 1999-2000, Microsoft Corporation
  3. ' Demonstrates the use of the Database.Import method and MsiDatabaseImport API
  4. '
  5. Option Explicit
  6. Const msiOpenDatabaseModeReadOnly = 0
  7. Const msiOpenDatabaseModeTransact = 1
  8. Const msiOpenDatabaseModeCreate = 3
  9. Const ForAppending = 8
  10. Const ForReading = 1
  11. Const ForWriting = 2
  12. Const TristateTrue = -1
  13. Dim argCount:argCount = Wscript.Arguments.Count
  14. Dim iArg:iArg = 0
  15. If (argCount < 3) Then
  16. Wscript.Echo "Windows Installer database table import utility" &_
  17. vbNewLine & " 1st argument is the path to MSI database (installer package)" &_
  18. vbNewLine & " 2nd argument is the path to folder containing the imported files" &_
  19. vbNewLine & " Subseqent arguments are names of archive files to import" &_
  20. vbNewLine & " Wildcards, such as *.idt, can be used to import multiple files" &_
  21. vbNewLine & " Specify /c or -c anywhere before file list to create new database" &_
  22. vbNewLine &_
  23. vbNewLine & "Copyright (C) Microsoft Corporation, 1999-2000. All rights reserved."
  24. Wscript.Quit 1
  25. End If
  26. ' Connect to Windows Installer object
  27. On Error Resume Next
  28. Dim installer : Set installer = Nothing
  29. Set installer = Wscript.CreateObject("WindowsInstaller.Installer") : CheckError
  30. Dim openMode:openMode = msiOpenDatabaseModeTransact
  31. Dim databasePath:databasePath = NextArgument
  32. Dim folder:folder = NextArgument
  33. ' Open database and process list of files
  34. Dim database, table
  35. Set database = installer.OpenDatabase(databasePath, openMode) : CheckError
  36. While iArg < argCount
  37. table = NextArgument
  38. ' Check file name for wildcard specification
  39. If (InStr(1,table,"*",vbTextCompare) <> 0) Or (InStr(1,table,"?",vbTextCompare) <> 0) Then
  40. ' Obtain list of files matching wildcard specification
  41. Dim WshShell, fileSys, file, tempFilePath
  42. Set WshShell = Wscript.CreateObject("Wscript.Shell") : CheckError
  43. tempFilePath = WshShell.ExpandEnvironmentStrings("%TEMP%") & "\dir.tmp"
  44. WshShell.Run "cmd.exe /U /c dir /b " & folder & "\" & table & ">" & tempFilePath, 0, True : CheckError
  45. Set fileSys = CreateObject("Scripting.FileSystemObject") : CheckError
  46. Set file = fileSys.OpenTextFile(tempFilePath, ForReading, False, TristateTrue) : CheckError
  47. ' Import each file in directory list
  48. Do While file.AtEndOfStream <> True
  49. table = file.ReadLine
  50. database.Import folder, table : CheckError
  51. Loop
  52. Else
  53. database.Import folder, table : CheckError
  54. End If
  55. Wend
  56. database.Commit 'commit changes if no import errors
  57. Wscript.Quit 0
  58. Function NextArgument
  59. Dim arg, chFlag
  60. Do
  61. arg = Wscript.Arguments(iArg)
  62. iArg = iArg + 1
  63. chFlag = AscW(arg)
  64. If (chFlag = AscW("/")) Or (chFlag = AscW("-")) Then
  65. chFlag = UCase(Right(arg, Len(arg)-1))
  66. If chFlag = "C" Then
  67. openMode = msiOpenDatabaseModeCreate
  68. Else
  69. Wscript.Echo "Invalid option flag:", arg : Wscript.Quit 1
  70. End If
  71. Else
  72. Exit Do
  73. End If
  74. Loop
  75. NextArgument = arg
  76. End Function
  77. Sub CheckError
  78. Dim message, errRec
  79. If Err = 0 Then Exit Sub
  80. message = Err.Source & " " & Hex(Err) & ": " & Err.Description
  81. If Not installer Is Nothing Then
  82. Set errRec = installer.LastErrorRecord
  83. If Not errRec Is Nothing Then message = message & vbNewLine & errRec.FormatText
  84. End If
  85. Wscript.Echo message
  86. Wscript.Quit 2
  87. End Sub