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

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;

begin

g_hAppCritSecMutex := CreateMutex( nil, true, PChar(Application.Title + '.OneInstance32.CriticalSection'));

// if GetLastError - лениво писать

g_hAppMutex := CreateMutex( nil, false, PChar(Application.Title + 'OneInstance32.Default'));

dw := WaitForSingleObject(g_hAppMutex, 0);

Result := (dw <> WAIT_TIMEOUT);

ReleaseMutex(g_hAppCritSecMutex); // необязательно вследствие последующего закрытия

CloseHandle(g_hAppCritSecMutex);

end;

initialization

g_hAppMutex := 0;

finalization

ifLongBool(g_hAppMutex) then begin

ReleaseMutex(g_hAppMutex); // необязательно

CloseHandle(g_hAppMutex);

end;

end.

Михаил Чумакрекомендует следующий код:

Есть такая штука Atom (см. Help).

programSelfCheck;

uses

Windows,Forms,Unit1 in'Unit1.pas' {Form1};

const

AtStr='MyProgram';

functionCheckThis : boolean;

var

Atom: THandle;

begin

Atom:= GlobalFindAtom(AtStr);

Result:= Atom <> 0;

if notresult thenGlobalAddAtom(AtStr);

end;

begin

if notCheckThis then begin

// Запуск программмы

Application.Initialize;

Application.CreateForm(TForm1, Form1);

Application.Run;

GlobalDeleteAtom(GlobalFindAtom(AtStr));

// !!!

end

else begin

MessageBox(0,'Нельзя запустить две копии','Моя программа',0);

end;

end.

Элегантно и работает однозначно. Спасибо Славе Шубину.

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

A: Воспользуйтесь функцией ActivatePrevInstance из библиотеки rxLib. Для завершения второго экземпляра используйте Application.Terminate.

(AS): Другой вариант: X:\DELPHI2\DEMOS\IPCDEMOS\ipcthrd.pas, функция IsMonitorRunning().

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

Если не принудительно, то можно послать на его Instance сообщение WM_QUIT. Если же необходимо принудительно терминировать приложение, то смотрите ниже — под Windows NT процесс можно терминировать через специально предназначенный для этого хэндл. Иначе гарантии нет. Предположим, что процесс создаем мы, ожидая его завершения в течение maxworktime. Тогда —