Mega Code Archive
How to ensure only one instance of application runs at once
<![CDATA[
Title: How to ensure only one instance of application runs at once?
This is the final of several incarnations. I can not take credit for all the code. It once had more comments than code and in an overzealous clean-up, all the credits were removed. I will search my archives and edit later to give credit where it is due.
First the unit, followed by how it is used:
CODE
unit PrevInst;
interface
Uses
Windows, SysUtils, Messages;
function ActivatePrevInstance(const MainFormClass, ATitle: string): Boolean;
(*
Usage:
if ActivatePrevInstance(TMainForm.ClassName, '') then
Exit;
*)
implementation
function StrPAlloc(const S: string): PChar;
begin
Result := StrPCopy(StrAlloc(Length(S) + 1), S);
end;
function GetWindowParent(Wnd: HWND): HWND;
begin
Result := GetWindowLong(Wnd, GWL_HWNDPARENT);
end;
function WindowClassName(Wnd: HWND): string;
var Buffer: array [0..255] of Char;
begin
SetString(Result, Buffer, GetClassName(Wnd, Buffer, SizeOf(Buffer) - 1));
end;
function WindowsEnum(Handle: HWND; Param: Longint): BOOL; export; stdcall;
begin
if WindowClassName(Handle) = 'TAppBuilder' then
begin
Result := False;
PLongint(Param)^ := 1;
end
else
Result := True;
end;
procedure ActivateWindow(Wnd: HWND);
begin
if Wnd 0 then
begin
ShowWindow(Wnd, SW_SHOWNOACTIVATE); //ShowWinNoAnimate(Wnd, SW_SHOW);
SetForegroundWindow(Wnd);
end;
end;
function FindPrevInstance(const MainFormClass, ATitle: string): HWnd;
var
BufClass, BufTitle: PChar;
begin
Result := 0;
if (MainFormClass = '') and (ATitle = '') then Exit;
BufClass := nil; BufTitle := nil;
if (MainFormClass '') then
BufClass := StrPAlloc(MainFormClass);
if (ATitle '') then
BufTitle := StrPAlloc(ATitle);
try
Result := FindWindow(BufClass, BufTitle);
finally
StrDispose(BufTitle);
StrDispose(BufClass);
end;
end; //FindPrevInstance
function ActivatePrevInstance(const MainFormClass, ATitle: string): Boolean;
var
PrevWnd, PopupWnd, ParentWnd: HWnd;
IsDelphi: Longint;
begin
Result := False;
PrevWnd := FindPrevInstance(MainFormClass, ATitle);
if PrevWnd 0 then begin
ParentWnd := GetWindowParent(PrevWnd);
while (ParentWnd GetDesktopWindow) and (ParentWnd 0) do begin
PrevWnd := ParentWnd;
ParentWnd := GetWindowParent(PrevWnd);
end;
if WindowClassName(PrevWnd) = 'TApplication' then begin
IsDelphi := 0;
EnumThreadWindows(GetWindowTask(PrevWnd), @WindowsEnum, LPARAM(@IsDelphi));
if Boolean(IsDelphi) then
Exit;
if IsIconic(PrevWnd) then { application is minimized }
begin
SendMessage(PrevWnd, WM_SYSCOMMAND, SC_RESTORE, 0);
Result := True;
Exit;
end
else
ShowWindow(PrevWnd, SW_SHOWNOACTIVATE); {ShowWinNoAnimate(PrevWnd, SW_SHOWNOACTIVATE);}
end
else
ActivateWindow(PrevWnd);
PopupWnd := GetLastActivePopup(PrevWnd);
if (PrevWnd PopupWnd) and IsWindowVisible(PopupWnd) and IsWindowEnabled(PopupWnd) then
SetForegroundWindow(PopupWnd)
else
ActivateWindow(PopupWnd);
Result := True;
end;
end; //ActivatePrevInstance
end.
The following DPR (project1.exe) will only launch once outside the IDE:
IMPORTANT NOTE: This function works ONLY if the Delphi IDE is NOT running. There is a line of code in ActivatePrevInstance "if Boolean(IsDelphi) then exit;" to allow debugging. It returns "false" if the IDE is running.
CODE
program Project1;
uses
Forms,
Unit1 in 'Unit1.pas' {Form1},
PrevInst in 'PrevInst.pas';
{$R *.res}
begin
if ActivatePrevInstance(TForm1.ClassName, '') then
Exit;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
]]>