unit sema;
interface
uses
Windows, Messages,SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
function BereitsAktiv: Boolean;
IMPLEMENTATION
function BereitsAktiv: Boolean;
var
semName,
appClass: PChar;
hSem : THandle;
hWndMe : HWnd;
appTitle: Array[0..MAX_PATH] of Char;
begin
// Init
Result := FALSE;
GetMem(semName,15);
GetMem(appClass,15);
StrPCopy(semName,'sema');
StrPCopy(appClass,'TApplication');
StrPCopy(appTitle,ExtractFileName(Application.Title));
// Create a Semaphore in memory. If this is the
// first instance, then hSem's value should be 0.
hSem := CreateSemaphore(nil,0,1,semName);
// Check to see if the semaphore exists
if (hSem <> 0) and (GetLastError() =
ERROR_ALREADY_EXISTS) then
begin
CloseHandle(hSem);
// Get the current window's
handle then change
// its title so we can look for the other instance
hWndMe := FindWindow(appClass,appTitle);
SetWindowText(hWndMe,'ZZZZZZZ');
// Search for other instance of this window then bring
// it to the top of the Z-order stack. We find it by
// matching the Application Class and
// Application Title.
hWndMe := FindWindow(appClass,appTitle);
if (hWndMe <> 0) then
begin
BringWindowToTop(hWndMe);
ShowWindow(hWndMe,SW_SHOWNORMAL);
end;
Result := TRUE;
end;
// Destroy PChars
FreeMem(semName,15);
FreeMem(appClass,15);
end;
end.