Thread message loop for a thread with a hidden window? Make AllocateHwnd safe

Thread message loop for a thread with a hidden window?

I have a Delphi 6 application that has a thread dedicated to communicating with a foreign application that uses SendMessage() and WM_COPYDATA messages to interface with external programs. Therefore, I create a hidden window with AllocateHWND() to service that need since a thread message queue won't work due to the SendMessage() function only accepting window handles, not thread IDs. What I'm not sure about is what to put in the thread Execute() method.

I assume that if I use a GetMessage() loop or a create a loop with a WaitFor*() function call in it that the thread will block and therefore the thread's WndProc() will never process the SendMessage() messages from the foreign program right? If so, what is the correct code to put in an Execute() loop that will not consume CPU cycles unnecessarily but will exit once a WM_QUIT message is received? I can always do a loop with a Sleep() if necessary but I'm wondering if there is a better way.

AllocateHWnd() (more specifically, MakeObjectInstance()) is not thread-safe, so you have to be careful with it. Better to use CreatWindow/Ex() directly instead.

In any case, an HWND is tied to the thread context that creates it, so you have to create and destroy the HWND inside your Execute() method, not in the thread's constructor/destructor. Also, even though SendMessage() is being used to send the messages to you, they are coming from another process, so they will not be processed by your HWND until its owning thread performs message retrieval operations, so the thread needs its own a message loop.

Your Execute() method should look something like this:

procedure TMyThread.Execute;
var
  Message: TMsg;
begin
  FWnd := AllocateHWnd(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
    DeallocateHWnd(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;

You should use DSiAllocateHwnd instead of AllocateHwnd.

How can I make AllocateHwnd threadsafe?

VCL components are designed to be used solely from the main thread of an application. For visual components this never presents me with any difficulties. However, I would sometimes like to be able to use, for example, non-visual components like TTimer from a background thread. Or indeed just create a hidden window. This is not safe because of the reliance on AllocateHwnd. Now, AllocateHwnd is not threadsafe which I understand is by design.

Is there an easy solution that allows me to use AllocateHwnd from a background thread?

This problem can be solved like so:

1. Obtain or implement a threadsafe version of AllocateHwnd and DeallocateHwnd.
2. Replace the VCL's unsafe versions of these functions.

For item 1 I use Primož Gabrijelcic's code, as described on his blog article on the subject.

For item 2 I simply use the very well-known trick of patching the code at runtime

and replacing the beginning of the unsafe routines with unconditional JMPinstructions that redirect execution to the threadsafe functions.

Putting it all together results in the following unit.

(* Makes AllocateHwnd safe to call from threads. 

For example this makes TTimer safe to use from threads.  Include this unit as early as possible in your .dpr file.  
It must come after any memory manager, but it must be included immediately after that 
before any included unit has an opportunity to call Classes.AllocateHwnd. *)


unit MakeAllocateHwndThreadsafe;

interface

implementation

{$IF CompilerVersion >= 23}{$DEFINE ScopedUnitNames}{$IFEND}
uses
  {$IFDEF ScopedUnitNames}System.SysUtils{$ELSE}SysUtils{$ENDIF},
  {$IFDEF ScopedUnitNames}System.Classes{$ELSE}Classes{$ENDIF},
  {$IFDEF ScopedUnitNames}Winapi.Windows{$ELSE}Windows{$ENDIF},
  {$IFDEF ScopedUnitNames}Winapi.Messages{$ELSE}Messages{$ENDIF};

const //DSiAllocateHwnd window extra data offsets
  GWL_METHODCODE = SizeOf(pointer) * 0;
  GWL_METHODDATA = SizeOf(pointer) * 1;

  //DSiAllocateHwnd hidden window (and window class) name
  CDSiHiddenWindowName = 'DSiUtilWindow';

var
  //DSiAllocateHwnd lock
  GDSiWndHandlerCritSect: TRTLCriticalSection;
  //Count of registered windows in this instance
  GDSiWndHandlerCount: integer;

//Class message dispatcher for the DSiUtilWindow class. Fetches instance's WndProc from
//the window extra data and calls it.
function DSiClassWndProc(Window: HWND; Message, WParam, LParam: longint): longint; stdcall;
var
  instanceWndProc: TMethod;
  msg            : TMessage;
begin
  {$IFDEF CPUX64}
  instanceWndProc.Code := pointer(GetWindowLongPtr(Window, GWL_METHODCODE));
  instanceWndProc.Data := pointer(GetWindowLongPtr(Window, GWL_METHODDATA));
  {$ELSE}
  instanceWndProc.Code := pointer(GetWindowLong(Window, GWL_METHODCODE));
  instanceWndProc.Data := pointer(GetWindowLong(Window, GWL_METHODDATA));
  {$ENDIF ~CPUX64}
  if Assigned(TWndMethod(instanceWndProc)) then
  begin
    msg.msg := Message;
    msg.wParam := WParam;
    msg.lParam := LParam;
    msg.Result := 0;
    TWndMethod(instanceWndProc)(msg);
    Result := msg.Result
  end
  else
    Result := DefWindowProc(Window, Message, WParam,LParam);
end; { DSiClassWndProc }

//Thread-safe AllocateHwnd.
//  @author  gabr [based on http://fidoforum.ru/pages/new46s35o217746.ru.delphi and
//                 TIcsWndHandler.AllocateHWnd from ICS v6 (http://www.overbyte.be)]
//  @since   2007-05-30
function DSiAllocateHWnd(wndProcMethod: TWndMethod): HWND;
var
  alreadyRegistered: boolean;
  tempClass        : TWndClass;
  utilWindowClass  : TWndClass;
begin
  Result := 0;
  FillChar(utilWindowClass, SizeOf(utilWindowClass), 0);
  EnterCriticalSection(GDSiWndHandlerCritSect);
  try
    alreadyRegistered := GetClassInfo(HInstance, CDSiHiddenWindowName, tempClass);
    if (not alreadyRegistered) or (tempClass.lpfnWndProc <> @DSiClassWndProc) then begin
      if alreadyRegistered then
        {$IFDEF ScopedUnitNames}Winapi.{$ENDIF}Windows.UnregisterClass(CDSiHiddenWindowName, HInstance);
      utilWindowClass.lpszClassName := CDSiHiddenWindowName;
      utilWindowClass.hInstance := HInstance;
      utilWindowClass.lpfnWndProc := @DSiClassWndProc;
      utilWindowClass.cbWndExtra := SizeOf(TMethod);
      if {$IFDEF ScopedUnitNames}Winapi.{$ENDIF}Windows.RegisterClass(utilWindowClass) = 0 then
        raise Exception.CreateFmt('Unable to register DSiWin32 hidden window class. %s',
          [SysErrorMessage(GetLastError)]);
    end;
    Result := CreateWindowEx(WS_EX_TOOLWINDOW, CDSiHiddenWindowName, '', WS_POPUP,
      0, 0, 0, 0, 0, 0, HInstance, nil);
    if Result = 0 then
      raise Exception.CreateFmt('Unable to create DSiWin32 hidden window. %s',
              [SysErrorMessage(GetLastError)]);
    {$IFDEF CPUX64}
    SetWindowLongPtr(Result, GWL_METHODDATA, NativeInt(TMethod(wndProcMethod).Data));
    SetWindowLongPtr(Result, GWL_METHODCODE, NativeInt(TMethod(wndProcMethod).Code));
    {$ELSE}
    SetWindowLong(Result, GWL_METHODDATA, cardinal(TMethod(wndProcMethod).Data));
    SetWindowLong(Result, GWL_METHODCODE, cardinal(TMethod(wndProcMethod).Code));
    {$ENDIF ~CPUX64}
    Inc(GDSiWndHandlerCount);
  finally LeaveCriticalSection(GDSiWndHandlerCritSect); end;
end; { DSiAllocateHWnd }

//Thread-safe DeallocateHwnd.
//  @author  gabr [based on http://fidoforum.ru/pages/new46s35o217746.ru.delphi and
//                 TIcsWndHandler.AllocateHWnd from ICS v6 (http://www.overbyte.be)]
//  @since   2007-05-30
procedure DSiDeallocateHWnd(wnd: HWND);
begin
  if wnd = 0 then
    Exit;
  DestroyWindow(wnd);
  EnterCriticalSection(GDSiWndHandlerCritSect);
  try
    Dec(GDSiWndHandlerCount);
    if GDSiWndHandlerCount <= 0 then
      {$IFDEF ScopedUnitNames}Winapi.{$ENDIF}Windows.UnregisterClass(CDSiHiddenWindowName, HInstance);
  finally LeaveCriticalSection(GDSiWndHandlerCritSect); end;
end; { DSiDeallocateHWnd }

procedure PatchCode(Address: Pointer; const NewCode; Size: Integer);
var
  OldProtect: DWORD;
begin
  if VirtualProtect(Address, Size, PAGE_EXECUTE_READWRITE, OldProtect) then begin
    Move(NewCode, Address^, Size);
    FlushInstructionCache(GetCurrentProcess, Address, Size);
    VirtualProtect(Address, Size, OldProtect, @OldProtect);
  end;
end;

type
  PInstruction = ^TInstruction;
  TInstruction = packed record
    Opcode: Byte;
    Offset: Integer;
  end;

procedure RedirectProcedure(OldAddress, NewAddress: Pointer);
var
  NewCode: TInstruction;
begin
  NewCode.Opcode := $E9;//jump relative
  NewCode.Offset := NativeInt(NewAddress)-NativeInt(OldAddress)-SizeOf(NewCode);
  PatchCode(OldAddress, NewCode, SizeOf(NewCode));
end;

initialization
  InitializeCriticalSection(GDSiWndHandlerCritSect);
  RedirectProcedure(@AllocateHWnd, @DSiAllocateHWnd);
  RedirectProcedure(@DeallocateHWnd, @DSiDeallocateHWnd);

finalization
  DeleteCriticalSection(GDSiWndHandlerCritSect);

end.

This unit must be included very early in the .dpr file's list of units.

Clearly it cannot appear before any custom memory manager, but it should appear immediately after that.

The reason being that the replacement routines must be installed before any calls to AllocateHwnd are made.

Update I have merged in the very latest version of Primož's code which he kindly sent to me.

AllocateHwnd is not Thread-Safe

[This article also serves as announcement of DSiWin32 1.26.]

[Update: Reported as QC #47559. Vote for it!]

You're probably asking yourself - what's that AllocateHwnd anyway? And why must it be thread-safe?

As the Google is guick to tell (BTW, Steve, thanks for the search filter!), AllocateHwnd is used to create a hidden window which you can use to receive messages in non-windowed components. Of course, you can use it outside of any component to set up simple and easy messaging subsystem anywhere in your application. If you need more communication channels, just call AllocateHwnd many times.

I won't bother you with the usage pattern - if you want to use AllocateHwnd and don't know how, use the search link above. You'll find many examples, including this one from DelphiDabbler, which Steve's searcher lists on the first place.

An example of a very popular component using AllocateHwnd internally is Delphi's TTimer.

That should answer the first question, but what about thread-safety?

Well, many programmers use AllocateHwnd in threaded code to create hidden windows where messages are processed. Many are also using TTimer inside threads without knowing the first thing about AllocateHwnd. But almost nobody knows that this is totally unsafe and may lead to rare and obscure crashes. AllocateHwnd was written with single-threaded VCL applications in mind and you can use it from a thread only if you take special precaution.

Why is AllocateHwnd dangerous

Let's see how the AllocateHwnd is implemented. Following code was copied from D2007's Classes.pas (in very old Delphis, AllocateHwnd was implemented in Forms.pas):

var
  UtilWindowClass: TWndClass = (
    style: 0;
    lpfnWndProc: @DefWindowProc;
    cbClsExtra: 0;
    cbWndExtra: 0;
    hInstance: 0;
    hIcon: 0;
    hCursor: 0;
    hbrBackground: 0;
    lpszMenuName: nil;
    lpszClassName: 'TPUtilWindow');

function AllocateHWnd(Method: TWndMethod): HWND;
var
  TempClass: TWndClass;
  ClassRegistered: Boolean;
begin
  UtilWindowClass.hInstance := HInstance;
{$IFDEF PIC}
  UtilWindowClass.lpfnWndProc := @DefWindowProc;
{$ENDIF}
  ClassRegistered := GetClassInfo(HInstance, UtilWindowClass.lpszClassName,
    TempClass);
  if not ClassRegistered or (TempClass.lpfnWndProc <> @DefWindowProc) then
  begin
    if ClassRegistered then
      Windows.UnregisterClass(UtilWindowClass.lpszClassName, HInstance);
    Windows.RegisterClass(UtilWindowClass);
  end;
  Result := CreateWindowEx(WS_EX_TOOLWINDOW, UtilWindowClass.lpszClassName,
    '', WS_POPUP {+ 0}, 0, 0, 0, 0, 0, 0, HInstance, nil);
  if Assigned(Method) then
    SetWindowLong(Result, GWL_WNDPROC, Longint(MakeObjectInstance(Method)));
end;

Basically, the code registers window class if necessary, creates a new window of that class, and sets window procedur for that window to MakeObjectInstance(Method). Nothing special, except this last step. Can you tell why it is necessary at all?

The reason lies in the discrepancy between Delphi's object model and Win32 API, which is not object oriented. The TWndMethod parameter passed to the AllocateHwnd is not just an address of code, but contains also the address of the object this method belongs to.

On the other hand, Win32 API wants to call a simple method anytime it has to deliver a message to a window.

MakeObjectInstance bridges this gap. It manages a linked list of methods together with a dynamically generated code preamble (address of which is returned from the MakeObjectInstance function). When Windows calls this code preamble, it makes sure that correct method is called on the correct object.

MakeObjectInstance is complicated, but it works. That is, until you call it from two threads at the same time. You see, MakeObjectInstance does nothing to lock its internal list while it is being manipulated. If you do this from two threads running on two CPUs, or even if you have only one CPU and context switch occurs at a bad time, internal instance list can get corrupted. Later, this may lead to crashes, bad program behaviour, you name it. And you'll never find the true culprit.

Admittedly, there is only a small window - few instructions - which are problematic. In most applications such problems will never occur. But if you're running 24/7 server which calls AllocateHwnd/DeallocateHwnd constantly from multiple threads, you can be sure that sooner or later it will crash.

Solution

There are two possible solutions to the problem - one is to wrap all AllocateHwnd and DeallocateHwnd in some sort of critical section, spinlock or mutex that will allow only one instance to be called at the same time and other is to write a better and thread-safe AllocateHwnd. First solution is somewhat clumsy to implement in production code while the second can be hard to write.

Actually, I search the net wide and deep and found only two alternative AllocateHwnd implementations (references below). I'm sure there are more. I just couldn't find them. None of them was really suitable for my needs so I created a third one using ideas from both of them. My version — DSiAllocateHwnd, DSiDeallocateHwnd and TDSiTimer — has been published as a part of the DSiWin32 library.

This is the current version of my AllocateHwnd alternative:

const 
  GWL_METHODCODE = SizeOf(pointer) * 0;
  GWL_METHODDATA = SizeOf(pointer) * 1;

  CDSiHiddenWindowName = 'DSiUtilWindow';

var
  GDSiWndHandlerCritSect: TRTLCriticalSection;
  GDSiWndHandlerCount: integer;

  function DSiClassWndProc(Window: HWND; Message, WParam, LParam: longint): longint; stdcall;
  var
    instanceWndProc: TMethod;
    msg            : TMessage;
  begin
    instanceWndProc.Code := Pointer(GetWindowLong(Window, GWL_METHODCODE));
    instanceWndProc.Data := Pointer(GetWindowLong(Window, GWL_METHODDATA));
    if Assigned(TWndMethod(instanceWndProc)) then
    begin
      msg.msg := Message;
      msg.wParam := WParam;
      msg.lParam := LParam;
      TWndMethod(instanceWndProc)(msg);
      Result := msg.Result
    end
    else
      Result := DefWindowProc(Window, Message, WParam,LParam);
  end; { DSiClassWndProc }

  function DSiAllocateHWnd(wndProcMethod: TWndMethod): HWND;
  var
    alreadyRegistered: boolean;
    tempClass        : TWndClass;
    utilWindowClass  : TWndClass;
  begin
    Result := 0;
    FillChar(utilWindowClass, SizeOf(utilWindowClass), 0);
    EnterCriticalSection(GDSiWndHandlerCritSect);
    try
      alreadyRegistered := GetClassInfo(HInstance, CDSiHiddenWindowName, tempClass);
      if (not alreadyRegistered) or (tempClass.lpfnWndProc <> @DSiClassWndProc) then begin
        if alreadyRegistered then
          Windows.UnregisterClass(CDSiHiddenWindowName, HInstance);
        utilWindowClass.lpszClassName := CDSiHiddenWindowName;
        utilWindowClass.hInstance := HInstance;
        utilWindowClass.lpfnWndProc := @DSiClassWndProc;
        utilWindowClass.cbWndExtra := SizeOf(TMethod);
        if Windows.RegisterClass(utilWindowClass) = 0 then
          raise Exception.CreateFmt('Unable to register DSiWin32 hidden window class. %s',
            [SysErrorMessage(GetLastError)]);
      end;
      Result := CreateWindowEx(WS_EX_TOOLWINDOW, CDSiHiddenWindowName, '', WS_POPUP,
        0, 0, 0, 0, 0, 0, HInstance, nil);
      if Result = 0 then
        raise Exception.CreateFmt('Unable to create DSiWin32 hidden window. %s',
                [SysErrorMessage(GetLastError)]);
      SetWindowLong(Result, GWL_METHODDATA, Longint(TMethod(wndProcMethod).Data));
      SetWindowLong(Result, GWL_METHODCODE, Longint(TMethod(wndProcMethod).Code));
      Inc(GDSiWndHandlerCount);
    finally LeaveCriticalSection(GDSiWndHandlerCritSect); end;
  end; { DSiAllocateHWnd }

  procedure DSiDeallocateHWnd(wnd: HWND);
  begin
    DestroyWindow(wnd);
    EnterCriticalSection(GDSiWndHandlerCritSect);
    try
      Dec(GDSiWndHandlerCount);
      if GDSiWndHandlerCount <= 0 then
        Windows.UnregisterClass(CDSiHiddenWindowName, HInstance);
    finally LeaveCriticalSection(GDSiWndHandlerCritSect); end;
  end; { DSiDeallocateHWnd }

There are many differences between this code and Delphi version.

• My code uses custom DefWindowProc method - DSiClassWndProc. 
• It reserves four extra bytes in each window of the DSiUtilWindow class (utilWindowClass.cbWndExtra setting). 
• It writes both parts of TMethod (code and data) directly into those four bytes of the hidden window's user data. 
• DSiClassWndProc retrieves those four bytes, reconstructs TMethod and calls it directly. 
• When all hidden windows are closed, window class gets unregistered (in DSiDeallocateHwnd).

I admit that this approach to message dispatching is slower than the Delphi's version, but usually that is not a problem - custom windows are usually created to process some small subset of messages only.

Acknowledgments

The AllocateHwnd problem is not something I have found by myself. It has been documented for years, but is not well known.

I'd like to thank to: 

• Arno Garrels on the ICS mailing list, who described the problem to me. 
• Francois Piette for providing ICS source code with custom AllocateHwnd solution. My approach is partially based on the Francois' code. 
• Alexander Grischenko, who wrote this solution from which I stole the idea of storing TMethod directly in window's extra data.