93 lines
3.5 KiB
Plaintext
93 lines
3.5 KiB
Plaintext
' Windows Installer database table import for use with Windows Scripting Host
|
|
' Copyright (c) 1999, 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"
|
|
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 = "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
|
|
Wscript.Echo message
|
|
Wscript.Quit 2
|
|
End Sub
|