64-разрядная DLL Delphi: проблемы с событиями OleCtrls

Я преобразовал DLL из 32-битной в 64-битную без проблем, но когда я загружаю эту DLL из 64-битного приложения, занимающего большой объем памяти, приложение падает и закрывается при загрузке DLL.

DLL представляет собой простую форму с TWebBrowser. Я использую Delphi 10 Сиэтл.

После отладки я обнаружил проблему 64-битного преобразования в модуле vcl "Vcl.OleCtrls.pas", решенную следующим образом:

procedure TOleControl.HookControlWndProc;
var
  WndHandle: HWnd;
begin
  if (FOleInPlaceObject <> nil) and (WindowHandle = 0) then
  begin
    WndHandle := 0;
    FOleInPlaceObject.GetWindow(WndHandle);
    if WndHandle = 0 then raise EOleError.CreateRes(@SNoWindowHandle);
    WindowHandle := WndHandle;
    //DefWndProc := Pointer(GetWindowLong(WindowHandle, GWL_WNDPROC));//OLD
    DefWndProc := Pointer(GetWindowLongPtr(WindowHandle, GWL_WNDPROC));
    CreationControl := Self;
    //SetWindowLong(WindowHandle, GWL_WNDPROC, Longint(@InitWndProc));//OLD
    SetWindowLongPtr(WindowHandle, GWL_WNDPROC, LONG_PTR(@InitWndProc));
    SendMessage(WindowHandle, WM_NULL, 0, 0);
  end;
end;

Это решает проблему сбоя, но события TWebBrowser больше не запускаются и происходят только на 64-битной версии.

Как исправить срабатывание событий TWebBrowser?

Нашли ли вы аналогичную проблему или обходной путь для исправления событий?

Спасибо


person ar099968    schedule 27.01.2017    source источник
comment
В WebBrowserEx этого дефекта гораздо больше. Нам очень сложно определить проблему без минимально воспроизводимого примера. Мой совет: включите распределение памяти сверху вниз на системном уровне и избавьтесь от всех дефектов. Emba ужасно плохо исправила свой сломанный 64-битный код.   -  person David Heffernan    schedule 27.01.2017
comment
FWIW, вам не нужно менять GetWindowLong, поскольку он реализуется путем вызова GetWindowLongPtr. Как и SetWindowLong. Проблема чисто в приведении к Longint. На самом деле вы могли бы использовать SetWindowLong(WindowHandle, GWL_WNDPROC, LONG_PTR(@InitWndProc)).   -  person David Heffernan    schedule 27.01.2017
comment
SetWindowSubclass() равно лучше и безопаснее использовать, чем SetWindowLongPtr(GWL_WNDPROC)   -  person Remy Lebeau    schedule 28.01.2017
comment
@Remy Это код Emba   -  person David Heffernan    schedule 28.01.2017
comment
Я не могу привести простой пример проблемы, но я нашел решение в других ошибках приведения.   -  person ar099968    schedule 01.02.2017


Ответы (1)


Я обнаружил еще одну ошибку приведения, которая создает проблему с событием TWebBrowser. В модуле Эмба "Vcl.OleCtrls.pas":

procedure TOleControl.InvokeEvent(DispID: TDispID; var Params: TDispParams);
{$IFDEF CPUX64}
var
  EventMethod: TMethod;
  ParamBlock : TParamBlock;
  i : Integer;
  StackParams2 : array of Int64;

begin
  GetEventMethod(DispID, EventMethod);
  //if Integer(EventMethod.Code) < $10000 then Exit; //OLD
  if Int64(EventMethod.Code) < $10000 then Exit;     //NEW

  ParamBlock.RegRCX := Int64(EventMethod.Data);
  ParamBlock.RegRDX := Int64(Self);

  if Params.cArgs > 2 then
  begin
    SetLength(StackParams2, Params.cArgs-2);
  end;

  for i := 1 to Params.cArgs do
    case i of
      1: ParamBlock.RegR8  := Int64(Params.rgvarg[Params.cArgs-1].unkVal);
      2: ParamBlock.RegR9  := Int64(Params.rgvarg[Params.cArgs-2].unkVal);
    else
      StackParams2[i-3] := Int64(Params.rgvarg[Params.cArgs-i].unkVal);
    end;

  ParamBlock.StackDataSize := Length(StackParams2) * sizeof(Pointer);
  ParamBlock.StackData := @StackParams2[0];

  RawInvoke(EventMethod.Code, @ParamBlock);
end;
{$ELSE !CPUX64}

Целочисленное приведение приводит к переполнению в ситуации с высоким использованием памяти, а выход из процедуры InvokeEvent не вызывает фактическое событие. Решено с помощью приведения Int64.

Я надеюсь, что Emba интегрирует это исправление и найдет аналог.

person ar099968    schedule 01.02.2017