procedure EnsureSingleInstance;
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(ExtractFileName(Application.ExeName))) <> 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;
No comments:
Post a Comment