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

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);
end;

function InitInstance : Boolean;
var
 BSMRecipients: DWORD;
begin
 Result := False;
 //- пробуем открыть MUTEX созданный предыдущей копией программы
 MutHandle := CreateMutex(Nil, True, UniqueAppStr);
 //- Мутекс уже был создан ?
 SecondExecution := (GetLastError = ERROR_ALREADY_EXISTS);
 if (MutHandle = 0) then begin
ShowMessage('Ошибка создания Mutex.');
  Exit;
 end;
 if Not (SecondExecution) then begin
//- назначаем новый обработчик сообщений приложения, а старый сохраняем
  OldWProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(@NewWndProc)));
  //- если обработчик не найден устанавливаем ошибку
  if (OldWProc = Nil) then begin
ShowMessage('Ошибка поиска стандартного обработчика сообщений приложения.');
   Exit;
  end;
  //- Установить "нормальный" статус основного окна приложения
  ShowWindow(Application.Handle, SW_ShowNormal);
  //- покажем основную форму приложения
  Application.ShowMainForm := True;
  //- все нормально мама трын тин тин тин тири тын тын
  Result := True;
 end
 else begin
//- установить статус окна приложения "невидимый"
  ShowWindow(Application.Handle, SW_Hide);
  //- Не покажем основную форму приложения
  Application.ShowMainForm := False;
  //- Посылаем другому приложению сообщение и информируем о необходимости
  // перевести фокус на себя
  BSMRecipients := BSM_APPLICATIONS;
  BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE, @BSMRecipients, MessageID, 0, 0);
 end;
end;

initialization
begin
 //- Создать ункальную строку для опознания приложения
 UniqueAppStr := PChar('YoungHackerNetworkDataBaseProgramm');
 //- Зарегистрировать в системе уникальное сообщение
 MessageID := RegisterWindowMessage(UniqueAppStr);
end;

finalization
begin
 if (OldWProc <> Nil) then
{ Приводим приложение в исходное состояние }
  SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(OldWProc));
 end;

end.

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

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

FindWindow является неполным решением (если меняется заголовок окна или если есть другая программа с таким же заголовком или типом окна).

Вторично: Это работает медленно.

Правильно — использовать обьекты синхронизации Win32 API.

Лениво пользовать семафоры, покажу на именованных мутексах (семафоры с двумя состояниями).