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?

Answer 1

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.

Answer 2

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.

Answer 3

I use this, works in XE2 through to Alexandria, 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]);
  MappingHandle := CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,SizeOf(TInstanceInfo),PChar(MappingName));
  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)

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;