home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 June / Chip_2001-06_cd1.bin / zkuste / vbasic / Data / Utility / MSISDK15.msi / WiImport.vbs < prev    next >
Text File  |  2000-10-05  |  3KB  |  95 lines
  1. ' Windows Installer database table import for use with Windows Scripting Host
  2. ' Copyright (c) 1999-2000, Microsoft Corporation
  3. ' Demonstrates the use of the Database.Import method and MsiDatabaseImport API
  4. '
  5. Option Explicit
  6.  
  7. Const msiOpenDatabaseModeReadOnly     = 0
  8. Const msiOpenDatabaseModeTransact     = 1
  9. Const msiOpenDatabaseModeCreate       = 3
  10. Const ForAppending = 8
  11. Const ForReading = 1
  12. Const ForWriting = 2
  13. Const TristateTrue = -1
  14.  
  15. Dim argCount:argCount = Wscript.Arguments.Count
  16. Dim iArg:iArg = 0
  17. If (argCount < 3) Then
  18.     Wscript.Echo "Windows Installer database table import utility" &_
  19.         vbNewLine & " 1st argument is the path to MSI database (installer package)" &_
  20.         vbNewLine & " 2nd argument is the path to folder containing the imported files" &_
  21.         vbNewLine & " Subseqent arguments are names of archive files to import" &_
  22.         vbNewLine & " Wildcards, such as *.idt, can be used to import multiple files" &_
  23.         vbNewLine & " Specify /c or -c anywhere before file list to create new database" &_
  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. On Error Resume Next
  31. Dim installer : Set installer = Nothing
  32. Set installer = Wscript.CreateObject("WindowsInstaller.Installer") : CheckError
  33.  
  34. Dim openMode:openMode = msiOpenDatabaseModeTransact
  35. Dim databasePath:databasePath = NextArgument
  36. Dim folder:folder = NextArgument
  37.  
  38. ' Open database and process list of files
  39. Dim database, table
  40. Set database = installer.OpenDatabase(databasePath, openMode) : CheckError
  41. While iArg < argCount
  42.     table = NextArgument
  43.     ' Check file name for wildcard specification
  44.     If (InStr(1,table,"*",vbTextCompare) <> 0) Or (InStr(1,table,"?",vbTextCompare) <> 0) Then
  45.         ' Obtain list of files matching wildcard specification
  46.         Dim WshShell, fileSys, file, tempFilePath
  47.         Set WshShell = Wscript.CreateObject("Wscript.Shell") : CheckError
  48.         tempFilePath = WshShell.ExpandEnvironmentStrings("%TEMP%") & "\dir.tmp"
  49.         WshShell.Run "cmd.exe /U /c dir /b " & folder & "\" & table & ">" & tempFilePath, 0, True : CheckError
  50.         Set fileSys = CreateObject("Scripting.FileSystemObject") : CheckError
  51.         Set file = fileSys.OpenTextFile(tempFilePath, ForReading, False, TristateTrue) : CheckError
  52.         ' Import each file in directory list
  53.         Do While file.AtEndOfStream <> True
  54.             table = file.ReadLine
  55.             database.Import folder, table : CheckError
  56.         Loop
  57.     Else
  58.         database.Import folder, table : CheckError
  59.     End If
  60. Wend
  61. database.Commit 'commit changes if no import errors
  62. Wscript.Quit 0
  63.  
  64. Function NextArgument
  65.     Dim arg, chFlag
  66.     Do
  67.         arg = Wscript.Arguments(iArg)
  68.         iArg = iArg + 1
  69.         chFlag = AscW(arg)
  70.         If (chFlag = AscW("/")) Or (chFlag = AscW("-")) Then
  71.             chFlag = UCase(Right(arg, Len(arg)-1))
  72.             If chFlag = "C" Then 
  73.                 openMode = msiOpenDatabaseModeCreate
  74.             Else
  75.                 Wscript.Echo "Invalid option flag:", arg : Wscript.Quit 1
  76.             End If
  77.         Else
  78.             Exit Do
  79.         End If
  80.     Loop
  81.     NextArgument = arg
  82. End Function
  83.  
  84. Sub CheckError
  85.     Dim message, errRec
  86.     If Err = 0 Then Exit Sub
  87.     message = Err.Source & " " & Hex(Err) & ": " & Err.Description
  88.     If Not installer Is Nothing Then
  89.         Set errRec = installer.LastErrorRecord
  90.         If Not errRec Is Nothing Then message = message & vbNewLine & errRec.FormatText
  91.     End If
  92.     Wscript.Echo message
  93.     Wscript.Quit 2
  94. End Sub
  95.