I thought I’d give a quick example of how advanced users can utilise advanced scripting in CubMakr.
Example 1: Integrating with your Application Tracker
The first example I want to show is how we can integrate the CubMakr with your in-house tracking tool. Some places use Sharepoint to track applications, some places use a SQL Server back-end (ok…so does Sharepoint….but I believe the preferred approach for querying Sharepoint is to use CAML and you can find a VBScript example on my blog here).
I’ll let you read the commented code to see what the script does, but basically:
- In order to link your package to your tracker record, you’ll need a reference. In this example I create a property in the MSI called ALKANEREF and set the value to the unique reference for my package.
- In the script, I read the value of ALKANEREF and then query the SQL Server database to retrieve various records (vendor, application and version).
- I then create a session property (i.e, not a property which will persist in my database) called ALKANEMANUFACTURER which we can then use as part of a CubMakr rule to validate (for example) the Manufacturer property value.
Because we want to set the ALKANEMANUFACTURER property before the CubMakr rules are run, we would obviously set this script to run before the CubMakr rules. Here’s the script:
Dim objConnection : Set objConnection = CreateObject("ADODB.Connection")
Dim objRecordSet : Set objRecordSet = CreateObject("ADODB.Recordset")
'Connection string for our fictitious application tracker
objConnection.Open _
"Provider=SQLOLEDB;Data Source=.\SQLExpress;" & _
"Trusted_Connection=Yes;Initial Catalog=alkanetracker;" & _
"User ID=alkanetest;Password=24rHj7Zz4OFNhYV;"
Dim packagevendor : packagevendor = ""
Dim packageapplication : packageapplication = ""
Dim packageversion : packageversion = ""
Const adVarChar = 200
Const adParamInput = 1
Dim sql : sql = ""
Dim oView, oRecord
'First get the package reference. We use Session.ProductProperty here because the ALKANEREF property is part of our MSI, and
'not a property which has been created in the current in-memory session.
alkaneRef = Session.ProductProperty("ALKANEREF")
'select all columns for our package with the specified package reference
set cmd = CreateObject("ADODB.Command")
with cmd
.ActiveConnection = objConnection
.CommandText = "SELECT * FROM packages WHERE packagereference = ?"
.Parameters.Append .CreateParameter("packagereference",adVarChar,adParamInput,50,alkaneRef)
end with
set objRecordSet = cmd.execute
Do While NOT objRecordSet.Eof
packagevendor = objRecordSet("packagevendor")
packageapplication = objRecordSet("packageapplication")
packageversion = objRecordSet("packageversion")
'set ALKANEMANUFACTURER for our CubMakr rule. Remember that Session.Property is read/write, Session.ProductProperty is read only!
Session.Property("ALKANEMANUFACTURER") = packagevendor
objRecordSet.MoveNext
Loop
set cmd = nothing
Set objConnection = Nothing
Set objRecordSet = NothingExample 2: Writing your own ICE routines
The second example I wanted to show you was writing your own custom ICE routines. CubMakr is used to provide a simplified way of checking for certain entries within the windows installer tables and summary information stream. It cannot handle more complex scenarios, such as checking for empty component, checking for duplicate registry entries etc. For these scenarios there is now the facility to add your own custom ICE routines. Here is an example of some custom ICE routines:
'initialise variables and constants
Const msiMessageTypeError = &H01000000
Const msiMessageTypeWarning = &H02000000
Const msiMessageTypeUser = &H03000000
Dim messageIceName, messageDescription, messageDescriptionAddition, messageType, messageTable, messageColumn
'Message Types
'0 MessageFail
'1 MessageError
'2 MessageWarning
'3 MessageInfo
'call Custom ICEs in this order
Call checkEmptyComponents()
Call checkNoKeypath()
Call noDuplicateRegistry()
'This function checks for empty components
Function checkEmptyComponents()
'Here we specify:
'The name of the ICE message
messageIceName = "EXAMPLE01"
'The type of ICE message (see top of script)
messageType = 2
'The description we want to show in the ICE message
messageDescription = "'[1]' is an empty component. Please delete."
'The table that the ICE message relates to
messageTable = "Component"
'The column where the issue resides
messageColumn = "Component"
Dim componentsView, componentsRec, tableView, tableRec, dataView, dataRec
Dim emptyComponent : emptyComponent = True
Dim tempComponent : tempComponent = ""
If Session.Database.TablePersistent("Component") = 1 Then
Set componentsView = Session.Database.OpenView("Select `Component` From `Component` ORDER BY `Component`")
componentsView.Execute
Set componentsRec = componentsView.Fetch
Do While Not componentsRec is Nothing
tempComponent = componentsRec.StringData(1)
'list the tables that have 'Component_' (foreign key) columns
Set tableView = Session.Database.OpenView("SELECT `Table` FROM `_Columns` WHERE `Name`= 'Component_' AND `Table` <> 'FeatureComponents'")
tableView.Execute
Set tableRec = tableView.Fetch
Do While Not tableRec is Nothing
emptyComponent = True
Set dataView = Session.Database.OpenView("SELECT `Component_` FROM `" & tableRec.StringData(1) & "` WHERE `Component_`='" & tempComponent & "'")
dataView.Execute
If Not dataView.Fetch is Nothing Then 'this table has a some data belonging to some component
'component contains data
emptyComponent = False
'skip component and move to next
Exit Do
End If
Set tableRec = tableView.Fetch
Loop
If emptyComponent Then
componentsRec.StringData(0) = messageIceName & Chr(9) & messageType & Chr(9) & messageDescription & Chr(9) & "" & Chr(9) & messageTable & chr(9) & messageColumn & chr(9) & "[1]"
Session.Message msiMessageTypeUser,componentsRec
End If
Set componentsRec = componentsView.Fetch
Loop
Set tableRec = Nothing
Set tableView = Nothing
Set componentsView = Nothing
Set componentsRec = Nothing
Set dataView = Nothing
End If
'return success
checkEmptyComponents = 1
End Function
'This function checks for components without a keypath, and if a keypath is available, suggests it.
Function checkNoKeypath()
Dim keypathView, keypathRec, blnKeypathSet, tempView, tempRec
messageIceName = "EXAMPLE02"
messageType = 2
messageDescription = "Component '[1]' does not have a keypath set."
messageTable = "Component"
messageColumn = "Component"
If Session.Database.TablePersistent("Component") = 1 Then
'find all components which do not have Keypaths
Set keypathView = Session.Database.OpenView("SELECT `Component`,`ComponentId`, `Attributes` FROM `Component` WHERE `KeyPath` IS Null")
keypathView.Execute
Set keypathRec = keypathView.Fetch
Do Until keypathRec Is Nothing
'initiate this to false
blnKeypathSet = False
messageDescriptionAddition = " No suitable keypath entries were found."
If Session.Database.TablePersistent("File") = 1 Then
'Check file table
Set Tempview = Session.Database.OpenView("SELECT `File`,`Component_` FROM `File` WHERE `Component_`='" & keypathRec.StringData(1) & "'")
Tempview.Execute
Set tempRec = Tempview.Fetch
If Not tempRec Is Nothing Then
blnKeypathSet = True
messageDescriptionAddition = " A suitable keypath may be '" & tempRec.StringData(1) & "' in the File table."
End If
Set Tempview = Nothing
Set tempRec = Nothing
End If
If Not blnKeypathSet Then
If Session.Database.TablePersistent("Registry") = 1 Then
Set Tempview = Session.Database.OpenView("SELECT `Registry`, `Component_` FROM `Registry` WHERE `Component_`='" & keypathRec.StringData(1) & "'")
Tempview.Execute
Set tempRec = Tempview.fetch
If Not tempRec is Nothing Then
blnKeypathSet = True
messageDescriptionAddition = " A suitable keypath may be '" & tempRec.StringData(1) & "' in the Registry table."
end If
Set Tempview = Nothing
Set tempRec = Nothing
End If
End If
If Not blnKeypathSet Then
If Session.Database.TablePersistent("ODBCDataSource") = 1 Then
'check ODBCDataSource table
Set Tempview = Session.Database.OpenView("SELECT `DataSource`, `Component_` FROM `ODBCDataSource` WHERE `Component_`='" & keypathRec.StringData(1) & "'")
Tempview.Execute
Set tempRec = Tempview.fetch
If Not tempRec is Nothing Then
blnKeypathSet = True
messageDescriptionAddition = " A suitable keypath may be '" & tempRec.StringData(1) & "' in the ODBCDataSource table."
end If
Set Tempview = Nothing
Set tempRec = Nothing
End If
End If
keypathRec.StringData(0) = messageIceName & Chr(9) & messageType & Chr(9) & messageDescription & messageDescriptionAddition & Chr(9) & "" & Chr(9) & messageTable & chr(9) & messageColumn & chr(9) & "[1]"
Session.Message msiMessageTypeUser,keypathRec
Set keypathRec = keypathView.Fetch
Loop
End If
Set keypathRec = Nothing
Set keypathView = Nothing
Set TempRec = Nothing
Set Tempview = Nothing
checkNoKeypath = 1
End Function
'This function checks that we do not have any duplicate registry. Duplicate registry items usually occur when users start to import
'registry and they're not being careful!
Function noDuplicateRegistry()
messageIceName = "EXAMPLE03"
messageType = 2
messageTable = "Registry"
messageColumn = "Registry"
Dim registryView, registryRecord, duplicateView, duplicateRecord, tempRecord
If Session.Database.TablePersistent("Registry") = 1 And Session.Database.TablePersistent("Component") = 1 Then
Set registryView = Session.Database.OpenView("SELECT `Registry`,`Key`,`Name`,`Value`,`Component_` FROM `Registry`")
registryView.Execute
Set registryRecord = registryView.Fetch
Do Until registryRecord Is Nothing
Set duplicateView = Session.Database.OpenView("SELECT `Registry` FROM `Registry` WHERE `Key`=? AND `Name`=? AND `Value`=? AND `Registry` <> ?")
Set tempRecord = Session.Installer.CreateRecord(4)
tempRecord.StringData(1) = registryRecord.StringData(2)
tempRecord.StringData(2) = registryRecord.StringData(3)
tempRecord.StringData(3) = registryRecord.StringData(4)
tempRecord.StringData(4) = registryRecord.StringData(1)
duplicateView.Execute(tempRecord)
Set tempRecord = Nothing
Set duplicateRecord = duplicateView.Fetch
While not duplicateRecord is Nothing
if not isMSMData(registryRecord.StringData(1)) and not isMSMData(duplicateRecord.StringData(1)) Then
messageDescription = "Registry entry '[1]' is a duplicate of registry entry '" & duplicateRecord.StringData(1) & "'. Please investigate."
registryRecord.StringData(0) = messageIceName & Chr(9) & messageType & Chr(9) & messageDescription & Chr(9) & "" & Chr(9) & messageTable & chr(9) & messageColumn & chr(9) & "[1]"
Session.Message msiMessageTypeUser,registryRecord
end If
Set duplicateRecord = duplicateView.Fetch
Wend
Set registryRecord = registryView.Fetch
Loop
End If
Set registryView = Nothing
Set registryRecord = Nothing
Set duplicateView = Nothing
Set duplicateRecord = Nothing
noDuplicateRegistry = 1
End Function
'returns true if tempData contains MSM decoration
Function isMSMData(tempData)
isMSMData = False
Dim Match
Dim regEx : Set regEx = New RegExp
regEx.MultiLine = vbTrue
regEx.global = vbTrue
regEx.Pattern = "[A-Za-z0-9]{8}_[A-Za-z0-9]{4}_[A-Za-z0-9]{4}_[A-Za-z0-9]{4}_[A-Za-z0-9]{12}"
For Each Match in regEx.Execute(tempData)
isMSMData = True
Next
Set regEx = Nothing
End Function
