Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001
{*******************************************************}
unit multinst;
interface
uses Forms, Windows, Dialogs, SysUtils;
const
MI_NO_ERROR = 0;
MI_FAIL_SUBCLASS = 1;
MI_FAIL_CREATE_MUTEX = 2;
function GetMIError: Integer;
function InitInstance : Boolean;
implementation
uses RegWork, FileWork;
var
UniqueAppStr : PChar;
MessageId: Integer;
WProc: TFNWndProc = Nil;
MutHandle: THandle = 0;
MIError: Integer = 0;
function GetMIError: Integer;
begin
Result := MIError;
end;
function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint): Longint; StdCall;
begin
Result := 1;
if Msg = MessageID then begin
if IsIconic(Application.Handle) then OpenIcon(Application.Handle)
else SetForegroundWindow(Application.Handle);
FileWork.LoadFileName(RegWork.RWGetParamStr1);
end
else Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
end;
procedure SubClassApplication;
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.
Файл TPrevInstUnitunit 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.
Лениво пользовать семафоры, покажу на именованных мутексах (семафоры с двумя состояниями).
Unit OneInstance32;
interface
implementation
uses
Forms;
var
g_hAppMutex: THandle;
function OneInstance: boolean;
var
g_hAppCritSecMutex: THandle;
dw: Longint;
