Universal Units to Prevent Multiple Instances of Applications - UniqueInstance.pas

{ unit UniqueInstance;/t/t/t/t/t/t/t }

{/t/t/t/t/t/t/t/t/t }

{ Check if previous application instance exists, if yes, the previous/t }

{ instance will be active, and current instance will be terminate./t }

{/t/t/t/t/t/t/t/t/t }

{ written by savetime, http://savetime.delphibbs.com 2004/6/27/t/t }

{/t/t/t/t/t/t/t/t/t }

{ Usage:/t/t/t/t/t/t/t/t }

{ Include this unit to your delphi project, no more job to do./t }

{/t/t/t/t/t/t/t/t/t }

{ Important:/t/t/t/t/t/t/t/t }

{ You must NOT remove the project line: Application.Initialize;/t }

{/t/t/t/t/t/t/t/t/t }

{ Notes:/t/t/t/t/t/t/t/t }

{ This unit identify an application by it''s EXE file name. So, if you want }

{ to specify another unique application name, you must change the value }

{ UniqueApplicationName in CheckPriviousInstance procedure./t/t }

{/t/t/t/t/t/t/t/t/t }

unit UniqueInstance;

interface

uses Classes, SysUtils, Windows, Forms;

implementation

var

UniqueMessageID: UINT;

UniqueMutexHandle: THandle;

PreviousWndProc: TFNWndProc;

NextInitProc: Pointer;

function ApplicationWndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM;

lParam: LPARAM): LResult; stdcall;

begin

// Note: Use "<>" may boost application speed.

if uMsg <> UniqueMessageID then

Result := CallWindowProc(PreviousWndProc, hWnd, uMsg, wParam, lParam)

else begin

if IsIconic(Application.Handle) then Application.Restore;

SetForegroundWindow(Application.Handle);

Result := 0;

end;

end;

procedure BringPreiviousInstanceForeground;

const

BSMRecipients: DWORD = BSM_APPLICATIONS;

begin

BroadcastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,

@BSMRecipients, UniqueMessageID, 0, 0);

Halt;

end;

procedure SubClassApplication;

begin

PreviousWndProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC,

Integer(@ApplicationWndProc)));

end;

procedure CheckPreviousInstance;

var

UniqueApplicationName: PChar;

begin

// Unique application name, default set to EXE file name,

// you can change it to yourself.

UniqueApplicationName := PChar(ExtractFileName(Application.ExeName));

// Register unique message id

UniqueMessageID := RegisterWindowMessage(UniqueApplicationName);

// Create mutex object

UniqueMutexHandle := CreateMutex(nil, False, UniqueApplicationName);

// Create mutex failed, terminate application

if UniqueMutexHandle = 0 then

Halt

// The same named mutex exists, show previous instance

else if GetLastError = ERROR_ALREADY_EXISTS then

BringPreiviousInstanceForeground

// No previous instance, subclass application window

else

SubClassApplication;

// Call next InitProc

if NextInitProc <> nil then TProcedure(NextInitProc);

end;

initialization

// Must use InitProc to check privious instance,

// as the reason of Application hasn''t been created!

NextInitProc := InitProc;

InitProc := @CheckPreviousInstance;

finalization

// Close the mutex handle

if UniqueMutexHandle <> 0 then CloseHandle(UniqueMutexHandle);

end.