home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 June / Chip_2001-06_cd1.bin / zkuste / vbasic / Data / Utility / MSISDK15.msi / WiLangId.vbs < prev    next >
Text File  |  2000-10-05  |  7KB  |  162 lines
  1. ' Windows Installer utility to report the language and codepage for a package
  2. ' For use with Windows Scripting Host, CScript.exe or WScript.exe
  3. ' Copyright (c) 1999-2000, Microsoft Corporation
  4. ' Demonstrates the access of language and codepage values                 
  5. '
  6. Option Explicit
  7.  
  8. Const msiOpenDatabaseModeReadOnly     = 0
  9. Const msiOpenDatabaseModeTransact     = 1
  10. Const ForReading = 1
  11. Const ForWriting = 2
  12. Const TristateFalse = 0
  13.  
  14. Const msiViewModifyInsert         = 1
  15. Const msiViewModifyUpdate         = 2
  16. Const msiViewModifyAssign         = 3
  17. Const msiViewModifyReplace        = 4
  18. Const msiViewModifyDelete         = 6
  19.  
  20. Dim argCount:argCount = Wscript.Arguments.Count
  21. If argCount > 0 Then If InStr(1, Wscript.Arguments(0), "?", vbTextCompare) > 0 Then argCount = 0
  22. If (argCount = 0) Then
  23.     message = "Windows Installer utility to manage language and codepage values for a package." &_
  24.         vbNewLine & "The package language is a summary information property that designates the" &_
  25.         vbNewLine & " primary language and any language transforms that are available, comma delim." &_
  26.         vbNewLine & "The ProductLanguage in the database Property table is the language that is" &_
  27.         vbNewLine & " registered for the product and determines the language used to load resources." &_
  28.         vbNewLine & "The codepage is the ANSI codepage of the database strings, 0 if all ASCII data," &_
  29.         vbNewLine & " and must represent the text data to avoid loss when persisting the database." &_
  30.         vbNewLine & "The 1st argument is the path to MSI database (installer package)" &_
  31.         vbNewLine & "To update a value, the 2nd argument contains the keyword and the 3rd the value:" &_
  32.         vbNewLine & "   Package  {base LangId optionally followed by list of language transforms}" &_
  33.         vbNewLine & "   Product  {LangId of the product (could be updated by language transforms)}" &_
  34.         vbNewLine & "   Codepage {ANSI codepage of text data (use with caution when text exists!)}" &_
  35.         vbNewLine &_
  36.         vbNewLine & "Copyright (C) Microsoft Corporation, 1999-2000.  All rights reserved."
  37.     Wscript.Echo message
  38.     Wscript.Quit 1
  39. End If
  40.  
  41. ' Connect to Windows Installer object
  42. On Error Resume Next
  43. Dim installer : Set installer = Nothing
  44. Set installer = Wscript.CreateObject("WindowsInstaller.Installer") : CheckError
  45.  
  46.  
  47. ' Open database
  48. Dim databasePath:databasePath = Wscript.Arguments(0)
  49. Dim openMode : If argCount >= 3 Then openMode = msiOpenDatabaseModeTransact Else openMode = msiOpenDatabaseModeReadOnly
  50. Dim database : Set database = installer.OpenDatabase(databasePath, openMode) : CheckError
  51.  
  52. ' Update value if supplied
  53. If argCount >= 3 Then
  54.     Dim value:value = Wscript.Arguments(2)
  55.     Select Case UCase(Wscript.Arguments(1))
  56.         Case "PACKAGE"  : SetPackageLanguage database, value
  57.         Case "PRODUCT"  : SetProductLanguage database, value
  58.         Case "CODEPAGE" : SetDatabaseCodepage database, value
  59.         Case Else       : Fail "Invalid value keyword"
  60.     End Select
  61.     CheckError
  62. End If
  63.  
  64. ' Extract language info and compose report message
  65. Dim message:message = "Package language = "         & PackageLanguage(database) &_
  66.                     ", ProductLanguage = " & ProductLanguage(database) &_
  67.                     ", Database codepage = "        & DatabaseCodepage(database)
  68. database.Commit : CheckError  ' no effect if opened ReadOnly
  69. Set database = nothing
  70. Wscript.Echo message
  71. Wscript.Quit 0
  72.  
  73. ' Get language list from summary information
  74. Function PackageLanguage(database)
  75.     On Error Resume Next
  76.     Dim sumInfo  : Set sumInfo = database.SummaryInformation(0) : CheckError
  77.     Dim template : template = sumInfo.Property(7) : CheckError
  78.     Dim iDelim:iDelim = InStr(1, template, ";", vbTextCompare)
  79.     If iDelim = 0 Then template = "Not specified!"
  80.     PackageLanguage = Right(template, Len(template) - iDelim)
  81.     If Len(PackageLanguage) = 0 Then PackageLanguage = "0"
  82. End Function
  83.  
  84. ' Get ProductLanguge property from Property table
  85. Function ProductLanguage(database)
  86.     On Error Resume Next
  87.     Dim view : Set view = database.OpenView("SELECT `Value` FROM `Property` WHERE `Property` = 'ProductLanguage'")
  88.     view.Execute : CheckError
  89.     Dim record : Set record = view.Fetch : CheckError
  90.     If record Is Nothing Then ProductLanguage = "Not specified!" Else ProductLanguage = record.IntegerData(1)
  91. End Function
  92.  
  93. ' Get ANSI codepage of database text data
  94. Function DatabaseCodepage(database)
  95.     On Error Resume Next
  96.     Dim WshShell : Set WshShell = Wscript.CreateObject("Wscript.Shell") : CheckError
  97.     Dim tempPath:tempPath = WshShell.ExpandEnvironmentStrings("%TEMP%") : CheckError
  98.     database.Export "_ForceCodepage", tempPath, "codepage.idt" : CheckError
  99.     Dim fileSys : Set fileSys = CreateObject("Scripting.FileSystemObject") : CheckError
  100.     Dim file : Set file = fileSys.OpenTextFile(tempPath & "\codepage.idt", ForReading, False, TristateFalse) : CheckError
  101.     file.ReadLine ' skip column name record
  102.     file.ReadLine ' skip column defn record
  103.     DatabaseCodepage = file.ReadLine
  104.     Dim iDelim:iDelim = InStr(1, DatabaseCodepage, vbTab, vbTextCompare)
  105.     If iDelim = 0 Then Fail "Failure in codepage export file"
  106.     DatabaseCodepage = Left(DatabaseCodepage, iDelim - 1)
  107. End Function
  108.  
  109. ' Set ProductLanguge property in Property table
  110. Sub SetProductLanguage(database, language)
  111.     On Error Resume Next
  112.     If Not IsNumeric(language) Then Fail "ProductLanguage must be numeric"
  113.     Dim view : Set view = database.OpenView("SELECT `Property`,`Value` FROM `Property`")
  114.     view.Execute : CheckError
  115.     Dim record : Set record = installer.CreateRecord(2)
  116.     record.StringData(1) = "ProductLanguage"
  117.     record.StringData(2) = CStr(language)
  118.     view.Modify msiViewModifyAssign, record : CheckError
  119. End Sub
  120.  
  121. ' Set ANSI codepage of database text data
  122. Sub SetDatabaseCodepage(database, codepage)
  123.     On Error Resume Next
  124.     If Not IsNumeric(codepage) Then Fail "Codepage must be numeric"
  125.     Dim WshShell : Set WshShell = Wscript.CreateObject("Wscript.Shell") : CheckError
  126.     Dim tempPath:tempPath = WshShell.ExpandEnvironmentStrings("%TEMP%") : CheckError
  127.     Dim fileSys : Set fileSys = CreateObject("Scripting.FileSystemObject") : CheckError
  128.     Dim file : Set file = fileSys.OpenTextFile(tempPath & "\codepage.idt", ForWriting, True, TristateFalse) : CheckError
  129.     file.WriteLine ' dummy column name record
  130.     file.WriteLine ' dummy column defn record
  131.     file.WriteLine codepage & vbTab & "_ForceCodepage"
  132.     file.Close : CheckError
  133.     database.Import tempPath, "codepage.idt" : CheckError
  134. End Sub     
  135.  
  136. ' Set language list in summary information
  137. Sub SetPackageLanguage(database, language)
  138.     On Error Resume Next
  139.     Dim sumInfo  : Set sumInfo = database.SummaryInformation(1) : CheckError
  140.     Dim template : template = sumInfo.Property(7) : CheckError
  141.     Dim iDelim:iDelim = InStr(1, template, ";", vbTextCompare)
  142.     Dim platform : If iDelim = 0 Then platform = ";" Else platform = Left(template, iDelim)
  143.     sumInfo.Property(7) = platform & language
  144.     sumInfo.Persist : CheckError
  145. End Sub
  146.  
  147. Sub CheckError
  148.     Dim message, errRec
  149.     If Err = 0 Then Exit Sub
  150.     message = Err.Source & " " & Hex(Err) & ": " & Err.Description
  151.     If Not installer Is Nothing Then
  152.         Set errRec = installer.LastErrorRecord
  153.         If Not errRec Is Nothing Then message = message & vbNewLine & errRec.FormatText
  154.     End If
  155.     Fail message
  156. End Sub
  157.  
  158. Sub Fail(message)
  159.     Wscript.Echo message
  160.     Wscript.Quit 2
  161. End Sub
  162.