delphi – 如何使AllocateHwnd线程安全？

>获取或实现一个线程安全版本的AllocateHwnd和DeallocateHwnd.
>替换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,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,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,'',WS_POPUP,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,cardinal(TMethod(wndProcMethod).Data));
    SetWindowLong(Result,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,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?的代码,他寄给我.