delphi - 如何确保分配手动线程安全？

Question

VCL 组件被设计为仅在应用程序的主线程中使用。对于视觉组件来说，这不会给我带来任何困难。但是，我有时希望能够在后台线程中使用诸如 TTimer 之类的非可视组件。或者实际上只是创建一个隐藏窗口。由于依赖 AllocateHwnd，这是不安全的。现在，AllocateHwnd 不是线程安全的，我理解这是设计使然。

是否有一个简单的解决方案可以让我从后台线程使用AllocateHwnd？

Answer 1

这个问题可以这样解决:

1. 获取或实现 AllocateHwnd 和 DeallocateHwnd 的线程安全版本。
2. 替换这些函数的 VCL 不安全版本。

对于第 1 项，我使用 Primož Gabrijelcic's代码，如他的 blog article 中所述就此主题而言。对于第 2 项，我只是使用了非常著名的技巧，即在运行时修补代码，并用将执行重定向到线程安全函数的无条件 JMP 指令替换不安全例程的开头。

将它们放在一起会产生以下单元。

(* 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.

该单位必须很早就包含在 .dpr 文件的单位列表中。显然它不能出现在任何自定义内存管理器之前，但它应该立即出现在之后。原因是必须在调用 AllocateHwnd 之前安装替换例程。

更新我已经合并了他好心发送给我的 Primož 代码的最新版本。