Как я могу сделать AllocateHwnd потокобезопасным?

Компоненты VCL предназначены для использования исключительно из основного потока приложения. Для визуальных компонентов это никогда не доставляет мне никаких трудностей. Однако иногда я хотел бы иметь возможность использовать, например, невизуальные компоненты, такие как TTimer из фоновой темы. Или просто создайте скрытое окно. Это небезопасно из-за зависимости от AllocateHwnd, Сейчас, AllocateHwnd это не потокобезопасный, который я понимаю, это дизайн.

Есть ли простое решение, которое позволяет мне использовать AllocateHwnd из фоновой темы?

3 ответа

Решение

Эта проблема может быть решена так:

  1. Получить или реализовать поточно-ориентированную версию AllocateHwnd а также DeallocateHwnd,
  2. Замените небезопасные версии этих функций VCL.

Для пункта 1 я использую код gabr, как описано в его статье в блоге на эту тему. Для пункта 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, 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 сделаны.

Обновление Я слил последнюю версию кода Приможа, которую он мне любезно прислал.

Не использовать TTimer в потоке, это никогда не будет безопасно. Есть нить либо:

1) использовать SetTimer() с ручной петлей сообщений. Вам не нужно HWND если вы используете функцию обратного вызова, но вам все равно придется отправлять сообщения.

2) использовать CreateWaitableTimer() а затем позвоните WaitForSingleObject() в цикле, пока таймер не будет сигнализирован.

3) использовать timeSetEvent(), который является многопоточным таймером. Просто будьте осторожны, потому что его обратный вызов вызывается в его собственном потоке, поэтому убедитесь, что ваша функция обратного вызова поточно-ориентирована, и существуют ограничения на то, что вам разрешено вызывать внутри этого потока. Лучше всего, чтобы он установил сигнал о том, что ваш реальный поток ожидает, а затем выполняет свою работу вне таймера.

Поскольку вы уже написали код, который работает в выделенном потоке, я предполагаю, что вы не ожидаете, что какой-либо код будет выполняться, пока этот код чего-то ждет. В этом случае вы можете просто вызвать Sleep либо с определенным числом миллисекунд, либо с небольшим количеством миллисекунд и использовать это в цикле, чтобы проверить Now или GetTickCount, чтобы увидеть, истекло ли определенное время. Использование Sleep также снизит нагрузку на процессор, поскольку операционная система сигнализирует о том, что вам не требуется, чтобы поток продолжал работать в течение этого времени.

Другие вопросы по тегам