¿Subproceso de mensaje de subproceso para un subproceso con una ventana oculta?

Question

Tengo una aplicación Delphi 6 que tiene un hilo dedicado a comunicarse con una aplicación extranjera que usa los mensajes SendMessage() y WM_COPYDATA para interactuar con programas externos. Por lo tanto, creo una ventana oculta con AllocateHWND() para dar servicio a esa necesidad ya que una cola de mensajes de subprocesos no funcionará debido a que la función SendMessage() solo acepta identificadores de ventana, no identificadores de subprocesos. De lo que no estoy seguro es de qué poner en el método de ejecución de hilo().

Supongo que si uso un bucle GetMessage() o un bucle con una función WaitFor *() llamo para que el hilo se bloquee y, por lo tanto, el hilo WndProc() nunca procesará los mensajes SendMessage() del programa extranjero ¿verdad? Si es así, ¿cuál es el código correcto para poner en un ciclo Execute() que no consumirá ciclos de CPU innecesariamente pero saldrá una vez que se reciba un mensaje WM_QUIT? Siempre puedo hacer un ciclo con Sleep() si es necesario pero me pregunto si hay una mejor manera.

Answer 1

AllocateHWnd() (más específicamente, MakeObjectInstance()) no es seguro para subprocesos, por lo que debe tener cuidado con él. Es mejor usar CreatWindow/Ex() directamente en lugar (o una versión segura para los subprocesos de AllocateHWnd(), como DSiAllocateHwnd().

En cualquier caso, un HWND está ligada al contexto hilo que lo crea, así que hay que crear y destruir el HWND dentro de su Execute() método, no en el constructor/destructor del subproceso. Además, aunque se está utilizando SendMessage() para enviarle los mensajes, provienen de otro proceso, por lo que no serán procesados ​​por su HWND hasta que su subproceso realice operaciones de recuperación de mensajes , por lo que el hilo necesita su propio bucle de mensaje.

Su Execute() mí DTO debería ser algo como esto:

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; 

alternativa:

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

Aquí es un bucle que no requiere Classes.pas y se basa únicamente en System.pas para algunas funciones auxiliares, windows.pas para las funciones API de Win32 y Messages.pas para las constantes WM_.

Tenga en cuenta que aquí se crea el identificador de ventana y se destruye desde el subproceso trabajador, pero el subproceso principal espera hasta que el subproceso trabajador complete la inicialización. Puedes posponer esta espera hasta un momento posterior, cuando realmente necesites el identificador de ventana, para que el hilo principal pueda hacer algo mientras tanto, mientras el hilo de trabajo se arma.

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.