home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 June / Chip_2001-06_cd1.bin / zkuste / vbasic / Data / Utility / MSISDK15.msi / WiLstXfm.vbs < prev    next >
Text File  |  2000-10-05  |  4KB  |  119 lines

  1. ' Windows Installer transform viewer for use with Windows Scripting Host
  2. ' Copyright (c) 1999-2000, Microsoft Corporation
  3. ' Demonstrates the use of the database APIs for viewing transform files
  4. '
  5. Option Explicit
  6.  
  7. Const iteAddExistingRow      = 1
  8. Const iteDelNonExistingRow   = 2
  9. Const iteAddExistingTable    = 4
  10. Const iteDelNonExistingTable = 8
  11. Const iteUpdNonExistingRow   = 16
  12. Const iteChangeCodePage      = 32
  13. Const iteViewTransform       = 256
  14.  
  15. Const icdLong       = 0
  16. Const icdShort      = &h400
  17. Const icdObject     = &h800
  18. Const icdString     = &hC00
  19. Const icdNullable   = &h1000
  20. Const icdPrimaryKey = &h2000
  21. Const icdNoNulls    = &h0000
  22. Const icdPersistent = &h0100
  23. Const icdTemporary  = &h0000
  24.  
  25. Const idoReadOnly = 0
  26.  
  27. Dim gErrors, installer, base, database, argCount, arg, argValue
  28. gErrors = iteAddExistingRow + iteDelNonExistingRow + iteAddExistingTable + iteDelNonExistingTable + iteUpdNonExistingRow + iteChangeCodePage
  29. Set database = Nothing
  30.  
  31. ' Check arg count, and display help if no all arguments present
  32. argCount = WScript.Arguments.Count
  33. If (argCount < 2) Then
  34.     WScript.Echo "Windows Installer Transform Viewer for Windows Scripting Host (CScript.exe)" &_
  35.         vbNewLine & " 1st non-numeric argument is path to base database which transforms reference" &_
  36.         vbNewLine & " Subsequent non-numeric arguments are paths to the transforms to be viewed" &_
  37.         vbNewLine & " Numeric argument is optional error suppression flags (default is ignore all)" &_
  38.         vbNewLine & " Arguments are executed left-to-right, as encountered" &_
  39.         vbNewLine &_
  40.         vbNewLine & "Copyright (C) Microsoft Corporation, 1999-2000.  All rights reserved."
  41.     Wscript.Quit 1
  42. End If
  43.  
  44. ' Cannot run with GUI script host, as listing is performed to standard out
  45. If UCase(Mid(Wscript.FullName, Len(Wscript.Path) + 2, 1)) = "W" Then
  46.     WScript.Echo "Cannot use WScript.exe - must use CScript.exe with this program"
  47.     Wscript.Quit 2
  48. End If
  49.  
  50. ' Create installer object
  51. On Error Resume Next
  52. Set installer = CreateObject("WindowsInstaller.Installer") : CheckError
  53.  
  54. ' Process arguments, opening database and applying transforms
  55. For arg = 0 To argCount - 1
  56.     argValue = WScript.Arguments(arg)
  57.     If IsNumeric(argValue) Then
  58.         gErrors = argValue
  59.     ElseIf database Is Nothing Then
  60.         Set database = installer.OpenDatabase(argValue, idoReadOnly)
  61.     Else
  62.         database.ApplyTransform argValue, iteViewTransform + gErrors
  63.     End If
  64.     CheckError
  65. Next
  66. ListTransform(database)
  67.  
  68. Function DecodeColDef(colDef)
  69.     Dim def
  70.     Select Case colDef AND (icdShort OR icdObject)
  71.     Case icdLong
  72.         def = "LONG"
  73.     Case icdShort
  74.         def = "SHORT"
  75.     Case icdObject
  76.         def = "OBJECT"
  77.     Case icdString
  78.         def = "CHAR(" & (colDef AND 255) & ")"
  79.     End Select
  80.     If (colDef AND icdNullable)   =  0 Then def = def & " NOT NULL"
  81.     If (colDef AND icdPrimaryKey) <> 0 Then def = def & " PRIMARY KEY"
  82.     DecodeColDef = def
  83. End Function
  84.  
  85. Sub ListTransform(database)
  86.     Dim view, record, row, column, change
  87.     On Error Resume Next
  88.     Set view = database.OpenView("SELECT * FROM `_TransformView` ORDER BY `Table`, `Row`")
  89.     If Err <> 0 Then Wscript.Echo "Transform viewing supported only in builds 4906 and beyond of MSI.DLL" : Wscript.Quit 2
  90.     view.Execute : CheckError
  91.     Do
  92.         Set record = view.Fetch : CheckError
  93.         If record Is Nothing Then Exit Do
  94.         change = Empty
  95.         If record.IsNull(3) Then
  96.             row = "<DDL>"
  97.             If NOT record.IsNull(4) Then change = "[" & record.StringData(5) & "]: " & DecodeColDef(record.StringData(4))
  98.         Else
  99.             row = "[" & Join(Split(record.StringData(3), vbTab, -1), ",") & "]"
  100.             If record.StringData(2) <> "INSERT" AND record.StringData(2) <> "DELETE" Then change = "{" & record.StringData(5) & "}->{" & record.StringData(4) & "}"
  101.         End If
  102.         column = record.StringData(1) & " " & record.StringData(2)
  103.         if Len(column) < 24 Then column = column & Space(24 - Len(column))
  104.         WScript.Echo column, row, change
  105.     Loop
  106. End Sub
  107.  
  108. Sub CheckError
  109.     Dim message, errRec
  110.     If Err = 0 Then Exit Sub
  111.     message = Err.Source & " " & Hex(Err) & ": " & Err.Description
  112.     If Not installer Is Nothing Then
  113.         Set errRec = installer.LastErrorRecord
  114.         If Not errRec Is Nothing Then message = message & vbNewLine & errRec.FormatText
  115.     End If
  116.     Wscript.Echo message
  117.     Wscript.Quit 2
  118. End Sub
  119.