unit OneInst;
interface
{ Make a call to this procedure in your project source
immediately before the first call to CreateForm.
That should ensure it is after the Application.Title
assignment that can muck up the logic.
If you haven't set an application title yet, then
do so to ensure this works }
procedure EnsureSingleInstance (MyGUID :
string) ;
implementation
uses
WinTypes, WinProcs, Forms, SysUtils, Messages;
procedure EnsureSingleInstance (MyGUID :
string) ;
var
Wnd: HWnd;
WndClass, WndText:
array[0..255]
of char;
begin
{$ifdef Win32}
{ Try and create a semaphore. If we succeed, then check }
{ if the semaphore was already present. If it was }
{ then a previous instance is floating around. }
{ Note the OS will free the returned semaphore handle }
{ when the app shuts so we can forget about it }
if (CreateSemaphore(
nil, 0, 1,
PChar(MyGUID)) <> 0)
and
(GetLastError = Error_Already_Exists)
then
{$else}
if HPrevInst <> 0
then
{$endif}
begin
Wnd := GetWindow(Application.Handle, gw_HWndFirst);
while Wnd <> 0
do
begin
{ Look for the other TApplication window out there }
if Wnd <> Application.Handle
then
begin
{ Check it's definitely got the same class and caption }
GetClassName(Wnd, WndClass, Pred(SizeOf(WndClass)));
GetWindowText(Wnd, WndText, Succ(Length(Application.Title)));
if (StrPas(WndClass) = Application.ClassName)
and
(StrPas(WndText) = Application.Title)
then
begin
{ This technique is used by the VCL: post }
{ a message then bring the window to the }
{ top, before the message gets processed }
PostMessage(Wnd, wm_SysCommand, sc_Restore, 0);
{$ifdef Win32}
SetForegroundWindow(Wnd);
{$else}
BringWindowToTop(Wnd);
{$endif}
Halt
end
end;
Wnd := GetWindow(Wnd, gw_HWndNext)
end
end
end;
end.