Хранить произвольные данные в экземпляре объекта

Question

Рассмотрим следующий пример:

type

  TTestClass = class
    public
      procedure method1; virtual;
  end;

  TForm2 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
  public
    vmi: TVirtualMethodInterceptor;
    ttc: TTestClass;
  end;

{ Initially SomeFlag is PostponeExecution }
procedure TForm2.FormCreate(Sender: TObject);
begin

  vmi := TVirtualMethodInterceptor.Create(TTestClass);
  ttc := TTestClass.Create;

  vmi.OnBefore :=
    procedure(Instance: TObject; Method: TRttiMethod;
      const Args: TArray<TValue>; out DoInvoke: Boolean;
        out Result: TValue)
    begin
      if { SomeFlag = DirectExecution } then
        DoInvoke := true
      else
      begin
        { SomeFlag := DirectExecution }
        TThread.CreateAnonymousThread(
          procedure
          begin                
            // Invoke() will trigger vmi.OnBefore 
            // because Instance is the proxified object
            // I want to keep "Self" to be the proxified object
            Method.Invoke(Instance, Args);
          end
        ).Start;
      end
    end;

  vmi.Proxify(ttc);

  ttc.method1;

end;

{ TTestClass }

procedure TTestClass.method1;
begin
  //  Do something async
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
  vmi.Unproxify(ttc);
  vmi.Free;
  ttc.Free;
end;

Я хочу, чтобы подключенный виртуальный метод выполнял себя в потоке, т.е. задерживал / откладывал выполнение.

Для этой цели я использую TVirtualMethodInterceptor для перехвата виртуальных методов данного класса. Когда виртуальный метод вызывается, vmi.OnBefore запускается. Это упрощенное представление моей идеи:

Call_VirtualMethod (method1) -> OnBefore_fires_1 -> CreateThread_and_InvokeAgain -> OnBefore_fires_2 -> DoInvoke: = true (т.е. непосредственно выполнять метод)

Объяснение:

1. Изначально SomeFlag имеет значение PostponeExecution.

2. Первый вызов ttc.method1 вызовет событие OnBefore (OnBefore_fires_1). Метод не будет выполнен, потому что SomeFlag - это PostponeExecution. Поэтому будет создан поток, который установит SomeFlag в DirectExecute и снова вызовет тот же метод, но в контексте потока.

3. Затем снова запускается OnBefore (поскольку Instance является проксируемым объектом, т.е. метод является подключаемым методом). На этот раз SomeFlag - это DirectExecute, и метод будет вызван.

Я использую проксифицированный объект (Instance var) при вызове метода, потому что я хочу, чтобы "Self" указывало на него. Таким образом, если method1 вызывает другой виртуальный метод того же класса, последний также будет автоматически выполнен в потоке.

Чтобы это произошло, мне нужно где-то хранить флаг, то есть указывать второй вызов OnBefore, что делать. У меня вопрос, как / где хранить "SomeFlag", чтобы он был доступен во время двух вызовов OnBefore? Решение должно быть кроссплатформенным. Предложения / другие решения также приветствуются.

Я предполагаю, что это можно сделать с помощью исправлений VMT ( link1, link2, link3), но VirtualProtect - это функция только для Windows, поэтому кросс-платформенное требование будет нарушено.

Любая идея высоко ценится.

О чем это все:

Представьте, что у вас может быть такой класс в Delphi:

TBusinessLogic = class
  public
    // Invokes asynchronously
    [InvokeType(Async)]
    procedure QueryDataBase;

    // Invokes asynchronously and automatically return asocciated ITask (via OnBefore event)
    [InvokeType(Await)]
    function DownloadFile(AUrl: string): ITask;

    // This method touches GUI i.e. synchonized
    [InvokeType(VclSend)]
    procedure UpdateProgressBar(AValue: integer);

    // Update GUI via TThread.Queue
    [InvokeType(VclPost)]
    procedure AddTreeviewItem(AText: string);

end;

...

procedure TBusinessLogic.QueryDataBase;
begin
  // QueryDataBase is executed ASYNC (QueryDataBase is tagged as Async)
  // Do heavy DB Query here

  // Updating GUI is easy, because AddTreeviewItem is tagged as VclPost
  for SQLRec in SQLRecords do
    AddTreeviewItem(SQLRec.FieldByName["CustomerName"].asString);
end;

Такой подход действительно упрощает многопоточность и синхронизацию. Больше не нужно вводить утки TThread.Synchronize(), TThread.Queue() и т. Д. Вы просто сосредотачиваетесь на бизнес-логике и вызываете соответствующие методы - событие OnBefore делает "грязную" работу за вас. Очень близко к методам Await в C#.

Это главная идея!

ОБНОВЛЕНИЕ:я отредактировал весь вопрос, чтобы сделать его более ясным.

Answer 1

Ваш подход неверен. В основном вы пытаетесь вызвать виртуальный метод, но без повторного прохождения через перехватчик. Поскольку сам перехватчик зарегистрировал заглушки внутри VMT, вызывающий метод через invoke, он снова попадет в заглушку перехватчика, вызывая рекурсию.

Я делал это в прошлом при перехвате Spring4D, выполняя вызов на более низком уровне, используя Rtti.Invoke рутина.

Вот как вы это делаете:

procedure DirectlyInvokeMethod(Instance: TObject; Method: TRttiMethod;
  const Args: TArray<TValue>);
var
  params: TArray<TRttiParameter>;
  values: TArray<TValue>;
  i: Integer;
begin
  params := Method.GetParameters;
  SetLength(values, Length(Args) + 1);
  values[0] := Instance;

  // convert arguments for Invoke call (like done in the DispatchInvoke methods
  for i := Low(Args) to High(Args) do
    PassArg(params[i], args[i], values[i + 1], Method.CallingConvention); // look at Rtti.pas for PassArg

  Rtti.Invoke(Method.CodeAddress, values, Method.CallingConvention, nil);
end;

Поскольку вы вызываете это асинхронно, я исключил обработку функций - иначе вы должны проверить ReturnType метода, чтобы передать правильный дескриптор, здесь мы просто передаем nil.

Для процедуры PassArg загляните в System.Rtt.pas.

Тогда вы просто называете это так:

vmi.OnBefore :=
  procedure(Instance: TObject; Method: TRttiMethod;
    const Args: TArray<TValue>; out DoInvoke: Boolean;
      out Result: TValue)
  begin
    DoInvoke := Method.Parent.Handle = TObject.ClassInfo; // this makes sure you are not intercepting any TObject virtual methods
    if not DoInvoke then // otherwise call asynchronously
      TThread.CreateAnonymousThread(
        procedure
        begin
          DirectlyInvokeMethod(Instance, Method, Args);
        end).Start;
  end;

Имейте в виду, что любые параметры var или out не подходят для этого подхода по очевидным причинам.