1
0
mirror of https://bitbucket.org/librepilot/librepilot.git synced 2024-12-03 11:24:10 +01:00
LibrePilot/ground/openpilotgcs/packaging/winx86/Wix/MsiTools/WiSubStg.vbs
stac 7195862d77 build: Move openpilotgcs into its own subdirectory
This will allow us to build a parent project for
qt-creator that sits above both openpilotgcs and
uavobjgenerator so that we can build both projects
at the same time.

git-svn-id: svn://svn.openpilot.org/OpenPilot/trunk@2528 ebee16cc-31ac-478f-84a7-5cbb03baadba
2011-01-22 17:40:26 +00:00

102 lines
4.5 KiB
Plaintext

' Windows Installer utility to add a transform or nested database as a substorage
' For use with Windows Scripting Host, CScript.exe or WScript.exe
' Copyright (c) Microsoft Corporation. All rights reserved.
' Demonstrates the use of the database _Storages table
'
Option Explicit
Const msiOpenDatabaseModeReadOnly = 0
Const msiOpenDatabaseModeTransact = 1
Const msiOpenDatabaseModeCreate = 3
Const msiViewModifyInsert = 1
Const msiViewModifyUpdate = 2
Const msiViewModifyAssign = 3
Const msiViewModifyReplace = 4
Const msiViewModifyDelete = 6
Const ForAppending = 8
Const ForReading = 1
Const ForWriting = 2
Const TristateTrue = -1
' Check arg count, and display help if argument not present or contains ?
Dim argCount:argCount = Wscript.Arguments.Count
If argCount > 0 Then If InStr(1, Wscript.Arguments(0), "?", vbTextCompare) > 0 Then argCount = 0
If (argCount = 0) Then
Wscript.Echo "Windows Installer database substorage managment utility" &_
vbNewLine & " 1st argument is the path to MSI database (installer package)" &_
vbNewLine & " 2nd argument is the path to a transform or database to import" &_
vbNewLine & " If the 2nd argument is missing, substorages will be listed" &_
vbNewLine & " 3rd argument is optional, the name used for the substorage" &_
vbNewLine & " If the 3rd arugment is missing, the file name is used" &_
vbNewLine & " To remove a substorage, use /D or -D as the 2nd argument" &_
vbNewLine & " followed by the name of the substorage to remove" &_
vbNewLine &_
vbNewLine & "Copyright (C) Microsoft Corporation. All rights reserved."
Wscript.Quit 1
End If
' Connect to Windows Installer object
On Error Resume Next
Dim installer : Set installer = Nothing
Set installer = Wscript.CreateObject("WindowsInstaller.Installer") : CheckError
' Evaluate command-line arguments and set open and update modes
Dim databasePath:databasePath = Wscript.Arguments(0)
Dim openMode : If argCount = 1 Then openMode = msiOpenDatabaseModeReadOnly Else openMode = msiOpenDatabaseModeTransact
Dim updateMode : If argCount > 1 Then updateMode = msiViewModifyAssign 'Either insert or replace existing row
Dim importPath : If argCount > 1 Then importPath = Wscript.Arguments(1)
Dim storageName : If argCount > 2 Then storageName = Wscript.Arguments(2)
If storageName = Empty And importPath <> Empty Then storageName = Right(importPath, Len(importPath) - InStrRev(importPath, "\",-1,vbTextCompare))
If UCase(importPath) = "/D" Or UCase(importPath) = "-D" Then updateMode = msiViewModifyDelete : importPath = Empty 'substorage will be deleted if no input data
' Open database and create a view on the _Storages table
Dim sqlQuery : Select Case updateMode
Case msiOpenDatabaseModeReadOnly: sqlQuery = "SELECT `Name` FROM _Storages"
Case msiViewModifyAssign: sqlQuery = "SELECT `Name`,`Data` FROM _Storages"
Case msiViewModifyDelete: sqlQuery = "SELECT `Name` FROM _Storages WHERE `Name` = ?"
End Select
Dim database : Set database = installer.OpenDatabase(databasePath, openMode) : CheckError
Dim view : Set view = database.OpenView(sqlQuery)
Dim record
If openMode = msiOpenDatabaseModeReadOnly Then 'If listing storages, simply fetch all records
Dim message, name
view.Execute : CheckError
Do
Set record = view.Fetch
If record Is Nothing Then Exit Do
name = record.StringData(1)
If message = Empty Then message = name Else message = message & vbNewLine & name
Loop
Wscript.Echo message
Else 'If adding a storage, insert a row, else if removing a storage, delete the row
Set record = installer.CreateRecord(2)
record.StringData(1) = storageName
view.Execute record : CheckError
If importPath <> Empty Then 'Insert storage - copy data into stream
record.SetStream 2, importPath : CheckError
Else 'Delete storage, fetch first to provide better error message if missing
Set record = view.Fetch
If record Is Nothing Then Wscript.Echo "Storage not present:", storageName : Wscript.Quit 2
End If
view.Modify updateMode, record : CheckError
database.Commit : CheckError
Set view = Nothing
Set database = Nothing
CheckError
End If
Sub CheckError
Dim message, errRec
If Err = 0 Then Exit Sub
message = Err.Source & " " & Hex(Err) & ": " & Err.Description
If Not installer Is Nothing Then
Set errRec = installer.LastErrorRecord
If Not errRec Is Nothing Then message = message & vbNewLine & errRec.FormatText
End If
Wscript.Echo message
Wscript.Quit 2
End Sub