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

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

И все. Точность этого способа до 1 мсек. минимальный интервал времени можно задавать 1 мсек.

Обратите внимание на то, что все CALLBACK-функции, вызываемые Windows, должны использовать соглашение о вызовах stdcall.

Как сделать чтобы при событиях моя программа отпpавляла кому-либо сообщение на мой компьютеp?

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

Если только послать, то проще всего, пожалуй…

W32: F1 «NetMessageBufferSend»;

Win16: Почему-то не описан, но руками наковырял…

function NetMessageBufferSend(Zero1, Zero2: Word; WhoTo: PChar; Buffer: PChar; BufSize: Word): Integer; external 'netapi' index 525;

«Кому» может быть '*' == всем.

Что нужно давать WSAAsyncSelect в качестве параметра handle, если тот запускается и используется в dll (init), и никакой формы (у которой можно было бы взять этот handle) в этой dll не создается?

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

const WM_ASYNCSELECT = WM_USER+0;
type TNetConnectionsManager = class(tobject)
protected
 FWndHandle : HWND;
procedure WndProc(var MsgRec : TMessage);
 …
end;

constructor TNetConnectionsManager.Create
begin
 inherited Create;
 FWndHandle := AllocateHWnd(WndProc);
 …
end;

destructor TNetConnectionsManager.Destroy;
begin
 …
 if FWndHandle<>0 then DeallocateHWnd(FWndHandle);
 inherited Destroy;
end;

procedure TNetConnectionsManeger.WndProc(var MsgRec : TMessage);
begin
 with MsgRec do
  if Msg = WM_ASYNCSELECT then WMAsyncSelect(MsgRec)
  else DefWindowProc(FWndHandle, Msg, wParam, lParam);
end;

Hо pекомендую посмотpеть WinSock2, в котоpом можно:

WSAEventSelect(FSocket, FEventHandle, FD_READ or fd_close);
WSAWaitForMultipleEvents(…);
WSAEnumNetworkEvents(FSocket, FEventHandle, lpNetWorkEvents);