Stream message loop for a stream with a hidden window?

Question

I have a Delphi 6 application that has a thread designed to communicate with a foreign application that uses SendMessage () and WM_COPYDATA messages to interact with external programs. Therefore, I create a hidden window with AllocateHWND () for the maintenance, which is necessary since the thread message queue will not work due to the SendMessage () function, only accepting window handles, not thread IDs. That I am not sure what to put the Execute () method in the stream.

I assume that if I use the GetMessage () loop or create a loop with the WaitFor * () function call in which the thread will block, and therefore the WndProc () thread will never process SendMessage () messages from a foreign program? If so, what is the correct code for entering the Execute () loop, which will not consume processor cycles unnecessarily, but will exit as soon as the WM_QUIT message is received? I can always do a loop with Hibernate () if necessary, but I wonder if there is a better way.

Answer 1

AllocateHWnd() (more precisely, MakeObjectInstance() ) is not thread safe, so you need to be careful with it. It is better to use CreatWindow/Ex() directly (or a streaming version of AllocateHWnd() , e.g. DSiAllocateHwnd() .

In any case, the HWND bound to the context of the thread that creates it, so you need to create and destroy the HWND inside your Execute() method, and not in the constructor / destructor of the stream. In addition, although SendMessage() used to send messages to you, they come from another process, so they will not be processed by your HWND until its own thread performs message search operations, so the thread needs its own message loop.

Your Execute() method should look something like this:

 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; 

As an alternative:

 // 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

Here is a loop that does not require Classes.pas and relies solely on System.pas for some helper functions, Windows.pas for Win32 API functions and Messages.pas for WM_ constants.

Note that a window handle is created and destroyed from the workflow, but the main thread waits until the workflow completes initialization. You can defer this wait until a later point when you really need a window handle, so the main thread can do some work at the same time as the worker thread sets itself.

 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.