windows-nt/Source/XPSP1/NT/tools/wiimport.vbs

93 lines
3.4 KiB
Plaintext
Raw Normal View History

2020-09-26 03:20:57 -05:00
' 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