var
PID: ULONG;
// Process-ID von 1. Instanz
HPipe: THandle = INVALID_HANDLE_VALUE;
// wird für Server (= 1. Instanz, CreateNamedPipe) und für Client (= 2. Instanz, CreateFile) verwendet
function GetNamedPipeServerProcessId(hNamedPipe: THandle;
out ServerProcessId: ULONG): BOOL;
stdcall;
external kernel32
name '
GetNamedPipeServerProcessId';
function EnumWindowsProcCallback(HWnd: THandle; PID: LPARAM): BOOL;
stdcall;
var
WinPID: DWORD;
begin
GetWindowThreadProcessId(HWnd, WinPID);
Result := WinPID <> (PULONG(PID))^;
if not Result
then
SetForegroundWindow(HWnd);
end;
initialization
HPipe := CreateNamedPipe(PipeName,
PIPE_ACCESS_OUTBOUND
or FILE_FLAG_FIRST_PIPE_INSTANCE,
PIPE_TYPE_BYTE
or PIPE_READMODE_BYTE
or PIPE_WAIT, 1, 4, 4, 0,
nil);
// erste Pipe-Instanz erstellen
if HPipe = INVALID_HANDLE_VALUE
then
begin // wenn Pipe bereits besteht
HPipe := CreateFile(PipeName, GENERIC_READ, 0,
nil, OPEN_EXISTING, 0, 0);
// auf Pipe verbinden
if HPipe <> INVALID_HANDLE_VALUE
then
begin
if GetNamedPipeServerProcessId(HPipe, PID)
then // Prozess-ID des Pipe-Servers erfragen (= 1. Instanz)
EnumWindows(@EnumWindowsProcCallback, LPARAM(@PID));
// Fenster durchforsten
end;
// wenn Verbindung zur Pipe erfolgreich, Meldung anzeigen -> aktuelle Instanz ist die 2.
// wenn Verbindung zur Pipe nicht erfolgreich, dann Meldung anzeigen wenn GetLastError <> ERROR_PIPE_BUSY -> keine Meldung für die 3. Instanz, die gleichzeitig geöffnet ist
if (HPipe <> INVALID_HANDLE_VALUE)
or (GetLastError <> ERROR_PIPE_BUSY)
then
MessageBox(0, '
Das Programm läuft bereits', '
',
MB_SYSTEMMODAL
or MB_SETFOREGROUND
or MB_TOPMOST);
Halt;
end;
finalization
// Pipe-Handle freigeben - Server und Client
if (HPipe <> INVALID_HANDLE_VALUE)
and CloseHandle(HPipe)
then
HPipe := INVALID_HANDLE_VALUE;
// Falls es sich um Client/2. Instanz handelt, dann ist die Pipe trotzdem weiterhin besetzt (weitere/spätere Verbindungsversuche verursachen ERROR_PIPE_BUSY) - Warum? #####
end.