// The project references this unit to prevent multiple instances from appearing at the same time.
Unit multinst;
Interface
Uses Windows, messages, sysutils, classes, forms;
Implementation
Const
Str_unique = '{2be6d96e-827f-4bf9-b33e-8740412cde96 }';
Mi_activeapp = 1; {activate the application}
Mi_gethandle = 2; {retrieve handle}
VaR
Imessageid: integer;
Oldwproc: tfnwndproc;
Muthandle: thandle;
Bsmrecipients: DWORD;
Function newwndproc (handle: hwnd; MSG: integer; wparam, lparam: longint): longint; stdcall;
Begin
Result: = 0;
If MSG = imessageid then
Begin
Case wparam
Mi_activeapp: {activate application}
If lparam <> 0 then
Begin
{Previous instance after receiving the message activation}
{Why is activation in another program ?}
{Because in the same process, setforegroundwindow cannot bring the form to the beginning}
If isiconic (lparam) then
Openicon (lparam)
Else
Setforegroundwindow (lparam );
Application. Terminate; {terminate this instance}
End;
Mi_gethandle: {get the program handle}
Begin
Postmessage (hwnd (lparam), imessageid, mi_activeapp, application. Handle );
End;
End;
End
Else
Result: = callwindowproc (oldwproc, handle, MSG, wparam, lparam );
End;
Procedure initinstance;
Begin
{Replace the message processing of the application}
Oldwproc: = tfnwndproc (setwindowlong (application. Handle, gwl_wndproc, longint (@ newwndproc )));
{Open mutex object}
Muthandle: = openmutex (mutex_all_access, false, str_unique );
If muthandle = 0 then
Begin
{Create a mutex object}
Muthandle: = createmutex (nil, false, str_unique );
End
Else
Begin
Application. showmainform: = false;
{A program instance already exists, and an instance handle is obtained for broadcast messages}
Bsmrecipients: = bsm_applications;
Broadcastsystemmessage (bsf_ignorecurrenttask or bsf_postmessage, @ bsmrecipients, imessageid, mi_gethandle, application. Handle );
End;
End;
Initialization
{Register message}
Imessageid: = registerwindowmessage (str_unique );
Initinstance;
Finalization
{Restore message processing process}
If oldwproc <> nil then
Setwindowlong (application. Handle, gwl_wndproc, longint (oldwproc ));
{Disable mutex objects}
If muthandle <> 0 then
Closehandle (muthandle );
End.