Советы по 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