Как не допустить запуск второй копии программы 11

Автор: Роман Василенко

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Запуск одной копии приложения (Mutex-базированный)

Единственная функция Init_Mutex этого модуля (only_one.pas) создает мьютекс
с именем, переданным в параметре mid.
Возврат: true, если мьютекс создан (запущен первый экземпляр приложения)
или false, если уже имеется мьютекс с подобным именем (mid).

Особенности:
1. даже при "гибели" приложения все, относящиеся к нему мьютексы удаляются
с большой степенью вероятности.
2. Желательно "отметить" приложение в системе так, как указано в примере.
При таком подходе Ваше приложение почти со стапроцентной вероятностью
не будет запущено два раза.

Зависимости: Windows
Автор:       Роман Василенко, romix@nm.ru, Пятигорск
Copyright:   Роман Василенко
Дата:        14 июня 2002 г.
***************************************************** }

unit Only_One;

interface

function Init_Mutex(mid: string): boolean;

implementation

uses Windows;

var
  mut: thandle;

function mut_id(s: string): string;
var
  f: integer;
begin
  result := s;
  for f := 1 to length(s) do
    if result[f] = '\' then
      result[f] := '_';
end;

function Init_Mutex(mid: string): boolean;
begin
  Mut := CreateMutex(nil, false, pchar(mut_id(mid)));
  Result := not ((Mut = 0) or (GetLastError = ERROR_ALREADY_EXISTS));
end;

initialization
  mut := 0;
finalization
  if mut <> 0 then
    CloseHandle(mut);
end.

Пример использования:

program MyProgram;

uses
  only_one,
  Unit1 in 'Unit1.pas' {Form1},
  Unit2 in 'Unit2.pas' {dm: TDataModule},
  Unit3 in 'Unit3.pas' {Form3},

{$R *.RES}

const
  UniqueString = 'MyProgramMutex';
    {Может быть любое слово. Желательно латинскими буквами.}

  begin
    if not init_mutex(UniqueString) then
      exit; {Выходим до инициализации, если мьютекс уже есть}
    Application.Initialize;
    Application.CreateForm(TForm1, Form1);
    Application.CreateForm(Tdm, dm);
    Application.CreateForm(TForm3, Form3);
    Application.Run;
  end.