帶隱藏窗口的線程的線程消息循環？

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.