home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 June / Chip_2001-06_cd1.bin / zkuste / vbasic / Data / Utility / MSISDK15.msi / WiFeatur.vbs < prev    next >
Text File  |  2000-10-05  |  8KB  |  192 lines
  1. ' Windows Installer utility to list feature composition in an MSI database
  2. ' For use with Windows Scripting Host, CScript.exe or WScript.exe
  3. ' Copyright (c) 1999-2000, Microsoft Corporation
  4. ' Demonstrates the use of adding temporary columns to a read-only database
  5. '
  6. Option Explicit
  7. Public isGUI, installer, database, message, featureParam, nextSequence  'global variables accessed across functions
  8.  
  9. Const msiOpenDatabaseModeReadOnly = 0
  10. Const msiDbNullInteger            = &h80000000
  11. Const msiViewModifyUpdate         = 2
  12.  
  13. ' Check if run from GUI script host, in order to modify display
  14. If UCase(Mid(Wscript.FullName, Len(Wscript.Path) + 2, 1)) = "W" Then isGUI = True
  15.  
  16. ' Show help if no arguments or if argument contains ?
  17. Dim argCount:argCount = Wscript.Arguments.Count
  18. If argCount > 0 Then If InStr(1, Wscript.Arguments(0), "?", vbTextCompare) > 0 Then argCount = 0
  19. If argCount = 0 Then
  20.     Wscript.Echo "Windows Installer utility to list feature composition in an installer database." &_
  21.         vbLf & " The 1st argument is the path to an install database, relative or complete path" &_
  22.         vbLf & " The 2nd argument is the name of the feature (the primary key of Feature table)" &_
  23.         vbLf & " If the 2nd argument is not present, all feature names will be listed as a tree" &_
  24.         vbLf & " If the 2nd argument is ""*"" then the composition of all features will be listed" &_
  25.         vbLf & " Large databases or features are better displayed by using CScript than WScript" &_
  26.         vbNewLine &_
  27.         vbNewLine & "Copyright (C) Microsoft Corporation, 1999-2000.  All rights reserved."
  28.     Wscript.Quit 1
  29. End If
  30.  
  31. ' Connect to Windows Installer object
  32. REM On Error Resume Next
  33. Set installer = Nothing
  34. Set installer = Wscript.CreateObject("WindowsInstaller.Installer") : CheckError
  35.  
  36. ' Open database
  37. Dim databasePath:databasePath = Wscript.Arguments(0)
  38. Set database = installer.OpenDatabase(databasePath, msiOpenDatabaseModeReadOnly) : CheckError
  39. REM Set database = installer.OpenDatabase(databasePath, 1) : CheckError
  40.  
  41. If argCount = 1 Then  'If no feature specified, then simply list features
  42.     ListFeatures False
  43.     ShowOutput "Features for " & databasePath, message
  44. ElseIf Left(Wscript.Arguments(1), 1) = "*" Then 'List all features
  45.     ListFeatures True
  46. Else
  47.     QueryFeature Wscript.Arguments(1) 
  48. End If
  49. Wscript.Quit 0
  50.  
  51. ' List all table rows referencing a given feature
  52. Function QueryFeature(feature)
  53.     ' Get feature info and format output header
  54.     Dim view, record, header, parent
  55.     Set view = database.OpenView("SELECT `Feature_Parent` FROM `Feature` WHERE `Feature` = ?") : CheckError
  56.     Set featureParam = installer.CreateRecord(1)
  57.     featureParam.StringData(1) = feature
  58.     view.Execute featureParam : CheckError
  59.     Set record = view.Fetch : CheckError
  60.     Set view = Nothing
  61.     If record Is Nothing Then Fail "Feature not in database: " & feature
  62.     parent = record.StringData(1)
  63.     header = "Feature: "& feature & "  Parent: " & parent
  64.  
  65.     ' List of tables with foreign keys to Feature table - with subsets of columns to display
  66.     DoQuery "FeatureComponents","Component_"                         '
  67.     DoQuery "Condition",        "Level,Condition"                    '
  68.     DoQuery "Billboard",        "Billboard,Action"                   'Ordering
  69.  
  70.     QueryFeature = ShowOutput(header, message)
  71.     message = Empty
  72. End Function
  73.  
  74. ' Query used for sorting and corresponding record field indices
  75. const irecParent   = 1  'put first in order to use as query parameter
  76. const irecChild    = 2  'primary key of Feature table
  77. const irecSequence = 3  'temporary column added for sorting
  78. const sqlSort = "SELECT `Feature_Parent`,`Feature`,`Sequence` FROM `Feature`"
  79.  
  80. ' Recursive function to resolve parent feature chain, return tree level (low order 8 bits of sequence number)
  81. Function LinkParent(childView)
  82.     Dim view, record, level
  83.     On Error Resume Next
  84.     Set record = childView.Fetch
  85.     If record Is Nothing Then Exit Function  'return Empty if no record found
  86.     If Not record.IsNull(irecSequence) Then LinkParent = (record.IntegerData(irecSequence) And 255) + 1 : Exit Function 'Already resolved
  87.     If record.IsNull(irecParent) Or record.StringData(irecParent) = record.StringData(irecChild) Then 'Root node
  88.         level = 0
  89.     Else  'child node, need to get level from parent
  90.         Set view = database.OpenView(sqlSort & " WHERE `Feature` = ?") : CheckError
  91.         view.Execute record : CheckError '1st param is parent feature
  92.         level = LinkParent(view)
  93.         If IsEmpty(level) Then Fail "Feature parent does not exist: " & record.StringData(irecParent)
  94.     End If
  95.     record.IntegerData(irecSequence) = nextSequence + level
  96.     nextSequence = nextSequence + 256
  97.     childView.Modify msiViewModifyUpdate, record : CheckError
  98.     LinkParent = level + 1
  99. End Function
  100.  
  101. ' List all features in database, sorted hierarchically
  102. Sub ListFeatures(queryAll)
  103.     Dim viewSchema, view, record, feature, level
  104.     On Error Resume Next
  105.     Set viewSchema = database.OpenView("ALTER TABLE Feature ADD Sequence LONG TEMPORARY") : CheckError
  106.     viewSchema.Execute : CheckError  'Add ordering column, keep view open to hold temp columns
  107.     Set view = database.OpenView(sqlSort) : CheckError
  108.     view.Execute : CheckError
  109.     nextSequence = 0
  110.     While LinkParent(view) : Wend  'Loop to link rows hierachically
  111.     Set view = database.OpenView("SELECT `Feature`,`Title`, `Sequence` FROM `Feature` ORDER BY Sequence") : CheckError
  112.     view.Execute : CheckError
  113.     Do
  114.         Set record = view.Fetch : CheckError
  115.         If record Is Nothing Then Exit Do
  116.         feature = record.StringData(1)
  117.         level = record.IntegerData(3) And 255
  118.         If queryAll Then
  119.             If QueryFeature(feature) = vbCancel Then Exit Sub
  120.         Else
  121.             If Not IsEmpty(message) Then message = message & vbLf
  122.             message = message & Space(level * 2) & feature & "  (" & record.StringData(2) & ")"
  123.         End If
  124.     Loop
  125. End Sub
  126.  
  127. ' Perform a join to query table rows linked to a given feature, delimiting and qualifying names to prevent conflicts
  128. Sub DoQuery(table, columns)
  129.     Dim view, record, columnCount, column, output, header, delim, columnList, tableList, tableDelim, query, joinTable, primaryKey, foreignKey, columnDelim
  130.     On Error Resume Next
  131.     tableList  = Replace(table,   ",", "`,`")
  132.     tableDelim = InStr(1, table, ",", vbTextCompare)
  133.     If tableDelim Then  ' need a 3-table join
  134.         joinTable = Right(table, Len(table)-tableDelim)
  135.         table = Left(table, tableDelim-1)
  136.         foreignKey = columns
  137.         Set record = database.PrimaryKeys(joinTable)
  138.         primaryKey = record.StringData(1)
  139.         columnDelim = InStr(1, columns, ",", vbTextCompare)
  140.         If columnDelim Then foreignKey = Left(columns, columnDelim - 1)
  141.         query = " AND `" & foreignKey & "` = `" & primaryKey & "`"
  142.     End If
  143.     columnList = table & "`." & Replace(columns, ",", "`,`" & table & "`.`")
  144.     query = "SELECT `" & columnList & "` FROM `" & tableList & "` WHERE `Feature_` = ?" & query
  145.     If database.TablePersistent(table) <> 1 Then Exit Sub
  146.     Set view = database.OpenView(query) : CheckError
  147.     view.Execute featureParam : CheckError
  148.     Do
  149.         Set record = view.Fetch : CheckError
  150.         If record Is Nothing Then Exit Do
  151.         If IsEmpty(output) Then
  152.             If Not IsEmpty(message) Then message = message & vbLf
  153.             message = message & "----" & table & " Table----  (" & columns & ")" & vbLf
  154.         End If
  155.         output = Empty
  156.         columnCount = record.FieldCount
  157.         delim = "  "
  158.         For column = 1 To columnCount
  159.             If column = columnCount Then delim = vbLf
  160.             output = output & record.StringData(column) & delim
  161.         Next
  162.         message = message & output
  163.     Loop
  164. End Sub
  165.  
  166. Sub CheckError
  167.     Dim message, errRec
  168.     If Err = 0 Then Exit Sub
  169.     message = Err.Source & " " & Hex(Err) & ": " & Err.Description
  170.     If Not installer Is Nothing Then
  171.         Set errRec = installer.LastErrorRecord
  172.         If Not errRec Is Nothing Then message = message & vbLf & errRec.FormatText
  173.     End If
  174.     Fail message
  175. End Sub
  176.  
  177. Function ShowOutput(header, message)
  178.     ShowOutput = vbOK
  179.     If IsEmpty(message) Then Exit Function
  180.     If isGUI Then
  181.         ShowOutput = MsgBox(message, vbOKCancel, header)
  182.     Else
  183.         Wscript.Echo "> " & header
  184.         Wscript.Echo message
  185.     End If
  186. End Function
  187.  
  188. Sub Fail(message)
  189.     Wscript.Echo message
  190.     Wscript.Quit 2
  191. End Sub
  192.