19

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?

David Heffernan
  • 601,492
  • 42
  • 1,072
  • 1,490
  • 1
    With pure Windows API; the [`SetTimer`](http://msdn.microsoft.com/en-us/library/windows/desktop/ms644906%28v=vs.85%29.aspx) doesn't require HWND; it's also possible to use callback function. See [`here`](http://stackoverflow.com/a/6761071/960757) for instance. – TLama Jan 11 '12 at 14:54
  • @TLama You are quite right, but `TTimer` does use `WM_TIMER` and that's the target here. – David Heffernan Jan 11 '12 at 14:56
  • I was thinking about something what's in my deleted post (pseudocode). Of course still you have to dispatch the messages to get the `WM_TIMER` pass through, but it looks for me less evil than `AllocateHwnd` for a worker thread :) – TLama Jan 11 '12 at 16:00
  • You can add the (I know, now deprecated) TClientSocket to the list of component being affected by this. MakeObjectInstance isn't thread safe by itself either. – Ken Bourassa Jan 12 '12 at 19:02
  • @KenBourassa Yes, `MakeObjectInstance` is actually the fundamental problem. I'd like a threadsafe version of that too but it seems a little harder to achieve. – David Heffernan Jan 12 '12 at 19:03

3 Answers3

16

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 JMP instructions 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: UINT; WParam: WPARAM; LParam: LPARAM): LRESULT; 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.

David Heffernan
  • 601,492
  • 42
  • 1,072
  • 1,490
  • If anyone wonders why I asked and answered my own question, this is in response to a request for this code made to me by somebody on Twitter. – David Heffernan Jan 11 '12 at 13:45
  • I don't really understand the question. If I had to control some GUI TTimer from some non-GUI thread, I would just PostMessage the interval and set the timer in the message-handler, (perhaps using '-1' to mean 'disable'). I could always post the TTimer instance in the other PostMessage parameter if there is more than one. – Martin James Jan 11 '12 at 14:32
  • @MartinJames: David is not trying to control a GUIThread bound TTimer from a background thread, but to work with a TTimer entirely from a background thread. – Marjan Venema Jan 11 '12 at 14:36
  • @MartinJames Marjan is right, I need the `WM_TIMER` messages to arrive in a message queue owned by the worker thread. – David Heffernan Jan 11 '12 at 14:38
  • 2
    @David, why on earth would you want a Timer in a background thread? Can you expand on this subject? – whosrdaddy Jan 11 '12 at 15:49
  • 1
    @whosrdaddy For example, to keep a network connection from timing out when the application goes idle. Start a timer in a background thread that pokes the connection periodically to keep it alive. – David Heffernan Jan 11 '12 at 15:54
  • @whosrdaddy Well, the `TTimer` component is unchanged. When you include this unit is becomes safe to create a `TTimer` on a background thread. If you use the vanilla VCL then doing so results in a race condition. – David Heffernan Jan 11 '12 at 16:00
  • @David: I see what you mean. I use signals to solve this problem. Each signal has a Timestamp associated, the workerthread keeps track of all signals and executes the signal when the timestamp is equal or less than the current time. – whosrdaddy Jan 11 '12 at 16:02
  • the worker will check the whole time for signals. I can set a speed property, which is fact nothing more than a sleep. – whosrdaddy Jan 11 '12 at 16:17
  • let us [continue this discussion in chat](http://chat.stackoverflow.com/rooms/6623/discussion-between-whosrdaddy-and-david-heffernan) – whosrdaddy Jan 11 '12 at 16:20
  • @DavidHeffernan So if i understand correctly. A visual control will also be safe to create in a background thread with this? –  Sep 29 '13 at 13:05
  • 1
    @Eric Not necessarily. This just avoids the race in MakeObjectInstance. You cannot run a VCL control this way. Non-visual timer is simple enough for this to be enough. – David Heffernan Sep 29 '13 at 13:35
  • @DavidHeffernan I get this error when compiling it. I have included the unit before anything in .DPR. `Exception class Exception with message 'Unable to register DSiWin32 hidden window class. Class already exists'`. It happens here `EventMonitor := TOmniEventMonitor.Create(nil);` –  Sep 30 '13 at 20:44
  • @Eric That's a runtime error. The code compiles, and if included as the first unit in your .dpr file, works fine. – David Heffernan Sep 30 '13 at 20:49
  • @DavidHeffernan Not really. Because `TOmniEventMonitor.Create` also calls `emMessageWindow := DSiAllocateHWnd(WndProc);` –  Sep 30 '13 at 20:49
  • @EricSantos My code does not include a type named `TOmniEventMonitor`. As I said, the code in the answer compiles and runs fine. – David Heffernan Sep 30 '13 at 20:50
  • @DavidHeffernan Put a `TOmniEventMonitor` on a Form and include your code and it will not work. –  Sep 30 '13 at 20:51
  • @DavidHeffernan To be compatible with `OmniThreadLibrary` one must change `CDSiHiddenWindowName = 'DSiUtilWindow';`. Please mention this in your answer. Thank you. –  Sep 30 '13 at 20:54
  • @EricSantos Then I guess you need to fix it. Change my code to use a different class name. – David Heffernan Sep 30 '13 at 20:55
  • @DanielMaurić Not so. You can call `DSiAllocateHWnd` multiple times. – David Heffernan Aug 17 '15 at 08:32
  • @DavidHeffernan Thanks, I figured it out and deleted the comment before I saw your reply. I do still have some problems with this but that may be another question. –  Aug 17 '15 at 20:51
  • +1 @DavidHeffernan what would happen if I use Halt in my programme.(the finalization part will not execute). and is that jump instruction also used for 64 bit or that is another story. – Nasreddine Galfout Nov 26 '17 at 09:48
  • +Nasreddine if you call Halt then you get a normal termination. The patch works just as well in 64 bit windows. – David Heffernan Nov 26 '17 at 10:11
  • 1
    The signature of the DSiClassWndProc function needs correction for x64, otherwise in some cases CreateWindowEx returns 0 and the error "Unable to create DSiWin32 hidden window" occurs. Correction: {$IFDEF CPUX64} function DSiClassWndProc(Window: HWND; Message, WParam, LParam: NativeInt): NativeInt; stdcall; {$ELSE} function DSiClassWndProc(Window: HWND; Message, WParam, LParam: longint): longint; stdcall; {$ENDIF} – Dmitro25 Jul 30 '23 at 15:53
  • @Dmitro25 this is a wiki, you should just edit the answer to correct that – David Heffernan Jul 30 '23 at 23:35
  • @Dmitro25 thanks. Actually your edit contained a mistake. The Message arg is UINT. In fact my subsequent edit shows how to do it without using a conditional. – David Heffernan Jul 31 '23 at 05:58
  • @DavidHeffernan Yes, you are right. Your code is better – Dmitro25 Jul 31 '23 at 07:14
6

Don't use TTimer in a thread, it will never be safe. Have the thread either:

1) use SetTimer() with a manual message loop. You don't need an HWND if you use a callback function, but you do still have to dispatch messages.

2) use CreateWaitableTimer() and then call WaitForSingleObject() in a loop until the timer is signalled.

3) use timeSetEvent(), which is a multi-threaded timer. Just be careful because its callback is called in its own thread so make sure your callback function is thread-safe, and there are restrictions to what you are allowed to call inside that thread. Best to have it set a signal that your real thread waits on an then does its work outside of the timer.

BenMorel
  • 34,448
  • 50
  • 182
  • 322
Remy Lebeau
  • 555,201
  • 31
  • 458
  • 770
  • I must say I find it strange that you appear to deny the viability or possibility of creating windows that have affinity with non-UI threads. Is that really what you mean? – David Heffernan Jan 12 '12 at 12:24
  • 1
    The Win32 API allows windows to be created in the context of worker threads, even UI windows, as long as the threads run their own message loops. But VCL-based windows are not safe to use outside the context of the main thread because the VCL internally does certain things, and uses certain resources, that are not protected from concurrent access. So the rule of thumb is to NEVER use VCL-based UIs in the context of worker threads, period. – Remy Lebeau Jan 12 '12 at 17:17
  • 1
    It is very unlikely that `AllocateHWnd()` will ever be "fixed" to allow use in worker threads. – Remy Lebeau Jan 12 '12 at 17:20
  • `AllocateHwnd` is fixed perfectly by my code and `TTimer` is safe to use from a worker thread after that fix. I agree that it can only work if you have full control over the `WndProc`, or, as is the case with `TTimer`, the `WndProc` is sufficiently benign. – David Heffernan Jan 12 '12 at 19:05
  • I was referring to Embarcadero making the VCL's native `AllocateHWnd()` implementation thread-safe. – Remy Lebeau Jan 12 '12 at 20:04
  • Remy, I asked David for the run-time patch to make AllocateHWnd thread-safe, though I may not be source of this question. It is related to a much bigger question I researched and not found an answer. I want to have a timer in an Indy thread. Specifically, the thread created for a (dbx) DataSnap user session. Indy's TCP server creates a thread for the connection. I'm certain there is a message loop in there to handle the WinSock calls. But I can't find a way to hook into the WndProc for this thread to even use SetTimer. I'll post another StackOverflow question for this specific question. – Jon Robertson Jan 25 '12 at 20:34
  • Indy uses blocking sockets, which do not use window messages. As such, Indy connection threads do not have a message queue or a message loop by default. If you need one, you have to provide it yourself. I would not recomnend it, as it does not fit into Indy's threading model (unless you absolutely need it, such as for apartment-threaded COM objects). There are other ways to do thread-based timers without using messages. – Remy Lebeau Jan 25 '12 at 20:49
  • Remy, question asked at http://stackoverflow.com/questions/9010281/hooking-into-message-loop-of-dbx-datasnap-user-session. I'd greatly appreciate suggestions for other ways to do thread-based timers. Thanks! – Jon Robertson Jan 25 '12 at 21:06
2

Since you have already written code that operates in a dedicated thread, I would assume you don't expect any code to run while this code waits for something. In that case you could just call Sleep either with a specific number of milliseconds, or with a small amount of milliseconds and use this in a loop to check Now or GetTickCount to see if a certain time has elapsed. Using Sleep will also keep CPU-usage down, since the operating system is signaled that you don't require the thread to keep running for that time.

Stijn Sanders
  • 35,982
  • 11
  • 45
  • 67
  • Once you start running a message loop, the message retrieval function `GetMessage` blocks when the queue is empty. – David Heffernan Jan 11 '12 at 16:39
  • 2
    Oh did I forget to mention? I'm suggesting to forget about TTimer and messaging altogether. – Stijn Sanders Jan 11 '12 at 16:42
  • 1
    I'm providing code for somebody that wants to use `TTimer`. Or for some reason needs to create a window handle with a window proc that is the method of an object. Each to their own. – David Heffernan Jan 11 '12 at 17:26
  • Threads are used for many, many things. Consider a server where multiple users connect simultaneously. From basic TCP server to DataSnap server, each connection is typically a separate thread that lasts the lifetime of the connection. Based on a request from a user, you want something to happen after an elapsed time. Such as caching data for 5 minutes one request is made in anticipation of another request. If no more requests after 5 minutes, clear the cache. The cache lives in that thread's context. I do not want to involve the main thread in any way. Suggestions without using a timer? – Jon Robertson Jan 25 '12 at 20:42
  • This is an entire new question in a comment on an answer to another question. Please use the 'ask question' button at the top left of this page. – Stijn Sanders Jan 25 '12 at 22:28
  • 1
    I just now noticed Stijn's response. I wasn't asking a question to get an answer but rather asking a rhetorical question to give another example of where David's code would be useful. My apologies for the confusion. – Jon Robertson May 07 '14 at 19:49