|
|
' Windows Installer database table import for use with Windows Scripting Host ' Copyright (c) 1999-2000, Microsoft Corporation ' Demonstrates the use of the Database.Import method and MsiDatabaseImport API ' Option Explicit
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 < 3) Then Wscript.Echo "Windows Installer database table import utility" &_ vbNewLine & " 1st argument is the path to MSI database (installer package)" &_ vbNewLine & " 2nd argument is the path to folder containing the imported files" &_ vbNewLine & " Subseqent arguments are names of archive files to import" &_ vbNewLine & " Wildcards, such as *.idt, can be used to import multiple files" &_ vbNewLine & " Specify /c or -c anywhere before file list to create new database" &_ vbNewLine &_ vbNewLine & "Copyright (C) Microsoft Corporation, 1999-2000. 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
Dim openMode:openMode = msiOpenDatabaseModeTransact Dim databasePath:databasePath = NextArgument Dim folder:folder = NextArgument
' Open database and process list of files Dim database, table Set database = installer.OpenDatabase(databasePath, openMode) : CheckError While iArg < argCount table = NextArgument ' Check file name for wildcard specification If (InStr(1,table,"*",vbTextCompare) <> 0) Or (InStr(1,table,"?",vbTextCompare) <> 0) Then ' Obtain list of files matching wildcard specification Dim WshShell, fileSys, file, tempFilePath Set WshShell = Wscript.CreateObject("Wscript.Shell") : CheckError tempFilePath = WshShell.ExpandEnvironmentStrings("%TEMP%") & "\dir.tmp" WshShell.Run "cmd.exe /U /c dir /b " & folder & "\" & table & ">" & tempFilePath, 0, True : CheckError Set fileSys = CreateObject("Scripting.FileSystemObject") : CheckError Set file = fileSys.OpenTextFile(tempFilePath, ForReading, False, TristateTrue) : CheckError ' Import each file in directory list Do While file.AtEndOfStream <> True table = file.ReadLine database.Import folder, table : CheckError Loop Else database.Import folder, table : CheckError End If Wend database.Commit 'commit changes if no import errors Wscript.Quit 0
Function NextArgument Dim arg, chFlag Do arg = Wscript.Arguments(iArg) iArg = iArg + 1 chFlag = AscW(arg) If (chFlag = AscW("/")) Or (chFlag = AscW("-")) Then chFlag = UCase(Right(arg, Len(arg)-1)) If chFlag = "C" Then openMode = msiOpenDatabaseModeCreate Else Wscript.Echo "Invalid option flag:", arg : Wscript.Quit 1 End If Else Exit Do End If Loop NextArgument = arg End Function
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
|