Just one instance of application

If want to allow users to run just one instance of application, one of possible methods is to use “mutext” (mutual exclusion).

First of all, we need to edit DPR (project) file of our application. Before we initialize application and create main form, we try to create mutext of specific name. If no error occurs, we can continue to start application. But if “mutext” already exists, it means, that it was created previously by first instance of application. In this case, we just switch to this first instance and stop starting a new one.

The rest of the code is for handling messages and to bring “front” existing instance. Put it in the main form unit. In example below, project file (DPR) code and main form unit code are in the same “file”, but you must put it in the right separate files in your real application.

program Project1;

uses
  Windows,
  Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
  CreateMutex(nil, false, 'MyApp');
  if GetLastError = ERROR_ALREADY_EXISTS then
  begin
    SendMessage(HWND_BROADCAST, RegisterWindowMessage('MyApp'), 0, 0);
    Halt(0);
  end;

  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

//////////////////////////////////////////

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  OldWindowProc: Pointer;
  MyMessage: DWord;

implementation

{$R *.dfm}

function NewWindowProc(WindowHandle : hWnd; TheMessage : LongInt; ParamW : LongInt; ParamL : LongInt) : LongInt stdcall;
begin
if TheMessage = MyMessage then
begin
  SendMessage(Application.Handle, WM_SYSCOMMAND, SC_RESTORE, 0);
  SetForegroundWindow(Application.Handle);
  Result := 0;
  exit;
end;
Result := CallWindowProc(OldWindowProc, WindowHandle, TheMessage, ParamW, ParamL);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MyMessage := RegisterWindowMessage('MyApp');
  OldWindowProc := Pointer(SetWindowLong(Form1.Handle, GWL_WNDPROC, LongInt(@NewWindowProc)));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  SetWindowLong(Form1.Handle, GWL_WNDPROC, LongInt(OldWindowProc));
end;

end.

And don’t forget to add Windows unit to project file (DPR), because CreateMutex function is in this unit.

Leave a Reply