How Can I Prevent Multiple Instances of My Application?

Solution 1

From: "David S. Lee" <davidlee@crl.com>

This is the way I do it:

In the begin..end block of the .dpr:

begin

if HPrevInst <>0 then begin

ActivatePreviousInstance;

Halt;

end;

end;

Here is the unit I use:

unit PrevInst;

interface

uses

WinProcs,

WinTypes,

SysUtils;

type

PHWnd = ^HWnd;

function EnumApps(Wnd: HWnd; TargetWindow: PHWnd): bool; export;

procedure ActivatePreviousInstance;

implementation

function EnumApps(Wnd: HWnd; TargetWindow: PHWnd): bool;

var

ClassName : array[0..30] of char;

begin

Result := true;

if GetWindowWord(Wnd, GWW_HINSTANCE) = HPrevInst then begin

GetClassName(Wnd, ClassName, 30);

if STRIComp(ClassName,'TApplication')=0 then begin

TargetWindow^ := Wnd;

Result := false;

end;

end;

end;

procedure ActivatePreviousInstance;

var

PrevInstWnd: HWnd;

begin

PrevInstWnd := 0;

EnumWindows(@EnumApps,LongInt(@PrevInstWnd));

if PrevInstWnd <> 0 then

if IsIconic(PrevInstWnd) then

ShowWindow(PrevInstWnd,SW_Restore)

else

BringWindowToTop(PrevInstWnd);

end;

end.

Solution 2

From: "The Graphical Gnome" <uddf@gnomehome.demon.nl>

Taken from Delphi 2 Developers Guide by Pacheco and Teixeira with heavy modifications.

Usage: In the Project source change to the following

if InitInstance then

begin

Application.Initialize;

Application.CreateForm(TFrmSelProject, FrmSelProject);

Application.Run;

end;

unit multinst;

{

Taken from Delphi 2 Developers Guide by Pacheco and Teixeira

With heavy Modifications.

Usage:

In the Project source change to the following

if InitInstance then

begin

Application.Initialize;

Application.CreateForm(TFrmSelProject, FrmSelProject);

Application.Run;

end;

That's all folks ( I hope ;()

}

interface

uses Forms, Windows, Dialogs, SysUtils;

const

MI_NO_ERROR = 0;

MI_FAIL_SUBCLASS = 1;

MI_FAIL_CREATE_MUTEX = 2;

{ Query this function to determine if error occurred in startup. }

{ Value will be one or more of the MI_* error flags. }

function GetMIError: Integer;

Function InitInstance : Boolean;

implementation

const

UniqueAppStr : PChar; {Change for every Application}

var

MessageId: Integer;

WProc: TFNWndProc = Nil;

MutHandle: THandle = 0;

MIError: Integer = 0;

function GetMIError: Integer;

begin

Result := MIError;

end;

function NewWndProc(Handle: HWND; Msg: Integer; wParam,

lParam: Longint): Longint; StdCall;

begin

{ If this is the registered message... }

if Msg = MessageID then begin

{ if main form is minimized, normalize it }

{ set focus to application }

if IsIconic(Application.Handle) then begin

Application.MainForm.WindowState := wsNormal;

ShowWindow(Application.Mainform.Handle, sw_restore);

end;

SetForegroundWindow(Application.MainForm.Handle);

end

{ Otherwise, pass message on to old window proc }

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_FAIL_SUBCLASS;

end;

procedure DoFirstInstance;

begin

SubClassApplication;

MutHandle := CreateMutex(Nil, False, UniqueAppStr);

if MutHandle = 0 then

MIError := MIError or MI_FAIL_CREATE_MUTEX;

end;

procedure BroadcastFocusMessage;

{ This is called when there is already an instance running. }

var

BSMRecipients: DWORD;

begin

{ Don't flash main form }

Application.ShowMainForm := False;

{ Post message and inform other instance to focus itself }

BSMRecipients := BSM_APPLICATIONS;

BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,

@BSMRecipients, MessageID, 0, 0);

end;

Function InitInstance : Boolean;

begin

MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr);

if MutHandle = 0 then

begin

{ Mutex object has not yet been created, meaning that no previous }

{ instance has been created. }

ShowWindow(Application.Handle, SW_ShowNormal);

Application.ShowMainForm:=True;

DoFirstInstance;

result := True;

end

else

begin

BroadcastFocusMessage;

result := False;

end;

end;

initialization

begin

UniqueAppStr := Application.Exexname;

MessageID := RegisterWindowMessage(UniqueAppStr);

ShowWindow(Application.Handle, SW_Hide);

Application.ShowMainForm:=FALSE;

end;

finalization

begin

if WProc <> Nil then

{ Restore old window procedure }

SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(WProc));

end;

end.

Solution 3

From: "Jerzy A.Radzimowski" <jerzyara@odn.zgora.pl>

VAR MutexHandle:THandle;

Var UniqueKey : string;

FUNCTION IsNextInstance:BOOLEAN;

BEGIN

Result:=FALSE;

MutexHandle:=0;

MutexHandle:=CREATEMUTEX( NIL,TRUE, UniqueKey);

IF MutexHandle<>0 THEN

BEGIN

IF GetLastError=ERROR_ALREADY_EXISTS THEN

BEGIN

Result:=TRUE;

CLOSEHANDLE(MutexHandle);

MutexHandle:=0;

END;

END;

END;

begin

CmdShow:=SW_HIDE;

MessageId:=RegisterWindowMessage(zAppName);

Application.Initialize;

IF IsNextInstance

THEN

PostMessage(HWND_BROADCAST, MessageId,0,0)

ELSE

BEGIN

Application.ShowMainForm:=FALSE;

Application.CreateForm(TMainForm, MainForm);

MainForm.StartTimer.Enabled:=TRUE;

Application.Run;

END;

IF MutexHandle<>0 THEN CLOSEHANDLE(MutexHandle);

end.

in MainForm you need add code for process private message

PROCEDURE TMainForm.OnAppMessage( VAR M:TMSG; VAR Ret:BOOLEAN );

BEGIN

IF M.Message=MessageId THEN

BEGIN

Ret:=TRUE;

// BringWindowToTop !!!!!!!!

END;

END;

INITIALIZATION

ShowWindow(Application.Handle, SW_Hide);

END.

inny

Prevent multi instances of application

Use FindWindow function to find another window with appropriate class name and caption. Use this code in project source.

if FindWindow('TForm1','QQQ')=0 then

begin

Application.Initialize;

Application.CreateForm(TForm1,Form1);

Application.Run;

end;