home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 June / Chip_2001-06_cd1.bin / zkuste / vbasic / Data / Utility / MSISDK15.msi / WiFilVer.vbs < prev    next >
Text File  |  2000-10-05  |  8KB  |  175 lines
  1. ' Windows Installer utility to report or update file versions, sizes, languages
  2. ' For use with Windows Scripting Host, CScript.exe or WScript.exe
  3. ' Copyright (c) 1999-2000, Microsoft Corporation
  4. ' Demonstrates the access to install engine and actions
  5. '
  6. Option Explicit
  7.  
  8. ' FileSystemObject.CreateTextFile and FileSystemObject.OpenTextFile
  9. Const OpenAsASCII   = 0 
  10. Const OpenAsUnicode = -1
  11.  
  12. ' FileSystemObject.CreateTextFile
  13. Const OverwriteIfExist = -1
  14. Const FailIfExist      = 0
  15.  
  16. ' FileSystemObject.OpenTextFile
  17. Const OpenAsDefault    = -2
  18. Const CreateIfNotExist = -1
  19. Const FailIfNotExist   = 0
  20. Const ForReading = 1
  21. Const ForWriting = 2
  22. Const ForAppending = 8
  23.  
  24. Const msiOpenDatabaseModeReadOnly = 0
  25. Const msiOpenDatabaseModeTransact = 1
  26.  
  27. Const msiViewModifyInsert         = 1
  28. Const msiViewModifyUpdate         = 2
  29. Const msiViewModifyAssign         = 3
  30. Const msiViewModifyReplace        = 4
  31. Const msiViewModifyDelete         = 6
  32.  
  33. Const msiUILevelNone = 2
  34.  
  35. Const msiRunModeSourceShortNames = 9
  36.  
  37. Const msidbFileAttributesNoncompressed = &h00002000
  38.  
  39. Dim argCount:argCount = Wscript.Arguments.Count
  40. Dim iArg:iArg = 0
  41. If argCount > 0 Then If InStr(1, Wscript.Arguments(0), "?", vbTextCompare) > 0 Then argCount = 0
  42. If (argCount < 1) Then
  43.     Wscript.Echo "Windows Installer utility to updata File table sizes and versions" &_
  44.         vbNewLine & " The 1st argument is the path to MSI database, at the source file root" &_
  45.         vbNewLine & " The 2nd argument can optionally specify separate source location from the MSI" &_
  46.         vbNewLine & " The following options may be specified at any point on the command line" &_
  47.         vbNewLine & "  /U to update the MSI database with the file sizes, versions, and languages" &_
  48.         vbNewLine & " Notes:" &_
  49.         vbNewLine & "  If source type set to compressed, all files will be opened at the root" &_
  50.         vbNewLine & "  Using CSCRIPT.EXE without the /U option, the file info will be displayed" &_
  51.         vbNewLine &_
  52.         vbNewLine & "Copyright (C) Microsoft Corporation, 1999-2000.  All rights reserved."
  53.     Wscript.Quit 1
  54. End If
  55.  
  56. ' Get argument values, processing any option flags
  57. Dim updateMsi    : updateMsi    = False
  58. Dim sequenceFile : sequenceFile = False
  59. Dim databasePath : databasePath = NextArgument
  60. Dim sourceFolder : sourceFolder = NextArgument
  61. If Not IsEmpty(NextArgument) Then Fail "More than 2 arguments supplied" ' process any trailing options
  62. If Not IsEmpty(sourceFolder) And Right(sourceFolder, 1) <> "\" Then sourceFolder = sourceFolder & "\"
  63. Dim console : If UCase(Mid(Wscript.FullName, Len(Wscript.Path) + 2, 1)) = "C" Then console = True
  64.  
  65. ' Connect to Windows Installer object
  66. On Error Resume Next
  67. Dim installer : Set installer = Nothing
  68. Set installer = Wscript.CreateObject("WindowsInstaller.Installer") : CheckError
  69.  
  70. ' Check if multiple language package, and force use of primary language
  71. REM    Set sumInfo = database.SummaryInformation(3) : CheckError
  72.  
  73. ' Open database
  74. Dim database, openMode, view, record, updateMode, sumInfo
  75. If updateMsi Then openMode = msiOpenDatabaseModeTransact Else openMode = msiOpenDatabaseModeReadOnly
  76. Set database = installer.OpenDatabase(databasePath, openMode) : CheckError
  77.  
  78. ' Create an install session and execute actions in order to perform directory resolution
  79. installer.UILevel = msiUILevelNone
  80. Dim session : Set session = installer.OpenPackage(database) : If Err <> 0 Then Fail "Database: " & databasePath & ". Invalid installer package format"
  81. Dim shortNames : shortNames = session.Mode(msiRunModeSourceShortNames) : CheckError
  82. If Not IsEmpty(sourceFolder) Then session.Property("OriginalDatabase") = sourceFolder : CheckError
  83. Dim stat : stat = session.DoAction("CostInitialize") : CheckError
  84. If stat <> 1 Then Fail "CostInitialize failed, returned " & stat
  85.  
  86. ' Join File table to Component table in order to find directories
  87. Dim orderBy : If sequenceFile Then orderBy = "Directory_" Else orderBy = "Sequence"
  88. Set view = database.OpenView("SELECT File,FileName,Directory_,FileSize,Version,Language FROM File,Component WHERE Component_=Component ORDER BY " & orderBy) : CheckError
  89. view.Execute : CheckError
  90.  
  91. ' Fetch each file and request the source path, then verify the source path, and get the file info if present
  92. Dim fileKey, fileName, folder, sourcePath, fileSize, version, language, delim, message, info
  93. Do
  94.     Set record = view.Fetch : CheckError
  95.     If record Is Nothing Then Exit Do
  96. REM    fileKey    = record.StringData(1)
  97.     fileName   = record.StringData(2)
  98.     folder     = record.StringData(3)
  99. REM    fileSize   = record.IntegerData(4)
  100. REM    version    = record.StringData(5)
  101. REM    language   = record.StringData(6)
  102.     delim = InStr(1, fileName, "|", vbTextCompare)
  103.     If delim <> 0 Then
  104.         If shortNames Then fileName = Left(fileName, delim-1) Else fileName = Right(fileName, Len(fileName) - delim)
  105.     End If
  106.     sourcePath = session.SourcePath(folder) & fileName
  107.     If installer.FileAttributes(sourcePath) = -1 Then
  108.         message = message & vbNewLine & sourcePath
  109.     Else
  110.         fileSize = installer.FileSize(sourcePath) : CheckError
  111.         version  = Empty : version  = installer.FileVersion(sourcePath, False) : Err.Clear ' early MSI implementation fails if no version
  112.         language = Empty : language = installer.FileVersion(sourcePath, True)  : Err.Clear ' early MSI implementation doesn't support language
  113.         If language = version Then language = Empty ' Temp check for MSI.DLL version without language support
  114.         If Err <> 0 Then version = Empty : Err.Clear
  115.         If updateMsi Then
  116.             record.IntegerData(4) = fileSize
  117.             If Len(version)  > 0 Then record.StringData(5) = version
  118.             If Len(language) > 0 Then record.StringData(6) = language
  119.             view.Modify msiViewModifyUpdate, record : CheckError
  120.         ElseIf console Then
  121.             info = fileName : If Len(info) < 12 Then info = info & Space(12 - Len(info))
  122.             info = info & "  size=" & fileSize : If Len(info) < 26 Then info = info & Space(26 - Len(info))
  123.             If Len(version)  > 0 Then info = info & "  vers=" & version : If Len(info) < 45 Then info = info & Space(45 - Len(info))
  124.             If Len(language) > 0 Then info = info & "  lang=" & language
  125.             Wscript.Echo info
  126.         End If
  127.     End If
  128. Loop
  129. REM Wscript.Echo "SourceDir = " & session.Property("SourceDir")
  130. If Not IsEmpty(message) Then Fail "Error, the following files were not available:" & message
  131.  
  132. ' Update SummaryInformation
  133. If updateMsi Then
  134.     Set sumInfo = database.SummaryInformation(3) : CheckError
  135.     sumInfo.Property(11) = Now
  136.     sumInfo.Property(13) = Now
  137.     sumInfo.Persist
  138. End If
  139.  
  140. ' Commit database in case updates performed
  141. database.Commit : CheckError
  142. Wscript.Quit 0
  143.  
  144. ' Extract argument value from command line, processing any option flags
  145. Function NextArgument
  146.     Dim arg
  147.     Do  ' loop to pull in option flags until an argument value is found
  148.         If iArg >= argCount Then Exit Function
  149.         arg = Wscript.Arguments(iArg)
  150.         iArg = iArg + 1
  151.         If (AscW(arg) <> AscW("/")) And (AscW(arg) <> AscW("-")) Then Exit Do
  152.         Select Case UCase(Right(arg, Len(arg)-1))
  153.             Case "U" : updateMsi    = True
  154.             Case Else: Wscript.Echo "Invalid option flag:", arg : Wscript.Quit 1
  155.         End Select
  156.     Loop
  157.     NextArgument = arg
  158. End Function
  159.  
  160. Sub CheckError
  161.     Dim message, errRec
  162.     If Err = 0 Then Exit Sub
  163.     message = Err.Source & " " & Hex(Err) & ": " & Err.Description
  164.     If Not installer Is Nothing Then
  165.         Set errRec = installer.LastErrorRecord
  166.         If Not errRec Is Nothing Then message = message & vbNewLine & errRec.FormatText
  167.     End If
  168.     Fail message
  169. End Sub
  170.  
  171. Sub Fail(message)
  172.     Wscript.Echo message
  173.     Wscript.Quit 2
  174. End Sub
  175.