Uninstall Fonts through VBScript

I had to uninstall Helvetica and FoundersGrotesk fonts from all the machines in our environment. They had been initially been deployed through MSI a few years back when no one bothered to check if the uninstall of that MSI was actually removing the fonts. So now, since those MSI were not uninstalling the fonts from the machine, I decided to write a VBScript to delete those fonts. While I could find scripts to remove the fonts, but none of them actually helped me to remove the fonts.

I wanted a script which will delete any font starting with Helvetica or FoundersGrotesk from Windows\Fonts folder and from Registry to completely remove it.

You can use this script for other fonts, by replacing Helvetica with your font name and then change the length from 9 to the one of your fonts length. I have mentioned this in comments in the script where you need to change it.

This script will work for both 32-bit an 64-bit machines.


'Script to Delete Font
'Created by: Piyush Nasa
'Date: 21-8-2015
const HKEY_LOCAL_MACHINE = &H80000002

Dim strFolder, objFSO, objFolder, oShell, sCurDir,FileName, oFSO
strFolder = "C:\Windows\Fonts"
Set oShell = CreateObject("WScript.Shell")
sCurDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\") - 1)

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strFolder)

strComputer = "."
Set objShell = Wscript.CreateObject("Wscript.Shell")
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_
strComputer & "\root\default:StdRegProv")

Call CleanFolder(objFolder) 'Remove Font Files

'Remove Registries

strKeyPath = "SOFTWARE\Wow6432Node\Microsoft\Windows NT\CurrentVersion\Fonts"

oReg.EnumValues HKEY_LOCAL_MACHINE, strKeyPath,_
 arrValueNames, arrValueTypes

For i=0 To UBound(arrValueNames)
'Change the length and Name in the line below    
    If (Left(arrValueNames(i), 9) = "Helvetica") Then
    'msgbox "Value Name: " & HKEY_LOCAL_MACHINE & "\" & strKeyPath & "\" & arrValueNames(i)
    objShell.RegDelete "HKEY_LOCAL_MACHINE\" & strKeyPath & "\" & arrValueNames(i)
    End If
Next




Sub CleanFolder(ByVal objParent)
  Dim objChild, objFile
Set oFSO = CreateObject("Scripting.FileSystemObject")
  Set oShell = CreateObject("WScript.Shell")
 
  For Each objFile In objParent.Files
   ' Wscript.Echo " " & objFile.Name
   'Change the length and Name in the line below    
    If (Left(objFile.Name, 9) = "helvetica") Then
FileName =objFSO.GetFileName(objFile)
strFile = strFolder & "\" & FileName
      If oFSO.FileExists(strFile) Then
' Delete the file
oFSO.DeleteFile strFile, True
    End If
    End If
  Next
  For Each objChild In objParent.SubFolders
    Call CleanFolder(objChild)
  Next
 
  Set oFSO = Nothing
End Sub

Citrix Receiver upgrade and double icon issue

I recently had to upgrade Citrix Receiver for one of my clients and I faced numerous issues during the install.
I had to enable SSO for Citrix Receiver and add a storefront URL so when the users launch Citrix Receiver they should be able to launch their apps store directly without going through login prompts and entering the url.

While Citrix Receiver can be installed with the following command:

CitrixReceiver.exe /silent /noreboot /includeSSON ENABLE_SSON=Yes ALLOWADDSTORE=N ALLOWSAVEPWD=S

And Store URL can be set in the ADM template of Citrix Receiver, however, you will need to uninstall the older version before you install the new one.

Other issues faced were for double icons which appeared on those users machines who had added an app store themselves in the previous version. When a new store was added through Group policy, it actually doubled the store and the icons.
The stores are created in the below registry key:
HKCU\Software\Citrix\Dazzle
When I removed this for the user and infact for all the users, it left behind dead icons in Start Menu, Desktop and in Citrix Receiver console. Also due to these dead icons, then I faced issues for Citrix stealing focus from all other applications.

Citrix suggests to use Citrix uninstall utility, but that works only when a logged on user runs it as an administrator which is rare in our environments.

I wrote following script to install, delete dead icons and remove the HKCU keys for all users of Citrix which are left behind.
You will Need:
1) Citrix Receiver
2) Receiver Cleanup Utility
to be in the same install  folder as these scripts.

Script 1

install.vbs

'Created: Piyush Nasa
'Date: 05-May-2015

Dim oExplorer
Dim oShell                   ' Windows Scripting Host shell
Dim oFSO                            ' File system object
Dim sCurDir, AppName, srd ' Script path
Dim sWinDir ' Windows root path
Dim scpf86, spf, strAppMsg, oEnv
dim strComputer, oReg, strKeyPath, strValueName, StringVal

'===========================================
' Main

'On Error Resume Next

Set oShell = CreateObject("WScript.Shell")

set oEnv = oShell.Environment("PROCESS")

oEnv("SEE_MASK_NOZONECHECKS") = 1

sCurDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\") - 1)

sWinDir = oShell.ExpandEnvironmentStrings ("%WinDir%")

const HKEY_LOCAL_MACHINE = &H80000002

'Check if previous version exists
'--------------------------------------

strComputer = "."

DIM fso  
Set fso = CreateObject("Scripting.FileSystemObject")

'Uninstall if anything left from Citrix
oShell.Run sCurDir & "\ReceiverCleanupUtility.exe /silent", 1, 1

'Uninstall Previous version

If (fso.FileExists("C:\ProgramData\Citrix\Citrix Receiver\TrolleyExpress.exe")) Then
  oShell.Run chr(34) & "C:\ProgramData\Citrix\Citrix Receiver\TrolleyExpress.exe" & chr(34) & " /Uninstall /Cleanup /silent", 1, 1
Else
  'Do Nothing
End If

'Uninstall if anything left from Citrix
oShell.Run sCurDir & "\ReceiverCleanupUtility.exe /silent", 1, 1

'Uninstall any Citrix Shortcuts left behind
oShell.Run sCurDir & "\DeleteShortcuts.vbs", 1, 1

'Uninstall Citrix keys in HKCU left behind
oShell.Run sCurDir & "\UninstallCitrixRegs.vbs", 1, 1

AppName = "Citrix Receiver 4.2.1"


' Install Citrix Receiver 4.2.1
oShell.Run sCurDir & "\CitrixReceiver.exe /silent /noreboot /includeSSON ENABLE_SSON=Yes ALLOWADDSTORE=N ALLOWSAVEPWD=S", 1, 1

oEnv.Remove("SEE_MASK_NOZONECHECKS")


'Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")

'strKeyPath = "SOFTWARE\\Applications\CitrixReceiver"

'strValueName = "Installed"
'StringVal = 1

'oReg.CreateKey HKEY_LOCAL_MACHINE,strKeyPath
'oReg.SetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,StringVal


Script 2.

DeleteShortcuts.vbs

On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set wshShell    = WScript.CreateObject("WScript.Shell")
'initialize logging
strLogFile = wshShell.ExpandEnvironmentStrings("%TEMP%\CitrixReceiverShortcutClean.log.txt")
Set objLogFile = objFSO.OpenTextFile(strLogFile, 8, True)
objLogFile.WriteLine Now & ": Logging Initialized"
'get list of folders in C:\Users
Set objFolder = objFSO.GetFolder("C:\Users")
objLogFile.WriteLine Now & ": Got list of user folders under C:\Users"
For Each UserSubFolder in objFolder.SubFolders
 'search the users start menu for Citrix shortcuts
'msgbox UserSubFolder.Path
 objStartFolder = UserSubFolder.Path & "\AppData\Roaming\Microsoft\Windows\Start Menu"
'msgbox objStartFolder
 objLogFile.WriteLine Now & ": Searching folder: " & objStartFolder
 Set objSearchFolder = objFSO.GetFolder(objStartFolder)
 Set colFiles = objSearchFolder.Files
 For Each objFile in colFiles
     If InStr(objFile.Name, ".lnk") Then
  IsCitrixShortcut objSearchFolder.Path & "\" & objFile.Name
     End If
 Next
 ShowSubfolders objFSO.GetFolder(objStartFolder)
 ' now search the users desktop for Citrix shortcuts
 objStartFolder = UserSubFolder.Path & "\Desktop"
 objLogFile.WriteLine Now & ": Searching folder: " & objStartFolder
 Set objSearchFolder = objFSO.GetFolder(objStartFolder)
 Set colFiles = objSearchFolder.Files
 For Each objFile in colFiles
     If InStr(objFile.Name, ".lnk") Then
  IsCitrixShortcut objSearchFolder.Path & "\" & objFile.Name
     End If
 Next
 ShowSubfolders objFSO.GetFolder(objStartFolder)
Next
objLogFile.WriteLine Now & ": Script complete"
Sub ShowSubFolders(Folder)

    For Each Subfolder in Folder.SubFolders
        Set objFolder = objFSO.GetFolder(Subfolder.Path)
        Set colFiles = objFolder.Files
        For Each objFile in colFiles

     If InStr(objFile.Name, ".lnk") Then

  IsCitrixShortcut SubFolder.Path & "\" & objFile.Name
     End If
        Next
        ShowSubFolders Subfolder
    Next
End Sub

Sub IsCitrixShortcut(strShortcut)
'msgbox strShortcut
 ' CreateShortcut works like a GetShortcut when the shortcut already exists!
 Set objShortcut2 = wshShell.CreateShortcut(strShortcut)
' WScript.Echo "Target Path       : " & objShortcut2.TargetPath

'WScript.Echo "Full Name         : " & objShortcut2.FullName
'WScript.Echo "Arguments         : " & objShortcut2.Arguments
'WScript.Echo "Working Directory : " & objShortcut2.WorkingDirectory
'WScript.Echo "Target Path       : " & objShortcut2.TargetPath
'WScript.Echo "Icon Location     : " & objShortcut2.IconLocation
'WScript.Echo "Hotkey            : " & objShortcut2.Hotkey
'WScript.Echo "Window Style      : " & objShortcut2.WindowStyle
'WScript.Echo "Description       : " & objShortcut2.Description




 If (InStr(objShortcut2.WorkingDirectory,"Citrix") Or InStr(objShortcut2.TargetPath,"Citrix")) Then
 'msgbox "found citrix"
 objLogFile.WriteLine Now & ": Deleting PNAgent Shortcut: " & strShortcut
If objFSO.FileExists (strShortcut) Then
  objFSO.DeleteFile strShortcut,True
'msgbox "File Deleted"
Else
'msgbox "File not found"
End If
 End If
End Sub


Script 3
UninstallCitrixRegs.vbs

'On Error Resume Next

Const HKEY_CURRENT_USER = &H80000001

Const HKU = &H80000003

strComputer = "."
strKeyPath = "Software\Citrix"
strKeyPath1 = "Software\Microsoft\Windows\CurrentVersion\Uninstall"
sName = "SiteName" ' Change this to site in your environment from which it starts and has common string

Set objRegistry = GetObject("winmgmts:\\" & _
    strComputer & "\root\default:StdRegProv")
Set wmi = GetObject("winmgmts:\\.\root\cimv2")
Set reg = GetObject("winmgmts:\\.\root\default:StdRegProv")

Set profs = wmi.ExecQuery("Select SID from Win32_UserProfile where SID like 'S-1-5-21%'")
For Each prof In profs
  key = prof.SID & "\Software\Citrix"
DeleteSubkeys HKU, key

  key1 = prof.SID & "\" & strKeyPath1

EnumerateKeys HKU, key1


' Call reg.DeleteKey(HKU, key) 'commented out for safety
Next
'End If



Sub DeleteSubkeys(HKU, strKeyPath)
    objRegistry.EnumKey HKU, strKeyPath, arrSubkeys

    If IsArray(arrSubkeys) Then
        For Each strSubkey In arrSubkeys
            DeleteSubkeys HKU, strKeyPath & "\" & strSubkey
        Next
    End If

    objRegistry.DeleteKey HKU, strKeyPath
End Sub

Sub EnumerateKeys(hive, key)
  'WScript.Echo key
  objRegistry.EnumKey hive, key, arrSubKeys
  If Not IsNull(arrSubKeys) Then
    For Each skey In arrSubKeys
      EnumerateKeys hive, key & "\" & skey
      t=(InStr(skey,"sName"))
      If (t=1) Then
      'MsgBox skey
      DeleteSubkeys hive, key & "\" & skey
      End If
     
    Next
  End If
End Sub

VBScript to change the proxy settings if disconnected from VPN

When connected to VPN, user's IE proxy settings get changed and is forced by VPN.
Often the users might get disconnected from VPN while working from home and this does not revert back the proxy settings to the original one.
I have written a VBScript to change the proxy settings of the users. This script can be made a shortcut and then used.

'Script Created by Piyush Nasa
'Script to change Proxy settings for user if disconnected from VPN

Option Explicit
Dim valUserIn
Dim objShell, RegLocate, RegLocate1
Set objShell = WScript.CreateObject("WScript.Shell")
On Error Resume Next
valUserIn = MsgBox("If you have been disconnected from VPN and want to reset your proxy, click Yes and restart Internet Explorer",4,"Proxy Reset")
If valUserIn=vbYes Then
RegLocate = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyServer"
objShell.RegWrite RegLocate,"","REG_SZ"
RegLocate = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyEnable"
objShell.RegWrite RegLocate,"0","REG_DWORD"

'Enable AutoDetect in the proxy by calling this sub
IEautomaticallydetect

MsgBox "Proxy is reset to AutoDetect"

else
'I do not want any proxy so I have disabled this, but if you want to set a proxy then you can use this.

'RegLocate = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyServer"
'objShell.RegWrite RegLocate,"xxxx.xxx.com:80","REG_SZ"
'RegLocate = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyEnable"
'objShell.RegWrite RegLocate,"1","REG_DWORD"
MsgBox "Your Proxy is not changed."
End If
WScript.Quit



 SUB IEautomaticallydetect


 DIM sKey,sValue,binaryVal
 Dim oReg
 Set oReg=GetObject( "winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")    'For registry operations througout

 Const HKCU=&H80000001

 sKey = "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Connections"
 sValue = "DefaultConnectionSettings"

 oReg.GetBinaryValue HKCU, sKey, sValue, binaryVal

'you can keep different values of this binary to have different options. 9 is just for Auto detect enable.
binaryVal(8) = 9

 oReg.SetBinaryValue HKCU, sKey, sValue, binaryVal
 end sub

Detection Method for MSU in Applications for SCCM 2012

In SCCM 2012 Applications you can have a detection method set for MSU with KB numbers.

You can use the Powershell or VBScript to do this. Here is an example of both.

Powershell Script:

get-hotfix | Where-Object {$_.HotFixID -match "KB981603"}

VBScript:

'Returns info if Windows 'KB981603'  in installed
' ----------------------------------------------------------'
Option Explicit

Dim objWMIService, strComputer
strComputer = "."

'Run the query
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" _
    & strComputer & "\root\cimv2")
 
Dim QFEs
Dim QFE
Set QFEs = objWMIService.ExecQuery ("Select * from win32_QuickFixEngineering where HotFixID like 'KB981603'")
For Each QFE in QFEs
    Wscript.echo "Update KB981603 was installed by " & QFE.InstalledBy & " on " & QFE.InstalledOn
Next
WScript.Quit

VBScript to Delete Registrly key and all subkeys

This script has worked good for me and I would like to share with all.

Option Explicit

    Dim intHive
    Dim strComputer
    Dim strKeyPath, objRegistry

    Const HKEY_CLASSES_ROOT        = &H80000000
    Const HKEY_CURRENT_USER    = &H80000001
    Const HKEY_LOCAL_MACHINE    = &H80000002
    Const HKEY_USERS        = &H80000003
    Const HKEY_CURRENT_CONFIG    = &H80000005

    'On Error Resume Next

    strComputer            = "."
    intHive                = HKEY_LOCAL_MACHINE
 
    strKeyPath            = "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ABC\XYZ"

    Set objRegistry        = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")

    DelSubkeys intHive, strKeypath

    Set objRegistry        = Nothing

    Sub DelSubkeys(ByVal intRegistryHive, ByVal strRegistryKey)
        Dim arrSubkeys

        objRegistry.EnumKey intRegistryHive, strRegistryKey, arrSubkeys
        If IsArray(arrSubkeys) Then
            For Each strSubkey In arrSubkeys
                DelSubkeys intRegistryHive, strRegistryKey & "\" & strSubkey
            Next
        End If

        objRegistry.DeleteKey intRegistryHive, strRegistryKey
    End Sub

VBScript to Delete Folder and all SubFolders with files

Here is the VBScript which will delete all Folders and Subfolders with even have files in it.

It took me so many hours to find this perfect script and all credits go to Rob van der Woude and the original script is here: http://www.robvanderwoude.com/vbstech_folders_deltree.php
I just want to keep this for my reference and for everyone so that we all can save some time.

Option Explicit

Dim objFSO, objTempFolder, strTempFolder

Const TEMP_FOLDER = 2

Set objFSO        = CreateObject( "Scripting.FileSystemObject" )
Set objTempFolder = objFSO.GetSpecialFolder( TEMP_FOLDER )
strTempFolder     = objTempFolder.Path

DelTree strTempFolder, True


Sub DelTree( myFolder, blnKeepRoot )
' With this subroutine you can delete folders and their content,
' including subfolders.
' You can specify if you only want to empty the folder, and thus
' keep the folder itself, or to delete the folder itself as well.
' Root directories and some (not all) vital system folders are
' protected: if you try to delete them you'll get a message that
' deleting these folders is not allowed.
'
' Arguments:
' myFolder     [string]   the folder to be emptied or deleted
' blnKeepRoot  [boolean]  if True, the folder is emptied only,
'                         otherwise it will be deleted itself too
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
'
    Dim arrSpecialFolders(3)
    Dim objMyFSO, objMyFile, objMyFolder, objMyShell
    Dim objPrgFolder, objPrgFolderItem, objSubFolder, wshMyShell
    Dim strPath, strSpecialFolder

    Const WINDOWS_FOLDER =  0
    Const SYSTEM_FOLDER  =  1
    Const PROGRAM_FILES  = 38

    ' Use custom error handling
    On Error Resume Next

    ' List the paths of system folders that should NOT be deleted
    Set wshMyShell       = CreateObject( "WScript.Shell" )
    Set objMyFSO         = CreateObject( "Scripting.FileSystemObject" )
    Set objMyShell       = CreateObject( "Shell.Application" )
    Set objPrgFolder     = objMyShell.Namespace( PROGRAM_FILES )
    Set objPrgFolderItem = objPrgFolder.Self

    arrSpecialFolders(0) = wshMyShell.SpecialFolders( "MyDocuments" )
    arrSpecialFolders(1) = objPrgFolderItem.Path
    arrSpecialFolders(2) = objMyFSO.GetSpecialFolder( SYSTEM_FOLDER  ).Path
    arrSpecialFolders(3) = objMyFSO.GetSpecialFolder( WINDOWS_FOLDER ).Path

    Set objPrgFolderItem = Nothing
    Set objPrgFolder     = Nothing
    Set objMyShell       = Nothing
    Set wshMyShell       = Nothing

    ' Check if a valid folder was specified
    If Not objMyFSO.FolderExists( myFolder ) Then
        WScript.Echo "Error: path not found (" & myFolder & ")"
        WScript.Quit 1
    End If
    Set objMyFolder = objMyFSO.GetFolder( myFolder )

    ' Protect vital system folders and root directories from being deleted
    For Each strSpecialFolder In arrSpecialFolders
        If UCase( strSpecialFolder ) = UCase( objMyFolder.Path ) Then
            WScript.Echo "Error: deleting """ _
                       & objMyFolder.Path & """ is not allowed"
            WScript.Quit 1
        End If
    Next

    ' Protect root directories from being deleted
    If Len( objMyFolder.Path ) < 4 Then
        WScript.Echo "Error: deleting root directories is not allowed"
        WScript.Quit 1
    End If

    ' First delete the files in the directory specified
    For Each objMyFile In objMyFolder.Files
        strPath = objMyFile.Path
        objMyFSO.DeleteFile strPath, True
        If Err Then
            WScript.Echo "Error # " & Err.Number & vbCrLf _
                       & Err.Description         & vbCrLf _
                       & "(" & strPath & ")"     & vbCrLf
        End If
    Next

    ' Next recurse through the subfolders
    For Each objSubFolder In objMyFolder.SubFolders
        DelTree objSubFolder, False
    Next

    ' Finally, remove the "root" directory unless it should be preserved
    If Not blnKeepRoot Then
        strPath = objMyFolder.Path
        objMyFSO.DeleteFolder strPath, True
        If Err Then
            WScript.Echo "Error # " & Err.Number & vbCrLf _
                       & Err.Description         & vbCrLf _
                       & "(" & strPath & ")"     & vbCrLf
        End If
    End If

    ' Cleaning up the mess
    On Error Goto 0
    Set objMyFolder = Nothing
    Set objMyFSO    = Nothing
End Sub

VBScript to Find and Replace

I have been using this script for some time now. I took inputs from some sites to create this VBScript. I have modified it to my needs. I want to share this and keep it gfor my reference for future use as well.
I am searching for a text and replacing it with the User input of mail id.

'-----------------------------------------------------
'Use the below function if you want it to run from commandline and take input from users.
'If WScript.Arguments.Count <> 2 then
'  WScript.Echo "usage: Find_And_replace.vbs filename word_to_find replace_with "
'  WScript.Quit
'end If
MailID=InputBox("Please enter your E-Mail ID")
sFind="abcxyz.com"
Set oshell=CreateObject("Wscript.shell")
prog=oshell.ExpandEnvironmentStrings("%ProgramFiles(x86)%")
TargetFile= prog & "\App\config.ini"
TempFile= prog & "\App\config1.ini"
FindAndReplace TargetFile, sFind, MailID
WScript.Echo "Operation Complete"

function FindAndReplace(strFile, strFind, strReplace)
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objInputFile = objFSO.OpenTextFile(strFile,1)
    'strTempDir = objFSO.GetSpecialFolder(2)
    Set objTempFile = objFSO.OpenTextFile(TempFile,2,true)
    do until objInputFile.AtEndOfStream
        objTempFile.WriteLine(Replace(objInputFile.ReadLine, strFind, strReplace))
    loop
    objInputFile.Close
    Set objInputFile = Nothing
    objTempFile.Close
    Set objTempFile = Nothing
    objFSO.DeleteFile strFile, true
    objFSO.MoveFile TempFile, strFile
    Set objFSO = Nothing
end function 
'-----------------------------------------------------

You can modify this script based on your needs and use it.

Re-Packaging Apple Quicktime 7.72.80.56 and later versions

Quicktime comes as an EXE file which can be extracted easily with 7Zip. The three MSI I received were AppleApplicationSupport, AppleSoftwareUpdate and Quicktime. The Apple Update MSI can be discarded if you do not want to AutoUpdate your Quicktime.

Apple Application Support MSI can be directly installed with /qb! switch.

iTunes can be packaged separately and I have created a separate post for its customization:
http://msiworld.blogspot.com.au/2012/06/re-packaging-apple-itunes-10617-and.html

Quicktime should be modified through Transform as follows:

1) Change the following properties in your MST:

 SCHEDULE_ASUW =0
  REGSRCH_DESKTOP_SHORTCUTS =0
 REBOOT=ReallySuppress

2) Install Quicktime on a test machine and do all the customizations you want with preferences. Once all customizations are complete, copy the quicktime.qtp file from "%userprofile%\AppData\LocalLow\Apple Computer\QuickTime\QuickTime.qtp"

Add this file to Transform in C:\ProgramData\Apple Computer\QuickTime\QuickTime.qtp.

Now add these two scripts in your package in Custom Action to run just before Install Finalize and with Condition as NOT REMOVE~="ALL"

a) This script will copy the .qtp file to all the users profile.
----------------------------------------------------------------------
'Created by Piyush Nasa
'Used to copy the config file to the current user\appdata\local directory.
on error resume next
Set oShell = CreateObject( "WScript.Shell" )
userprofile=oShell.ExpandEnvironmentStrings("%USERPROFILE%")
systemdrive=oShell.ExpandEnvironmentStrings("%SYSTEMDRIVE%")
Set fso = CreateObject("Scripting.FileSystemObject")
Set afile = fso.GetFile(systemdrive & "\ProgramData\Apple Computer\QuickTime\QuickTime.qtp")
strDestination1 =userprofile & "\AppData\LocalLow\Apple Computer\QuickTime\QuickTime.qtp"

fso.CreateFolder(userprofile & "\Application Data\LocalLow\Apple Computer")
fso.CreateFolder(userprofile & "\Application Data\LocalLow\Apple Computer\QuickTime")
afile.Copy(strDestination1)
------------------------------------------------------------------------
b) This script will create the registry key for every user.
------------------------------------------------------------------------
'Created by Piyush Nasa
'Used to create HKCU registry to point to qtp file.
Option Explicit
Dim Temp
'HKEY_CURRENT_USER = HKCU
'HKEY_LOCAL_MACHINE = HKLM
'HKEY_CLASSES_ROOT = HKCR
'HKEY_USERS = HKEY_USERS
'HKEY_CURRENT_CONFIG = HKEY_CURRENT_CONFIG
Temp = WriteReg("HKCU\Software\Apple Computer, Inc.\QuickTime\LocalUserPreferences\FolderPath","%userprofile%\AppData\LocalLow\Apple Computer\QuickTime\","REG_SZ")

Function WriteReg(RegPath, Value, RegType)
       'Regtype should be "REG_SZ" for string, "REG_DWORD" for a integer,…
       '"REG_BINARY" for a binary or boolean, and "REG_EXPAND_SZ" for an expandable string
       Dim objRegistry, Key
       Set objRegistry = CreateObject("Wscript.shell")
      Key = objRegistry.RegWrite(RegPath, Value, RegType)
       WriteReg = Key
End Function
---------------------------------------------------------------------------

3) Add any HKCU registry key in a new component placed at the highest parent Feature. Set this as a keypath. This will ensure that the application is self healed when launched by the user.

4) You will have to remove a Launch condition to check if the existing version is installed already, because I faced a problem and it was not uninstalling properly too with that condition being there. Though this step is optional.

Please note that this package works fine when deployed/installed through any deployment tool in System context as it will trigger the self heal. If you have to manually install this application then you need to add the file the LOCALAPPDATAFOLDER manually in your transform.

Hope this will expidite your packaging of Quicktime application.

Re-Packaging Apple iTunes 10.6.1.7 and later

iTunes comes as an EXE file which can be extracted easily with 7Zip. The five MSI I received were AppleApplicationSupport, AppleMobileDeviceSupport64, AppleSoftwareUpdate, Bonjour64 and iTunes64. The Apple Software Update MSI and Bonjour MSI can be discarded if you do not want to AutoUpdate your iTunes. Bonjour can be kept if you want to allow file sharing on your desktop fleet. We did not want this so we removed this MSI. If you want to install Bonjour then it can be installed silently with /qb! switch.

From this Version QuickTime is not part of iTunes. QuickTime can be packaged separately. more details for packaging this is in this post:
http://msiworld.blogspot.com.au/2012/06/re-packaging-apple-quicktime-7728056.html

Apple Application Support and Apple Mobile Device Support MSI can be installed silently with /qb! switch.

You will have to customize iTunes by creating an MST file.

1) Change the following Public Properties in the MST:
DESKTOP_SHORTCUTS = 0
DISABLEADVTSHORTCUTS = 0
SCHEDULE_ASUW = 0
AMDS_IS_INSTALLED = 1
BONJOUR_IS_INSTALLED = 1
REBOOT = ReallySuppress
NO_ASUW = 0
NO_BONJOUR = 0
IAcceptLicense = Yes
REGSRCH_DESKTOP_SHORTCUTS = 0

2) Install iTunes on a test machine and make all the customizations you want. All the customizations will be stored in following files:

a) "%userprofile%\AppData\Local\Apple Computer\iTunes\cache.db
b) "%userprofile%\AppData\Local\Apple Computer\iTunes\iTunesPrefs.xml"
c) "%userprofile%\AppData\Roaming\Apple Computer\iTunes\iTunesPrefs.xml"
d) "%userprofile%\AppData\Roaming\Apple Computer\iTunes\Preferences\com.apple.iTunes.plist"
e) "%userprofile%\AppData\Roaming\Apple Computer\iTunes\Preferences\keychain.plist"

Copy these files in C:\ProgramData\Apple Computer\iTunes\ folder in your MST file and then use the below script to run in Custom Action just before InstallFinalize. Condition to be kept as NOT REMOVE~="ALL"


'Created by Piyush Nasa
'Used to copy the config file to the current user\appdata\local directory.
on error resume next
Set oShell = CreateObject( "WScript.Shell" )
userprofile=oShell.ExpandEnvironmentStrings("%USERPROFILE%")
systemdrive=oShell.ExpandEnvironmentStrings("%SYSTEMDRIVE%")
Set fso = CreateObject("Scripting.FileSystemObject")
Set afile = fso.GetFile(systemdrive & "\ProgramData\Apple iTunes\local\cache.db")
strDestination1 =userprofile & "\AppData\Local\Apple Computer\iTunes\cache.db"
Set bfile = fso.GetFile(systemdrive & "\ProgramData\Apple iTunes\local\iTunesPrefs.xml")
strDestination2 =userprofile & "\AppData\Local\Apple Computer\iTunes\iTunesPrefs.xml"
Set cfile = fso.GetFile(systemdrive & "\ProgramData\Apple iTunes\Roaming\iTunesPrefs.xml")
strDestination3 =userprofile & "\AppData\Roaming\Apple Computer\iTunes\iTunesPrefs.xml"
Set dfile = fso.GetFile(systemdrive & "\ProgramData\Apple iTunes\Roaming\Preferences\com.apple.iTunes.plist")
strDestination4 =userprofile & "\AppData\Roaming\Apple Computer\iTunes\Preferences\com.apple.iTunes.plist"
Set efile = fso.GetFile(systemdrive & "\ProgramData\Apple iTunes\Roaming\Preferences\keychain.plist")
strDestination5 =userprofile & "\AppData\Roaming\Apple Computer\iTunes\Preferences\keychain.plist"

fso.CreateFolder(userprofile & "\AppData\Local\Apple Computer")
fso.CreateFolder(userprofile & "\AppData\Local\Apple Computer\iTunes")
fso.CreateFolder(userprofile & "\AppData\Roaming\Apple Computer")
fso.CreateFolder(userprofile & "\AppData\Roaming\Apple Computer\iTunes")
fso.CreateFolder(userprofile & "\AppData\Roaming\Apple Computer\iTunes\Preferences")
afile.Copy(strDestination1)
bfile.Copy(strDestination2)
cfile.Copy(strDestination3)
dfile.Copy(strDestination4)
efile.Copy(strDestination5)

3) Add any HKCU registry key in a new component placed at the highest parent Feature. Set this as a keypath. This will ensure that the application is self healed when launched by the user.

Please note that this package works fine when deployed/installed through any deployment tool in System context as it will trigger the self heal. If you have to manually install this application then you need to add the file the LOCALAPPDATAFOLDER manually in your transform.

Hope this will expidite your packaging of iTunes application.

Packaging Google Chrome for Enterprise deployment

Many times it is an issue with the Administrators to deploy Google Chrome enterprise wide as there are lots of issues like:

1) Many people would have already installed various other versions of Chrome either through MSI or through exe.
2) How to customize Google chrome for enterprise wide deployment.

*Edited: The new version has a few differences, please see the end of post on how to tackle this.*

First, I would like to mention here that Google Chrome Enterprise version can be downloaded from the following location:
http://www.google.com/intl/en/chrome/business/browser/

This site contains an MSI, which is already customized for business as in there are no desktop/Taskbar shortcuts and the application automatically goes to Program files folder.
If you need to customize this, it is best to capture this MSI as it runs a Setup.exe from within.
I would say that, this MSI is good enough to go like this too so not recommended to waste your time in capturing the MSI unless specifically required.

You can add master_preferences file in the Google\Chrome\Application folder with following contents:

{
"homepage" : "http://msiworld.blogspot.com",
"homepage_is_newtabpage" : false,
"browser" : {
"show_home_button" : true,
 "check_default_browser" : false,
 "window_placement": {
 "bottom": 1000,
 "left": 10,
 "maximized": false,
 "right": 904,
 "top": 10,
 "work_area_bottom": 1010,
 "work_area_left": 0,
 "work_area_right": 1680,
 "work_area_top": 0
 }
 },
 "bookmark_bar" : {
"show_on_all_tabs" : true
},
"distribution" : {
"skip_first_run_ui" : true,
"show_welcome_page" : false,
"import_search_engine" : false,
"import_history" : false,
"create_all_shortcuts" : true,
"do_not_launch_chrome" : true,
"make_chrome_default" : false
}
}

If you add this, change the install sequence of Custom Actions which are already there in the MSI to run before InstallFiles action. That is, move InstallFiles Action after DoInstall. This will make sure your master_preferences file is retained till end.
*Edited
There are are 3 Custom Actions by the name starting from : CallUninstaller
Change their condition to REMOVE="ALL"
This will enable for a clean upgrade else you will face issues while upgrading the application.
*
Uninstall Any Previous Version of Chrome:

To Uninstall any previous version of Chrome, I have written this VBScript which can be run before the installation of your MSI.

'==============================================================
'Lines to get the computer Name
Const HKEY_LOCAL_MACHINE = &H80000002
 Set wshShell = WScript.CreateObject( "WScript.Shell" )
 strComputerName = wshShell.ExpandEnvironmentStrings( "%COMPUTERNAME%" )
 dim folder, MyProperties, arrMyProperties, Exe, Param, oReg, strKeyPath, strValueName

'==============================================================
 'To check whether the OS is 32 bit or 64 bit of Windows 7
'==============================================================
'Lines to detect whether the OS is 32 bit or 64 bit of Windows 7
 Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputerName & "\root\default:StdRegProv")
   strKeyPath = "HARDWARE\DESCRIPTION\System\CentralProcessor\0"
   strValueName = "Identifier"

 oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
'==============================================================
'Checking Condition whether the build is 64bit or 32 bit
   if (instr(strValue,"64")) then
 folder = "C:\Program Files (x86)\Google\Chrome"
 RegVal = ReadReg ("HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\Google Chrome\UninstallString")
 End If
if (instr(strValue,"x86")) then
 folder = "C:\Program Files\Google\Chrome"
 RegVal = ReadReg ("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\Google Chrome\UninstallString")
End If
'==============================================================

MyProperties = RegVal
arrMyProperties = Split(MyProperties, "-")
Exe = arrMyProperties(0)
Param = "--uninstall --multi-install --chrome --system-level --force-uninstall"
'Uninstall Previous version Chrome
'==============================================================
wshShell.run Exe & Param, 1, True
'Delete leftover folder and files from Previous version Chrome
'==============================================================
dim filesys
Set filesys = CreateObject("Scripting.FileSystemObject")
If filesys.FolderExists(folder & "\") Then 
   filesys.DeleteFolder folder
End If
Function ReadReg(RegPath)
      Dim objRegistry, Key
      Set objRegistry = CreateObject("Wscript.shell")
      Key = objRegistry.RegRead(RegPath)
      ReadReg = Key
 End Function


Hope these steps will reduce your efforts in deployment of Chrome.

*
With the New version 26.0.1410.64, Google has changed the install sequence. do the following:

1) In InstallExecuteSequence Table move InstallFiles action after DoInstall Custom Action. This DoInstall Custom Action is actually installing the Google Chrome from an exe. So if the MSI already had copied the master_preferences file, this exe will replace it with its own. If you place the InstallFile Action after DoInstall, then the file which you have added in your package will overwrite the one which Google provides.
2) You might have to write a small script to delete the shortcut from C:\Users\Public\Desktop, if you do not want a desktop shortcut.
Place this CA at the end just before InstallFinalize.

VBScript to Determine 32-bit or 64-bit machine

Often we come across a situation where we need to see the Operating system bit information and then install application or do any customization. Here is a script which I use for this purpose:


'===============================================================

Const HKEY_LOCAL_MACHINE = &H80000002
'Lines to get the computer Name

Set wshShell = WScript.CreateObject( "WScript.Shell" )
strComputerName = wshShell.ExpandEnvironmentStrings( "%COMPUTERNAME%" )

 
'===============================================================
'To check whether the OS is 32 bit or 64 bit of Windows 7
'===============================================================

'Lines to detect whether the OS is 32 bit or 64 bit of Windows 7

Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputerName & "\root\default:StdRegProv")

  strKeyPath = "HARDWARE\DESCRIPTION\System\CentralProcessor\0"

  strValueName = "Identifier"

oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
'===============================================================

'Checking Condition whether the build is 64bit or 32 bit

  if (instr(strValue,"64")) then

'Perform functions for 64-bit OS.
End If

if (instr(strValue,"x86")) then

'Perform functions for 32-bit OS
 End If
'===============================================================

VBScript to determine Root Drive

As per best practices we should not hard code the Root Drive in our package. If your package goes to multiple machines having different Root Drives, then you can use this simple VBScript in your package as Custom Action and it will set the Root Drive automatically for that machine.
This script picks up the Root Drive from where Program Files folder is installed.

Set oshell=CreateObject("Wscript.shell")
prog=oshell.ExpandEnvironmentStrings("%ProgramFiles%")
vletter=Split(prog,":")
dletter=vletter(0) & ":\"
session.property("ROOTDRIVE")=dletter

VBScript to copy file and Powershell Script to copy file

VBScript to copy file:

dim filesys, oShell
Set filesys = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("WScript.Shell")
sup = oShell.ExpandEnvironmentStrings ("%APPDATA%")
des = oShell.ExpandEnvironmentStrings ("%ProgramFiles(x86)%")
destfile= sup & "\AR System\HOME\AR"
sourcefile= des & "\AR System\User\AR"
If filesys.FileExists(sourcefile) Then
   filesys.CopyFile sourcefile, destfile
End If


Powershell Script to copy file:

$SourceFile = "c:\foo\Test.txt"; 
$NewFile    = "c:\foo\Test2.txt"; 
 
# Now - check to see if $Sourcefile exists, and if so, 
# copy it to $newfile  
if ([System.IO.File]::Exists($SourceFile))  { 
   [System.IO.File]::Copy($SourceFile, $NewFile) 
   "Source File ($SourceFile) copied to ($newFile)" 
} 
else { 
"Source file ($Sourcefile) does not exist." 
}

Creating a SendTo Shortcut through MSI

If you want to create a SendTo shortcut through MSI, then if you just add the shortcut in MSI in SendTo folder, it will not work. Even if you get the shortcut there in every user profile, still it will not work. To make a SendTo shortcut, you need to create it on the fly, which means that shortcut should be created from original exe. To solve this issue for one of my application, WinSCP, I wrote the below VBScript and placed it in %ALLUSERPROFILE%\WinSCP folder. Then I created an Active setup to call this VBScript.


Set Shell = CreateObject("WScript.Shell")
ShortcutPath = Shell.SpecialFolders("SendTo")
Set link = Shell.CreateShortcut(ShortcutPath & "\WinSCP (for upload).lnk")
link.Arguments = "/upload"
link.Description = "WinScp"
link.HotKey = ""
link.IconLocation = "C:\Program Files (x86)\WinSCP\WinSCP.exe,0"
link.TargetPath = "C:\Program Files (x86)\WinSCP\WinSCP.exe"
link.WindowStyle = 3
link.WorkingDirectory = "C:\Program Files (x86)\WinSCP"
link.Save


To delete this SendTo shortcut, I wrote another script and added an active setup registry key through CA during Remove sequence to run this script.


dim filesys
Set filesys = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("WScript.Shell")
sup = oShell.ExpandEnvironmentStrings ("%APPDATA%")
WinSCPlnk= sup & "\Microsoft\Windows\SendTo\WinSCP (for upload).lnk"
If filesys.FileExists(WinSCPlnk) Then
filesys.DeleteFile WinSCPlnk
End If


Also remember to make the above component as permanent, because you do not want to delete this vbs file at uninstall of application.

VBScript to Kill a Process

This worked great for me. Just use as function and kill as many processes as you like.

KillProc "abc.exe"
Sub KillProc( myProcess )
    Dim blnRunning, colProcesses, objProcess
    blnRunning = False
    Set colProcesses = GetObject( _
                       "winmgmts:{impersonationLevel=impersonate}" _
                       ).ExecQuery( "Select * From Win32_Process", , 48 )
    For Each objProcess in colProcesses
        If LCase( myProcess ) = LCase( objProcess.Name ) Then
            ' Confirm that the process was actually running
            blnRunning = True
            ' Get exact case for the actual process name
            myProcess  = objProcess.Name
            ' Kill all instances of the process
            objProcess.Terminate()
        End If
    Next
    If blnRunning Then
        Do Until Not blnRunning
            Set colProcesses = GetObject( _
                               "winmgmts:{impersonationLevel=impersonate}" _
                               ).ExecQuery( "Select * From Win32_Process Where Name = '" _
                             & myProcess & "'" )
            WScript.Sleep 100 'Wait for 100 MilliSeconds
            If colProcesses.Count = 0 Then 'If no more processes are running, exit loop
                blnRunning = False
            End If
        Loop
      End If
End Sub

VBScript to enable "Use this connection's DNS Suffix in DNS registration" in IPV4

I have written this below VBScript to enable "Use this connection's DNS Suffix in DNS registration" in IPV4 Advanced Settings.

For Desktop adaptor, this (to enable "Use this connection's DNS Suffix in DNS registration" in IPV4) can be fixed by changing the registry value of HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\services\Tcpip\Parameters\Interfaces\NetworkInterfaceID\RegisterAdapterName to 1

Here NetowrkInterfaceID is a unique ID for every user and this can be obtained from "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\NetworkCards\8\ServiceName" key.

The issue is there can be multiple Network adaptors connected to the machine like Network adaptor for Desktop, Wireless Adaptor, VMware adaptor etc and they all are stored under different hive, like 8, 12, 14 etc. Hence I have written a script which will check for all this and will change the value for all adaptors. If you want for only one particular adaptor, you can modify the script accordingly.

Following VB Functions can be independently picked too:
1) Read Registry
2) Registry Key exists
3) iteration in VBScript (For Loop)
4) Write Registry key.


On Error Resume Next

Dim NetworkInterfaceID, RegKeyValue, Temp

'HKEY_CURRENT_USER = HKCU
 'HKEY_LOCAL_MACHINE = HKLM
 'HKEY_CLASSES_ROOT = HKCR
 'HKEY_USERS = HKEY_USERS
 'HKEY_CURRENT_CONFIG = HKEY_CURRENT_CONFIG
Function KeyExists(key)
    Dim objShell
    On Error Resume Next
    Set objShell = CreateObject("WScript.Shell")
        objShell.RegRead (key)
    Set objShell = Nothing
    If Err = 0 Then KeyExists = True
End Function

For i = 0 to 20
  
RegistryKeyName = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\NetworkCards\" & i & "\"
If KeyExists(RegistryKeyName) Then
Reg= RegistryKeyName + "ServiceName"
NetworkInterfaceID = ReadReg(Reg)
RegKeyValue = "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\services\Tcpip\Parameters\Interfaces\" + NetworkInterfaceID + "\RegisterAdapterName"
WriteReg RegKeyValue, 1 ,"REG_DWORD"
End If
Next
 'WScript.Echo Temp
 Function WriteReg(RegPath, Value, RegType)
       'Regtype should be "REG_SZ" for string, "REG_DWORD" for a integer,…
       '"REG_BINARY" for a binary or boolean, and "REG_EXPAND_SZ" for an expandable string
       Dim objRegistry, Key
       Set objRegistry = CreateObject("Wscript.shell")

      Key = objRegistry.RegWrite(RegPath, Value, RegType)
       WriteReg = Key
 End Function
 Function ReadReg(RegPath)
       Dim objRegistry, Key
       Set objRegistry = CreateObject("Wscript.shell")

      Key = objRegistry.RegRead(RegPath)
       ReadReg = Key
 End Function

VB Script to check for Microsoft Office 2003 and Word 2007

I had written this script to check the presence of MS Office 2003 and Word 2007 on a machine before proceeding for installation. Here is the code:

officepath11= sProgramFilesDir & "\Microsoft Office\Office11\"
officepath12= sProgramFilesDir & "\Microsoft Office\Office12\"

'set File System Object
set fso=createobject("scripting.filesystemobject")

'Check if file exists for Office 2003 and if yes then its version
path11 = fso.GetAbsolutePathName("C:\Program Files (x86)\Microsoft Office\Office11\winword.exe")

if (fso.FileExists(path11)) then
returnstring11=fso.getfileversion(officepath11 & "winword.exe")
else
returnstring11="Null"
end if

'Check if file exists for Word 2007 and if yes then its version
path12 = fso.GetAbsolutePathName("C:\Program Files (x86)\Microsoft Office\Office12\winword.exe")

if (fso.FileExists(path12)) then
returnstring12=fso.getfileversion(officepath12 & "winword.exe")
else
returnstring12="Null"
end if


arr11=split(returnstring11,".")
arr12=split(returnstring12,".")

if (arr11(0)="11" AND arr12(0)="12") then
'msgbox "Office 2003 and word 2007 both are installed, continue with script below"
else
if (arr11(0)="11" AND arr12(0)="Null") then
msgbox "Please install Word 2007 before installing this application"
WScript.Quit
else
if (arr11(0)="Null" AND arr12(0)="12") then
msgbox "Please install Office 2003 before installing this application"
WScript.Quit
else
if (arr11(0)="Null" AND arr12(0)="Null") then
msgbox "Please install Office 2003 and Word 2007 before installing this application"
WScript.Quit
end if
end if
end if
end if

set fso=nothing