带隐藏窗口的线程的线程消息循环？

Question

我有一个Delphi 6应用程序，它有一个专用于与使用SendMessage（）和WM_COPYDATA消息与外部程序接口的外部应用程序进行通信的线程。因此，我使用AllocateHWND（）创建了一个隐藏窗口来处理该需求，因为由于SendMessage（）函数只接受窗口句柄而不是线程ID，所以线程消息队列将不起作用。我不确定的是在Execute（）方法中放入什么。我假设如果我使用GetMessage（）循环或创建一个带WaitFor *（）函数调用的循环，线程将阻塞，因此线程的WndProc（）将永远不会处理SendMessage（）消息来自国外的计划吧？如果是这样，放入Execute（）循环的正确代码是什么，它不会不必要地占用CPU周期，但是一旦收到WM_QUIT消息就会退出？如果有必要，我总是可以用Sleep（）做一个循环，但是我想知道是否有更好的方法。

Answer 1

AllocateHWnd()（更具体地说，MakeObjectInstance()）不是线程安全的，所以你必须小心。最好使用CreatWindow/Ex()，而不是直接（或AllocateHWnd()一个线程安全的版本，像DSiAllocateHwnd()。

在任何情况下，HWND被绑定到创建它的线程上下文，所以你必须创建和销毁HWND里面你Execute()方法，而不是在线程的构造函数/析构函数中。此外，即使使用SendMessage()来向您发送消息，它们来自另一个进程，因此它们将不会被您的HWND处理，直到其拥有的线程执行消息检索操作，所以线程需要自己的消息循环。

Your Execute() me应的ThOD看起来是这样的：

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) 
    procedure 
    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} 

Answer 2

这里是不需要Classes.pas并只对System.pas依赖于一些辅助功能，Windows.pas循环对于Win32 API函数和WM_常量的Messages.pas。

请注意，此处的窗口句柄是由工作线程创建和销毁的，但主线程会等待，直到工作线程完成初始化。你可以推迟这个等待，直到晚些时候，当你真的需要窗口句柄时，所以主线程可能会做一些工作，而工作线程自己设置。

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.