multithreading - 将任意数据存储到对象实例中

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;

我希望 Hook 的虚拟方法在线程中执行自身，即延迟/延迟其执行。

为此，我使用 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 是推迟执行。因此将创建一个线程来设置SomeFlag 到 DirectExecute 并将再次调用相同的方法，但是在线程的上下文中。

3. 然后 OnBefore 再次触发(因为 Instance 是代理对象 即该方法是 Hook 方法)。这次 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 事件会为您完成“脏”工作。非常接近 C# 中的 Await 方法。

这就是主要思想!

更新:我重新编辑了整个问题以使其更加清晰。

Answer 1

你的做法是错误的。您尝试做的基本上是调用虚拟方法，但不再通过拦截器。由于拦截器本身已经在VMT内部注册了 stub ，通过invoke调用该方法将再次命中拦截器 stub ，从而导致递归。

我过去在 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 参数都不适合这种方法。