home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 June / Chip_2001-06_cd1.bin / zkuste / vbasic / Data / Utility / MSISDK15.msi / WiExport.vbs < prev    next >
Text File  |  2000-10-05  |  3KB  |  87 lines
  1. ' Windows Installer database table export for use with Windows Scripting Host
  2. ' Copyright (c) 1999-2000, Microsoft Corporation
  3. ' Demonstrates the use of the Database.Export method and MsiDatabaseExport API
  4. '
  5. Option Explicit
  6.  
  7. Const msiOpenDatabaseModeReadOnly     = 0
  8.  
  9. Dim shortNames:shortNames = False
  10. Dim argCount:argCount = Wscript.Arguments.Count
  11. Dim iArg:iArg = 0
  12. If (argCount < 3) Then
  13.     Wscript.Echo "Windows Installer database table export utility" &_
  14.         vbNewLine & " 1st argument is path to MSI database (installer package)" &_
  15.         vbNewLine & " 2nd argument is path to folder to contain the exported table(s)" &_
  16.         vbNewLine & " Subseqent arguments are table names to export (case-sensitive)" &_
  17.         vbNewLine & " Specify '*' to export all tables, including _SummaryInformation" &_
  18.         vbNewLine & " Specify /s or -s anywhere before table list to force short names" &_
  19.         vbNewLine &_
  20.         vbNewLine & " Copyright (C) Microsoft Corporation, 1999-2000.  All rights reserved."
  21.     Wscript.Quit 1
  22. End If
  23.  
  24. On Error Resume Next
  25. Dim installer : Set installer = Nothing
  26. Set installer = Wscript.CreateObject("WindowsInstaller.Installer") : CheckError
  27.  
  28. Dim database : Set database = installer.OpenDatabase(NextArgument, msiOpenDatabaseModeReadOnly) : CheckError
  29. Dim folder : folder = NextArgument
  30. Dim table, view, record
  31. While iArg < argCount
  32.     table = NextArgument
  33.     If table = "*" Then
  34.         Set view = database.OpenView("SELECT `Name` FROM _Tables")
  35.         view.Execute : CheckError
  36.         Do
  37.             Set record = view.Fetch : CheckError
  38.             If record Is Nothing Then Exit Do
  39.             table = record.StringData(1)
  40.             Export table, folder : CheckError
  41.         Loop
  42.         Set view = Nothing
  43.         table = "_SummaryInformation" 'not an actual table
  44.         Export table, folder : Err.Clear  ' ignore if no summary information
  45.     Else
  46.         Export table, folder : CheckError
  47.     End If
  48. Wend
  49. Wscript.Quit(0)            
  50.  
  51. Sub Export(table, folder)
  52.     Dim file : If shortNames Then file = Left(table, 8) & ".idt" Else file = table & ".idt"
  53.     database.Export table, folder, file
  54. End Sub
  55.  
  56. Function NextArgument
  57.     Dim arg, chFlag
  58.     Do
  59.         arg = Wscript.Arguments(iArg)
  60.         iArg = iArg + 1
  61.         chFlag = AscW(arg)
  62.         If (chFlag = AscW("/")) Or (chFlag = AscW("-")) Then
  63.             chFlag = UCase(Right(arg, Len(arg)-1))
  64.             If chFlag = "S" Then 
  65.                 shortNames = True
  66.             Else
  67.                 Wscript.Echo "Invalid option flag:", arg : Wscript.Quit 1
  68.             End If
  69.         Else
  70.             Exit Do
  71.         End If
  72.     Loop
  73.     NextArgument = arg
  74. End Function
  75.  
  76. Sub CheckError
  77.     Dim message, errRec
  78.     If Err = 0 Then Exit Sub
  79.     message = Err.Source & " " & Hex(Err) & ": " & Err.Description
  80.     If Not installer Is Nothing Then
  81.         Set errRec = installer.LastErrorRecord
  82.         If Not errRec Is Nothing Then message = message & vbNewLine & errRec.FormatText
  83.     End If
  84.     Wscript.Echo message
  85.     Wscript.Quit 2
  86. End Sub
  87.