How to ensure only a single instance of my application runs?

Question

Is there support in the Delphi XE VCL for ensuring only a single instance of an application is running?

In the past, I've used library code to control a Mutex which has always seemed complicated. As I'm starting a new project in Delphi XE, I wonder if I need to dig up that old code, or if there is support built into XE already? Or is there another easy to apply code that is nice and modern?

Metrorrhagia

What makes you think creating a mutex is not modern? – Dictatorship

I have implemented instancing for the following type which works across multiple user sessions: TEAppSingleInstance = (siYes, siMultipleAcrossUsers, siNo). Yes means a single instance across all users, no means each user can run multiple instances, and multiple across users means each user can run only a single instance for their session, but multiple users can run the application at the same time. – Unequaled

possible duplicate of How can I tell if another instance of my program is already running? – Expansive

Answer 1

I use JCL to do this:

program MyProgram;

uses
  JclAppInst;

begin
  JclAppInstances.CheckSingleInstance; // Added instance checking
  Application.Initialize;
  Application.CreateForm(TMainForm, MainForm);
  Application.Run;
end.

Documentation for this, and the notification scheme, is at the JCL Wiki.

Frederik

+1 for using JCL. Which is tested, and some day, might even be portable to different platforms. – Barncard

Thanks - this has the notification too. Not in the VCL, but the next best thing. – Metrorrhagia

You can call it with custom GUID like so "JclAppInstances('Custom GUID here').CheckSingleInstance;" – Bristling

Answer 2

You create a named Mutex when you start the application. Check GetLastError to see if an other instance is already running.

Put this code right after "begin" in your DPR file. Replace the GUID with one of your own. When I need a text constant that's unlikely to be used for anything else, I usually just hit Ctrl+G to get a GUID!

if CreateMutex(nil, True, '6EACD0BF-F3E0-44D9-91E7-47467B5A2B6A') = 0 then
  RaiseLastOSError;

if GetLastError = ERROR_ALREADY_EXISTS then
  Exit;

It might look like the code is leaking an handle because it's not saving the return of CreateMutex. It's not. Windows will automatically release the handle when our application is terminated, and that's absolutely fine with us.

Sole

yes, but is there any support in Delphi XE for it, or is it still DIY? – Metrorrhagia

You don't need specific Delphi XE support for two lines of Windows API. Make sure you add Windows and SysUtils to the uses clause of your DPR. – Sole

Ok - my old code brings the other instance to the front, but in this case it doesn't actually matter. Will accept with the new edit. – Metrorrhagia

This will create the mutex in the session namespace. A process in a different session (think fast user switching) will be able to start a new process whilst the one in the other session is running. You can use Global\ as a prefix to the name to get a mutex in the global namespace. – Expansive

Good point David. However, maybe this behaviour (session namespace) might be what some developers actually want, even though they haven't thought about that. Imagine you wanted to deploy a rich database client application, that can be run using Windows Terminal Services, you might one one-app-per-desktop instead of one-app-per-machine. – Barncard

Even simpler example: Imagine you implement this for Your Next Big Chat Program; The Wife comes to the computer and actually does "Switch User" (my wife does!) and logs on to her account, attempts to start the Next Big Chat Program. Oooops! Any way, good point David, everyone should read the documentation anyway. – Sole

@HeinduPlessis, two and a half years and no one spotted that, corrected it. Thanks. – Sole

Your solution is simple. I like straight forward solutions one that doesn't involve downloading or installing tools and/or components or using third-party tool(s). This is just what I was looking for. Thanks. – Roderic

+1 for going directly to the VCL and Win API instead of JCL. Nothing wrong with JCL, but why use an external tool when it's not necessary? We used this solution in our shop for many years without issue. As for a differnent user, as you mentioned, generally that's what you want - a different user should get a different session/instance. – Stinger

How do you switch bring to front the previous instance? – Binette

Answer 3

I use this, works in XE2 through to Athens, has the benefit of being able to bring the currently running instance to the front.

Those that say it shouldn't do that, well, given the last thing the user did was to try launch the app, bringing a currently running instance to the front makes sense

unit CheckPrevious;

interface

uses
  Windows, SysUtils, WinSock;

function RestoreIfRunning(const AppHandle : THandle; MaxInstances : integer = 1) : boolean;

implementation

type
  PInstanceInfo = ^TInstanceInfo;
  TInstanceInfo = packed record
    PreviousHandle : THandle;
    RunCounter : integer;
  end;
var
  MappingHandle: THandle;
  InstanceInfo: PInstanceInfo;
  MappingName : string;
  RemoveMe : boolean = True;

function RestoreIfRunning(const AppHandle : THandle; MaxInstances : integer = 1) : boolean;
begin
  Result := True;
  MappingName := StringReplace(ParamStr(0),'\','',[rfReplaceAll, rfIgnoreCase]);
  {$IFDEF WIN64}
  MappingHandle := CreateFileMapping($FFFFFFFFFFFFFFFF,nil,PAGE_READWRITE,0,SizeOf(TInstanceInfo),PChar(MappingName));
  {$ELSE}
  MappingHandle := CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,SizeOf(TInstanceInfo),PChar(MappingName));
  {$ENDIF}
  if MappingHandle = 0 then
    RaiseLastOSError
  else
  begin
    if GetLastError <> ERROR_ALREADY_EXISTS then
    begin
      InstanceInfo := MapViewOfFile(MappingHandle,FILE_MAP_ALL_ACCESS,0,0,SizeOf(TInstanceInfo));
      InstanceInfo^.PreviousHandle := AppHandle;
      InstanceInfo^.RunCounter := 1;
      Result := False;
    end
    else //already runing
    begin
      MappingHandle := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(MappingName));
      if MappingHandle <> 0 then
      begin
        InstanceInfo := MapViewOfFile(MappingHandle,FILE_MAP_ALL_ACCESS,0,0,SizeOf(TInstanceInfo));
        if InstanceInfo^.RunCounter >= MaxInstances then
        begin
          RemoveMe := False;
          if IsIconic(InstanceInfo^.PreviousHandle) then
            ShowWindow(InstanceInfo^.PreviousHandle, SW_RESTORE);
          SetForegroundWindow(InstanceInfo^.PreviousHandle);
        end
        else
        begin
          InstanceInfo^.PreviousHandle := AppHandle;
          InstanceInfo^.RunCounter := 1 + InstanceInfo^.RunCounter;
          Result := False;
        end
      end;
    end;
  end;
end;

initialization

finalization
  //remove one instance
  if RemoveMe then
  begin
    MappingHandle := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(MappingName));
    if MappingHandle <> 0 then
    begin
      InstanceInfo := MapViewOfFile(MappingHandle, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TInstanceInfo));
      InstanceInfo^.RunCounter := -1 + InstanceInfo^.RunCounter;
    end
    else
      RaiseLastOSError;
  end;
  if Assigned(InstanceInfo) then
    UnmapViewOfFile(InstanceInfo);
  if MappingHandle <> 0 then
    CloseHandle(MappingHandle);
end.

In your project DPR, add the CheckPrevious unit to the uses, then just after begin put the following

  if RestoreIfRunning(Application.Handle, 1) then
    Exit;

I have no idea of where this code originated, otherwise I would gladly credit the author. (A search of RestoreIfRunning may suggest it was from Zarko Gajic)

Feudality

This works for me where the JCL code doesn't. Running my app a second time with JclAppInstances.CheckSingleInstance() causes the first instance to terminate without starting the second instance. – Clap

Added 64bit support. I prefer this solution as well as it is simple and just works. – Outwardly

Answer 4

This is how i do it.

closeProc(extractfilename(paramstr(0)));

function TForm1.closeProc(pname : string): integer;
const
PROCESS_TERMINATE = $0001;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
i : integer;
pname2 : string;
begin
try
Result := 0;
i := 0;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
while Integer(ContinueLoop) <> 0 do
    begin
    pname2 := trim(UpperCase(ExtractFileName(FProcessEntry32.szExeFile)));
    if ( pname2 = uppercase(pname)) then
      if FProcessEntry32.th32ProcessID <> GetCurrentProcessId then
        begin
          Result := Integer(TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0), FProcessEntry32.th32ProcessID), 0));
          inc(i);
        end;
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
    if i > 50 then
      break;
    end;
CloseHandle(FSnapshotHandle);
except
end;
end;

Adaiha