Советы по Delphi. Версия 1.4.3 от 1.1.2001

begin
 WProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(@NewWndProc)));
 if WProc = Nil then MIError := MIError or MI_FAIL_SUBCLASS;
end;

procedure DoFirstInstance;
begin
 SubClassApplication;
 MutHandle := CreateMutex(Nil, False, UniqueAppStr);
 if MutHandle = 0 then MIError := MIError or MI_FAIL_CREATE_MUTEX;
end;

procedure BroadcastFocusMessage;
begin
 Application.ShowMainForm := False;
 PostMessage(HWND_BROADCAST, MessageId, 0, 0);
end;

function InitInstance : Boolean;
begin
 MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr);
 if MutHandle = 0 then begin
ShowWindow(Application.Handle, SW_ShowNormal);
 Application.ShowMainForm:=True;
 DoFirstInstance;
 result := True;
 end
 else begin
 RegWork.RWSetParamStr1;
 BroadcastFocusMessage;
 result := False;
 end;
end;

initialization
begin
 UniqueAppStr := PChar(Application.ExeName);
 MessageID := RegisterWindowMessage(UniqueAppStr);
 ShowWindow(Application.Handle, SW_Hide);
 Application.ShowMainForm:=FALSE;
end;

finalization
begin
 if WProc <> Nil then SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(WProc));
end;

end.

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

YoungHacker рекомендует следующий код:

Был взят из кулибы и доработан, поскольку возникали ситуации когда программа, по HotKey назначенным на ярлык, запускалась дважды и более раз. Связано с тем что поиск мутекса и его создание разнесены во времени и пока в одном приложении мутекс не нашелся но еще не создался второе приложение тоже не находит мутекса и инициирует его создание

Поиск окон и создание их нарываются на те-же проблемы. Из RxLib Функция тоже не обходит этой ситуации.

Мой вариант немного дорабатывает уже значительно переработанное то что предоставили разработчики Delphi 2 Пачека (Pacheco) и Тайхайра (Teixeira). и находится в файле TPrevInstUnit. В файле проекта пишется следующий вызов:

begin
 //– Найти предыдущую версию программы
 if (initinstance) then begin
 …
 Application.Initialize;
 …
 Application.CreateForm(…);
 …
 Application.Run;
 end;
end.

Файл TPrevInstUnit

unit TPrevInstUnit;

interface

uses Forms, Windows, Dialogs, SysUtils;

function InitInstance : Boolean;

implementation

const
 UniqueAppStr : PChar = #0; // Различное для каждого приложения
 // Но одинаковое для каждой копии программы
var
 MessageId : Integer;
 OldWProc : TFNWndProc = Nil;
 MutHandle : THandle = 0;
 SecondExecution : Boolean = False;

function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint): Longint; StdCall;
begin
 //- Если это - сообщение о регистрации... }
 if (Msg = MessageID) then begin
//- если основная форма минимизирована
 if IsIconic(Application.Handle) then begin
//- восстанавливаем
 ееApplication.Restore;
 end
 else begin
//- вытаскиваем на перед
 ShowWindow(Application.Handle, SW_SHOW);
 SetForegroundWindow(Application.Handle);
 Application.BringToFront;
 end;
 Result := 0;
 end
 else
{ В противном случае посылаем сообщение предыдущему окну }
 Result := CallWindowProc(OldWProc, Handle, Msg, wParam, lParam);