85 lines
2.6 KiB
Plaintext
85 lines
2.6 KiB
Plaintext
' Windows Installer database table export for use with Windows Scripting Host
|
|
' Copyright (c) 1999, Microsoft Corporation
|
|
' Demonstrates the use of the Database.Export method and MsiDatabaseExport API
|
|
'
|
|
Option Explicit
|
|
|
|
Const msiOpenDatabaseModeReadOnly = 0
|
|
|
|
Dim shortNames:shortNames = False
|
|
Dim argCount:argCount = Wscript.Arguments.Count
|
|
Dim iArg:iArg = 0
|
|
If (argCount < 3) Then
|
|
Wscript.Echo "Windows Installer database table export utility" &_
|
|
vbNewLine & " 1st argument is path to MSI database (installer package)" &_
|
|
vbNewLine & " 2nd argument is path to folder to contain the exported table(s)" &_
|
|
vbNewLine & " Subseqent arguments are table names to export (case-sensitive)" &_
|
|
vbNewLine & " Specify '*' to export all tables, including _SummaryInformation" &_
|
|
vbNewLine & " Specify /s or -s anywhere before table list to force short names"
|
|
Wscript.Quit 1
|
|
End If
|
|
|
|
On Error Resume Next
|
|
Dim installer : Set installer = Nothing
|
|
Set installer = Wscript.CreateObject("WindowsInstaller.Installer") : CheckError
|
|
|
|
Dim database : Set database = installer.OpenDatabase(NextArgument, msiOpenDatabaseModeReadOnly) : CheckError
|
|
Dim folder : folder = NextArgument
|
|
Dim table, view, record
|
|
While iArg < argCount
|
|
table = NextArgument
|
|
If table = "*" Then
|
|
Set view = database.OpenView("SELECT `Name` FROM _Tables")
|
|
view.Execute : CheckError
|
|
Do
|
|
Set record = view.Fetch : CheckError
|
|
If record Is Nothing Then Exit Do
|
|
table = record.StringData(1)
|
|
Export table, folder : CheckError
|
|
Loop
|
|
Set view = Nothing
|
|
table = "_SummaryInformation" 'not an actual table
|
|
Export table, folder : Err.Clear ' ignore if no summary information
|
|
Else
|
|
Export table, folder : CheckError
|
|
End If
|
|
Wend
|
|
Wscript.Quit(0)
|
|
|
|
Sub Export(table, folder)
|
|
Dim file : If shortNames Then file = Left(table, 8) & ".idt" Else file = table & ".idt"
|
|
database.Export table, folder, file
|
|
End Sub
|
|
|
|
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 = "S" Then
|
|
shortNames = True
|
|
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
|