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

' 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