home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 June / Chip_2001-06_cd1.bin / zkuste / vbasic / Data / Utility / MSISDK15.msi / WiCompon.vbs < prev    next >
Text File  |  2000-10-05  |  9KB  |  182 lines
  1. ' Windows Installer utility to list component composition of 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 various tables having foreign keys to the Component table
  5. '
  6. Option Explicit
  7. Public isGUI, installer, database, message, compParam  'global variables access across functions
  8.  
  9. Const msiOpenDatabaseModeReadOnly     = 0
  10.  
  11. ' Check if run from GUI script host, in order to modify display
  12. If UCase(Mid(Wscript.FullName, Len(Wscript.Path) + 2, 1)) = "W" Then isGUI = True
  13.  
  14. ' Show help if no arguments or if argument contains ?
  15. Dim argCount:argCount = Wscript.Arguments.Count
  16. If argCount > 0 Then If InStr(1, Wscript.Arguments(0), "?", vbTextCompare) > 0 Then argCount = 0
  17. If argCount = 0 Then
  18.     Wscript.Echo "Windows Installer utility to list component composition in an install database." &_
  19.         vbLf & " The 1st argument is the path to an install database, relative or complete path" &_
  20.         vbLf & " The 2nd argument is the name of the component (primary key of Component table)" &_
  21.         vbLf & " If the 2nd argument is not present, the names of all components will be listed" &_
  22.         vbLf & " If the 2nd argument is a ""*"", the composition of all components will be listed" &_
  23.         vbLf & " Large databases or components are better displayed using CScript than WScript." &_
  24.         vbNewLine &_
  25.         vbNewLine & "Copyright (C) Microsoft Corporation, 1999-2000.  All rights reserved."
  26.     Wscript.Quit 1
  27. End If
  28.  
  29. ' Connect to Windows Installer object
  30. REM On Error Resume Next
  31. Set installer = Nothing
  32. Set installer = Wscript.CreateObject("WindowsInstaller.Installer") : CheckError
  33.  
  34. ' Open database
  35. Dim databasePath:databasePath = Wscript.Arguments(0)
  36. Set database = installer.OpenDatabase(databasePath, msiOpenDatabaseModeReadOnly) : CheckError
  37.  
  38. If argCount = 1 Then  'If no component specified, then simply list components
  39.     ListComponents False
  40.     ShowOutput "Components for " & databasePath, message
  41. ElseIf Left(Wscript.Arguments(1), 1) = "*" Then 'List all components
  42.     ListComponents True
  43. Else
  44.     QueryComponent Wscript.Arguments(1) 
  45. End If
  46. Wscript.Quit 0
  47.  
  48. ' List all table rows referencing a given component
  49. Function QueryComponent(component)
  50.     ' Get component info and format output header
  51.     Dim view, record, header, componentId
  52.     Set view = database.OpenView("SELECT `ComponentId` FROM `Component` WHERE `Component` = ?") : CheckError
  53.     Set compParam = installer.CreateRecord(1)
  54.     compParam.StringData(1) = component
  55.     view.Execute compParam : CheckError
  56.     Set record = view.Fetch : CheckError
  57.     Set view = Nothing
  58.     If record Is Nothing Then Fail "Component not in database: " & component
  59.     componentId = record.StringData(1)
  60.     header = "Component: "& component & "  ComponentId = " & componentId
  61.  
  62.     ' List of tables with foreign keys to Component table - with subsets of columns to display
  63.     DoQuery "FeatureComponents","Feature_"                           '
  64.     DoQuery "PublishComponent", "ComponentId,Qualifier"              'AppData,Feature
  65.     DoQuery "File",             "File,Sequence,FileName,Version"     'FileSize,Language,Attributes
  66.     DoQuery "SelfReg,File",     "File_"                              'Cost
  67.     DoQuery "BindImage,File",   "File_"                              'Path
  68.     DoQuery "Font,File",        "File_,FontTitle"                    '
  69.     DoQuery "Patch,File",       "File_"                              'Sequence,PatchSize,Attributes,Header
  70.     DoQuery "DuplicateFile",    "FileKey,File_,DestName"             'DestFolder
  71.     DoQuery "MoveFile",         "FileKey,SourceName,DestName"        'SourceFolder,DestFolder,Options
  72.     DoQuery "RemoveFile",       "FileKey,FileName,DirProperty"       'InstallMode
  73.     DoQuery "IniFile",          "IniFile,FileName,Section,Key"       'Value,Action
  74.     DoQuery "RemoveIniFile",    "RemoveIniFile,FileName,Section,Key" 'Value,Action
  75.     DoQuery "Registry",         "Registry,Root,Key,Name"             'Value
  76.     DoQuery "RemoveRegistry",   "RemoveRegistry,Root,Key,Name"       '
  77.     DoQuery "Shortcut",         "Shortcut,Directory_,Name,Target"    'Arguments,Description,Hotkey,Icon_,IconIndex,ShowCmd,WkDir
  78.     DoQuery "Class",            "CLSID,Description"                  'Context,ProgId_Default,AppId_,FileType,Mask,Icon_,IconIndex,DefInprocHandler,Argument,Feature_
  79.     DoQuery "ProgId,Class",     "Class_,ProgId,Description"          'ProgId_Parent,Icon_IconIndex,Insertable
  80.     DoQuery "Extension",        "Extension,ProgId_"                  'MIME_,Feature_
  81.     DoQuery "Verb,Extension",   "Extension_,Verb"                    'Sequence,Command.Argument
  82.     DoQuery "MIME,Extension",   "Extension_,ContentType"             'CLSID
  83.     DoQuery "TypeLib",          "LibID,Language,Version,Description" 'Directory_,Feature_,Cost
  84.     DoQuery "CreateFolder",     "Directory_"                         ' 
  85.     DoQuery "Environment",      "Environment,Name"                   'Value
  86.     DoQuery "ODBCDriver",       "Driver,Description"                 'File_,File_Setup
  87.     DoQuery "ODBCAttribute,ODBCDriver", "Driver_,Attribute,Value" '
  88.     DoQuery "ODBCTranslator",   "Translator,Description"             'File_,File_Setup
  89.     DoQuery "ODBCDataSource",   "DataSource,Description,DriverDescription" 'Registration
  90.     DoQuery "ODBCSourceAttribute,ODBCDataSource", "DataSource_,Attribute,Value" '
  91.     DoQuery "ServiceControl",   "ServiceControl,Name,Event"          'Arguments,Wait
  92.     DoQuery "ServiceInstall",   "ServiceInstall,Name,DisplayName"    'ServiceType,StartType,ErrorControl,LoadOrderGroup,Dependencies,StartName,Password
  93.     DoQuery "ReserveCost",      "ReserveKey,ReserveFolder"           'ReserveLocal,ReserveSource
  94.  
  95.     QueryComponent = ShowOutput(header, message)
  96.     message = Empty
  97. End Function
  98.  
  99. ' List all components in database
  100. Sub ListComponents(queryAll)
  101.     Dim view, record, component
  102.     Set view = database.OpenView("SELECT `Component`,`ComponentId` FROM `Component`") : CheckError
  103.     view.Execute : CheckError
  104.     Do
  105.         Set record = view.Fetch : CheckError
  106.         If record Is Nothing Then Exit Do
  107.         component = record.StringData(1)
  108.         If queryAll Then
  109.             If QueryComponent(component) = vbCancel Then Exit Sub
  110.         Else
  111.             If Not IsEmpty(message) Then message = message & vbLf
  112.             message = message & component
  113.         End If
  114.     Loop
  115. End Sub
  116.  
  117. ' Perform a join to query table rows linked to a given component, delimiting and qualifying names to prevent conflicts
  118. Sub DoQuery(table, columns)
  119.     Dim view, record, columnCount, column, output, header, delim, columnList, tableList, tableDelim, query, joinTable, primaryKey, foreignKey, columnDelim
  120.     On Error Resume Next
  121.     tableList  = Replace(table,   ",", "`,`")
  122.     tableDelim = InStr(1, table, ",", vbTextCompare)
  123.     If tableDelim Then  ' need a 3-table join
  124.         joinTable = Right(table, Len(table)-tableDelim)
  125.         table = Left(table, tableDelim-1)
  126.         foreignKey = columns
  127.         Set record = database.PrimaryKeys(joinTable)
  128.         primaryKey = record.StringData(1)
  129.         columnDelim = InStr(1, columns, ",", vbTextCompare)
  130.         If columnDelim Then foreignKey = Left(columns, columnDelim - 1)
  131.         query = " AND `" & foreignKey & "` = `" & primaryKey & "`"
  132.     End If
  133.     columnList = table & "`." & Replace(columns, ",", "`,`" & table & "`.`")
  134.     query = "SELECT `" & columnList & "` FROM `" & tableList & "` WHERE `Component_` = ?" & query
  135.     If database.TablePersistent(table) <> 1 Then Exit Sub
  136.     Set view = database.OpenView(query) : CheckError
  137.     view.Execute compParam : CheckError
  138.     Do
  139.         Set record = view.Fetch : CheckError
  140.         If record Is Nothing Then Exit Do
  141.         If IsEmpty(output) Then
  142.             If Not IsEmpty(message) Then message = message & vbLf
  143.             message = message & "----" & table & " Table----  (" & columns & ")" & vbLf
  144.         End If
  145.         output = Empty
  146.         columnCount = record.FieldCount
  147.         delim = "  "
  148.         For column = 1 To columnCount
  149.             If column = columnCount Then delim = vbLf
  150.             output = output & record.StringData(column) & delim
  151.         Next
  152.         message = message & output
  153.     Loop
  154. End Sub
  155.  
  156. Sub CheckError
  157.     Dim message, errRec
  158.     If Err = 0 Then Exit Sub
  159.     message = Err.Source & " " & Hex(Err) & ": " & Err.Description
  160.     If Not installer Is Nothing Then
  161.         Set errRec = installer.LastErrorRecord
  162.         If Not errRec Is Nothing Then message = message & vbLf & errRec.FormatText
  163.     End If
  164.     Fail message
  165. End Sub
  166.  
  167. Function ShowOutput(header, message)
  168.     ShowOutput = vbOK
  169.     If IsEmpty(message) Then Exit Function
  170.     If isGUI Then
  171.         ShowOutput = MsgBox(message, vbOKCancel, header)
  172.     Else
  173.         Wscript.Echo "> " & header
  174.         Wscript.Echo message
  175.     End If
  176. End Function
  177.  
  178. Sub Fail(message)
  179.     Wscript.Echo message
  180.     Wscript.Quit 2
  181. End Sub
  182.