1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:

procedure TForm1.FormShow(Sender: TObject);
Var sem: THANDLE;
begin
  Sem := CreateSemaphore(nil, 0, 1, 'Programmname');
  if ((Sem <> 0) and (GetLastError = ERROR_ALREADY_EXISTS)) then
  begin
    CloseHandle(Sem);
    ShowMessage('Programmname is already running.');
    Application.Terminate;
  end;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:

var Sem: THandle;

function IsInstanceExists: Boolean;
begin
  Sem:= CreateSemaphore(nil, 0, 1, 'Programmname');
  result:= (((Sem <> 0) and
           (GetLastError = ERROR_ALREADY_EXISTS) and
           (MessageDlg('Programm bereits gestartet !', mtWarning, [mbIgnore, mbAbort], 0) <> mrIgnore)));
end;


begin

  if not IsInstanceExists then begin
    Application.Initialize;
    Application.CreateForm(TForm1, Form1);
    Application.Run;
  end;

  CloseHandle(Sem);

end.                    

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:

program Name;

uses
  Forms,
  Windows,
  Unit1 in 'Unit1.pas' {TForm1};

{$R *.res}

var
  hWndFirst,
  hWndApp: HWND;
  hMutex: THandle;

begin
  Application.Initialize;
  Application.Title := 'Name';

  // Mehrfachstart unterbinden
  hMutex := CreateMutex(NIL, TRUE, PChar('Name gestartet'));
  if (GetLastError() = ERROR_ALREADY_EXISTS) then begin
    ReleaseMutex(hMutex);
    hWndFirst := FindWindow('TForm1', 'Name');
    if (hWndFirst <> 0) then begin
      hWndApp := GetWindow(hWndFirst, GW_OWNER); // Handle des TApplication-Fensters
      if IsIconic(hWndApp) then
        ShowWindow(hWndApp, SW_RESTORE); // restore, wenn minimiert
      SetForegroundWindow(hWndFirst);
      BringWindowToTop(hWndFirst);
    end;
    Application.Terminate;
    Application.ProcessMessages;
    Exit;
  end;

  Application.CreateForm(TForm1, Form1);
  Application.Run;

  ReleaseMutex(hMutex);
end.