Clean Up the Windows Start Menu

Sometimes after an install or an uninstall we want to clean up the start menu – usually this involves removing shortcuts to uninstall the application, shortcuts that link to help files and/or shortcuts that attempt to install additional components.  This tidy script (tested on Windows 7) can be used to populate file(s) and folder(s) names that require deleting.

Option Explicit

dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject") 
dim objShell : Set objShell = CreateObject("WScript.Shell") 

dim strProgramsPath : strProgramsPath = objShell.ExpandEnvironmentStrings("%AllUsersProfile%") & "\Microsoft\Windows\Start Menu\Programs"

'delete an array of files (shortcuts) from the start menu
dim arrFilesToDelete : arrFilesToDelete = Array( _
	strProgramsPath & "\Folder1\Link1.lnk", _
	strProgramsPath & "\Folder1\Link2.lnk", _
	strProgramsPath & "\Folder2\Link3.lnk", _
	strProgramsPath & "\Folder2\Link4.lnk" _
	)

dim strFile
For Each strFile In arrFilesToDelete
	If objFSO.FileExists(strFile) Then objFSO.DeleteFile strFile, True
Next

'delete an array of folders from the Start Menu
dim arrFoldersToDelete : arrFoldersToDelete = Array( _
	strProgramsPath & "\Folder1", _
	strProgramsPath & "\Folder2" _
	)

dim strFolder
For Each strFolder In arrFoldersToDelete
	If objFSO.FolderExists(strFolder) Then objFSO.DeleteFolder strFolder, True
Next

Set objFSO = Nothing
Set objShell = Nothing

 

Access a Windows Installer property in a Deferred Custom Action

Description:

This post describes how to access a Windows Installer property in a Deferred Custom Action.  Deferred, commit, and rollback custom actions can only access a limited number of built-in Windows Installer properties – CustomActionData, ProductCode, and UserSID.  In brief (since this has been discussed plenty of times before elsewhere) this is due to them being executed in a separate process (they spawn another MSIEXEC.exe process which is run in a System Account context – check Task Manager during an installation to see this).  To pass any Windows Installer property to a deferred Custom Action, we must pass it via the CustomActionData property.  In this example, we’ll pass the ProductName property during the installation of our product.

Step 1
Create a property. Call it ‘AlkaneCustomProperty’ and give it a default value of anything (we’re going to set this to our directory name in Step 2….).

Step 2
Create a SetProperty custom action (Type 51), call it ‘setAlkaneCustomProperty’, select your ‘AlkaneCustomProperty’ property, and under property value write ‘[ProductName]’. Execute this action as Immediate, before InstallInitialize with a condition of ‘NOT Installed’.

Step 3
Create another CA – this time a ‘Call VBScript from Embedded code’ (Type 38). It is IMPORTANT you call this the same name as your property you made earlier, so call it ‘AlkaneCustomProperty’. In your script, to retrieve the directory name use:

Dim ProductName : ProductName = Session.Property("CustomActionData")
MsgBox ProductName

Schedule this CA as ‘Deferred in a System Context’ and put it anywhere between the standard actions ‘InstallInitialize’ and ‘InstallFinalize’.  Use a condition of ‘NOT Installed’.

Use VBScript to amend the the Hosts/Services or any other text file

Description:

This post shows how to use VBScript to amend the the Hosts/Services or any other text file.  It contains two scripts to add/remove lines of text.  This example adds to the C:\Windows\System32\drivers\etc\Services file.

Source:

N/A

Script:

Add to Services file

dim objFSO : set objFSO = CreateObject("Scripting.FileSystemObject")
dim windowsFolder: windowsFolder = objFSO.GetSpecialFolder(0)
dim targetFile : targetFile = windowsFolder & "\System32\drivers\etc\Services"
Dim arrobjFileLines()
dim i : i = 0
Const ForAppending = 8
Const ForReading = 1

if objFSO.FileExists(targetFile) Then

	Dim objFile : Set objFile = objFSO.OpenTextFile(targetFile, ForReading)
	strobjFile = objFile.ReadAll
	objFile.Close
	Set objFile = Nothing

	Set objFile = objFSO.OpenTextFile(targetFile, ForAppending)
	if right(strobjFile,2) <> VbCrlf then
		objFile.WriteBlankLines 1
	end if

	objFile.WriteLine "alkaneTest1 3601/tcp"
	objFile.WriteLine "alkaneTest2 3602/tcp"
	objFile.WriteLine "alkaneTest3 3603/tcp"
	
	objFile.close
	Set objFile = Nothing
	
end if

Set objFSO = Nothing

Remove from Services file

dim objFSO : set objFSO = CreateObject("Scripting.FileSystemObject")
dim windowsFolder: windowsFolder = objFSO.GetSpecialFolder(0)
dim filename: filename = windowsFolder & "\System32\drivers\etc\Services"
Const ForReading = 1
Const ForWriting = 2

if objFSO.FileExists(filename) Then
	
	Set objFile = objFSO.OpenTextFile(filename, ForReading)
	
	Do Until objFile.AtEndOfStream
	    strLine = objFile.ReadLine
	    If strLine <> "alkaneTest1 3601/tcp" _
		AND strLine <> "alkaneTest2 3602/tcp" _
		AND strLine <> "alkaneTest3 3603/tcp" Then
	        strNewContents = strNewContents & strLine & vbCrLf
		End If		
	Loop
	
	objFile.Close
	Set objFile = Nothing
	
	Set objFile = objFSO.OpenTextFile(filename, ForWriting)
	objFile.Write strNewContents
	objFile.Close
	Set objFile = Nothing
	
end if

Set objFSO = Nothing

 

Create a Nested Folder Structure using VBScript

Description:

The Filesystem Object cannot create a nested folder structure in a single invocation of the CreateFolder method.  For example, if we tried executing the following code it would return a ‘Path Not Found’ error unless c:\alkanesolutions\ already exists:

objFSO.CreateFolder “c:\alkanesolutions\test\”

The function below resolves this limitation.

Source:

Technet Forums

Script:

Dim FullPath : FullPath = "c:\alkanesolutions\test\folder"
Dim objFSO : Set objFSO = CreateObject("Scripting.FilesystemObject")

BuildFullPath FullPath

Sub BuildFullPath(ByVal FullPath)
  If Not objFSO.FolderExists(FullPath) Then
    BuildFullPath objFSO.GetParentFolderName(FullPath)
    objFSO.CreateFolder FullPath
  End If
End Sub

 

 

Extract an EXE from the binary table and run it from a VBScript Custom Action

Somebody over at ITNinja recently asked how they could run an executable stored in the binary table, from a VBScript Custom Action. Here’s an example I knocked up which describes how to extract an EXE from the binary table and run it from a VBScript Custom Action. I basically streamed notepad.exe into the binary table, and gave it a name of ‘notepad’.  In this Custom Action, I extract it to the %temp% folder and run it from there.  Note that there is no cleanup of the extraction afterwards.  Also note that because this uses the Session object, it can only be executed in the Immediate context.  So more consideration would be required (and probably a separate Custom Action) to execute the extracted EXE in a deferred context.

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

Dim tempFolder : tempFolder = oFSO.GetSpecialFolder(2) 
Dim outputFile : outputFile = tempFolder & "\notepad.exe"

extractFromBinary "notepad", outputFile

If oFSO.fileExists(outputFile) Then 
    Dim objShell : Set objShell = CreateObject("WScript.Shell") 
    objShell.Run (outputFile) 
    Set objShell = Nothing
End If

Function extractFromBinary(ByVal binaryName, ByVal binaryOutputFile)

    Const msiReadStreamInteger = 0 
    Const msiReadStreamBytes = 1 
    Const msiReadStreamAnsi = 2  
    Const msiReadStreamDirect = 3

    Dim binaryView : Set binaryView = Session.Database.OpenView("SELECT * FROM Binary WHERE Name = '" & binaryName & "'")  
    binaryView.Execute

    Dim binaryRecord : Set binaryRecord = binaryView.Fetch  
    Dim binaryData : binaryData = binaryRecord.ReadStream(2, binaryRecord.DataSize(2), msiReadStreamAnsi)  
    Set binaryRecord = Nothing  
    Dim binaryStream : Set binaryStream = oFSO.CreateTextFile(binaryOutputFile, True)  
    binaryStream.Write binaryData  
    binaryStream.Close 
    Set binaryStream = Nothing
  
End Function

Set oFSO = Nothing

Below is an updated version that extracts from the binary table using msiReadStreamDirect (as a binary string), converts the string to binary and outputs it using ADODB.Stream.  It may resolve locale-specific issues with the aforementioned approach.

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

Dim tempFolder : tempFolder = oFSO.GetSpecialFolder(2) 
Dim outputFile : outputFile = tempFolder & "\notepad.exe"

extractFromBinary "notepad", outputFile

If oFSO.fileExists(outputFile) Then 
    Dim objShell : Set objShell = CreateObject("WScript.Shell") 
    objShell.Run (outputFile) 
    Set objShell = Nothing
End If

Function MultiByteToBinary(MultiByte)
  'obtained from http://www.motobit.com
  'MultiByteToBinary converts multibyte string To real binary data (VT_UI1 | VT_ARRAY)
  'Using recordset
  Dim RS, LMultiByte, Binary
  Const adLongVarBinary = 205
  Set RS = CreateObject("ADODB.Recordset")
  LMultiByte = LenB(MultiByte)
  If LMultiByte>0 Then
    RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte
    RS.Open
    RS.AddNew
      RS("mBinary").AppendChunk MultiByte & ChrB(0)
    RS.Update
    Binary = RS("mBinary").GetChunk(LMultiByte)
  End If
  Set RS = Nothing
  MultiByteToBinary = Binary
End Function

Function SaveBinaryData(FileName, ByteArray)
  Const adTypeBinary = 1
  Const adSaveCreateOverWrite = 2
  
  'Create Stream object
  Dim BinaryStream
  Set BinaryStream = CreateObject("ADODB.Stream")
  
  'Specify stream type - we want To save binary data.
  BinaryStream.Type = adTypeBinary
  
  'Open the stream And write binary data To the object
  BinaryStream.Open
  BinaryStream.Write ByteArray
  
  'Save binary data To disk
  BinaryStream.SaveToFile FileName, adSaveCreateOverWrite

  Set BinaryStream = Nothing
End Function

Function extractFromBinary(ByVal binaryName, ByVal binaryOutputFile)

    Const msiReadStreamInteger = 0 
    Const msiReadStreamBytes = 1 
    Const msiReadStreamAnsi = 2  
    Const msiReadStreamDirect = 3

    Dim binaryView : Set binaryView = Session.Database.OpenView("SELECT * FROM Binary WHERE Name = '" & binaryName & "'")  
    binaryView.Execute

    Dim binaryRecord : Set binaryRecord = binaryView.Fetch  
    Dim binaryData : binaryData = binaryRecord.ReadStream(2, binaryRecord.DataSize(2), msiReadStreamDirect)  
    Set binaryRecord = Nothing  
    
    'convert to string of byte pairs to binary
    binaryData = MultiByteToBinary(binaryData)
    
    'save binary data
    SaveBinaryData binaryOutputFile, binaryData

End Function

Set oFSO = Nothing

Finally, i verified the file imported into the Binary table against the file extracted from the Binary table using this simple command line:
fc.exe /b [full_path_file_1] [full_path_file_2]

Alternatives to using WScript.Sleep in a Custom Action

Description:

Sometimes in our Custom Actions we need to pause the script execution, for example when we’re manipulating processes. Since we can’t use Wscript.Sleep from a Custom Action we need another way of pausing the execution of a script. Here I present two alternatives to using WScript.Sleep in a Custom Action.

Source:

NA

Script 1:

Msgbox "start" 
sleep1 5 
MsgBox "stop" 

Sub sleep1(strSeconds) 
       	Dim dteWait : dteWait = DateAdd("s", strSeconds, Now()) 
       	Do Until (Now() > dteWait) 
       	Loop 
End Sub

Script 2:

Msgbox "start"
sleep2 5
MsgBox "stop"

Sub sleep2(strSeconds)    
       	Dim objShell : set objShell = CreateObject("wscript.Shell")
    	objShell.Run "%COMSPEC% /c ping -n " & strSeconds & " 127.0.0.1>nul",0,1 
	set objShell = Nothing
End Sub

Kill One or Many Processes

Description:

Useful when we want to terminate processes during uninstall.  Sometimes when processes are still running during uninstall it may cause the uninstall to fail or not remove all files. This script is an example of how to kill one or many processes.

Source:

NA

Script:

Using Windows Management Instrumentation:

Dim process, processArray, objWMIService, sQuery, objProcess, objProcessList

'Add one or many processes to this array
processArray = Array("process1.exe", "process2.exe", "process3.exe")

For Each process In processArray    

	set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
	sQuery="select * from win32_process where name='" & process & "'"
	set objProcessList = objWMIService.execquery(sQuery)

	Do While objProcessList.count > 0
		For Each objProcess in objProcessList
			If IsObject(objProcess) Then
				objProcess.Terminate()
			End If
		Next

		set objWMIService =getobject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
		sQuery="select * from win32_process where name='" & process & "'"
		set objProcessList = objWMIService.execquery(sQuery)		
	Loop

Next

set objWMIService= nothing
set objProcessList =nothing

 

Or using Windows Script Host:

dim WshShell : Set WshShell = CreateObject("WScript.Shell")

'Add one or many processes to this array
dim processArray  : processArray = Array("notepad.exe", "iexplore.exe")
dim process
 
For Each process In processArray  
	WshShell.Run "TASKKILL /im " & chr(34) & process & chr(34) &  " /f /t", 0, true
Next
 
Set WshShell = Nothing

 

Check if a Folder is Empty (contains no files and no subfolders)

Description:

Useful when we want to delete folders which have been left behind after uninstall, but we first need to check that the folder is actually empty!! An example may be a folder named as the vendor (E.g, ‘Adobe’), where other products could also be installed into the same folder (E.g, Acrobat Reader, Acrobat Standard, Creative Suite etc). This script will check if a folder is empty (contains no files and no subfolders) and delete it if so.

Source:

www.winfrastructure.net

Script:

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

Dim folderToDelete : folderToDelete = "C:\FolderName\"

If objFSO.FolderExists(folderToDelete) Then

	Dim objFolder : Set objFolder = objFSO.GetFolder(folderToDelete)

	If objFolder.Files.Count = 0 And objFolder.SubFolders.Count = 0 Then
		objFolder.Delete(true)
	End If

End If

Set objFSO = Nothing

 

Delete a Registry Key and its Subkeys

Description:

Useful when we want to delete registry which has been left behind post uninstall.

Source:

technet.microsoft.com

Script:

Option Explicit

Dim intHive
Dim strComputer
Dim strKeyPath
Dim strSubkey 
Dim arrSubkeys

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 = "."
strKeyPath = "Software\Test" 

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

DeleteSubkeys HKEY_LOCAL_MACHINE, strKeypath 

Set objRegistry  = Nothing

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

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

    objRegistry.DeleteKey HKEY_HIVE, strKeyPath 
End Sub