Цикл сообщений потока для потока со скрытым окном?

У меня есть приложение Delphi 6, в котором есть поток, предназначенный для связи с сторонним приложением, использующим сообщения SendMessage() и WM_COPYDATA для взаимодействия с внешними программами. Поэтому я создаю скрытое окно с AllocateHWND() для обслуживания, которое необходимо, поскольку очередь сообщений потока не будет работать из-за того, что функция SendMessage() принимает только дескрипторы окон, а не идентификаторы потоков. В чем я не уверен, так это в том, что поместить в поток метода Execute().

Я предполагаю, что если я использую цикл GetMessage () или создаю цикл с вызовом функции WaitFor * (), то поток будет блокироваться, и поэтому WndProc () потока никогда не будет обрабатывать сообщения SendMessage() из сторонней программы право? Если да, то какой правильный код следует поместить в цикл Execute(), который не будет излишне потреблять циклы ЦП, но завершится после получения сообщения WM_QUIT? Я всегда могу сделать цикл с Sleep(), если необходимо, но мне интересно, есть ли лучший способ.

Источник

2 ответа

Решение

AllocateHWnd() (более конкретно, MakeObjectInstance()) не является потокобезопасным, поэтому вы должны быть осторожны с ним. Лучше использовать CreatWindow/Ex() непосредственно вместо (или потокобезопасная версия AllocateHWnd(), лайк DSiAllocateHwnd(),

В любом случае, HWND связан с контекстом потока, который его создает, поэтому вы должны создать и уничтожить HWND внутри вашего Execute() метод, а не в конструкторе / деструкторе потока. Кроме того, даже если SendMessage() используется для отправки вам сообщений, они приходят из другого процесса, поэтому они не будут обрабатываться вашим HWND до тех пор, пока его собственный поток не выполнит операции извлечения сообщений, поэтому поток должен иметь свой собственный цикл сообщений.

Ваш Execute() Метод должен выглядеть примерно так:

procedure TMyThread.Execute;
var
  Message: TMsg;
begin
  FWnd := ...; // create the HWND and tie it to WndProc()...
  try
    while not Terminated do
    begin
      if MsgWaitForMultipleObjects(0, nil^, False, 1000, QS_ALLINPUT) = WAIT_OBJECT_0 then
      begin
        while PeekMessage(Message, 0, 0, 0, PM_REMOVE) do
        begin
          TranslateMessage(Message);
          DispatchMessage(Message);
        end;
      end;
    end;
  finally
    // destroy FWnd...
  end;
end;

procedure TMyThread.WndProc(var Message: TMessage);
begin
  if Message.Msg = WM_COPYDATA then
  begin
    ...
    Message.Result := ...;
  end else
    Message.Result := DefWindowProc(FWnd, Message.Msg, Message.WParam, Message.LParam);
end;

В качестве альтернативы:

// In Delphi XE2, a virtual TerminatedSet() method was added to TThread,
// which is called when TThread.Terminate() is called.  In earlier versions,
// use a custom method instead...

type
  TMyThread = class(TThread)
  private
    procedure Execute; override;
    {$IF RTLVersion >= 23}
    procedure TerminatedSet; override;
    {$IFEND}
  public
    {$IF RTLVersion < 23}
    procedure Terminate; reintroduce;
    {$IFEND}
  end;

procedure TMyThread.Execute;
var
  Message: TMsg;
begin
  FWnd := ...; // create the HWND and tie it to WndProc()...
  try
    while not Terminated do
    begin
      if WaitMessage then
      begin
        while PeekMessage(Message, 0, 0, 0, PM_REMOVE) do
        begin
          if Message.Msg = WM_QUIT then Break;
          TranslateMessage(Message);
          DispatchMessage(Message);
        end;
      end;
    end;
  finally
    // destroy FWnd...
  end;
end;

{$IF RTLVersion < 23}
procedure TMyThread.Terminate;
begin
  inherited Terminate;
  PostThreadMessage(ThreadID, WM_QUIT, 0, 0);
end;
{$ELSE}
procedure TMyThread.TerminatedSet;
begin
  PostThreadMessage(ThreadID, WM_QUIT, 0, 0);
end;
{$IFEND}
Источник

Вот цикл, который не требует Classes.pas и полагается исключительно на System.pas для некоторых вспомогательных функций, Windows.pas для функций Win32 API и Messages.pas для констант WM_.

Обратите внимание, что дескриптор окна здесь создается и уничтожается из рабочего потока, но основной поток ожидает, пока рабочий поток завершит инициализацию. Вы можете отложить это ожидание до более позднего момента, когда вам действительно понадобится дескриптор окна, так что основной поток может пока что выполнить некоторую работу, пока рабочий поток настраивается сам.

unit WorkerThread;

interface

implementation

uses
  Messages,
  Windows;

var
  ExitEvent, ThreadReadyEvent: THandle;
  ThreadId: TThreadID;
  ThreadHandle: THandle;
  WindowHandle: HWND;

function HandleCopyData(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
  Result := 0; // handle it
end;

function HandleWmUser(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
// you may handle other messages as well - just an example of the WM_USER handling
begin
  Result := 0; // handle it
end;

function MyWindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  if Msg = WM_COPYDATA then
  begin
    Result := HandleCopyData(hWnd, Msg, wParam, lParam);
  end else
  if Msg = WM_USER then
  begin
    // you may handle other messages as well - just an example of the WM_USER handling
    // if you have more than 2 differnt messag types, use the "case" switch
    Result := HandleWmUser(hWnd, Msg, wParam, lParam);
  end else
  begin
    Result := DefWindowProc(hWnd, Msg, wParam, lParam);
  end;
end;

const
  WindowClassName = 'MsgHelperWndClass';
  WindowClass: TWndClass = (
    style: 0;
    lpfnWndProc: @MyWindowProc;
    cbClsExtra: 0;
    cbWndExtra: 0;
    hInstance: 0;
    hIcon: 0;
    hCursor: 0;
    hbrBackground: 0;
    lpszMenuName: nil;
    lpszClassName: WindowClassName);

procedure CreateWindowFromThread;
var
  A: ATOM;
begin
  A := RegisterClass(WindowClass);
  WindowHandle := CreateWindowEx(WS_EX_TOOLWINDOW, WindowClassName, 'Message Helper Window', WS_POPUP, 0, 0, 0, 0, 0, 0, hInstance, nil);
end;

procedure FreeWindowFromThread;
var
  H: HWND;
begin
  H := WindowHandle;
  WindowHandle := 0;
  DestroyWindow(H);
  UnregisterClass(WindowClassName, hInstance);
end;

function ThreadFunc(P: Pointer): Integer;  //The worker thread main loop, windows handle initialization and finalization
const
  EventCount = 1;
var
  EventArray: array[0..EventCount-1] of THandle;
  R: Cardinal;
  M: TMsg;
begin
  Result := 0;
  CreateWindowFromThread;
  try
    EventArray[0] := ExitEvent; // you may add other events if you need - just enlarge the Events array
    SetEvent(ThreadReadyEvent);
    repeat
      R := MsgWaitForMultipleObjects(EventCount, EventArray, False, INFINITE, QS_ALLINPUT);
      if R = WAIT_OBJECT_0 + EventCount then
      begin
        while PeekMessage(M, WindowHandle, 0, 0, PM_REMOVE) do
        begin
          case M.Message of
             WM_QUIT:
               Break;
             else
                begin
                  TranslateMessage(M);
                  DispatchMessage(M);
                end;
          end;
        end;
        if M.Message = WM_QUIT then
          Break;
      end else
      if R = WAIT_OBJECT_0 then
      begin
        // we have the ExitEvent signaled - so the thread have to quit
        Break;
      end else
      if R = WAIT_TIMEOUT then
      begin
        // do nothing, the timeout should not have happened since we have the INFINITE timeout
      end else
      begin
        // some errror happened, or the wait was abandoned with WAIT_ABANDONED_0 to (WAIT_ABANDONED_0 + nCount– 1)
        // just exit the thread
        Break;
      end;
    until False;
  finally
    FreeWindowFromThread;
  end;
end;

procedure InitializeFromMainThread;
begin
  ExitEvent := CreateEvent(nil, False, False, nil);
  ThreadReadyEvent := CreateEvent(nil, False, False, nil);
  ThreadHandle := BeginThread(nil, 0, @ThreadFunc, nil, 0, ThreadId);
end;

procedure WaitUntilHelperThreadIsReady;
begin
  WaitForSingleObject(ThreadReadyEvent, INFINITE); // wait until the worker thread start running and initialize the main window
  CloseHandle(ThreadReadyEvent); // we won't need it any more
  ThreadReadyEvent := 0;
end;

procedure FinalizeFromMainThread;
begin
  SetEvent(ExitEvent); // we should call it AFTER terminate for the Terminated property would already be True when the tread exits from MsgWaitForMultipleObjects
  WaitForSingleObject(ThreadHandle, INFINITE);
  CloseHandle(ThreadHandle); ThreadHandle := 0;
  CloseHandle(ExitEvent); ExitEvent := 0;
end;

initialization
  InitializeFromMainThread;

  WaitUntilHelperThreadIsReady; // we can call it later, just before we need the window handle
finalization
  FinalizeFromMainThread;
end.
Источник
Другие вопросы по тегам