VMware ThinApp Blog

'   ========================================================
'    Script Information
'   
'   Title:               ThinApp Instance Checking Script
'   Author:               Dean Flaming
'   Originally created:   28-Aug-10
'   
'   Description:
'   ============
'   This Script is designed to check for multiple instances
'   of a ThinApp process, even under ThinApp 4.5 and newer,
'   to determine if there is a second instance of a process
'   being started and not allow it to run.
'   
'   This script will work on Entry Points of the same and
'   of different names from their source executables as
'   well as executable data containers and entry points that
'   are not data containers.
'   
'   This Script will ONLY work on ENTRY POINTS and executable
'   DATA CONTAINERS and will not track or limit child launched
'   processes or services.
'   
'   Known Issues:
'   =============
'   This script will not work on a ThinApp package which has
'   multiple entry points where RemoveSandboxOnExit is not
'   enabled.  In the case where multiple entry points are
'   needed, enable RemoveSandboxOnExit=1 in the PACKAGE.INI
'   and disable the OnLastProcessExit code. Additional mods
'   may also be necessary to OnFirstParentExit.
'   ========================================================

' DECLARE VARIABLES
Dim WSHNetwork, WSHShell, objFSO, objShell, objWMIService, strComputer
Dim objProcess, colProcess, colParentProcess, objParentProcess
Dim GCPCurProcName, TSCurProcName, CurProcName, CurProcID, CurParentProcName, CurParentProcID
Dim RecProcID, RecParentProcName, RecParentProcID, RecExplorerProcID, ERRProcRunning, ERRProcName

strComputer = "."

' SET GLOBAL VARIABLES
Set WSHNetwork = CreateObject("WScript.Network")
Set WSHShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

' DEFINE SCRIPT ENVIRONMENT VARIABLES
'Find the Entry Point Process Name
TSOrigin = GetEnvironmentVariable("TS_ORIGIN")
TSLastSlash = InStrRev(TSOrigin, "\")
TSSourcePath = Left(TSOrigin, TSLastSlash)
TSCurProcName = Mid(TSOrigin, TSLastSlash + 1, Len(TSOrigin))

'Find the Current Process Name
GCPOrigin = GetCurrentProcessName
GCPLastSlash = InStrRev(GCPOrigin, "\")
GCPSourcePath = Left(GCPOrigin, GCPLastSlash)
GCPCurProcName = Mid(GCPOrigin, GCPLastSlash + 1, Len(GCPOrigin))

'Find the Sandbox Name and Path
SandboxParent = GetBuildOption("SandboxPath")
SandboxName = GetBuildOption("SandboxName")
If SandboxParent = "." Then
   SandboxPath = SourcePath & SandboxName
Else
   SandboxPath = SandboxParent & Chr(92) & SandboxName
End If


Function OnFirstSandboxOwner
   CheckProcessCount
End Function


Function OnFirstParentStart
   CheckProcessCount
End Function


Function OnFirstParentExit
'   ' -----------------------------------------
'   'Check for IEUSER (on Vista) and
'   'WLLOGINPROXY (on XP) and terminate
'   'processes
'   ' -----------------------------------------
'   Dim strProcessKill
'   strProcessKill = "'ieuser.exe'"
'   Set colProcess = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = " & strProcessKill )
'   For Each objProcess In colProcess
'      objProcess.Terminate()
'   Next
'   strProcessKill = "'wlloginproxy.exe'"
'   Set colProcess = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = " & strProcessKill )
'   For Each objProcess In colProcess
'      objProcess.Terminate()
'   Next
   If ERRProcRunning = "" Then
      'MsgBox "Deleteing registry values for '" & GCPCurProcName & "'",,"Test Message - OnFirstParentExit"
      On Error Resume Next
      WSHShell.RegDelete "HKEY_CURRENT_USER\SOFTWARE\" & SandboxName & "\" & GCPCurProcName & "\" & "RecProcID"
      WSHShell.RegDelete "HKEY_CURRENT_USER\SOFTWARE\" & SandboxName & "\" & GCPCurProcName & "\" & "RecParentProcID"
      WSHShell.RegDelete "HKEY_CURRENT_USER\SOFTWARE\" & SandboxName & "\" & GCPCurProcName & "\" & "RecParentProcName"
      WSHShell.RegDelete "HKEY_CURRENT_USER\SOFTWARE\" & SandboxName & "\" & GCPCurProcName & "\"
      On Error Goto 0
   Else
      'MsgBox "Not removing registry values for '" & ERRProcName & "'",,"Test Message - OnFirstParentExit"
   End If
End Function


Function OnLastProcessExit
   ' -----------------------------------------------------------------------------------------------------------------------------------
   ' Clean up after duplicate process searching if RemoveSandboxOnExit=1 not set in PACKAGE.INI
   ' -----------------------------------------------------------------------------------------------------------------------------------
   'MsgBox "Deleteing registry values for '" & SandboxName & "'",,"Test Message - OnLastProcessExit"
   On Error Resume Next
   WshShell.RegDelete "HKEY_CURRENT_USER\SOFTWARE\" & SandboxName & "\"
   On Error Goto 0
End Function


Function CheckProcessCount
   'Reset Values to Null
   ERRProcRunning = ""
   ERRProcName = ""
   CurProcID = ""
   CurParentProcName = ""
   CurParentProcID = ""
   RecProcID = ""
   RecParentProcName = ""
   RecParentProcID = ""
   RecExplorerProcID = ""
      
   ' -----------------------------------------------------------------------------------------------------------------------------------
   ' Search for all processes with Current Process Name and find process information
   ' -----------------------------------------------------------------------------------------------------------------------------------
   'Find the Current Process based upon the initial Sandbox Owner Entry Point used.
   CurProcName = GCPCurProcName
   Set colProcess = objWMIService.ExecQuery("Select * from Win32_Process Where Name = '" & CurProcName & "'")
   For Each objProcess In colProcess
      CurProcID = objProcess.ProcessId
      CurParentProcID = objProcess.ParentProcessId
   Next
      
   'If the Current Process based upon the actual process name. This is used only if the above process discovery fails.
   If CurProcID = "" Then
      CurProcName = TSCurProcName
      Set colProcess = objWMIService.ExecQuery("Select * from Win32_Process Where Name = '" & CurProcName & "'")
      For Each objProcess In colProcess
         CurProcID = objProcess.ProcessId
         CurParentProcID = objProcess.ParentProcessId
      Next
   End If
   
   ' -----------------------------------------------------------------------------------------------------------------------------------
   ' Search for all processes with Current Parent Process ID
   ' -----------------------------------------------------------------------------------------------------------------------------------
   Set colParentProcess = objWMIService.ExecQuery("Select * from Win32_Process Where ProcessId = " & CurParentProcID)
   For Each objParentProcess In colParentProcess
      CurParentProcName = objParentProcess.Name
   Next
      
   'MsgBox "Current Process Name: " & GCPCurProcName & vbCrLf & "Current Process ID: " & CurProcID & vbCrLf & "Current Parent Process ID: " & CurParentProcID & vbCrLf & "Current Parent Process Name: " & CurParentProcName,, "Test Message - CheckProcessCount"
   
   ' -----------------------------------------------------------------------------------------------------------------------------------
   ' Search for HKCU registry keys to record process information and create it if not found in VOS
   ' -----------------------------------------------------------------------------------------------------------------------------------
   On Error Resume Next
   RecProcID = WSHShell.RegRead("HKEY_CURRENT_USER\SOFTWARE\" & SandboxName & "\" & GCPCurProcName & "\" & "RecProcID")
   On Error Goto 0
   
   If RecProcID = "" Then 'If the registry entry doesn't exist, we can assume this is the first run and record the info.
      WSHShell.RegWrite "HKEY_CURRENT_USER\SOFTWARE\" & SandboxName & "\" & GCPCurProcName & "\" & "RecProcID", CurProcID, "REG_SZ"
      WSHShell.RegWrite "HKEY_CURRENT_USER\SOFTWARE\" & SandboxName & "\" & GCPCurProcName & "\" & "RecParentProcID", CurParentProcID, "REG_SZ"
      WSHShell.RegWrite "HKEY_CURRENT_USER\SOFTWARE\" & SandboxName & "\" & GCPCurProcName & "\" & "RecParentProcName", CurParentProcName, "REG_SZ"
   Else 'If the registry entry does exist, we can assume a second instance and begin comparison of existing Process info with previously recorded Process info.
      RecParentProcID = WSHShell.RegRead("HKEY_CURRENT_USER\SOFTWARE\" & SandboxName & "\" & GCPCurProcName & "\" & "RecParentProcID")
      RecParentProcName = WSHShell.RegRead("HKEY_CURRENT_USER\SOFTWARE\" & SandboxName & "\" & GCPCurProcName & "\" & "RecParentProcName")
      If Abs(Fix(CurProcID)) <> Abs(Fix(RecProcID)) Then 'If the Current Process ID is different from the Recorded Process ID...
         If Not Abs(Fix(CurParentProcID)) = Abs(Fix(RecProcID)) Then 'If the Current Parent Process ID is not the same as the Recorded Process ID...
            '...Warn the user, define error messages, and exit the current process.
            MsgBox "This appears to be a second instance of '" & CurProcName & "'",, "Process Already Running!"
            ERRProcRunning = "Process Running"
            ERRProcName = GCPCurProcName
            ExitProcess 0 'Exit the current process
         End If
      End If
   End If
End Function