Советы по Delphi. Версия 1.4.3 от 1.1.2001 - страница 11
>
> 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;
>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
> if LongBool(g_hAppMutex) then begin
> ReleaseMutex(g_hAppMutex); // необязательно
> CloseHandle(g_hAppMutex);
> end;
>end.
Как не допустить запуск второй копии программы XI
Михаил Чумак рекомендует следующий код:
Есть такая штука Atom (см. Help).
>program SelfCheck;
>uses
> Windows,Forms,Unit1 in 'Unit1.pas' {Form1};
>const
> AtStr='MyProgram';
>function CheckThis : boolean;
>var
> Atom: THandle;
>begin
> Atom:= GlobalFindAtom(AtStr);
> Result:= Atom <> 0;
> if not result then GlobalAddAtom(AtStr);
>end;
>begin
> if not CheckThis then begin
> // Запуск программмы
> Application.Initialize;
> Application.CreateForm(TForm1, Form1);
> Application.Run;
> GlobalDeleteAtom(GlobalFindAtom(AtStr));
> // !!!
> end
> else begin
>MessageBox(0,'Нельзя запустить две копии','Моя программа',0);
> end;
>end.
Элегантно и работает однозначно. Спасибо Славе Шубину.
Как не допустить запуск второй копии программы XII
Nomadic рекомендует следующее:
A: Воспользуйтесь функцией ActivatePrevInstance из библиотеки rxLib. Для завершения второго экземпляра используйте Application.Terminate.
(AS): Другой вариант: X:\DELPHI2\DEMOS\IPCDEMOS\ipcthrd.pas, функция IsMonitorRunning().
Как правильно завершить некое приложение?
Nomadic рекомендует следующий код:
Если не принудительно, то можно послать на его Instance сообщение WM_QUIT. Если же необходимо принудительно терминировать приложение, то смотрите ниже — под Windows NT процесс можно терминировать через специально предназначенный для этого хэндл. Иначе гарантии нет. Предположим, что процесс создаем мы, ожидая его завершения в течение maxworktime. Тогда —
>var
> dwResult: Longint; // This example was converted from C source.
>begin
>// Not tested. Some 'nil' assignments must be applied
> // as zero assignments in Pascal. Some vars need to
> // be declared (maxworktime, si, pi). AA.
> if CreateProcess(nil, CmdStr, nil, nil, FALSE,CREATE_NEW_CONSOLE, nil, nil, si, pi) then begin
> CloseHandle(pi.hThread);
> dwResult := WaitForSingleObject(pi.hProcess, maxworktime*1000*60);
> CloseHandle(pi.hProcess);
> if dwResult <> WAIT_OBJECT_0 then begin
> pi.hProcess := OpenProcess(PROCESS_TERMINATE, FALSE, pi.dwProcessId);
> if pi.hProcess <> nil then begin
> TerminateProcess(pi.hProcess, 0);
> CloseHandle(pi.hProcess);
> end;
> end;
> end;
>end;
Как отчитывать промежутки времени с точностью, большей чем 60 мсек?
Nomadic рекомендует следующий код:
Для начала описываешь процедуру, которая будет вызываться по сообщению от таймера :
>procedure FNTimeCallBack(uTimerID, uMessage: UINT;dwUser, dw1, dw2: DWORD); stdcall;
>begin
> //// Тело процедуры.
>end;
а дальше в программе (например по нажатию кнопки) создаешь Таймер и вешаешь на него созданную процедуру
> uTimerID:=timeSetEvent(10, 500, @FNTimeCallBack, 100, TIME_PERIODIC);
Подробности смотри в Help. Hу и в конце убиваешь таймер
>timeKillEvent(uTimerID);