Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

FileWork.LoadFileName(RegWork.RWGetParamStr1);

end

elseResult := CallWindowProc(WProc, Handle, Msg, wParam, lParam);

end;

procedureSubClassApplication;

begin

WProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(@NewWndProc)));

ifWProc = Nil thenMIError := MIError orMI_FAIL_SUBCLASS;

end;

procedureDoFirstInstance;

begin

SubClassApplication;

MutHandle := CreateMutex( Nil, False, UniqueAppStr);

ifMutHandle = 0 thenMIError := MIError orMI_FAIL_CREATE_MUTEX;

end;

procedureBroadcastFocusMessage;

begin

Application.ShowMainForm := False;

PostMessage(HWND_BROADCAST, MessageId, 0, 0);

end;

functionInitInstance : Boolean;

begin

MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr);

ifMutHandle = 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

ifWProc <> Nil thenSetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(WProc));

end;

end.

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

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

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

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

begin

//– Найти предыдущую версию программы

if(initinstance) then begin

…

Application.Initialize;

…

Application.CreateForm( …);

…

Application.Run;

end;

end.

unitTPrevInstUnit;

interface

usesForms, Windows, Dialogs, SysUtils;

functionInitInstance : Boolean;

implementation

const

UniqueAppStr : PChar = #0; // Различное для каждого приложения

// Но одинаковое для каждой копии программы

var

MessageId : Integer;

OldWProc : TFNWndProc = Nil;

MutHandle : THandle = 0;

SecondExecution : Boolean = False;

functionNewWndProc(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;

functionInitInstance : 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 orBSF_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.

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

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

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

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

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

UnitOneInstance32;

interface

implementation

uses

Forms;

var

g_hAppMutex: THandle;

functionOneInstance: boolean;

var

g_hAppCritSecMutex: THandle;

dw: Longint;