Source code of Windows XP (NT5)
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

84 lines
2.6 KiB

' 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