Just one instance of application
If you want to allow users to run just one instance of application, one of possible methods is to use “mutext” (mutual exclusion).
First of all, we need to edit DPR (project) file of our application. Before we initialize application and create main form, we try to create mutext of specific name. If no error occurs, we can continue to start application. But if “mutext” already exists, it means, that it was created previously by first instance of application. In this case, we just switch to this first instance and stop starting a new one.
The rest of the code is for handling messages and to bring “front” existing instance. Put it in the main form unit. In example below, project file (DPR) code and main form unit code are in the same “file”, but you must put it in the right separate files in your real application.
And don’t forget to add Windows unit to project file (DPR), because CreateMutex function is in this unit.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 |
program Project1; uses Windows, Forms, Unit1 in 'Unit1.pas' {Form1}; {$R *.res} begin CreateMutex(nil, false, 'MyApp'); if GetLastError = ERROR_ALREADY_EXISTS then begin SendMessage(HWND_BROADCAST, RegisterWindowMessage('MyApp'), 0, 0); Halt(0); end; Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end. ////////////////////////////////////////// unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs; type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; OldWindowProc: Pointer; MyMessage: DWord; implementation {$R *.dfm} function NewWindowProc(WindowHandle : hWnd; TheMessage : LongInt; ParamW : LongInt; ParamL : LongInt) : LongInt stdcall; begin if TheMessage = MyMessage then begin SendMessage(Application.Handle, WM_SYSCOMMAND, SC_RESTORE, 0); SetForegroundWindow(Application.Handle); Result := 0; exit; end; Result := CallWindowProc(OldWindowProc, WindowHandle, TheMessage, ParamW, ParamL); end; procedure TForm1.FormCreate(Sender: TObject); begin MyMessage := RegisterWindowMessage('MyApp'); OldWindowProc := Pointer(SetWindowLong(Form1.Handle, GWL_WNDPROC, LongInt(@NewWindowProc))); end; procedure TForm1.FormDestroy(Sender: TObject); begin SetWindowLong(Form1.Handle, GWL_WNDPROC, LongInt(OldWindowProc)); end; end. |