How App-V works?





Click on the image to enlarge



· When a user logs on to a device that has one of the clients (either App-V Terminal Services or Desktop Client) installed, the client sends a request to the server for a list of applications assigned to the current user.

· The server communicates with Active Directory to determine which groups the user is a member of and then returns the list of applications back to the client.

· The client begins building advertisements for the virtual applications that have been assigned to that particular user.

· In this publishing phase the below files are created in the client machine:

•  Microsoft Application Virtualization-enabled application (.sft) file.
• One or more Open Software Description (.osd) "link" files
• One or more icon (.ico) files
• Microsoft Application Virtualization project (.sprj) file. 

· The icons, instead of pointing to executables that reside in the program files directory, point to the App-V client, which relies on a launcher file (an OSD file) for its configuration.

· When the user launches a virtual application, the client reads an OSD configuration file, which has been stored on the local machine.

· This tells the client which protocol to use when communicating with the App-V management server and on which server the application resides.

· The appropriate server responds to the client by streaming down the initial launch threshold, which is typically 20–40 percent of the full application.

· Once the entire launch threshold has been streamed (again, just 20–40 percent of the application), the virtual application is ready to run.

· The streaming really is one of the key elements that can send just enough of an application so that it can run without wasting valuable network bandwidth.

· All the data being delivered to the client resides in a local cache file on the device and any subsequent launches of the application are launched from the local cache, eliminating additional network traffic.

· Once the virtual application is finished streaming, the client builds an isolated environment that prevents the application from altering the local machine.

· The client allows the virtual application to access the local file system when saving and editing files, and it also allows the application to interact with local services (such as printing) as long as the user has the appropriate privileges on the local system.

· But any changes made by a virtual application to the local system's files and registry are redirected to the virtualized environment so the host device will remain unaltered.

· When the application is being run, any features that haven't been used previously are delivered as needed and cached for subsequent use. The upside to this is that only components needed by the user are loaded on initial launch and features that aren't needed don't consume network resources.

· Consider Microsoft Office Word, for example. Almost all users use spell checker and therefore, it would be part of the initial launch. But not as many users use Help feature in Word, and, thus, it wouldn't need to be delivered in the initial launch. Instead, it would be sent to a user the first time he accesses it.

· When the user is finished and closes the application, the client tears down the virtual environment and stores all the user settings in a user-specific location so the environment can be retained and rebuilt upon next launch.

· Whatever percentage of the virtual application that had been streamed remains in the local cache and is available for the next launch. And if another user logs onto the same host system and launches the same virtual application, the new user benefits from the application already stored in the cache.

· To remove the virtual application advertisements, simply remove the user from the appropriate Active Directory group.

· To uninstall the virtual application from a desktop completely, you can simply clear the cache. Since the application was never really installed locally, there are no annoying prompts asking, "Do you want to remove this shared component?"

· Even if a virtual application is stored in the cache, that doesn't mean all users have access to it. Unlike locally installed applications where users can simply search or browse for executables that they don't have rights to, there are no visual or physical representations that the virtual application exists unless the user has been given explicit rights to it through Active Directory groups.

*************************************************

VBScript to copy a file from Source directory

The below script is used to copy "vpnclient_setup.msi file" from the Source directory to "[ProgramFilesFolder]Cisco Systems\Install\", if the directory exists and if it doesn't exists, this script will create a folder named "Install" and will copy the file. This is achieved by declaring "SOURCEDIR" as a session property and copying from there.

Note: This script should be placed at the end of the "Execute Immediate" sequence for it to work.

*************************************************

Dim objfso,wshshell,str

Set wshshell = createobject("wscript.shell")

PF = wshshell.expandenvironmentstrings("%ProgramFiles%")

Set objFSO = CreateObject("Scripting.FileSystemObject")

str = Session.Property("SOURCEDIR")

Set oFile1 = objfso.GetFile(str & "\vpnclient_setup.msi")

If objfso.FolderExists(PF & "\Cisco Systems\Install") Then

objFSO.CopyFile oFile1, PF & "\Cisco Systems\Install\", True

Else

Set objFolder = objFSO.CreateFolder (PF & "\Cisco Systems\Install")

objFSO.CopyFile oFile1, PF & "\Cisco Systems\Install\", True

End If

*************************************************

VBScript for silent merge of a registry file

Set WshShell = CreateObject( "WScript.Shell" )


PF=WshShell.ExpandEnvironmentStrings("%ProgramFiles%")

wshshell.Run "REGEDIT /s " & Chr(34) & PF & "\QuickTime\FileCap.reg" & Chr(34), 0, True

**********************************************

VBScript to Stop and Start a service

To Stop a Service:

-------------------

strComputer = "."


strServiceName = "CVPND"

Set a= GetObject("winmgmts:\\" & strComputer)

Set b = a.ExecQuery("Select * from Win32_Service Where Name ='" & strServiceName & "'")

For Each c in b

c.StopService()

Next

 
To Start a Service:

-------------------

 
strServiceName = "CVPND"


Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")

Set colListOfServices = objWMIService.ExecQuery ("Select * from Win32_Service Where Name ='" & strServiceName & "'")

For Each objService in colListOfServices

objService.StartService()

Next

***********************************************

Vbscripts to set Permission via LockPermission Table

LocalGroupLocalized.vbs:
---------------------------

**********************************************************************************
Option Explicit


On Error Resume Next

Const conAPPLICATION = "Get localized group names"

Dim intCODE, strMARK

Dim objHOST, objNET

' Creating Objects

Set objNET = CreateObject("Wscript.Network")

Set objHOST = CreateObject("WScript.Shell")



Bail "Start " & conAPPLICATION & " " & Now(), 0



Main ' Cals the start subfunction that starts the script



'*********************************************************

' Purpose: Starts the script.

'

' Assumptions: Assumes that objHOST, objNET are defined globaly.

'

' Effects : None.

'

' Inputs: none.

'

' Return Values : Nothing.

'*********************************************************

Sub Main()

On Error Resume Next

'Begin to insert Your code here



Dim strComputerName : strComputerName = objNET.ComputerName

Dim objWMIService, colAccounts, objAccount

Dim strUsersGroupSID : strUsersGroupSID = "S-1-5-32-545"

Dim strPowerUsersGroupSID : strPowerUsersGroupSID = "S-1-5-32-547"



Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")



Set colAccounts = objWMIService.ExecQuery("Select * From Win32_Group Where SID = '" & strUsersGroupSID & "' And Domain = '" & strComputerName & "'")

For Each objAccount In colAccounts

session.property("BuiltinUsers") = objAccount.Name

Bail "Users group name is: " & objAccount.Name, 0

'MsgBox objAccount.Name & VbCrLf & objAccount.Caption & VbCrLf & objAccount.Description & VbCrLf & objAccount.Domain & VbCrLf & objAccount.Installdate & VbCrLf & objAccount.SID & VbCrLf & objAccount.SIDType & VbCrLf & objAccount.Status

Next



Set colAccounts = objWMIService.ExecQuery("Select * From Win32_Group Where SID = '" & strPowerUsersGroupSID & "' And Domain = '" & strComputerName & "'")

For Each objAccount in colAccounts

session.property("PowerUsers") = objAccount.Name

Bail "Power Users group name is: " & objAccount.Name, 0

'MsgBox objAccount.Name & VbCrLf & objAccount.Caption & VbCrLf & objAccount.Description & VbCrLf & objAccount.Domain & VbCrLf & objAccount.Installdate & VbCrLf & objAccount.SID & VbCrLf & objAccount.SIDType & VbCrLf & objAccount.Status

Next











End Sub



Bail "Stop " & conAPPLICATION & " " & Now(), 0

LogIt

Set objNET = Nothing

Set objHOST = Nothing











'*********************************************************

' Purpose: Writes to the application log.

'

' Assumptions: Assumes that intCODE, strMARK, objHOST, objNET are defined globaly.

'

' Effects : None.

'

' Inputs: No argoments.

'

' Return Values : Nothing.

'*********************************************************

Function LogIt()

On Error Resume Next

objHOST.LogEvent intCODE, strMARK, objNET.ComputerName

End Function



'*********************************************************

' Purpose: Catch errors during execution of the script.

'

' Assumptions: Assumes that intCODE, strMARK, are defined globaly

' and that the LogIt function exist.

'

' Effects : Sets intCODE, strMARK.

'

' Inputs:

' strEvent: The text that will be written to the application eventlog

' and if wanted as a message box to the user.

'

' intShow: If intShow equals 1 and an error has been generated, an error message is displayed to the user.

' If intShow differs from 1 and an error has been generated, the error is written to the application log.

' If an error has been generated and strEvent contains a string, than the string and the error are logged to the aspplications log.

'

' Return Values : The error number.

'*********************************************************

Function Bail(Byval strEvent, intShow)

Dim strERRMESSAGE, intBOX, blnQUIT, intRET, intButton

Bail = Err.Number



If intCODE <> 1 Then intCODE = 4

If Err.Number = 0 And strEvent = vbNullString Then Exit Function

If Err.Number <> 0 Then

strEVENT = strEVENT & "-Err Number 0x" & Hex(Err.Number) & " " & Err.Description

intCODE = 1

If intSHOW = 1 Then

Select Case Hex(Err.Number)

'Insert your case numer here



Case Else

' All not handled errors gets here. This case gives the user no second chanse to try again.

strERRMESSAGE = "Unknown error. Please report this to the support."

intBOX = vbCritical

intButton = vbOKOnly + vbDefaultButton1

blnQUIT = True

End Select

intRET = MsgBox(strERRMESSAGE & vbCrLf & vbCrLf & strEVENT, intBOX + intButton, conAPPLICATION)



End If

Else

strEVENT = strEVENT & " - OK"

End If

strMARK = strMARK & vbCrLF & strEVENT

Err.Clear



If blnQUIT Or intRET = vbNo Then

strMARK = strMARK & vbCrLF & "Premature termination " & Now()

LogIt

WScript.Quit 1

End If



End Function

********************************************************************************** 
 
LockPermissions_Reg_WSI.vbs:
----------------------------------
 
**********************************************************************************
Option Explicit


On Error Resume Next

Const conAPPLICATION = "LockPermissions Registry addition"



' SpecialFolder Constants

Const conWindowsFolder = 0

Const conSystemFolder = 1

Const conTemporaryFolder = 2



Const msiOpenDatabaseModeReadOnly = 0

Const msiOpenDatabaseModeTransact = 1

Const conmsiOpenDatabaseModeDirect = 2 'Opens a database direct read/write without transaction.

Const msiOpenDatabaseModeCreate = 3





Dim intCODE, strMARK

Dim objHOST, objNET

' Creating Objects

Set objNET = CreateObject("Wscript.Network")

Set objHOST = CreateObject("WScript.Shell")

Dim objInstaller : Set objInstaller = CreateObject("WindowsInstaller.Installer")

Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")

Dim strWsiFile : strWsiFile = WScript.Arguments(0)

Dim intRoot, strRoot

Dim strKey



Bail "Start " & conAPPLICATION & " " & Now(), 0



Main ' Cals the start subfunction that starts the script



'*********************************************************

' Purpose: Starts the script.

'

' Assumptions: Assumes that objHOST, objNET are defined globaly.

'

' Effects : None.

'

' Inputs: none.

'

' Return Values : Nothing.

'*********************************************************

Sub Main()

On Error Resume Next

'Begin to insert Your code here

Dim objFile

Dim objDatabase, objView, objRecord

Dim strRegistryTable()

ReDim strRegistryTable(0)



Dim intI



Dim strProgId 'WfWIWSI.Document

Dim strCompileCommand '"C:\Program Files\Altiris\Wise Package Studio\Windows Installer Editor\WfWI.exe" "%1" /c





Dim objREGEXP : Set objREGEXP = New RegExp

Dim objMatches, objMatch

objREGEXP.Global = True 'Sets a Boolean value that indicates if a pattern should match all occurrences in an entire search string or just the first one.

objREGEXP.IgnoreCase = True 'Sets a Boolean value that indicates if a pattern search is case-sensitive or not.





' ============= Error handling =================================================

If WScript.Arguments.Count() <> 1 Then

Err.Raise -1

Bail "This script takes one argumants" & VbCrLf & "The argumnet should be the WSI file" & VbCrLf, 1

End If



If Not (InStrRev(strWsiFile, ".WSI", -1, vbtextcompare) = (Len(strWsiFile) - 3)) Then

Err.Raise -1

Bail "The argument must be a WSI file" & VbCrLf, 1

End If





' ============= Error handling =================================================



Set objFile = objFSO.GetFile(strWsiFile)



objFile.Copy objFile.ParentFolder & "\Backup " & Year(Now) & "-" & Month(Now) & "-" & Day(Now) & " " & Hour(Now) & ";" & Minute(Now) & ";" & Second(Now) & " " & objFile.Name, False

If Bail("Backing up file", 0) <> 0 Then

Bail "Backing up file failed. Quitting!", 0

LogIt

WScript.Quit -1

End If





strRoot = InputBox("Enter registry root!" & VbCrLf & VbCrLf & "Valid roots are:" & VbCrLf & "0=HKCR" & VbCrLf & "1=HKCU" & VbCrLf & "2=HKLM" & VbCrLf & "3=HKU", "Registry root", 2)

If Len(strRoot) = 0 Then

Err.Raise -1

Bail "An invalid root was entered", 1

Else

intRoot = Cint(strRoot)

If intRoot < 0 Or intRoot > 3 Then

Err.Raise -1

Bail "An invalid root was entered", 1

End If

End If



strKey = InputBox("Enter registry key!" & VbCrLf & VbCrLf & "Example: SOFTWARE\JOA\ABC", "Registry key")

If Len(strKey) = 0 Then

Err.Raise -1

Bail "An invalid key was entered", 1

Else

If InStr(1, strKey, "Software\Policies", vbtextcompare) > 0 Or InStr(1, strKey, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies", vbtextcompare) > 0 Then

Err.Raise -1

Bail "An invalid key was entered", 1

End If

End If



Set objDatabase = objInstaller.OpenDatabase(strWsiFile, conmsiOpenDatabaseModeDirect)

Bail "Open DB", 0



AddCustomAction "6", "CA_GetLocalizedGroupsNames", "GetLocalizedGroups", ScriptDir() & "LocalGroupLocalized.vbs", objDatabase

Bail "Add custom action",0





Set objView = objDatabase.OpenView("SELECT `Registry`, `Key` FROM `Registry` WHERE `Root`=" & intRoot)

Bail "Read registry entries for a given root and key", 0

If Not IsObject(objView) Then

LogIt

WScript.Quit

End If



objView.Execute

Set objRecord = objView.Fetch()

Do While Not objRecord Is Nothing



If InStr(1, objRecord.StringData(2), strKey, vbTextCompare) > 0 Then

strRegistryTable(Ubound(strRegistryTable)) = objRecord.StringData(1)



ReDim Preserve strRegistryTable(Ubound(strRegistryTable) + 1)

End If



Set objRecord = objView.Fetch()

Loop

ReDim Preserve strRegistryTable(Ubound(strRegistryTable) - 1)



objView.Close



' #define KEY_QUERY_VALUE (0x0001)

' #define KEY_SET_VALUE (0x0002)

' #define KEY_CREATE_SUB_KEY (0x0004)

' #define KEY_ENUMERATE_SUB_KEYS (0x0008)

' #define KEY_NOTIFY (0x0010)

' #define KEY_CREATE_LINK (0x0020)

'

' #define DELETE (0x00010000L)

' #define READ_CONTROL (0x00020000L)

' #define WRITE_DAC (0x00040000L)

' #define WRITE_OWNER (0x00080000L)

'

'

'

' Users - READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL = 131097 (dec)

'

' Power Users - Special = KEY_QUERY_VALUE + KEY_SET_VALUE + KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + DELETE + READ_CONTROL = 196639 (dec)

'

' Administrators FC = KEY_QUERY_VALUE + KEY_SET_VALUE + KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + KEY_CREATE_LINK + DELETE + WRITE_DAC + WRITE_OWNER + READ_CONTROL = 983103 (dec)





For intI = 0 To UBound(strRegistryTable)

Set objView = objDatabase.OpenView("INSERT INTO LockPermissions (`LockObject`, `Table`, `User`, `Permission`) VALUES ('" & strRegistryTable(intI) & "', 'Registry', 'Administrators', '983103')")

Bail "Create OpnenView INSERT INTO query",0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "LockPermission row exists. Trying to update instead", 0

Set objView = objDatabase.OpenView("UPDATE LockPermissions SET `Permission` = '983103' WHERE `LockObject` = '" & strRegistryTable(intI) & "' AND `Table` = 'Registry' AND `Domain` = '' AND `User` = 'Administrators'")

Bail "Create OpnenView UPDATE query",0

objView.Execute

End If

Bail "Execute OpenView", 0

objView.Close

Bail "Close OpenView", 0



Set objView = objDatabase.OpenView("INSERT INTO LockPermissions (`LockObject`, `Table`, `User`, `Permission`) VALUES ('" & strRegistryTable(intI) & "', 'Registry', '[BuiltinUsers]', '196639')")

Bail "Create OpnenView INSERT INTO query",0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "LockPermission row exists. Trying to update instead", 0

Set objView = objDatabase.OpenView("UPDATE LockPermissions SET `Permission` = '196639' WHERE `LockObject` = '" & strRegistryTable(intI) & "' AND `Table` = 'Registry' AND `Domain` = '' AND `User` = '[BuiltinUsers]'")

Bail "Create OpnenView UPDATE query",0

objView.Execute

End If

Bail "Execute OpenView", 0

objView.Close

Bail "Close OpenView", 0



Set objView = objDatabase.OpenView("INSERT INTO LockPermissions (`LockObject`, `Table`, `User`, `Permission`) VALUES ('" & strRegistryTable(intI) & "', 'Registry', '[PowerUsers]', '196639')")

Bail "Create OpnenView INSERT INTO query",0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "LockPermission row exists. Trying to update instead", 0

Set objView = objDatabase.OpenView("UPDATE LockPermissions SET `Permission` = '196639' WHERE `LockObject` = '" & strRegistryTable(intI) & "' AND `Table` = 'Registry' AND `Domain` = '' AND `User` = '[PowerUsers]'")

Bail "Create OpnenView UPDATE query",0

objView.Execute

End If

Bail "Execute OpenView", 0

objView.Close

Bail "Close OpenView", 0

Next



objDatabase.Commit

Bail "Commit DB changes", 0



strProgId = objHOST.RegRead("HKEY_CLASSES_ROOT\.wsi\")

strCompileCommand = objHOST.RegRead("HKEY_CLASSES_ROOT\" & strProgId & "\shell\CompileWPS\command\")



objREGEXP.Pattern = "%1"

strCompileCommand = objREGEXP.Replace(strCompileCommand, strWsiFile)



If MsgBox("Done! Do you want to compile now?", vbYesNo + vbQuestion + vbDefaultButton2 + vbSystemModal, "End") = vbYes Then

objHOST.Run strCompileCommand, 1, False

Else



End if

End Sub



Bail "Stop " & conAPPLICATION & " " & Now(), 0

LogIt

Set objNET = Nothing

Set objHOST = Nothing





'*********************************************************

' Purpose: Add an action prior to an existing action in InstallExecuteSequence table.

'

' Assumptions:

'

' Effects :

'

' Inputs: strActionToAdd = Name of the action to add

' strRelativeToAction = Name of the action to place the action infront of

' objDaBa = Object containing the database (MSI) to edit

' Return Values : Nothing.

'*********************************************************

Function AddActionPriorTo(strActionToAdd, strRelativeToAction, objDaBa)

On Error Resume Next

'Insert Your function code here

Dim objView, objRecord, intSeqRel, intFreeSeq, blnFree 'objDaBa

blnFree = False

Bail "Creating row in InstallExecuteSequence for " & strActionToAdd, 0



'Set objDaBa = objInstaller.OpenDatabase(strDBFile, msiOpenDatabaseModeTransact)

'Bail "Open DB " & strDBFile, 0

Set objView = objDaBa.OpenView("SELECT `Action`, `Sequence` FROM `InstallExecuteSequence` WHERE `Action`='" & strRelativeToAction & "'")

Bail "Select created for finding sequence relative to",0

objView.Execute

Bail "Execute select for finding sequence relative to",0

Set objRecord = objView.Fetch()

intSeqRel = objRecord.StringData(2)

intFreeSeq = intSeqRel

Bail strRelativeToAction & " found at " & intSeqRel, 0

Do

'Find previous free sequence number

intFreeSeq = intFreeSeq -1

Set objView = objDaBa.OpenView("SELECT `Action`, `Sequence` FROM `InstallExecuteSequence` WHERE `Sequence`=" & intFreeSeq)

Bail "Select created for finding free sequence",0

objView.Execute

Bail "Execute select to find out if sequence " & intFreeSeq & " is free", 0

Set objRecord = objView.Fetch()

If objRecord Is Nothing Then blnFree = True

Loop Until blnFree



Bail "Free sequence is " & intFreeSeq, 0

Set objView = objDaBa.OpenView("INSERT INTO InstallExecuteSequence (`Action`, `Sequence`) VALUES ('" & strActionToAdd & "', '" & intFreeSeq & "')")

Bail "Create OpnenView INSERT INTO query for CA " & strActionToAdd, 0

objView.Execute



If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "InstallExecuteSequence row exists. Trying to update instead", 0

Set objView = objDaBa.OpenView("UPDATE InstallExecuteSequence SET `Sequence` = '" & intFreeSeq & "' WHERE `Action` = '" & strActionToAdd & "'")

Bail "Create OpnenView UPDATE query for CA " & strActionToAdd, 0

objView.Execute

End If

Bail "Execute OpenView for INSERT INTO/UPDATE", 0

objView.Close

Bail "Close OpenView", 0

objDaBa.Commit

Bail "Commit DB changes", 0





End Function





'*********************************************************

' Purpose: Add a custom action to the CustomAction table.

'

' Assumptions:

'

' Effects :

'

' Inputs: strCAType = The custom action type (number)

' strCAName = The Custom action name

' strCASource = The Custom action source

' strFile = The file that should be place in binary table. Path plus file

' objDB = Object containing the database (MSI) to edit

'

' Return Values : Explanation of the value returned.

'*********************************************************

Function AddCustomAction(strCAType, strCAName, strCASource, strFile, objDB)

On Error Resume Next

'Insert Your function code here

Dim objView



AddScriptToBinaryTable strCASource, strFile, objDB



Bail "Creating a row in CustumActions table for " & strCAName, 0



Set objView = objDB.OpenView("INSERT INTO CustomAction (`Action`, `Type`, `Source`) VALUES ('" & strCAName & "', '" & strCAType &"', '" & strCASource & "')")

Bail "Create OpnenView INSERT INTO query for adding CA " & strCAName, 0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "CustumActions row exists. Trying to update instead", 0

Set objView = objDB.OpenView("UPDATE CustomAction SET `Type` = '" & strCAType & "', `Source` = '" & strCASource & "' WHERE `Action` = '" & strCAName & "'")

Bail "Create OpnenView UPDATE query uptating " & strCAName, 0

objView.Execute

End If

Bail "Execute OpenView for INSERT INTO/UPDATE", 0

objView.Close

Bail "Close OpenView", 0

objDB.Commit

Bail "Commit DB changes", 0





AddActionPriorTo strCAName, "CostFinalize", objDB







End Function





'*********************************************************

' Purpose: Add an entry in binary table

'

' Assumptions:

'

' Effects :

'

' Inputs: strBinName = The name in Binary table

' strFilename = The file that should be place in binary table. Path plus file

' objDB = Object containing the database (MSI) to edit

'

' Return Values : Explanation of the value returned.

'*********************************************************

Function AddScriptToBinaryTable(strBinName, strFilename, objDB)

On Error Resume Next

'Insert Your function code here



Dim objVw

Dim objRec

Bail "Creating a row in binary table for " & strFilename, 0

Set objRec = objInstaller.CreateRecord(1)

objRec.SetStream 1, strFilename





Set objVw = objDB.OpenView("INSERT INTO `Binary` (`Name`, `Data`) VALUES ('" & strBinName & "', ?)")

Bail "Create OpnenView INSERT INTO query for adding file " & strFilename & " into Binary table", 0

objVw.Execute objRec

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "Binary table row exists. Trying to update instead", 0

Set objVw = objDB.OpenView("UPDATE Binary SET `Data` = ? WHERE `Name` = '" & strBinName & "'")

Bail "Create OpnenView UPDATE query for updating file " & strFilename & " in Binary table", 0

objVw.Execute objRec

End if

Bail "Execute OpenView for INSERT INTO/UPDATE", 0

objVw.Close

Bail "Close OpenView", 0

objDB.Commit ' save changes

Bail "Commit DB changes", 0



End Function









'*********************************************************

' Purpose: Returns the directory where the script resides.

'

' Assumptions: Nothing

'

' Effects : Nothings

'

' Inputs: Nothing

'

' Return Values : The folder including final backslash

'*********************************************************

Function ScriptDir()

On Error Resume Next

ScriptDir = Mid(WScript.ScriptFullName, 1, Len(WScript.ScriptFullName)- Len(WScript.ScriptName))



End Function



'*********************************************************

' Purpose: Writes to the application log.

'

' Assumptions: Assumes that intCODE, strMARK, objHOST, objNET are defined globaly.

'

' Effects : None.

'

' Inputs: No argoments.

'

' Return Values : Nothing.

'*********************************************************

Function LogIt()

On Error Resume Next

objHOST.LogEvent intCODE, strMARK, objNET.ComputerName

End Function



'*********************************************************

' Purpose: Catch errors during execution of the script.

'

' Assumptions: Assumes that intCODE, strMARK, are defined globaly

' and that the LogIt function exist.

'

' Effects : Sets intCODE, strMARK.

'

' Inputs:

' strEvent: The text that will be written to the application eventlog

' and if wanted as a message box to the user.

'

' intShow: If intShow equals 1 and an error has been generated, an error message is displayed to the user.

' If intShow differs from 1 and an error has been generated, the error is written to the application log.

' If an error has been generated and strEvent contains a string, than the string and the error are logged to the aspplications log.

'

' Return Values : The error number.

'*********************************************************

Function Bail(Byval strEvent, intShow)

Dim strERRMESSAGE, intBOX, blnQUIT, intRET, intButton

Bail = Err.Number



If intCODE <> 1 Then intCODE = 4

If Err.Number = 0 And strEvent = vbNullString Then Exit Function

If Err.Number <> 0 Then

strEVENT = strEVENT & "-Err Number 0x" & Hex(Err.Number) & " " & Err.Description

intCODE = 1

If intSHOW = 1 Then

Select Case Hex(Err.Number)

'Insert your case numer here



Case Else

' All not handled errors gets here. This case gives the user no second chanse to try again.

strERRMESSAGE = "Unknown error. Please report this to the support."

intBOX = vbCritical

intButton = vbOKOnly + vbDefaultButton1

blnQUIT = True

End Select

intRET = MsgBox(strERRMESSAGE & vbCrLf & vbCrLf & strEVENT, intBOX + intButton, conAPPLICATION)



End If

Else

strEVENT = strEVENT & " - OK"

End If

strMARK = strMARK & vbCrLF & strEVENT

Err.Clear



If blnQUIT Or intRET = vbNo Then

strMARK = strMARK & vbCrLF & "Premature termination " & Now()

LogIt

WScript.Quit 1

End If



End Function
 
LockPermissions_Reg_MST.vbs:
----------------------------------
 
Option Explicit


On Error Resume Next

Const conAPPLICATION = "MST LockPermissions RegKey"



' SpecialFolder Constants

Const conWindowsFolder = 0

Const conSystemFolder = 1

Const conTemporaryFolder = 2



Const msiOpenDatabaseModeReadOnly = 0

Const msiOpenDatabaseModeTransact = 1

Const conmsiOpenDatabaseModeDirect = 2 'Opens a database direct read/write without transaction.

Const msiOpenDatabaseModeCreate = 3



Const msiTransformErrorNone = 0

Const msiTransformValidationNone = 0



Const conFILE_ATTRIBUTE_NORMAL = 0 '0x00000000



Dim intCODE, strMARK

Dim objHOST, objNET

' Creating Objects

Set objNET = CreateObject("Wscript.Network")

Set objHOST = CreateObject("WScript.Shell")

Dim objInstaller ': Set objInstaller = CreateObject("WindowsInstaller.Installer")

Set objInstaller = Wscript.CreateObject("WindowsInstaller.Installer")

Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")



Bail "Start " & conAPPLICATION & " " & Now(), 0



Main ' Cals the start subfunction that starts the script



'*********************************************************

' Purpose: Starts the script.

'

' Assumptions: Assumes that objHOST, objNET are defined globaly.

'

' Effects : None.

'

' Inputs: none.

'

' Return Values : Nothing.

'*********************************************************

Sub Main()

On Error Resume Next

'Begin to insert Your code here

Dim objDatabaseMaster, objDatabaseIntermediate, objDatabaseTransformed

Dim strMsiFile

Dim strMstFile

Dim strMsiFileName, strMstFileName

Dim objView, objRecord

Dim strRegistryTable()

Dim intI



Dim objFile



ReDim strRegistryTable(0)







Dim strRoot, intRoot, strKey

' ============= Error handling =================================================

If WScript.Arguments.Count() = 0 Then

Err.Raise -1

Bail "This script takes two argumants" & VbCrLf & "The fisrt is the MSI file" & VbCrLf & "The second is the MST file" & VbCrLf, 1

End if



strMsiFile = WScript.Arguments(0)



If Not (InStrRev(strMsiFile, ".MSI", -1, vbtextcompare) = (Len(strMsiFile) - 3)) Then

Err.Raise -1

Bail "The fisrt argument must be a MSI file" & VbCrLf, 1

End If



If WScript.Arguments.Count() = 2 Then

strMstFile = WScript.Arguments(1)

Else

strMstFile = InputBox ("Full path inkl. MST-file name.","MST file path",Mid(WScript.Arguments(0), 1, Len(WScript.Arguments(0))-1) & "t")

End If



If Not (InStrRev(strMstFile, ".MST", -1, vbtextcompare) = (Len(strMstFile) - 3)) Then

Err.Raise -1

Bail "The second argument must be a MST file" & VbCrLf, 1

End If

' ============= Error handling =================================================





objFSO.CopyFile strMsiFile, objFSO.GetSpecialFolder(conTemporaryFolder) & "\", True 'Create a copy of the Windiws Installer database

objFSO.CopyFile strMstFile, objFSO.GetSpecialFolder(conTemporaryFolder) & "\", True 'Create a copy of the Windiws Installer transform





If InStrRev(strMsiFile,"\", -1, vbTextCompare) > 0 Then



strMsiFileName = Mid(strMsiFile, InStrRev(strMsiFile,"\", -1, vbTextCompare)+1)

Else



strMsiFileName = strMsiFile

End If



If InStrRev(strMstFile,"\", -1, vbTextCompare) > 0 Then



strMstFileName = Mid(strMstFile, InStrRev(strMstFile,"\", -1, vbTextCompare)+1)

Else



strMstFileName = strMstFile

End If



Set objFile = objFSO.GetFile(objFSO.GetSpecialFolder(conTemporaryFolder) & "\" & strMsiFileName)

objFile.Attributes = conFILE_ATTRIBUTE_NORMAL



strRoot = InputBox("Enter registry root!" & VbCrLf & VbCrLf & "Valid roots are:" & VbCrLf & "0=HKCR" & VbCrLf & "1=HKCU" & VbCrLf & "2=HKLM" & VbCrLf & "3=HKU", "Registry root", 2)

If Len(strRoot) = 0 Then

Err.Raise -1

Bail "An invalid root was entered", 1

Else

intRoot = Cint(strRoot)

If intRoot < 0 Or intRoot > 3 Then

Err.Raise -1

Bail "An invalid root was entered", 1

End If

End If



strKey = InputBox("Enter registry key!" & VbCrLf & VbCrLf & "Example: SOFTWARE\JOA\ABC", "Registry key")

If Len(strKey) = 0 Then

Err.Raise -1

Bail "An invalid key was entered", 1

Else

If InStr(1, strKey, "Software\Policies", vbtextcompare) > 0 Or InStr(1, strKey, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies", vbtextcompare) > 0 Then

Err.Raise -1

Bail "An invalid key was entered", 1

End If

End If







Set objDatabaseTransformed = objInstaller.OpenDatabase(objFSO.GetSpecialFolder(conTemporaryFolder) & "\" & strMsiFileName, conmsiOpenDatabaseModeDirect)

Bail "Open DB", 0

objDatabaseTransformed.ApplyTransform objFSO.GetSpecialFolder(conTemporaryFolder) & "\" & strMstFileName, 0 '256 '63+256

Bail "Apply transform", 0





AddCustomAction "6", "CA_GetLocalizedGroupsNames", "GetLocalizedGroups", ScriptDir() & "LocalGroupLocalized.vbs", objDatabaseTransformed

Bail "Add custom action",0





Set objView = objDatabaseTransformed.OpenView("SELECT `Registry`, `Key` FROM `Registry` WHERE `Root`=" & intRoot)

Bail "Read registry entries for a given root and key", 0

If Not IsObject(objView) Then

LogIt

WScript.Quit

End If



objView.Execute

Set objRecord = objView.Fetch()

Do While Not objRecord Is Nothing



If InStr(1, objRecord.StringData(2), strKey, vbTextCompare) > 0 Then

strRegistryTable(Ubound(strRegistryTable)) = objRecord.StringData(1)



ReDim Preserve strRegistryTable(Ubound(strRegistryTable) + 1)

End If



Set objRecord = objView.Fetch()

Loop

ReDim Preserve strRegistryTable(Ubound(strRegistryTable) - 1)



objView.Close



' #define KEY_QUERY_VALUE (0x0001)

' #define KEY_SET_VALUE (0x0002)

' #define KEY_CREATE_SUB_KEY (0x0004)

' #define KEY_ENUMERATE_SUB_KEYS (0x0008)

' #define KEY_NOTIFY (0x0010)

' #define KEY_CREATE_LINK (0x0020)

'

' #define DELETE (0x00010000L)

' #define READ_CONTROL (0x00020000L)

' #define WRITE_DAC (0x00040000L)

' #define WRITE_OWNER (0x00080000L)

'

'

'

' Users - READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL = 131097 (dec)

'

' Power Users - Special = KEY_QUERY_VALUE + KEY_SET_VALUE + KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + DELETE + READ_CONTROL = 196639 (dec)

'

' Administrators FC = KEY_QUERY_VALUE + KEY_SET_VALUE + KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + KEY_CREATE_LINK + DELETE + WRITE_DAC + WRITE_OWNER + READ_CONTROL = 983103 (dec)





For intI = 0 To UBound(strRegistryTable)

Set objView = objDatabaseTransformed.OpenView("INSERT INTO LockPermissions (`LockObject`, `Table`, `User`, `Permission`) VALUES ('" & strRegistryTable(intI) & "', 'Registry', 'Administrators', '983103')")

Bail "Create OpnenView INSERT INTO query",0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "LockPermission row exists. Trying to update instead", 0

Set objView = objDatabaseTransformed.OpenView("UPDATE LockPermissions SET `Permission` = '983103' WHERE `LockObject` = '" & strRegistryTable(intI) & "' AND `Table` = 'Registry' AND `Domain` = '' AND `User` = 'Administrators'")

Bail "Create OpnenView UPDATE query",0

objView.Execute

End If

Bail "Execute OpenView", 0

objView.Close

Bail "Close OpenView", 0



Set objView = objDatabaseTransformed.OpenView("INSERT INTO LockPermissions (`LockObject`, `Table`, `User`, `Permission`) VALUES ('" & strRegistryTable(intI) & "', 'Registry', '[BuiltinUsers]', '196639')")

Bail "Create OpnenView INSERT INTO query",0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "LockPermission row exists. Trying to update instead", 0

Set objView = objDatabaseTransformed.OpenView("UPDATE LockPermissions SET `Permission` = '196639' WHERE `LockObject` = '" & strRegistryTable(intI) & "' AND `Table` = 'Registry' AND `Domain` = '' AND `User` = '[BuiltinUsers]'")

Bail "Create OpnenView UPDATE query",0

objView.Execute

End If

Bail "Execute OpenView", 0

objView.Close

Bail "Close OpenView", 0



Set objView = objDatabaseTransformed.OpenView("INSERT INTO LockPermissions (`LockObject`, `Table`, `User`, `Permission`) VALUES ('" & strRegistryTable(intI) & "', 'Registry', '[PowerUsers]', '196639')")

Bail "Create OpnenView INSERT INTO query",0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "LockPermission row exists. Trying to update instead", 0

Set objView = objDatabaseTransformed.OpenView("UPDATE LockPermissions SET `Permission` = '196639' WHERE `LockObject` = '" & strRegistryTable(intI) & "' AND `Table` = 'Registry' AND `Domain` = '' AND `User` = '[PowerUsers]'")

Bail "Create OpnenView UPDATE query",0

objView.Execute

End If

Bail "Execute OpenView", 0

objView.Close

Bail "Close OpenView", 0

Next



objDatabaseTransformed.Commit

Bail "Commit DB changes", 0











Set objDatabaseMaster = objInstaller.OpenDatabase(strMsiFile, msiOpenDatabaseModeReadOnly)







If Not objFSO.FolderExists(objFSO.GetSpecialFolder(conTemporaryFolder) & "\New_MSTs") Then objFSO.CreateFolder objFSO.GetSpecialFolder(conTemporaryFolder) & "\New_MSTs"

If objFSO.FileExists(objFSO.GetSpecialFolder(conTemporaryFolder) & "\New_MSTs\" & strMstFileName) Then objFSO.DeleteFile objFSO.GetSpecialFolder(conTemporaryFolder) & "\New_MSTs\" & strMstFileName, True



objDatabaseTransformed.GenerateTransform objDatabaseMaster, objFSO.GetSpecialFolder(conTemporaryFolder) & "\New_MSTs\" & strMstFileName

Bail "Create Transform", 0

objDatabaseTransformed.CreateTransformSummaryInfo objDatabaseMaster, objFSO.GetSpecialFolder(conTemporaryFolder) & "\New_MSTs\" & strMstFileName, msiTransformErrorNone, msiTransformValidationNone

Bail "CreateTransformSummaryInfo", 0

objHOST.Run """" & objFSO.GetSpecialFolder(conTemporaryFolder) & "\New_MSTs" & """", 1, False

End Sub



Bail "Stop " & conAPPLICATION & " " & Now(), 0

LogIt

Set objNET = Nothing

Set objHOST = Nothing





'*********************************************************

' Purpose: Add an action prior to an existing action in InstallExecuteSequence table.

'

' Assumptions:

'

' Effects :

'

' Inputs: strActionToAdd = Name of the action to add

' strRelativeToAction = Name of the action to place the action infront of

' objDaBa = Object containing the database (MSI) to edit

' Return Values : Nothing.

'*********************************************************

Function AddActionPriorTo(strActionToAdd, strRelativeToAction, objDaBa)

On Error Resume Next

'Insert Your function code here

Dim objView, objRecord, intSeqRel, intFreeSeq, blnFree 'objDaBa

blnFree = False

Bail "Creating row in InstallExecuteSequence for " & strActionToAdd, 0



'Set objDaBa = objInstaller.OpenDatabase(strDBFile, msiOpenDatabaseModeTransact)

'Bail "Open DB " & strDBFile, 0

Set objView = objDaBa.OpenView("SELECT `Action`, `Sequence` FROM `InstallExecuteSequence` WHERE `Action`='" & strRelativeToAction & "'")

Bail "Select created for finding sequence relative to",0

objView.Execute

Bail "Execute select for finding sequence relative to",0

Set objRecord = objView.Fetch()

intSeqRel = objRecord.StringData(2)

intFreeSeq = intSeqRel

Bail strRelativeToAction & " found at " & intSeqRel, 0

Do

'Find previous free sequence number

intFreeSeq = intFreeSeq -1

Set objView = objDaBa.OpenView("SELECT `Action`, `Sequence` FROM `InstallExecuteSequence` WHERE `Sequence`=" & intFreeSeq)

Bail "Select created for finding free sequence",0

objView.Execute

Bail "Execute select to find out if sequence " & intFreeSeq & " is free", 0

Set objRecord = objView.Fetch()

If objRecord Is Nothing Then blnFree = True

Loop Until blnFree



Bail "Free sequence is " & intFreeSeq, 0

Set objView = objDaBa.OpenView("INSERT INTO InstallExecuteSequence (`Action`, `Sequence`) VALUES ('" & strActionToAdd & "', '" & intFreeSeq & "')")

Bail "Create OpnenView INSERT INTO query for CA " & strActionToAdd, 0

objView.Execute



If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "InstallExecuteSequence row exists. Trying to update instead", 0

Set objView = objDaBa.OpenView("UPDATE InstallExecuteSequence SET `Sequence` = '" & intFreeSeq & "' WHERE `Action` = '" & strActionToAdd & "'")

Bail "Create OpnenView UPDATE query for CA " & strActionToAdd, 0

objView.Execute

End If

Bail "Execute OpenView for INSERT INTO/UPDATE", 0

objView.Close

Bail "Close OpenView", 0

objDaBa.Commit

Bail "Commit DB changes", 0





End Function





'*********************************************************

' Purpose: Add a custom action to the CustomAction table.

'

' Assumptions:

'

' Effects :

'

' Inputs: strCAType = The custom action type (number)

' strCAName = The Custom action name

' strCASource = The Custom action source

' strFile = The file that should be place in binary table. Path plus file

' objDB = Object containing the database (MSI) to edit

'

' Return Values : Explanation of the value returned.

'*********************************************************

Function AddCustomAction(strCAType, strCAName, strCASource, strFile, objDB)

On Error Resume Next

'Insert Your function code here

Dim objView



AddScriptToBinaryTable strCASource, strFile, objDB



Bail "Creating a row in CustumActions table for " & strCAName, 0



Set objView = objDB.OpenView("INSERT INTO CustomAction (`Action`, `Type`, `Source`) VALUES ('" & strCAName & "', '" & strCAType &"', '" & strCASource & "')")

Bail "Create OpnenView INSERT INTO query for adding CA " & strCAName, 0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "CustumActions row exists. Trying to update instead", 0

Set objView = objDB.OpenView("UPDATE CustomAction SET `Type` = '" & strCAType & "', `Source` = '" & strCASource & "' WHERE `Action` = '" & strCAName & "'")

Bail "Create OpnenView UPDATE query uptating " & strCAName, 0

objView.Execute

End If

Bail "Execute OpenView for INSERT INTO/UPDATE", 0

objView.Close

Bail "Close OpenView", 0

objDB.Commit

Bail "Commit DB changes", 0





AddActionPriorTo strCAName, "CostFinalize", objDB







End Function





'*********************************************************

' Purpose: Add an entry in binary table

'

' Assumptions:

'

' Effects :

'

' Inputs: strBinName = The name in Binary table

' strFilename = The file that should be place in binary table. Path plus file

' objDB = Object containing the database (MSI) to edit

'

' Return Values : Explanation of the value returned.

'*********************************************************

Function AddScriptToBinaryTable(strBinName, strFilename, objDB)

On Error Resume Next

'Insert Your function code here



Dim objVw

Dim objRec

Bail "Creating a row in binary table for " & strFilename, 0

Set objRec = objInstaller.CreateRecord(1)

objRec.SetStream 1, strFilename





Set objVw = objDB.OpenView("INSERT INTO `Binary` (`Name`, `Data`) VALUES ('" & strBinName & "', ?)")

Bail "Create OpnenView INSERT INTO query for adding file " & strFilename & " into Binary table", 0

objVw.Execute objRec

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "Binary table row exists. Trying to update instead", 0

Set objVw = objDB.OpenView("UPDATE Binary SET `Data` = ? WHERE `Name` = '" & strBinName & "'")

Bail "Create OpnenView UPDATE query for updating file " & strFilename & " in Binary table", 0

objVw.Execute objRec

End if

Bail "Execute OpenView for INSERT INTO/UPDATE", 0

objVw.Close

Bail "Close OpenView", 0

objDB.Commit ' save changes

Bail "Commit DB changes", 0



End Function









'*********************************************************

' Purpose: Returns the directory where the script resides.

'

' Assumptions: Nothing

'

' Effects : Nothings

'

' Inputs: Nothing

'

' Return Values : The folder including final backslash

'*********************************************************

Function ScriptDir()

On Error Resume Next

ScriptDir = Mid(WScript.ScriptFullName, 1, Len(WScript.ScriptFullName)- Len(WScript.ScriptName))



End Function













'*********************************************************

' Purpose: Writes to the application log.

'

' Assumptions: Assumes that intCODE, strMARK, objHOST, objNET are defined globaly.

'

' Effects : None.

'

' Inputs: No argoments.

'

' Return Values : Nothing.

'*********************************************************

Function LogIt()

On Error Resume Next

objHOST.LogEvent intCODE, strMARK, objNET.ComputerName

End Function



'*********************************************************

' Purpose: Catch errors during execution of the script.

'

' Assumptions: Assumes that intCODE, strMARK, are defined globaly

' and that the LogIt function exist.

'

' Effects : Sets intCODE, strMARK.

'

' Inputs:

' strEvent: The text that will be written to the application eventlog

' and if wanted as a message box to the user.

'

' intShow: If intShow equals 1 and an error has been generated, an error message is displayed to the user.

' If intShow differs from 1 and an error has been generated, the error is written to the application log.

' If an error has been generated and strEvent contains a string, than the string and the error are logged to the aspplications log.

'

' Return Values : The error number.

'*********************************************************

Function Bail(Byval strEvent, intShow)

Dim strERRMESSAGE, intBOX, blnQUIT, intRET, intButton

Bail = Err.Number



If intCODE <> 1 Then intCODE = 4

If Err.Number = 0 And strEvent = vbNullString Then Exit Function

If Err.Number <> 0 Then

strEVENT = strEVENT & "-Err Number 0x" & Hex(Err.Number) & " " & Err.Description

intCODE = 1

If intSHOW = 1 Then

Select Case Hex(Err.Number)

'Insert your case numer here



Case Else

' All not handled errors gets here. This case gives the user no second chanse to try again.

strERRMESSAGE = "Unknown error. Please report this to the support."

intBOX = vbCritical

intButton = vbOKOnly + vbDefaultButton1

blnQUIT = True

End Select

intRET = MsgBox(strERRMESSAGE & vbCrLf & vbCrLf & strEVENT, intBOX + intButton, conAPPLICATION)



End If

Else

strEVENT = strEVENT & " - OK"

End If

strMARK = strMARK & vbCrLF & strEVENT

Err.Clear



If blnQUIT Or intRET = vbNo Then

strMARK = strMARK & vbCrLF & "Premature termination " & Now()

LogIt

WScript.Quit 1

End If



End Function
 
LockPermissions_Folder_WSI.vbs:
-------------------------------------
 
Option Explicit


On Error Resume Next

Const conAPPLICATION = "LockPermissions Folder addition"



' SpecialFolder Constants

Const conWindowsFolder = 0

Const conSystemFolder = 1

Const conTemporaryFolder = 2



Const msiOpenDatabaseModeReadOnly = 0

Const msiOpenDatabaseModeTransact = 1

Const conmsiOpenDatabaseModeDirect = 2 'Opens a database direct read/write without transaction.

Const msiOpenDatabaseModeCreate = 3





Dim intCODE, strMARK

Dim objHOST, objNET

' Creating Objects

Set objNET = CreateObject("Wscript.Network")

Set objHOST = CreateObject("WScript.Shell")

Dim objInstaller : Set objInstaller = CreateObject("WindowsInstaller.Installer")

Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")

Dim strWsiFile : strWsiFile = WScript.Arguments(0)

Dim intRoot, strRoot

Dim strKey



Bail "Start " & conAPPLICATION & " " & Now(), 0



Main ' Cals the start subfunction that starts the script



'*********************************************************

' Purpose: Starts the script.

'

' Assumptions: Assumes that objHOST, objNET are defined globaly.

'

' Effects : None.

'

' Inputs: none.

'

' Return Values : Nothing.

'*********************************************************

Sub Main()

On Error Resume Next

'Begin to insert Your code here

Dim objFile

Dim objDatabase, objView, objRecord

Dim strRegistryTable()

ReDim strRegistryTable(0)



Dim intI



Dim strProgId 'WfWIWSI.Document

Dim strCompileCommand '"C:\Program Files\Altiris\Wise Package Studio\Windows Installer Editor\WfWI.exe" "%1" /c



Dim strFolder_, strComponent_



Dim objREGEXP : Set objREGEXP = New RegExp

Dim objMatches, objMatch

objREGEXP.Global = True 'Sets a Boolean value that indicates if a pattern should match all occurrences in an entire search string or just the first one.

objREGEXP.IgnoreCase = True 'Sets a Boolean value that indicates if a pattern search is case-sensitive or not.





' ============= Error handling =================================================

If WScript.Arguments.Count() <> 1 Then

Err.Raise -1

Bail "This script takes one argumants" & VbCrLf & "The argumnet should be the WSI file" & VbCrLf, 1

End If



If Not (InStrRev(strWsiFile, ".WSI", -1, vbtextcompare) = (Len(strWsiFile) - 3)) Then

Err.Raise -1

Bail "The argument must be a WSI file" & VbCrLf, 1

End If





' ============= Error handling =================================================



Set objFile = objFSO.GetFile(strWsiFile)



objFile.Copy objFile.ParentFolder & "\Backup " & Year(Now) & "-" & Month(Now) & "-" & Day(Now) & " " & Hour(Now) & ";" & Minute(Now) & ";" & Second(Now) & " " & objFile.Name, False

If Bail("Backing up file", 0) <> 0 Then

Bail "Backing up file failed. Quitting!", 0

LogIt

WScript.Quit -1

End If



strFolder_ = InputBox("Enter Folder property!" & VbCrLf & VbCrLf & "(from the first collumn of the Directory table for the folder you want to change permissions for)", "Primary key in Directory table")



strComponent_ = InputBox("Enter Component property!" & VbCrLf & VbCrLf & "(from the first collumn of the Component table for the component you want to be responsible for changing the permissions)", "Primary key in Directory table")





' #define SYNCHRONIZE (0x00100000L) = 1048576 dec

'

' Traverse Folder/Execute File

' #define FILE_EXECUTE ( 0x0020 ) // file

' #define FILE_TRAVERSE ( 0x0020 ) // directory

'

'

' List Folder/Read data

' #define FILE_READ_DATA ( 0x0001 ) // file & pipe

' #define FILE_LIST_DIRECTORY ( 0x0001 ) // directory

'

' Read Attributes

' #define FILE_READ_ATTRIBUTES ( 0x0080 ) // all

'

' Read Extended Attributes

' #define FILE_READ_EA ( 0x0008 ) // file & directory

'

' Create files/write data

' #define FILE_WRITE_DATA ( 0x0002 ) // file & pipe

' #define FILE_ADD_FILE ( 0x0002 ) // directory

'

' Create Folders/Append data

' #define FILE_APPEND_DATA ( 0x0004 ) // file

' #define FILE_ADD_SUBDIRECTORY ( 0x0004 ) // directory

' #define FILE_CREATE_PIPE_INSTANCE ( 0x0004 ) // named pipe

'

' Write attributes

' #define FILE_WRITE_ATTRIBUTES ( 0x0100 ) // all

'

' Write Extended attributes

' #define FILE_WRITE_EA ( 0x0010 ) // file & directory

'

' Delete

' #define DELETE (0x00010000L)

'

' Read permission

' #define READ_CONTROL (0x00020000L)

'

'

' Power Users in Program Files

' Sum SYNCHRO Total

' Total = 301BF = 197055 + 1048576 = 1245631



' Administrators

' #define FILE_DELETE_CHILD ( 0x0040 ) // directory

' #define WRITE_DAC (0x00040000L)

' #define WRITE_OWNER (0x00080000L)

'

' Sum SYNCHRO Total

' File/Folder Total = 301BF + 40 + 40000 + 80000 = F01FF = 983551 + 1048576 = 2032127







Set objDatabase = objInstaller.OpenDatabase(strWsiFile, conmsiOpenDatabaseModeDirect)

Bail "Open DB", 0



AddCustomAction "6", "CA_GetLocalizedGroupsNames", "GetLocalizedGroups", ScriptDir() & "LocalGroupLocalized.vbs", objDatabase

Bail "Add custom action",0



Set objView = objDatabase.OpenView("INSERT INTO LockPermissions (`LockObject`, `Table`, `User`, `Permission`) VALUES ('" & strFolder_ & "', 'CreateFolder', 'Administrators', '2032127')")

Bail "Create OpnenView INSERT INTO query",0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "LockPermission row exists. Trying to update instead", 0

Set objView = objDatabase.OpenView("UPDATE LockPermissions SET `Permission` = '2032127' WHERE `LockObject` = '" & strFolder_ & "' AND `Table` = 'CreateFolder' AND `Domain` = '' AND `User` = 'Administrators'")

Bail "Create OpnenView UPDATE query",0

objView.Execute

End If

Bail "Execute OpenView", 0

objView.Close

Bail "Close OpenView", 0



Set objView = objDatabase.OpenView("INSERT INTO LockPermissions (`LockObject`, `Table`, `User`, `Permission`) VALUES ('" & strFolder_ & "', 'CreateFolder', '[BuiltinUsers]', '1245631')")

Bail "Create OpnenView INSERT INTO query",0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "LockPermission row exists. Trying to update instead", 0

Set objView = objDatabase.OpenView("UPDATE LockPermissions SET `Permission` = '1245631' WHERE `LockObject` = '" & strFolder_ & "' AND `Table` = 'CreateFolder' AND `Domain` = '' AND `User` = '[BuiltinUsers]'")

Bail "Create OpnenView UPDATE query",0

objView.Execute

End If

Bail "Execute OpenView", 0

objView.Close

Bail "Close OpenView", 0



Set objView = objDatabase.OpenView("INSERT INTO LockPermissions (`LockObject`, `Table`, `User`, `Permission`) VALUES ('" & strFolder_ & "', 'CreateFolder', '[PowerUsers]', '1245631')")

Bail "Create OpnenView INSERT INTO query",0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "LockPermission row exists. Trying to update instead", 0

Set objView = objDatabase.OpenView("UPDATE LockPermissions SET `Permission` = '1245631' WHERE `LockObject` = '" & strFolder_ & "' AND `Table` = 'CreateFolder' AND `Domain` = '' AND `User` = '[PowerUsers]'")

Bail "Create OpnenView UPDATE query",0

objView.Execute

End If

Bail "Execute OpenView", 0

objView.Close

Bail "Close OpenView", 0









Set objView = objDatabase.OpenView("INSERT INTO CreateFolder (`Directory_`, `Component_`) VALUES ('" & strFolder_ & "', '" & strComponent_ & "')")

Bail "Create OpnenView INSERT INTO query",0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "CreateFolder row exists. Do nothing", 0

End If

Bail "Execute OpenView", 0

objView.Close

Bail "Close OpenView", 0







objDatabase.Commit

Bail "Commit DB changes", 0



strProgId = objHOST.RegRead("HKEY_CLASSES_ROOT\.wsi\")

strCompileCommand = objHOST.RegRead("HKEY_CLASSES_ROOT\" & strProgId & "\shell\CompileWPS\command\")



objREGEXP.Pattern = "%1"

strCompileCommand = objREGEXP.Replace(strCompileCommand, strWsiFile)



If MsgBox("Done! Do you want to compile now?", vbYesNo + vbQuestion + vbDefaultButton2 + vbSystemModal, "End") = vbYes Then

objHOST.Run strCompileCommand, 1, False

Else



End if

End Sub



Bail "Stop " & conAPPLICATION & " " & Now(), 0

LogIt

Set objNET = Nothing

Set objHOST = Nothing





'*********************************************************

' Purpose: Add an action prior to an existing action in InstallExecuteSequence table.

'

' Assumptions:

'

' Effects :

'

' Inputs: strActionToAdd = Name of the action to add

' strRelativeToAction = Name of the action to place the action infront of

' objDaBa = Object containing the database (MSI) to edit

' Return Values : Nothing.

'*********************************************************

Function AddActionPriorTo(strActionToAdd, strRelativeToAction, objDaBa)

On Error Resume Next

'Insert Your function code here

Dim objView, objRecord, intSeqRel, intFreeSeq, blnFree 'objDaBa

blnFree = False

Bail "Creating row in InstallExecuteSequence for " & strActionToAdd, 0



'Set objDaBa = objInstaller.OpenDatabase(strDBFile, msiOpenDatabaseModeTransact)

'Bail "Open DB " & strDBFile, 0

Set objView = objDaBa.OpenView("SELECT `Action`, `Sequence` FROM `InstallExecuteSequence` WHERE `Action`='" & strRelativeToAction & "'")

Bail "Select created for finding sequence relative to",0

objView.Execute

Bail "Execute select for finding sequence relative to",0

Set objRecord = objView.Fetch()

intSeqRel = objRecord.StringData(2)

intFreeSeq = intSeqRel

Bail strRelativeToAction & " found at " & intSeqRel, 0

Do

'Find previous free sequence number

intFreeSeq = intFreeSeq -1

Set objView = objDaBa.OpenView("SELECT `Action`, `Sequence` FROM `InstallExecuteSequence` WHERE `Sequence`=" & intFreeSeq)

Bail "Select created for finding free sequence",0

objView.Execute

Bail "Execute select to find out if sequence " & intFreeSeq & " is free", 0

Set objRecord = objView.Fetch()

If objRecord Is Nothing Then blnFree = True

Loop Until blnFree



Bail "Free sequence is " & intFreeSeq, 0

Set objView = objDaBa.OpenView("INSERT INTO InstallExecuteSequence (`Action`, `Sequence`) VALUES ('" & strActionToAdd & "', '" & intFreeSeq & "')")

Bail "Create OpnenView INSERT INTO query for CA " & strActionToAdd, 0

objView.Execute



If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "InstallExecuteSequence row exists. Trying to update instead", 0

Set objView = objDaBa.OpenView("UPDATE InstallExecuteSequence SET `Sequence` = '" & intFreeSeq & "' WHERE `Action` = '" & strActionToAdd & "'")

Bail "Create OpnenView UPDATE query for CA " & strActionToAdd, 0

objView.Execute

End If

Bail "Execute OpenView for INSERT INTO/UPDATE", 0

objView.Close

Bail "Close OpenView", 0

objDaBa.Commit

Bail "Commit DB changes", 0





End Function





'*********************************************************

' Purpose: Add a custom action to the CustomAction table.

'

' Assumptions:

'

' Effects :

'

' Inputs: strCAType = The custom action type (number)

' strCAName = The Custom action name

' strCASource = The Custom action source

' strFile = The file that should be place in binary table. Path plus file

' objDB = Object containing the database (MSI) to edit

'

' Return Values : Explanation of the value returned.

'*********************************************************

Function AddCustomAction(strCAType, strCAName, strCASource, strFile, objDB)

On Error Resume Next

'Insert Your function code here

Dim objView



AddScriptToBinaryTable strCASource, strFile, objDB



Bail "Creating a row in CustumActions table for " & strCAName, 0



Set objView = objDB.OpenView("INSERT INTO CustomAction (`Action`, `Type`, `Source`) VALUES ('" & strCAName & "', '" & strCAType &"', '" & strCASource & "')")

Bail "Create OpnenView INSERT INTO query for adding CA " & strCAName, 0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "CustumActions row exists. Trying to update instead", 0

Set objView = objDB.OpenView("UPDATE CustomAction SET `Type` = '" & strCAType & "', `Source` = '" & strCASource & "' WHERE `Action` = '" & strCAName & "'")

Bail "Create OpnenView UPDATE query uptating " & strCAName, 0

objView.Execute

End If

Bail "Execute OpenView for INSERT INTO/UPDATE", 0

objView.Close

Bail "Close OpenView", 0

objDB.Commit

Bail "Commit DB changes", 0





AddActionPriorTo strCAName, "CostFinalize", objDB







End Function





'*********************************************************

' Purpose: Add an entry in binary table

'

' Assumptions:

'

' Effects :

'

' Inputs: strBinName = The name in Binary table

' strFilename = The file that should be place in binary table. Path plus file

' objDB = Object containing the database (MSI) to edit

'

' Return Values : Explanation of the value returned.

'*********************************************************

Function AddScriptToBinaryTable(strBinName, strFilename, objDB)

On Error Resume Next

'Insert Your function code here



Dim objVw

Dim objRec

Bail "Creating a row in binary table for " & strFilename, 0

Set objRec = objInstaller.CreateRecord(1)

objRec.SetStream 1, strFilename





Set objVw = objDB.OpenView("INSERT INTO `Binary` (`Name`, `Data`) VALUES ('" & strBinName & "', ?)")

Bail "Create OpnenView INSERT INTO query for adding file " & strFilename & " into Binary table", 0

objVw.Execute objRec

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "Binary table row exists. Trying to update instead", 0

Set objVw = objDB.OpenView("UPDATE Binary SET `Data` = ? WHERE `Name` = '" & strBinName & "'")

Bail "Create OpnenView UPDATE query for updating file " & strFilename & " in Binary table", 0

objVw.Execute objRec

End if

Bail "Execute OpenView for INSERT INTO/UPDATE", 0

objVw.Close

Bail "Close OpenView", 0

objDB.Commit ' save changes

Bail "Commit DB changes", 0



End Function









'*********************************************************

' Purpose: Returns the directory where the script resides.

'

' Assumptions: Nothing

'

' Effects : Nothings

'

' Inputs: Nothing

'

' Return Values : The folder including final backslash

'*********************************************************

Function ScriptDir()

On Error Resume Next

ScriptDir = Mid(WScript.ScriptFullName, 1, Len(WScript.ScriptFullName)- Len(WScript.ScriptName))



End Function













'*********************************************************

' Purpose: Writes to the application log.

'

' Assumptions: Assumes that intCODE, strMARK, objHOST, objNET are defined globaly.

'

' Effects : None.

'

' Inputs: No argoments.

'

' Return Values : Nothing.

'*********************************************************

Function LogIt()

On Error Resume Next

objHOST.LogEvent intCODE, strMARK, objNET.ComputerName

End Function



'*********************************************************

' Purpose: Catch errors during execution of the script.

'

' Assumptions: Assumes that intCODE, strMARK, are defined globaly

' and that the LogIt function exist.

'

' Effects : Sets intCODE, strMARK.

'

' Inputs:

' strEvent: The text that will be written to the application eventlog

' and if wanted as a message box to the user.

'

' intShow: If intShow equals 1 and an error has been generated, an error message is displayed to the user.

' If intShow differs from 1 and an error has been generated, the error is written to the application log.

' If an error has been generated and strEvent contains a string, than the string and the error are logged to the aspplications log.

'

' Return Values : The error number.

'*********************************************************

Function Bail(Byval strEvent, intShow)

Dim strERRMESSAGE, intBOX, blnQUIT, intRET, intButton

Bail = Err.Number



If intCODE <> 1 Then intCODE = 4

If Err.Number = 0 And strEvent = vbNullString Then Exit Function

If Err.Number <> 0 Then

strEVENT = strEVENT & "-Err Number 0x" & Hex(Err.Number) & " " & Err.Description

intCODE = 1

If intSHOW = 1 Then

Select Case Hex(Err.Number)

'Insert your case numer here



Case Else

' All not handled errors gets here. This case gives the user no second chanse to try again.

strERRMESSAGE = "Unknown error. Please report this to the support."

intBOX = vbCritical

intButton = vbOKOnly + vbDefaultButton1

blnQUIT = True

End Select

intRET = MsgBox(strERRMESSAGE & vbCrLf & vbCrLf & strEVENT, intBOX + intButton, conAPPLICATION)



End If

Else

strEVENT = strEVENT & " - OK"

End If

strMARK = strMARK & vbCrLF & strEVENT

Err.Clear



If blnQUIT Or intRET = vbNo Then

strMARK = strMARK & vbCrLF & "Premature termination " & Now()

LogIt

WScript.Quit 1

End If



End Function
 
LockPermissions_Folder_MST.vbs:
-------------------------------------
Option Explicit


On Error Resume Next

Const conAPPLICATION = "MST LockPermissions Folder"



' SpecialFolder Constants

Const conWindowsFolder = 0

Const conSystemFolder = 1

Const conTemporaryFolder = 2



Const msiOpenDatabaseModeReadOnly = 0

Const msiOpenDatabaseModeTransact = 1

Const conmsiOpenDatabaseModeDirect = 2 'Opens a database direct read/write without transaction.

Const msiOpenDatabaseModeCreate = 3



Const msiTransformErrorNone = 0

Const msiTransformValidationNone = 0



Const conFILE_ATTRIBUTE_NORMAL = 0 '0x00000000



Dim intCODE, strMARK

Dim objHOST, objNET

' Creating Objects

Set objNET = CreateObject("Wscript.Network")

Set objHOST = CreateObject("WScript.Shell")

Dim objInstaller ': Set objInstaller = CreateObject("WindowsInstaller.Installer")

Set objInstaller = Wscript.CreateObject("WindowsInstaller.Installer")

Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")



Bail "Start " & conAPPLICATION & " " & Now(), 0



Main ' Cals the start subfunction that starts the script



'*********************************************************

' Purpose: Starts the script.

'

' Assumptions: Assumes that objHOST, objNET are defined globaly.

'

' Effects : None.

'

' Inputs: none.

'

' Return Values : Nothing.

'*********************************************************

Sub Main()

On Error Resume Next

'Begin to insert Your code here

Dim objDatabaseMaster, objDatabaseIntermediate, objDatabaseTransformed

Dim strMsiFile

Dim strMstFile

Dim strMsiFileName, strMstFileName

Dim objView, objRecord

Dim strRegistryTable()

Dim intI



Dim objFile



ReDim strRegistryTable(0)







Dim strFolder_, strComponent_, strKey

' ============= Error handling =================================================

If WScript.Arguments.Count() = 0 Then

Err.Raise -1

Bail "This script takes two argumants" & VbCrLf & "The fisrt is the MSI file" & VbCrLf & "The second is the MST file" & VbCrLf, 1

End if



strMsiFile = WScript.Arguments(0)



If Not (InStrRev(strMsiFile, ".MSI", -1, vbtextcompare) = (Len(strMsiFile) - 3)) Then

Err.Raise -1

Bail "The fisrt argument must be a MSI file" & VbCrLf, 1

End If



If WScript.Arguments.Count() = 2 Then

strMstFile = WScript.Arguments(1)

Else

strMstFile = InputBox ("Full path inkl. MST-file name.","MST file path",Mid(WScript.Arguments(0), 1, Len(WScript.Arguments(0))-1) & "t")

End If



If Not (InStrRev(strMstFile, ".MST", -1, vbtextcompare) = (Len(strMstFile) - 3)) Then

Err.Raise -1

Bail "The second argument must be a MST file" & VbCrLf, 1

End If

' ============= Error handling =================================================





objFSO.CopyFile strMsiFile, objFSO.GetSpecialFolder(conTemporaryFolder) & "\", True 'Create a copy of the Windiws Installer database

objFSO.CopyFile strMstFile, objFSO.GetSpecialFolder(conTemporaryFolder) & "\", True 'Create a copy of the Windiws Installer transform





If InStrRev(strMsiFile,"\", -1, vbTextCompare) > 0 Then



strMsiFileName = Mid(strMsiFile, InStrRev(strMsiFile,"\", -1, vbTextCompare)+1)

Else



strMsiFileName = strMsiFile

End If



If InStrRev(strMstFile,"\", -1, vbTextCompare) > 0 Then



strMstFileName = Mid(strMstFile, InStrRev(strMstFile,"\", -1, vbTextCompare)+1)

Else



strMstFileName = strMstFile

End If



Set objFile = objFSO.GetFile(objFSO.GetSpecialFolder(conTemporaryFolder) & "\" & strMsiFileName)

objFile.Attributes = conFILE_ATTRIBUTE_NORMAL



strFolder_ = InputBox("Enter Folder property!" & VbCrLf & VbCrLf & "(from the first collumn of the Directory table for the folder you want to change permissions for)", "Primary key in Directory table")



If Len(strFolder_) = 0 Then

Err.Raise -1

Bail "User aborted folder property input", 1

End If



strComponent_ = InputBox("Enter Component property!" & VbCrLf & VbCrLf & "(from the first collumn of the Component table for the component you want to be responsible for changing the permissions)", "Primary key in Directory table")



If Len(strComponent_) = 0 Then

Err.Raise -1

Bail "User aborted component property input", 1

End If



Set objDatabaseTransformed = objInstaller.OpenDatabase(objFSO.GetSpecialFolder(conTemporaryFolder) & "\" & strMsiFileName, conmsiOpenDatabaseModeDirect)

Bail "Open DB", 0

objDatabaseTransformed.ApplyTransform objFSO.GetSpecialFolder(conTemporaryFolder) & "\" & strMstFileName, 0 '256 '63+256

Bail "Apply transform", 0



AddCustomAction "6", "CA_GetLocalizedGroupsNames", "GetLocalizedGroups", ScriptDir() & "LocalGroupLocalized.vbs", objDatabaseTransformed

Bail "Add custom action",0



' #define SYNCHRONIZE (0x00100000L) = 1048576 dec

'

' Traverse Folder/Execute File

' #define FILE_EXECUTE ( 0x0020 ) // file

' #define FILE_TRAVERSE ( 0x0020 ) // directory

'

'

' List Folder/Read data

' #define FILE_READ_DATA ( 0x0001 ) // file & pipe

' #define FILE_LIST_DIRECTORY ( 0x0001 ) // directory

'

' Read Attributes

' #define FILE_READ_ATTRIBUTES ( 0x0080 ) // all

'

' Read Extended Attributes

' #define FILE_READ_EA ( 0x0008 ) // file & directory

'

' Create files/write data

' #define FILE_WRITE_DATA ( 0x0002 ) // file & pipe

' #define FILE_ADD_FILE ( 0x0002 ) // directory

'

' Create Folders/Append data

' #define FILE_APPEND_DATA ( 0x0004 ) // file

' #define FILE_ADD_SUBDIRECTORY ( 0x0004 ) // directory

' #define FILE_CREATE_PIPE_INSTANCE ( 0x0004 ) // named pipe

'

' Write attributes

' #define FILE_WRITE_ATTRIBUTES ( 0x0100 ) // all

'

' Write Extended attributes

' #define FILE_WRITE_EA ( 0x0010 ) // file & directory

'

' Delete

' #define DELETE (0x00010000L)

'

' Read permission

' #define READ_CONTROL (0x00020000L)

'

'

' Power Users in Program Files

' Sum SYNCHRO Total

' Total = 301BF = 197055 + 1048576 = 1245631



' Administrators

' #define FILE_DELETE_CHILD ( 0x0040 ) // directory

' #define WRITE_DAC (0x00040000L)

' #define WRITE_OWNER (0x00080000L)

'

' Sum SYNCHRO Total

' File/Folder Total = 301BF + 40 + 40000 + 80000 = F01FF = 983551 + 1048576 = 2032127







Set objView = objDatabaseTransformed.OpenView("INSERT INTO LockPermissions (`LockObject`, `Table`, `User`, `Permission`) VALUES ('" & strFolder_ & "', 'CreateFolder', 'Administrators', '2032127')")

Bail "Create OpnenView INSERT INTO query",0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "LockPermission row exists. Trying to update instead", 0

Set objView = objDatabaseTransformed.OpenView("UPDATE LockPermissions SET `Permission` = '2032127' WHERE `LockObject` = '" & strFolder_ & "' AND `Table` = 'CreateFolder' AND `Domain` = '' AND `User` = 'Administrators'")

Bail "Create OpnenView UPDATE query",0

objView.Execute

End If

Bail "Execute OpenView", 0

objView.Close

Bail "Close OpenView", 0



Set objView = objDatabaseTransformed.OpenView("INSERT INTO LockPermissions (`LockObject`, `Table`, `User`, `Permission`) VALUES ('" & strFolder_ & "', 'CreateFolder', '[BuiltinUsers]', '1245631')")

Bail "Create OpnenView INSERT INTO query",0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "LockPermission row exists. Trying to update instead", 0

Set objView = objDatabaseTransformed.OpenView("UPDATE LockPermissions SET `Permission` = '1245631' WHERE `LockObject` = '" & strFolder_ & "' AND `Table` = 'CreateFolder' AND `Domain` = '' AND `User` = '[BuiltinUsers]'")

Bail "Create OpnenView UPDATE query",0

objView.Execute

End If

Bail "Execute OpenView", 0

objView.Close

Bail "Close OpenView", 0



Set objView = objDatabaseTransformed.OpenView("INSERT INTO LockPermissions (`LockObject`, `Table`, `User`, `Permission`) VALUES ('" & strFolder_ & "', 'CreateFolder', '[PowerUsers]', '1245631')")

Bail "Create OpnenView INSERT INTO query",0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "LockPermission row exists. Trying to update instead", 0

Set objView = objDatabaseTransformed.OpenView("UPDATE LockPermissions SET `Permission` = '1245631' WHERE `LockObject` = '" & strFolder_ & "' AND `Table` = 'CreateFolder' AND `Domain` = '' AND `User` = '[PowerUsers]'")

Bail "Create OpnenView UPDATE query",0

objView.Execute

End If

Bail "Execute OpenView", 0

objView.Close

Bail "Close OpenView", 0









Set objView = objDatabaseTransformed.OpenView("INSERT INTO CreateFolder (`Directory_`, `Component_`) VALUES ('" & strFolder_ & "', '" & strComponent_ & "')")

Bail "Create OpnenView INSERT INTO query",0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "CreateFolder row exists. Do nothing", 0

End If

Bail "Execute OpenView", 0

objView.Close

Bail "Close OpenView", 0







objDatabaseTransformed.Commit

Bail "Commit DB changes", 0











Set objDatabaseMaster = objInstaller.OpenDatabase(strMsiFile, msiOpenDatabaseModeReadOnly)







If Not objFSO.FolderExists(objFSO.GetSpecialFolder(conTemporaryFolder) & "\New_MSTs") Then objFSO.CreateFolder objFSO.GetSpecialFolder(conTemporaryFolder) & "\New_MSTs"

If objFSO.FileExists(objFSO.GetSpecialFolder(conTemporaryFolder) & "\New_MSTs\" & strMstFileName) Then objFSO.DeleteFile objFSO.GetSpecialFolder(conTemporaryFolder) & "\New_MSTs\" & strMstFileName, True



objDatabaseTransformed.GenerateTransform objDatabaseMaster, objFSO.GetSpecialFolder(conTemporaryFolder) & "\New_MSTs\" & strMstFileName

Bail "Create Transform", 0

objDatabaseTransformed.CreateTransformSummaryInfo objDatabaseMaster, objFSO.GetSpecialFolder(conTemporaryFolder) & "\New_MSTs\" & strMstFileName, msiTransformErrorNone, msiTransformValidationNone

Bail "CreateTransformSummaryInfo", 0

objHOST.Run """" & objFSO.GetSpecialFolder(conTemporaryFolder) & "\New_MSTs" & """", 1 , False

End Sub



Bail "Stop " & conAPPLICATION & " " & Now(), 0

LogIt

Set objNET = Nothing

Set objHOST = Nothing





'*********************************************************

' Purpose: Add an action prior to an existing action in InstallExecuteSequence table.

'

' Assumptions:

'

' Effects :

'

' Inputs: strActionToAdd = Name of the action to add

' strRelativeToAction = Name of the action to place the action infront of

' objDaBa = Object containing the database (MSI) to edit

' Return Values : Nothing.

'*********************************************************

Function AddActionPriorTo(strActionToAdd, strRelativeToAction, objDaBa)

On Error Resume Next

'Insert Your function code here

Dim objView, objRecord, intSeqRel, intFreeSeq, blnFree 'objDaBa

blnFree = False

Bail "Creating row in InstallExecuteSequence for " & strActionToAdd, 0



'Set objDaBa = objInstaller.OpenDatabase(strDBFile, msiOpenDatabaseModeTransact)

'Bail "Open DB " & strDBFile, 0

Set objView = objDaBa.OpenView("SELECT `Action`, `Sequence` FROM `InstallExecuteSequence` WHERE `Action`='" & strRelativeToAction & "'")

Bail "Select created for finding sequence relative to",0

objView.Execute

Bail "Execute select for finding sequence relative to",0

Set objRecord = objView.Fetch()

intSeqRel = objRecord.StringData(2)

intFreeSeq = intSeqRel

Bail strRelativeToAction & " found at " & intSeqRel, 0

Do

'Find previous free sequence number

intFreeSeq = intFreeSeq -1

Set objView = objDaBa.OpenView("SELECT `Action`, `Sequence` FROM `InstallExecuteSequence` WHERE `Sequence`=" & intFreeSeq)

Bail "Select created for finding free sequence",0

objView.Execute

Bail "Execute select to find out if sequence " & intFreeSeq & " is free", 0

Set objRecord = objView.Fetch()

If objRecord Is Nothing Then blnFree = True

Loop Until blnFree



Bail "Free sequence is " & intFreeSeq, 0

Set objView = objDaBa.OpenView("INSERT INTO InstallExecuteSequence (`Action`, `Sequence`) VALUES ('" & strActionToAdd & "', '" & intFreeSeq & "')")

Bail "Create OpnenView INSERT INTO query for CA " & strActionToAdd, 0

objView.Execute



If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "InstallExecuteSequence row exists. Trying to update instead", 0

Set objView = objDaBa.OpenView("UPDATE InstallExecuteSequence SET `Sequence` = '" & intFreeSeq & "' WHERE `Action` = '" & strActionToAdd & "'")

Bail "Create OpnenView UPDATE query for CA " & strActionToAdd, 0

objView.Execute

End If

Bail "Execute OpenView for INSERT INTO/UPDATE", 0

objView.Close

Bail "Close OpenView", 0

objDaBa.Commit

Bail "Commit DB changes", 0





End Function





'*********************************************************

' Purpose: Add a custom action to the CustomAction table.

'

' Assumptions:

'

' Effects :

'

' Inputs: strCAType = The custom action type (number)

' strCAName = The Custom action name

' strCASource = The Custom action source

' strFile = The file that should be place in binary table. Path plus file

' objDB = Object containing the database (MSI) to edit

'

' Return Values : Explanation of the value returned.

'*********************************************************

Function AddCustomAction(strCAType, strCAName, strCASource, strFile, objDB)

On Error Resume Next

'Insert Your function code here

Dim objView



AddScriptToBinaryTable strCASource, strFile, objDB



Bail "Creating a row in CustumActions table for " & strCAName, 0



Set objView = objDB.OpenView("INSERT INTO CustomAction (`Action`, `Type`, `Source`) VALUES ('" & strCAName & "', '" & strCAType &"', '" & strCASource & "')")

Bail "Create OpnenView INSERT INTO query for adding CA " & strCAName, 0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "CustumActions row exists. Trying to update instead", 0

Set objView = objDB.OpenView("UPDATE CustomAction SET `Type` = '" & strCAType & "', `Source` = '" & strCASource & "' WHERE `Action` = '" & strCAName & "'")

Bail "Create OpnenView UPDATE query uptating " & strCAName, 0

objView.Execute

End If

Bail "Execute OpenView for INSERT INTO/UPDATE", 0

objView.Close

Bail "Close OpenView", 0

objDB.Commit

Bail "Commit DB changes", 0





AddActionPriorTo strCAName, "CostFinalize", objDB







End Function





'*********************************************************

' Purpose: Add an entry in binary table

'

' Assumptions:

'

' Effects :

'

' Inputs: strBinName = The name in Binary table

' strFilename = The file that should be place in binary table. Path plus file

' objDB = Object containing the database (MSI) to edit

'

' Return Values : Explanation of the value returned.

'*********************************************************

Function AddScriptToBinaryTable(strBinName, strFilename, objDB)

On Error Resume Next

'Insert Your function code here



Dim objVw

Dim objRec

Bail "Creating a row in binary table for " & strFilename, 0

Set objRec = objInstaller.CreateRecord(1)

objRec.SetStream 1, strFilename





Set objVw = objDB.OpenView("INSERT INTO `Binary` (`Name`, `Data`) VALUES ('" & strBinName & "', ?)")

Bail "Create OpnenView INSERT INTO query for adding file " & strFilename & " into Binary table", 0

objVw.Execute objRec

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "Binary table row exists. Trying to update instead", 0

Set objVw = objDB.OpenView("UPDATE Binary SET `Data` = ? WHERE `Name` = '" & strBinName & "'")

Bail "Create OpnenView UPDATE query for updating file " & strFilename & " in Binary table", 0

objVw.Execute objRec

End if

Bail "Execute OpenView for INSERT INTO/UPDATE", 0

objVw.Close

Bail "Close OpenView", 0

objDB.Commit ' save changes

Bail "Commit DB changes", 0



End Function









'*********************************************************

' Purpose: Returns the directory where the script resides.

'

' Assumptions: Nothing

'

' Effects : Nothings

'

' Inputs: Nothing

'

' Return Values : The folder including final backslash

'*********************************************************

Function ScriptDir()

On Error Resume Next

ScriptDir = Mid(WScript.ScriptFullName, 1, Len(WScript.ScriptFullName)- Len(WScript.ScriptName))



End Function











'*********************************************************

' Purpose: Writes to the application log.

'

' Assumptions: Assumes that intCODE, strMARK, objHOST, objNET are defined globaly.

'

' Effects : None.

'

' Inputs: No argoments.

'

' Return Values : Nothing.

'*********************************************************

Function LogIt()

On Error Resume Next

objHOST.LogEvent intCODE, strMARK, objNET.ComputerName

End Function



'*********************************************************

' Purpose: Catch errors during execution of the script.

'

' Assumptions: Assumes that intCODE, strMARK, are defined globaly

' and that the LogIt function exist.

'

' Effects : Sets intCODE, strMARK.

'

' Inputs:

' strEvent: The text that will be written to the application eventlog

' and if wanted as a message box to the user.

'

' intShow: If intShow equals 1 and an error has been generated, an error message is displayed to the user.

' If intShow differs from 1 and an error has been generated, the error is written to the application log.

' If an error has been generated and strEvent contains a string, than the string and the error are logged to the aspplications log.

'

' Return Values : The error number.

'*********************************************************

Function Bail(Byval strEvent, intShow)

Dim strERRMESSAGE, intBOX, blnQUIT, intRET, intButton

Bail = Err.Number



If intCODE <> 1 Then intCODE = 4

If Err.Number = 0 And strEvent = vbNullString Then Exit Function

If Err.Number <> 0 Then

strEVENT = strEVENT & "-Err Number 0x" & Hex(Err.Number) & " " & Err.Description

intCODE = 1

If intSHOW = 1 Then

Select Case Hex(Err.Number)

'Insert your case numer here



Case Else

' All not handled errors gets here. This case gives the user no second chanse to try again.

strERRMESSAGE = "Unknown error. Please report this to the support."

intBOX = vbCritical

intButton = vbOKOnly + vbDefaultButton1

blnQUIT = True

End Select

intRET = MsgBox(strERRMESSAGE & vbCrLf & vbCrLf & strEVENT, intBOX + intButton, conAPPLICATION)



End If

Else

strEVENT = strEVENT & " - OK"

End If

strMARK = strMARK & vbCrLF & strEVENT

Err.Clear



If blnQUIT Or intRET = vbNo Then

strMARK = strMARK & vbCrLF & "Premature termination " & Now()

LogIt

WScript.Quit 1

End If



End Function
 
LockPermissions_File_WSI .vbs:
----------------------------------
 
Option Explicit


On Error Resume Next

Const conAPPLICATION = "LockPermissions File addition"



' SpecialFolder Constants

Const conWindowsFolder = 0

Const conSystemFolder = 1

Const conTemporaryFolder = 2



Const msiOpenDatabaseModeReadOnly = 0

Const msiOpenDatabaseModeTransact = 1

Const conmsiOpenDatabaseModeDirect = 2 'Opens a database direct read/write without transaction.

Const msiOpenDatabaseModeCreate = 3





Dim intCODE, strMARK

Dim objHOST, objNET

' Creating Objects

Set objNET = CreateObject("Wscript.Network")

Set objHOST = CreateObject("WScript.Shell")

Dim objInstaller : Set objInstaller = CreateObject("WindowsInstaller.Installer")

Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")

Dim strWsiFile : strWsiFile = WScript.Arguments(0)

Dim intRoot, strRoot

Dim strKey



Bail "Start " & conAPPLICATION & " " & Now(), 0



Main ' Cals the start subfunction that starts the script



'*********************************************************

' Purpose: Starts the script.

'

' Assumptions: Assumes that objHOST, objNET are defined globaly.

'

' Effects : None.

'

' Inputs: none.

'

' Return Values : Nothing.

'*********************************************************

Sub Main()

On Error Resume Next

'Begin to insert Your code here

Dim objFile

Dim objDatabase, objView, objRecord

Dim strRegistryTable()

ReDim strRegistryTable(0)



Dim intI



Dim strProgId 'WfWIWSI.Document

Dim strCompileCommand '"C:\Program Files\Altiris\Wise Package Studio\Windows Installer Editor\WfWI.exe" "%1" /c



Dim str_File



Dim objREGEXP : Set objREGEXP = New RegExp

Dim objMatches, objMatch

objREGEXP.Global = True 'Sets a Boolean value that indicates if a pattern should match all occurrences in an entire search string or just the first one.

objREGEXP.IgnoreCase = True 'Sets a Boolean value that indicates if a pattern search is case-sensitive or not.





' ============= Error handling =================================================

If WScript.Arguments.Count() <> 1 Then

Err.Raise -1

Bail "This script takes one argumants" & VbCrLf & "The argumnet should be the WSI file" & VbCrLf, 1

End If



If Not (InStrRev(strWsiFile, ".WSI", -1, vbtextcompare) = (Len(strWsiFile) - 3)) Then

Err.Raise -1

Bail "The argument must be a WSI file" & VbCrLf, 1

End If





' ============= Error handling =================================================



Set objFile = objFSO.GetFile(strWsiFile)



objFile.Copy objFile.ParentFolder & "\Backup " & Year(Now) & "-" & Month(Now) & "-" & Day(Now) & " " & Hour(Now) & ";" & Minute(Now) & ";" & Second(Now) & " " & objFile.Name, False

If Bail("Backing up file", 0) <> 0 Then

Bail "Backing up file failed. Quitting!", 0

LogIt

WScript.Quit -1

End If





str_File = InputBox("Enter File property!" & VbCrLf & VbCrLf & "(from the first collumn of the file table for the file you want to change permissions for)", "Primary key in File table")





' #define SYNCHRONIZE (0x00100000L) = 1048576 dec

'

' Traverse Folder/Execute File

' #define FILE_EXECUTE ( 0x0020 ) // file

' #define FILE_TRAVERSE ( 0x0020 ) // directory

'

'

' List Folder/Read data

' #define FILE_READ_DATA ( 0x0001 ) // file & pipe

' #define FILE_LIST_DIRECTORY ( 0x0001 ) // directory

'

' Read Attributes

' #define FILE_READ_ATTRIBUTES ( 0x0080 ) // all

'

' Read Extended Attributes

' #define FILE_READ_EA ( 0x0008 ) // file & directory

'

' Create files/write data

' #define FILE_WRITE_DATA ( 0x0002 ) // file & pipe

' #define FILE_ADD_FILE ( 0x0002 ) // directory

'

' Create Folders/Append data

' #define FILE_APPEND_DATA ( 0x0004 ) // file

' #define FILE_ADD_SUBDIRECTORY ( 0x0004 ) // directory

' #define FILE_CREATE_PIPE_INSTANCE ( 0x0004 ) // named pipe

'

' Write attributes

' #define FILE_WRITE_ATTRIBUTES ( 0x0100 ) // all

'

' Write Extended attributes

' #define FILE_WRITE_EA ( 0x0010 ) // file & directory

'

' Delete

' #define DELETE (0x00010000L)

'

' Read permission

' #define READ_CONTROL (0x00020000L)

'

'

' Power Users in Program Files

' Sum SYNCHRO Total

' Total = 301BF = 197055 + 1048576 = 1245631



' Administrators

' #define FILE_DELETE_CHILD ( 0x0040 ) // directory

' #define WRITE_DAC (0x00040000L)

' #define WRITE_OWNER (0x00080000L)

'

' Sum SYNCHRO Total

' File/Folder Total = 301BF + 40 + 40000 + 80000 = F01FF = 983551 + 1048576 = 2032127







Set objDatabase = objInstaller.OpenDatabase(strWsiFile, conmsiOpenDatabaseModeDirect)

Bail "Open DB", 0



AddCustomAction "6", "CA_GetLocalizedGroupsNames", "GetLocalizedGroups", ScriptDir() & "LocalGroupLocalized.vbs", objDatabase

Bail "Add custom action",0



Set objView = objDatabase.OpenView("INSERT INTO LockPermissions (`LockObject`, `Table`, `User`, `Permission`) VALUES ('" & str_File & "', 'File', 'Administrators', '2032127')")

Bail "Create OpnenView INSERT INTO query",0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "LockPermission row exists. Trying to update instead", 0

Set objView = objDatabase.OpenView("UPDATE LockPermissions SET `Permission` = '2032127' WHERE `LockObject` = '" & str_File & "' AND `Table` = 'File' AND `Domain` = '' AND `User` = 'Administrators'")

Bail "Create OpnenView UPDATE query",0

objView.Execute

End If

Bail "Execute OpenView", 0

objView.Close

Bail "Close OpenView", 0



Set objView = objDatabase.OpenView("INSERT INTO LockPermissions (`LockObject`, `Table`, `User`, `Permission`) VALUES ('" & str_File & "', 'File', '[BuiltinUsers]', '1245631')")

Bail "Create OpnenView INSERT INTO query",0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "LockPermission row exists. Trying to update instead", 0

Set objView = objDatabase.OpenView("UPDATE LockPermissions SET `Permission` = '1245631' WHERE `LockObject` = '" & str_File & "' AND `Table` = 'File' AND `Domain` = '' AND `User` = '[BuiltinUsers]'")

Bail "Create OpnenView UPDATE query",0

objView.Execute

End If

Bail "Execute OpenView", 0

objView.Close

Bail "Close OpenView", 0



Set objView = objDatabase.OpenView("INSERT INTO LockPermissions (`LockObject`, `Table`, `User`, `Permission`) VALUES ('" & str_File & "', 'File', '[PowerUsers]', '1245631')")

Bail "Create OpnenView INSERT INTO query",0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "LockPermission row exists. Trying to update instead", 0

Set objView = objDatabase.OpenView("UPDATE LockPermissions SET `Permission` = '1245631' WHERE `LockObject` = '" & str_File & "' AND `Table` = 'File' AND `Domain` = '' AND `User` = '[PowerUsers]'")

Bail "Create OpnenView UPDATE query",0

objView.Execute

End If

Bail "Execute OpenView", 0

objView.Close

Bail "Close OpenView", 0







objDatabase.Commit

Bail "Commit DB changes", 0



strProgId = objHOST.RegRead("HKEY_CLASSES_ROOT\.wsi\")

strCompileCommand = objHOST.RegRead("HKEY_CLASSES_ROOT\" & strProgId & "\shell\CompileWPS\command\")



objREGEXP.Pattern = "%1"

strCompileCommand = objREGEXP.Replace(strCompileCommand, strWsiFile)



If MsgBox("Done! Do you want to compile now?", vbYesNo + vbQuestion + vbDefaultButton2 + vbSystemModal, "End") = vbYes Then

objHOST.Run strCompileCommand, 1, False

Else



End if

End Sub



Bail "Stop " & conAPPLICATION & " " & Now(), 0

LogIt

Set objNET = Nothing

Set objHOST = Nothing





'*********************************************************

' Purpose: Add an action prior to an existing action in InstallExecuteSequence table.

'

' Assumptions:

'

' Effects :

'

' Inputs: strActionToAdd = Name of the action to add

' strRelativeToAction = Name of the action to place the action infront of

' objDaBa = Object containing the database (MSI) to edit

' Return Values : Nothing.

'*********************************************************

Function AddActionPriorTo(strActionToAdd, strRelativeToAction, objDaBa)

On Error Resume Next

'Insert Your function code here

Dim objView, objRecord, intSeqRel, intFreeSeq, blnFree 'objDaBa

blnFree = False

Bail "Creating row in InstallExecuteSequence for " & strActionToAdd, 0



'Set objDaBa = objInstaller.OpenDatabase(strDBFile, msiOpenDatabaseModeTransact)

'Bail "Open DB " & strDBFile, 0

Set objView = objDaBa.OpenView("SELECT `Action`, `Sequence` FROM `InstallExecuteSequence` WHERE `Action`='" & strRelativeToAction & "'")

Bail "Select created for finding sequence relative to",0

objView.Execute

Bail "Execute select for finding sequence relative to",0

Set objRecord = objView.Fetch()

intSeqRel = objRecord.StringData(2)

intFreeSeq = intSeqRel

Bail strRelativeToAction & " found at " & intSeqRel, 0

Do

'Find previous free sequence number

intFreeSeq = intFreeSeq -1

Set objView = objDaBa.OpenView("SELECT `Action`, `Sequence` FROM `InstallExecuteSequence` WHERE `Sequence`=" & intFreeSeq)

Bail "Select created for finding free sequence",0

objView.Execute

Bail "Execute select to find out if sequence " & intFreeSeq & " is free", 0

Set objRecord = objView.Fetch()

If objRecord Is Nothing Then blnFree = True

Loop Until blnFree



Bail "Free sequence is " & intFreeSeq, 0

Set objView = objDaBa.OpenView("INSERT INTO InstallExecuteSequence (`Action`, `Sequence`) VALUES ('" & strActionToAdd & "', '" & intFreeSeq & "')")

Bail "Create OpnenView INSERT INTO query for CA " & strActionToAdd, 0

objView.Execute



If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "InstallExecuteSequence row exists. Trying to update instead", 0

Set objView = objDaBa.OpenView("UPDATE InstallExecuteSequence SET `Sequence` = '" & intFreeSeq & "' WHERE `Action` = '" & strActionToAdd & "'")

Bail "Create OpnenView UPDATE query for CA " & strActionToAdd, 0

objView.Execute

End If

Bail "Execute OpenView for INSERT INTO/UPDATE", 0

objView.Close

Bail "Close OpenView", 0

objDaBa.Commit

Bail "Commit DB changes", 0





End Function





'*********************************************************

' Purpose: Add a custom action to the CustomAction table.

'

' Assumptions:

'

' Effects :

'

' Inputs: strCAType = The custom action type (number)

' strCAName = The Custom action name

' strCASource = The Custom action source

' strFile = The file that should be place in binary table. Path plus file

' objDB = Object containing the database (MSI) to edit

'

' Return Values : Explanation of the value returned.

'*********************************************************

Function AddCustomAction(strCAType, strCAName, strCASource, strFile, objDB)

On Error Resume Next

'Insert Your function code here

Dim objView



AddScriptToBinaryTable strCASource, strFile, objDB



Bail "Creating a row in CustumActions table for " & strCAName, 0



Set objView = objDB.OpenView("INSERT INTO CustomAction (`Action`, `Type`, `Source`) VALUES ('" & strCAName & "', '" & strCAType &"', '" & strCASource & "')")

Bail "Create OpnenView INSERT INTO query for adding CA " & strCAName, 0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "CustumActions row exists. Trying to update instead", 0

Set objView = objDB.OpenView("UPDATE CustomAction SET `Type` = '" & strCAType & "', `Source` = '" & strCASource & "' WHERE `Action` = '" & strCAName & "'")

Bail "Create OpnenView UPDATE query uptating " & strCAName, 0

objView.Execute

End If

Bail "Execute OpenView for INSERT INTO/UPDATE", 0

objView.Close

Bail "Close OpenView", 0

objDB.Commit

Bail "Commit DB changes", 0





AddActionPriorTo strCAName, "CostFinalize", objDB







End Function





'*********************************************************

' Purpose: Add an entry in binary table

'

' Assumptions:

'

' Effects :

'

' Inputs: strBinName = The name in Binary table

' strFilename = The file that should be place in binary table. Path plus file

' objDB = Object containing the database (MSI) to edit

'

' Return Values : Explanation of the value returned.

'*********************************************************

Function AddScriptToBinaryTable(strBinName, strFilename, objDB)

On Error Resume Next

'Insert Your function code here



Dim objVw

Dim objRec

Bail "Creating a row in binary table for " & strFilename, 0

Set objRec = objInstaller.CreateRecord(1)

objRec.SetStream 1, strFilename





Set objVw = objDB.OpenView("INSERT INTO `Binary` (`Name`, `Data`) VALUES ('" & strBinName & "', ?)")

Bail "Create OpnenView INSERT INTO query for adding file " & strFilename & " into Binary table", 0

objVw.Execute objRec

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "Binary table row exists. Trying to update instead", 0

Set objVw = objDB.OpenView("UPDATE Binary SET `Data` = ? WHERE `Name` = '" & strBinName & "'")

Bail "Create OpnenView UPDATE query for updating file " & strFilename & " in Binary table", 0

objVw.Execute objRec

End if

Bail "Execute OpenView for INSERT INTO/UPDATE", 0

objVw.Close

Bail "Close OpenView", 0

objDB.Commit ' save changes

Bail "Commit DB changes", 0



End Function









'*********************************************************

' Purpose: Returns the directory where the script resides.

'

' Assumptions: Nothing

'

' Effects : Nothings

'

' Inputs: Nothing

'

' Return Values : The folder including final backslash

'*********************************************************

Function ScriptDir()

On Error Resume Next

ScriptDir = Mid(WScript.ScriptFullName, 1, Len(WScript.ScriptFullName)- Len(WScript.ScriptName))



End Function













'*********************************************************

' Purpose: Writes to the application log.

'

' Assumptions: Assumes that intCODE, strMARK, objHOST, objNET are defined globaly.

'

' Effects : None.

'

' Inputs: No argoments.

'

' Return Values : Nothing.

'*********************************************************

Function LogIt()

On Error Resume Next

objHOST.LogEvent intCODE, strMARK, objNET.ComputerName

End Function



'*********************************************************

' Purpose: Catch errors during execution of the script.

'

' Assumptions: Assumes that intCODE, strMARK, are defined globaly

' and that the LogIt function exist.

'

' Effects : Sets intCODE, strMARK.

'

' Inputs:

' strEvent: The text that will be written to the application eventlog

' and if wanted as a message box to the user.

'

' intShow: If intShow equals 1 and an error has been generated, an error message is displayed to the user.

' If intShow differs from 1 and an error has been generated, the error is written to the application log.

' If an error has been generated and strEvent contains a string, than the string and the error are logged to the aspplications log.

'

' Return Values : The error number.

'*********************************************************

Function Bail(Byval strEvent, intShow)

Dim strERRMESSAGE, intBOX, blnQUIT, intRET, intButton

Bail = Err.Number



If intCODE <> 1 Then intCODE = 4

If Err.Number = 0 And strEvent = vbNullString Then Exit Function

If Err.Number <> 0 Then

strEVENT = strEVENT & "-Err Number 0x" & Hex(Err.Number) & " " & Err.Description

intCODE = 1

If intSHOW = 1 Then

Select Case Hex(Err.Number)

'Insert your case numer here



Case Else

' All not handled errors gets here. This case gives the user no second chanse to try again.

strERRMESSAGE = "Unknown error. Please report this to the support."

intBOX = vbCritical

intButton = vbOKOnly + vbDefaultButton1

blnQUIT = True

End Select

intRET = MsgBox(strERRMESSAGE & vbCrLf & vbCrLf & strEVENT, intBOX + intButton, conAPPLICATION)



End If

Else

strEVENT = strEVENT & " - OK"

End If

strMARK = strMARK & vbCrLF & strEVENT

Err.Clear



If blnQUIT Or intRET = vbNo Then

strMARK = strMARK & vbCrLF & "Premature termination " & Now()

LogIt

WScript.Quit 1

End If



End Function
 
LockPermissions_File_MST.vbs:
----------------------------------
Option Explicit


On Error Resume Next

Const conAPPLICATION = "MST LockPermissions File"



' SpecialFolder Constants

Const conWindowsFolder = 0

Const conSystemFolder = 1

Const conTemporaryFolder = 2



Const msiOpenDatabaseModeReadOnly = 0

Const msiOpenDatabaseModeTransact = 1

Const conmsiOpenDatabaseModeDirect = 2 'Opens a database direct read/write without transaction.

Const msiOpenDatabaseModeCreate = 3



Const msiTransformErrorNone = 0

Const msiTransformValidationNone = 0



Const conFILE_ATTRIBUTE_NORMAL = 0 '0x00000000



Dim intCODE, strMARK

Dim objHOST, objNET

' Creating Objects

Set objNET = CreateObject("Wscript.Network")

Set objHOST = CreateObject("WScript.Shell")

Dim objInstaller ': Set objInstaller = CreateObject("WindowsInstaller.Installer")

Set objInstaller = Wscript.CreateObject("WindowsInstaller.Installer")

Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")



Bail "Start " & conAPPLICATION & " " & Now(), 0



Main ' Cals the start subfunction that starts the script



'*********************************************************

' Purpose: Starts the script.

'

' Assumptions: Assumes that objHOST, objNET are defined globaly.

'

' Effects : None.

'

' Inputs: none.

'

' Return Values : Nothing.

'*********************************************************

Sub Main()

On Error Resume Next

'Begin to insert Your code here

Dim objDatabaseMaster, objDatabaseIntermediate, objDatabaseTransformed

Dim strMsiFile

Dim strMstFile

Dim strMsiFileName, strMstFileName

Dim objView, objRecord

Dim strRegistryTable()

Dim intI



Dim objFile

ReDim strRegistryTable(0)





Dim str_File, intRoot, strKey

' ============= Error handling =================================================

If WScript.Arguments.Count() = 0 Then

Err.Raise -1

Bail "This script takes two arguments" & VbCrLf & "The fisrt is the MSI file" & VbCrLf & "The second is the MST file" & VbCrLf, 1

End if



strMsiFile = WScript.Arguments(0)



If Not (InStrRev(strMsiFile, ".MSI", -1, vbtextcompare) = (Len(strMsiFile) - 3)) Then

Err.Raise -1

Bail "The fisrt argument must be a MSI file" & VbCrLf, 1

End If



If WScript.Arguments.Count() = 2 Then

strMstFile = WScript.Arguments(1)

Else

strMstFile = InputBox ("Full path inkl. MST-file name.","MST file path",Mid(WScript.Arguments(0), 1, Len(WScript.Arguments(0))-1) & "t")

End If





If Not (InStrRev(strMstFile, ".MST", -1, vbtextcompare) = (Len(strMstFile) - 3)) Then

Err.Raise -1

Bail "The second argument must be a MST file" & VbCrLf, 1

End If

' ============= Error handling =================================================





objFSO.CopyFile strMsiFile, objFSO.GetSpecialFolder(conTemporaryFolder) & "\", True 'Create a copy of the Windiws Installer database



objFSO.CopyFile strMstFile, objFSO.GetSpecialFolder(conTemporaryFolder) & "\", True 'Create a copy of the Windiws Installer transform





If InStrRev(strMsiFile,"\", -1, vbTextCompare) > 0 Then



strMsiFileName = Mid(strMsiFile, InStrRev(strMsiFile,"\", -1, vbTextCompare)+1)

Else



strMsiFileName = strMsiFile

End If



If InStrRev(strMstFile,"\", -1, vbTextCompare) > 0 Then



strMstFileName = Mid(strMstFile, InStrRev(strMstFile,"\", -1, vbTextCompare)+1)

Else



strMstFileName = strMstFile

End If



Set objFile = objFSO.GetFile(objFSO.GetSpecialFolder(conTemporaryFolder) & "\" & strMsiFileName)

objFile.Attributes = conFILE_ATTRIBUTE_NORMAL



str_File = InputBox("Enter File property!" & VbCrLf & VbCrLf & "(from the first collumn of the file table for the file you want to change permissions for)", "Primary key in File table")



If Len(str_File) = 0 Then

Err.Raise -1

Bail "User aborted file property input", 1

End If







Set objDatabaseTransformed = objInstaller.OpenDatabase(objFSO.GetSpecialFolder(conTemporaryFolder) & "\" & strMsiFileName, conmsiOpenDatabaseModeDirect)

Bail "Open DB", 0

objDatabaseTransformed.ApplyTransform objFSO.GetSpecialFolder(conTemporaryFolder) & "\" & strMstFileName, 0 '256 '63+256

Bail "Apply transform", 0



AddCustomAction "6", "CA_GetLocalizedGroupsNames", "GetLocalizedGroups", ScriptDir() & "LocalGroupLocalized.vbs", objDatabaseTransformed

Bail "Add custom action",0





' #define SYNCHRONIZE (0x00100000L) = 1048576 dec

'

' Traverse Folder/Execute File

' #define FILE_EXECUTE ( 0x0020 ) // file

' #define FILE_TRAVERSE ( 0x0020 ) // directory

'

'

' List Folder/Read data

' #define FILE_READ_DATA ( 0x0001 ) // file & pipe

' #define FILE_LIST_DIRECTORY ( 0x0001 ) // directory

'

' Read Attributes

' #define FILE_READ_ATTRIBUTES ( 0x0080 ) // all

'

' Read Extended Attributes

' #define FILE_READ_EA ( 0x0008 ) // file & directory

'

' Create files/write data

' #define FILE_WRITE_DATA ( 0x0002 ) // file & pipe

' #define FILE_ADD_FILE ( 0x0002 ) // directory

'

' Create Folders/Append data

' #define FILE_APPEND_DATA ( 0x0004 ) // file

' #define FILE_ADD_SUBDIRECTORY ( 0x0004 ) // directory

' #define FILE_CREATE_PIPE_INSTANCE ( 0x0004 ) // named pipe

'

' Write attributes

' #define FILE_WRITE_ATTRIBUTES ( 0x0100 ) // all

'

' Write Extended attributes

' #define FILE_WRITE_EA ( 0x0010 ) // file & directory

'

' Delete

' #define DELETE (0x00010000L)

'

' Read permission

' #define READ_CONTROL (0x00020000L)

'

'

' Power Users in Program Files

' Sum SYNCHRO Total

' Total = 301BF = 197055 + 1048576 = 1245631



' Administrators

' #define FILE_DELETE_CHILD ( 0x0040 ) // directory

' #define WRITE_DAC (0x00040000L)

' #define WRITE_OWNER (0x00080000L)

'

' Sum SYNCHRO Total

' File/Folder Total = 301BF + 40 + 40000 + 80000 = F01FF = 983551 + 1048576 = 2032127





Set objView = objDatabaseTransformed.OpenView("INSERT INTO LockPermissions (`LockObject`, `Table`, `User`, `Permission`) VALUES ('" & str_File & "', 'File', 'Administrators', '2032127')")

Bail "Create OpnenView INSERT INTO query",0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "LockPermission row exists. Trying to update instead", 0

Set objView = objDatabaseTransformed.OpenView("UPDATE LockPermissions SET `Permission` = '2032127' WHERE `LockObject` = '" & str_File & "' AND `Table` = 'File' AND `Domain` = '' AND `User` = 'Administrators'")

Bail "Create OpnenView UPDATE query",0

objView.Execute

End If

Bail "Execute OpenView", 0

objView.Close

Bail "Close OpenView", 0



Set objView = objDatabaseTransformed.OpenView("INSERT INTO LockPermissions (`LockObject`, `Table`, `User`, `Permission`) VALUES ('" & str_File & "', 'File', '[BuiltinUsers]', '1245631')")

Bail "Create OpnenView INSERT INTO query",0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "LockPermission row exists. Trying to update instead", 0

Set objView = objDatabaseTransformed.OpenView("UPDATE LockPermissions SET `Permission` = '1245631' WHERE `LockObject` = '" & str_File & "' AND `Table` = 'File' AND `Domain` = '' AND `User` = '[BuiltinUsers]'")

Bail "Create OpnenView UPDATE query",0

objView.Execute

End If

Bail "Execute OpenView", 0

objView.Close

Bail "Close OpenView", 0



Set objView = objDatabaseTransformed.OpenView("INSERT INTO LockPermissions (`LockObject`, `Table`, `User`, `Permission`) VALUES ('" & str_File & "', 'File', '[PowerUsers]', '1245631')")

Bail "Create OpnenView INSERT INTO query",0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "LockPermission row exists. Trying to update instead", 0

Set objView = objDatabaseTransformed.OpenView("UPDATE LockPermissions SET `Permission` = '1245631' WHERE `LockObject` = '" & str_File & "' AND `Table` = 'File' AND `Domain` = '' AND `User` = '[PowerUsers]'")

Bail "Create OpnenView UPDATE query",0

objView.Execute

End If

Bail "Execute OpenView", 0

objView.Close

Bail "Close OpenView", 0





objDatabaseTransformed.Commit

Bail "Commit DB changes", 0











Set objDatabaseMaster = objInstaller.OpenDatabase(strMsiFile, msiOpenDatabaseModeReadOnly)







If Not objFSO.FolderExists(objFSO.GetSpecialFolder(conTemporaryFolder) & "\New_MSTs") Then objFSO.CreateFolder objFSO.GetSpecialFolder(conTemporaryFolder) & "\New_MSTs"

If objFSO.FileExists(objFSO.GetSpecialFolder(conTemporaryFolder) & "\New_MSTs\" & strMstFileName) Then objFSO.DeleteFile objFSO.GetSpecialFolder(conTemporaryFolder) & "\New_MSTs\" & strMstFileName, True



objDatabaseTransformed.GenerateTransform objDatabaseMaster, objFSO.GetSpecialFolder(conTemporaryFolder) & "\New_MSTs\" & strMstFileName

Bail "Create Transform", 0

objDatabaseTransformed.CreateTransformSummaryInfo objDatabaseMaster, objFSO.GetSpecialFolder(conTemporaryFolder) & "\New_MSTs\" & strMstFileName, msiTransformErrorNone, msiTransformValidationNone

Bail "CreateTransformSummaryInfo", 0

objHOST.Run """" & objFSO.GetSpecialFolder(conTemporaryFolder) & "\New_MSTs" & """", 1 ,False

End Sub



Bail "Stop " & conAPPLICATION & " " & Now(), 0

LogIt

Set objNET = Nothing

Set objHOST = Nothing





'*********************************************************

' Purpose: Add an action prior to an existing action in InstallExecuteSequence table.

'

' Assumptions:

'

' Effects :

'

' Inputs: strActionToAdd = Name of the action to add

' strRelativeToAction = Name of the action to place the action infront of

' objDaBa = Object containing the database (MSI) to edit

' Return Values : Nothing.

'*********************************************************

Function AddActionPriorTo(strActionToAdd, strRelativeToAction, objDaBa)

On Error Resume Next

'Insert Your function code here

Dim objView, objRecord, intSeqRel, intFreeSeq, blnFree 'objDaBa

blnFree = False

Bail "Creating row in InstallExecuteSequence for " & strActionToAdd, 0



'Set objDaBa = objInstaller.OpenDatabase(strDBFile, msiOpenDatabaseModeTransact)

'Bail "Open DB " & strDBFile, 0

Set objView = objDaBa.OpenView("SELECT `Action`, `Sequence` FROM `InstallExecuteSequence` WHERE `Action`='" & strRelativeToAction & "'")

Bail "Select created for finding sequence relative to",0

objView.Execute

Bail "Execute select for finding sequence relative to",0

Set objRecord = objView.Fetch()

intSeqRel = objRecord.StringData(2)

intFreeSeq = intSeqRel

Bail strRelativeToAction & " found at " & intSeqRel, 0

Do

'Find previous free sequence number

intFreeSeq = intFreeSeq -1

Set objView = objDaBa.OpenView("SELECT `Action`, `Sequence` FROM `InstallExecuteSequence` WHERE `Sequence`=" & intFreeSeq)

Bail "Select created for finding free sequence",0

objView.Execute

Bail "Execute select to find out if sequence " & intFreeSeq & " is free", 0

Set objRecord = objView.Fetch()

If objRecord Is Nothing Then blnFree = True

Loop Until blnFree



Bail "Free sequence is " & intFreeSeq, 0

Set objView = objDaBa.OpenView("INSERT INTO InstallExecuteSequence (`Action`, `Sequence`) VALUES ('" & strActionToAdd & "', '" & intFreeSeq & "')")

Bail "Create OpnenView INSERT INTO query for CA " & strActionToAdd, 0

objView.Execute



If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "InstallExecuteSequence row exists. Trying to update instead", 0

Set objView = objDaBa.OpenView("UPDATE InstallExecuteSequence SET `Sequence` = '" & intFreeSeq & "' WHERE `Action` = '" & strActionToAdd & "'")

Bail "Create OpnenView UPDATE query for CA " & strActionToAdd, 0

objView.Execute

End If

Bail "Execute OpenView for INSERT INTO/UPDATE", 0

objView.Close

Bail "Close OpenView", 0

objDaBa.Commit

Bail "Commit DB changes", 0





End Function





'*********************************************************

' Purpose: Add a custom action to the CustomAction table.

'

' Assumptions:

'

' Effects :

'

' Inputs: strCAType = The custom action type (number)

' strCAName = The Custom action name

' strCASource = The Custom action source

' strFile = The file that should be place in binary table. Path plus file

' objDB = Object containing the database (MSI) to edit

'

' Return Values : Explanation of the value returned.

'*********************************************************

Function AddCustomAction(strCAType, strCAName, strCASource, strFile, objDB)

On Error Resume Next

'Insert Your function code here

Dim objView



AddScriptToBinaryTable strCASource, strFile, objDB



Bail "Creating a row in CustumActions table for " & strCAName, 0



Set objView = objDB.OpenView("INSERT INTO CustomAction (`Action`, `Type`, `Source`) VALUES ('" & strCAName & "', '" & strCAType &"', '" & strCASource & "')")

Bail "Create OpnenView INSERT INTO query for adding CA " & strCAName, 0

objView.Execute

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "CustumActions row exists. Trying to update instead", 0

Set objView = objDB.OpenView("UPDATE CustomAction SET `Type` = '" & strCAType & "', `Source` = '" & strCASource & "' WHERE `Action` = '" & strCAName & "'")

Bail "Create OpnenView UPDATE query uptating " & strCAName, 0

objView.Execute

End If

Bail "Execute OpenView for INSERT INTO/UPDATE", 0

objView.Close

Bail "Close OpenView", 0

objDB.Commit

Bail "Commit DB changes", 0





AddActionPriorTo strCAName, "CostFinalize", objDB







End Function





'*********************************************************

' Purpose: Add an entry in binary table

'

' Assumptions:

'

' Effects :

'

' Inputs: strBinName = The name in Binary table

' strFilename = The file that should be place in binary table. Path plus file

' objDB = Object containing the database (MSI) to edit

'

' Return Values : Explanation of the value returned.

'*********************************************************

Function AddScriptToBinaryTable(strBinName, strFilename, objDB)

On Error Resume Next

'Insert Your function code here



Dim objVw

Dim objRec

Bail "Creating a row in binary table for " & strFilename, 0

Set objRec = objInstaller.CreateRecord(1)

objRec.SetStream 1, strFilename





Set objVw = objDB.OpenView("INSERT INTO `Binary` (`Name`, `Data`) VALUES ('" & strBinName & "', ?)")

Bail "Create OpnenView INSERT INTO query for adding file " & strFilename & " into Binary table", 0

objVw.Execute objRec

If Hex(Err.Number) = 80004005 Then

Err.Clear

Bail "Binary table row exists. Trying to update instead", 0

Set objVw = objDB.OpenView("UPDATE Binary SET `Data` = ? WHERE `Name` = '" & strBinName & "'")

Bail "Create OpnenView UPDATE query for updating file " & strFilename & " in Binary table", 0

objVw.Execute objRec

End if

Bail "Execute OpenView for INSERT INTO/UPDATE", 0

objVw.Close

Bail "Close OpenView", 0

objDB.Commit ' save changes

Bail "Commit DB changes", 0



End Function









'*********************************************************

' Purpose: Returns the directory where the script resides.

'

' Assumptions: Nothing

'

' Effects : Nothings

'

' Inputs: Nothing

'

' Return Values : The folder including final backslash

'*********************************************************

Function ScriptDir()

On Error Resume Next

ScriptDir = Mid(WScript.ScriptFullName, 1, Len(WScript.ScriptFullName)- Len(WScript.ScriptName))



End Function











'*********************************************************

' Purpose: Writes to the application log.

'

' Assumptions: Assumes that intCODE, strMARK, objHOST, objNET are defined globaly.

'

' Effects : None.

'

' Inputs: No argoments.

'

' Return Values : Nothing.

'*********************************************************

Function LogIt()

On Error Resume Next

objHOST.LogEvent intCODE, strMARK, objNET.ComputerName

End Function



'*********************************************************

' Purpose: Catch errors during execution of the script.

'

' Assumptions: Assumes that intCODE, strMARK, are defined globaly

' and that the LogIt function exist.

'

' Effects : Sets intCODE, strMARK.

'

' Inputs:

' strEvent: The text that will be written to the application eventlog

' and if wanted as a message box to the user.

'

' intShow: If intShow equals 1 and an error has been generated, an error message is displayed to the user.

' If intShow differs from 1 and an error has been generated, the error is written to the application log.

' If an error has been generated and strEvent contains a string, than the string and the error are logged to the aspplications log.

'

' Return Values : The error number.

'*********************************************************

Function Bail(Byval strEvent, intShow)

Dim strERRMESSAGE, intBOX, blnQUIT, intRET, intButton

Bail = Err.Number



If intCODE <> 1 Then intCODE = 4

If Err.Number = 0 And strEvent = vbNullString Then Exit Function

If Err.Number <> 0 Then

strEVENT = strEVENT & "-Err Number 0x" & Hex(Err.Number) & " " & Err.Description

intCODE = 1

If intSHOW = 1 Then

Select Case Hex(Err.Number)

'Insert your case numer here



Case Else

' All not handled errors gets here. This case gives the user no second chanse to try again.

strERRMESSAGE = "Unknown error. Please report this to the support."

intBOX = vbCritical

intButton = vbOKOnly + vbDefaultButton1

blnQUIT = True

End Select

intRET = MsgBox(strERRMESSAGE & vbCrLf & vbCrLf & strEVENT, intBOX + intButton, conAPPLICATION)



End If

Else

strEVENT = strEVENT & " - OK"

End If

strMARK = strMARK & vbCrLF & strEVENT

Err.Clear



If blnQUIT Or intRET = vbNo Then

strMARK = strMARK & vbCrLF & "Premature termination " & Now()

LogIt

WScript.Quit 1

End If



End Function
 
Drag and Drop the wsi/mst on the appropriate script by placing the script with it.