How to allow only one instance of an application

Problem/Question/Abstract:

I use Delphi 6 to make an application. Everytime I run the executable, an instance of my application starts up (of course). Is there any way to detect at runtime if another instance of the same application is running and switch control to the original window instead of making a new one?

Answer:

Solve 1:

Include the following unit in your code:

unit MultInst;

interface

const
  MI_QUERYWINDOWHANDLE = 1;
  MI_RESPONDWINDOWHANDLE = 2;
  MI_ERROR_NONE = 0;
  MI_ERROR_FAILSUBCLASS = 1;
  MI_ERROR_CREATINGMUTEX = 2;

  {Call this function to determine if error occurred in startup. Value will be one or
  more of the MI_ERROR_* error flags.}

function GetMIError: Integer;

implementation

uses
  Forms, Windows, SysUtils;

const
  UniqueAppStr = 'DDG.I_am_the_Eggman!';

var
  MessageId: Integer;
  WProc: TFNWndProc;
  MutHandle: THandle;
  MIError: Integer;

function GetMIError: Integer;
begin
  Result := MIError;
end;

function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint): Longint;
  stdcall;
begin
  Result := 0;
  {If this is the registered message...}
  if Msg = MessageID then
  begin
    case wParam of
      MI_QUERYWINDOWHANDLE:
        {A new instance is asking for main window handle in order to focus the
                                main window, so normalize app and send back message with main window handle.}
        begin
          if IsIconic(Application.Handle) then
          begin
            Application.MainForm.WindowState := wsNormal;
            Application.Restore;
          end;
          PostMessage(HWND(lParam), MessageID, MI_RESPONDWINDOWHANDLE,
            Application.MainForm.Handle);
        end;
      MI_RESPONDWINDOWHANDLE:
        {The running instance has returned its main window handle, so we need to
                          focus it and go away.}
        begin
          SetForegroundWindow(HWND(lParam));
          Application.Terminate;
        end;
    end;
  end
    {Otherwise, pass message on to old window procedure}
  else
    Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
end;

procedure SubClassApplication;
begin
  {We subclass Application window procedure so that Application.OnMessage
  remains available for user.}
  WProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC,
    Longint(@NewWndProc)));
  {Set appropriate error flag if error condition occurred}
  if WProc = nil then
    MIError := MIError or MI_ERROR_FAILSUBCLASS;
end;

procedure DoFirstInstance;
{This is called only for the first instance of the application}
begin
  {Create the mutex with the (hopefully) unique string}
  MutHandle := CreateMutex(nil, False, UniqueAppStr);
  if MutHandle = 0 then
    MIError := MIError or MI_ERROR_CREATINGMUTEX;
end;

procedure BroadcastFocusMessage;
{This is called when there is already an instance running.}
var
  BSMRecipients: DWORD;
begin
  {Prevent main form from flashing}
  Application.ShowMainForm := False;
  {Post message to try to establish a dialogue with previous instance}
  BSMRecipients := BSM_APPLICATIONS;
  BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,
    @BSMRecipients, MessageID, MI_QUERYWINDOWHANDLE, Application.Handle);
end;

procedure InitInstance;
begin
  SubClassApplication; {hook application message loop}
  MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr);
  if MutHandle = 0 then
    {Mutex object has not yet been created, meaning that no previous instance
                has been created.}
    DoFirstInstance
  else
    BroadcastFocusMessage;
end;

initialization
  MessageID := RegisterWindowMessage(UniqueAppStr);
  InitInstance;
finalization
  {Restore old application window procedure}
  if WProc <> nil then
    SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(WProc));
  if MutHandle <> 0 then
    CloseHandle(MutHandle); {Free mutex}
end.


Solve 2:

The simplest way to do this is to make the following changes to your dpr where TForm1 is the name of your main form.

program Project1;

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

{$R *.RES}

begin
  if FindWindow('TForm1', nil) <> 0 then
  begin
    SetForegroundWindow(FindWindow('TForm1', nil));
    Exit;
  end;
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.