home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 June / Chip_2001-06_cd1.bin / zkuste / vbasic / Data / Utility / MSISDK15.msi / WiLstPrd.vbs < prev    next >
Text File  |  2000-10-05  |  8KB  |  192 lines
  1. ' Windows Installer utility to list registered products and product info
  2. ' For use with Windows Scripting Host, CScript.exe or WScript.exe
  3. ' Copyright (c) 1999-2000, Microsoft Corporation
  4. ' Demonstrates the use of the product enumeration and ProductInfo methods and underlying APIs
  5. '
  6. Option Explicit
  7.  
  8. Const msiInstallStateNotUsed      = -7
  9. Const msiInstallStateBadConfig    = -6
  10. Const msiInstallStateIncomplete   = -5
  11. Const msiInstallStateSourceAbsent = -4
  12. Const msiInstallStateInvalidArg   = -2
  13. Const msiInstallStateUnknown      = -1
  14. Const msiInstallStateBroken       =  0
  15. Const msiInstallStateAdvertised   =  1
  16. Const msiInstallStateRemoved      =  1
  17. Const msiInstallStateAbsent       =  2
  18. Const msiInstallStateLocal        =  3
  19. Const msiInstallStateSource       =  4
  20. Const msiInstallStateDefault      =  5
  21.  
  22. ' Connect to Windows Installer object
  23. On Error Resume Next
  24. Dim installer : Set installer = Nothing
  25. Set installer = Wscript.CreateObject("WindowsInstaller.Installer") : CheckError
  26.  
  27. ' If no arguments supplied, then list all installed or advertised products
  28. Dim argCount:argCount = Wscript.Arguments.Count
  29. If (argCount = 0) Then
  30.     Dim product, products, info, productList, version
  31.     On Error Resume Next
  32.     Set products = installer.Products : CheckError
  33.     For Each product In products
  34.         version = DecodeVersion(installer.ProductInfo(product, "Version")) : CheckError
  35.         info = product & " = " & installer.ProductInfo(product, "ProductName") & " " & version : CheckError
  36.         If productList <> Empty Then productList = productList & vbNewLine & info Else productList = info
  37.     Next
  38.     If productList = Empty Then productList = "No products installed or advertised"
  39.     Wscript.Echo productList
  40.     Set products = Nothing
  41.     Wscript.Quit 0
  42. End If
  43.  
  44. ' Check for ?, and show help message if found
  45. Dim productName:productName = Wscript.Arguments(0)
  46. If InStr(1, productName, "?", vbTextCompare) > 0 Then
  47.     Wscript.Echo "Windows Installer utility to list registered products and product information" &_
  48.         vbNewLine & " Lists all installed and advertised products if no arguments are specified" &_
  49.         vbNewLine & " Else 1st argument is a product name (case-insensitive) or product ID (GUID)" &_
  50.         vbNewLine & " If 2nd argument is missing or contains 'p', then product properties are listed" &_
  51.         vbNewLine & " If 2nd argument contains 'f', features, parents, & installed states are listed" &_
  52.         vbNewLine & " If 2nd argument contains 'c', installed components for that product are listed" &_
  53.         vbNewLine & " If 2nd argument contains 'd', HKLM ""SharedDlls"" count for key files are listed" &_
  54.         vbNewLine &_
  55.         vbNewLine & "Copyright (C) Microsoft Corporation, 1999-2000.  All rights reserved."
  56.     Wscript.Quit 1
  57. End If
  58.  
  59. ' If Product name supplied, need to search for product code
  60. Dim productCode, property, value, message
  61. If Left(productName, 1) = "{" And Right(productName, 1) = "}" Then
  62.     If installer.ProductState(productName) <> msiInstallStateUnknown Then productCode = UCase(productName)
  63. Else
  64.     For Each productCode In installer.Products : CheckError
  65.         If LCase(installer.ProductInfo(productCode, "ProductName")) = LCase(productName) Then Exit For
  66.     Next
  67. End If
  68. If IsEmpty(productCode) Then Wscript.Echo "Product is not registered: " & productName : Wscript.Quit 2
  69.  
  70. ' Check option argument for type of information to display, default is properties
  71. Dim optionFlag : If argcount > 1 Then optionFlag = LCase(Wscript.Arguments(1)) Else optionFlag = "p"
  72. If InStr(1, optionFlag, "*", vbTextCompare) > 0 Then optionFlag = "pfcd"
  73.  
  74. If InStr(1, optionFlag, "p", vbTextCompare) > 0 Then
  75.     message = "ProductCode = " & productCode
  76.     For Each property In Array(_
  77.             "Language",_
  78.             "ProductName",_
  79.             "PackageCode",_
  80.             "Transforms",_
  81.             "AssignmentType",_
  82.             "PackageName",_
  83.             "InstalledProductName",_
  84.             "VersionString",_
  85.             "Assigned",_
  86.             "Clients",_
  87.             "AdvertiseFlags",_
  88.             "RegCompany",_
  89.             "RegOwner",_
  90.             "ProductID",_
  91.             "InstallLocation",_
  92.             "InstallSource",_
  93.             "InstallDate",_
  94.             "Publisher",_
  95.             "LocalPackage",_
  96.             "HelpLink",_
  97.             "HelpTelephone",_
  98.             "URLInfoAbout",_
  99.             "URLUpdateInfo") : CheckError
  100.         value = installer.ProductInfo(productCode, property) ': CheckError
  101.         If Err <> 0 Then Err.Clear : value = Empty
  102.         If (property = "Version") Then value = DecodeVersion(value)
  103.         If value <> Empty Then message = message & vbNewLine & property & " = " & value
  104.     Next
  105.     Wscript.Echo message
  106. End If
  107.  
  108. If InStr(1, optionFlag, "f", vbTextCompare) > 0 Then
  109.     Dim feature, features, parent, state, featureInfo
  110.     Set features = installer.Features(productCode)
  111.     message = "---Features in product " & productCode & "---"
  112.     For Each feature In features
  113.         parent = installer.FeatureParent(productCode, feature) : CheckError
  114.         If Len(parent) Then parent = " {" & parent & "}"
  115.         state = installer.FeatureState(productCode, feature)
  116.         Select Case(state)
  117.             Case msiInstallStateBadConfig:    state = "Corrupt"
  118.             Case msiInstallStateIncomplete:   state = "InProgress"
  119.             Case msiInstallStateSourceAbsent: state = "SourceAbsent"
  120.             Case msiInstallStateBroken:       state = "Broken"
  121.             Case msiInstallStateAdvertised:   state = "Advertised"
  122.             Case msiInstallStateAbsent:       state = "Uninstalled"
  123.             Case msiInstallStateLocal:        state = "Local"
  124.             Case msiInstallStateSource:       state = "Source"
  125.             Case msiInstallStateDefault:      state = "Default"
  126.             Case Else:                        state = "Unknown"
  127.         End Select
  128.         message = message & vbNewLine & feature & parent & " = " & state
  129.     Next
  130.     Set features = Nothing
  131.     Wscript.Echo message
  132. End If 
  133.  
  134. If InStr(1, optionFlag, "c", vbTextCompare) > 0 Then
  135.     Dim component, components, client, clients, path
  136.     Set components = installer.Components : CheckError
  137.     message = "---Components in product " & productCode & "---"
  138.     For Each component In components
  139.         Set clients = installer.ComponentClients(component) : CheckError
  140.         For Each client In Clients
  141.             If client = productCode Then
  142.                 path = installer.ComponentPath(productCode, component) : CheckError
  143.                 message = message & vbNewLine & component & " = " & path
  144.                 Exit For
  145.             End If
  146.         Next
  147.         Set clients = Nothing
  148.     Next
  149.     Set components = Nothing
  150.     Wscript.Echo message
  151. End If
  152.  
  153. If InStr(1, optionFlag, "d", vbTextCompare) > 0 Then
  154.     Set components = installer.Components : CheckError
  155.     message = "---Shared DLL counts for key files of " & productCode & "---"
  156.     For Each component In components
  157.         Set clients = installer.ComponentClients(component) : CheckError
  158.         For Each client In Clients
  159.             If client = productCode Then
  160.                 path = installer.ComponentPath(productCode, component) : CheckError
  161.                 If Len(path) = 0 Then path = "0"
  162.                 If AscW(path) >= 65 Then  ' ignore registry key paths
  163.                     value = installer.RegistryValue(2, "SOFTWARE\Microsoft\Windows\CurrentVersion\SharedDlls", path)
  164.                     If Err <> 0 Then value = 0 : Err.Clear
  165.                     message = message & vbNewLine & value & " = " & path
  166.                 End If
  167.                 Exit For
  168.             End If
  169.         Next
  170.         Set clients = Nothing
  171.     Next
  172.     Set components = Nothing
  173.     Wscript.Echo message
  174. End If
  175.  
  176. Function DecodeVersion(version)
  177.     version = CLng(version)
  178.     DecodeVersion = version\65536\256 & "." & (version\65535 MOD 256) & "." & (version Mod 65536)
  179. End Function
  180.  
  181. Sub CheckError
  182.     Dim message, errRec
  183.     If Err = 0 Then Exit Sub
  184.     message = Err.Source & " " & Hex(Err) & ": " & Err.Description
  185.     If Not installer Is Nothing Then
  186.         Set errRec = installer.LastErrorRecord
  187.         If Not errRec Is Nothing Then message = message & vbNewLine & errRec.FormatText
  188.     End If
  189.     Wscript.Echo message
  190.     Wscript.Quit 2
  191. End Sub
  192.