запрет второго такого же процесса

[D_E_N]

Всем привет! Ребят как сделать чтоб приложение запускалось в единственном экземпляре. Я делал проверку имени и пути к файлу но работало не стабильно. что посоветуете?

[Volt]

program Project1;

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

{$R *.res}
Var HM :THandle;

function Check: boolean;
begin
  HM:=OpenMutex(MUTEX_ALL_ACCESS, false, 'Proj');
  Result:=(HM<>0);
  if HM=0 then HM:=CreateMutex(nil, false, 'Proj');
end;

begin
If Check then
begin
  ShowMessage('Извините, но одна из копий программы уже запущена.');
  exit;
end;
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

[artemavd]

Или так:

var
  AtomText: array [0..31] of Char;

procedure LookForPreviousInstance;
var
  PreviousInstanceWindow : hWnd;
  AppName : array[0..30] of char;
  FoundAtom : TAtom;
begin
  // помещаем имя приложения в AtomText
  StrFmt(AtomText, 'OnlyOne%s', [Copy(Application.Title,1,20)]);
  // Проверяем, не создано ли уже атома с таким именем приложения
  FoundAtom := GlobalFindAtom(AtomText);
  if FoundAtom <> 0 then { эта копия приложения уже запущена }
  begin
    StrFmt(AppName,'%s', [Application.Title]);
    // изменяем текущий заголовок, чтобы FindWindow не видела его
    Application.ShowMainForm := false;
    Application.Title := 'destroy me';
    // ищем предыдущую копию приложения
    PreviousInstanceWindow := FindWindow(nil,AppName);
    // Передаём фокус на предыдущую копию приложения
    // завершаем текущую копию
    Application.Terminate;

    if PreviousInstanceWindow <> 0 then
      if IsIconic(PreviousInstanceWindow) then
        ShowWindow(PreviousInstanceWindow,SW_RESTORE)
      else
        SetForegroundWindow(PreviousInstanceWindow);
  end;
  // создаём глобальный атом, чтобы предотвратить
  // запуск другой копии приложения
  FoundAtom := GlobalAddAtom(AtomText);
end;

constructor TForm.Create(AOwner: TComponent);
begin
  inherited;
  LookForPreviousInstance;
end;

destructor TForm.Destroy;
var
  FoundAtom : TAtom;
  ValueReturned : word;
begin
  // не забудьте удалить глобальный атом
  FoundAtom := GlobalFindAtom(AtomText);
  if FoundAtom <> 0 then
    ValueReturned := GlobalDeleteAtom(FoundAtom);
  inherited Destroy;
end;

[D_E_N]

Спасибо, попробую.

[Somebody]

Атомы, насколько помню, не удаляются из таблицы после некорректного убийства процесса. А теперь насчёт первого примера... Нет ReleaseMutex, да и вторую копию можно запустить, пока первая выполняется между OpenMutex и CreateMutex (то же со вторым примером). Проверять наличие признака уже выполняющейся проги и создавать этот признак, каким бы он ни был, надо обязательно одной операцией. Иначе последствия могут быть очень нехорошие.
Примеры похожих ошибок: Состояние гонки
Мой вариант:

{$APPTYPE CONSOLE}
uses
  Windows;
var
  h: THandle;
begin
  h := CreateMutex(nil, false, 'ProgramQwertierIsRunning');
  if h = 0 then
  begin
    MessageBox(0, 'Something''s going wrong', nil, MB_ICONERROR);
    halt(0);
  end;
  if not (WaitForSingleObject(h, 0) in [WAIT_OBJECT_0, WAIT_ABANDONED]) then
  begin
    MessageBox(0, 'The program is already running', nil, MB_ICONERROR);
    halt(0);
  end;
  Write('Hi there!');
  ReadLn;
  ReleaseMutex(h);
end.

WAIT_ABANDONED - если предыдущую копию проги завершили ненормально.