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） - ＆gt; OnBefore_fires_1 - ＆gt; CreateThread_and_InvokeAgain - ＆gt; OnBefore_fires_2 - ＆gt; DoInvoke：= true（即直接执行方法）

说明：

最初，SomeFlag的值为PostponeExecution。
第一次调用ttc.method1将触发OnBefore事件（OnBefore_fires_1）。这个方法不会执行，因为SomeFlag是 PostponeExecution。因此将创建一个将设置的线程 SomeFlag to DirectExecute并将再次调用相同的方法，但是在线程的上下文中。
然后OnBefore再次触发（因为Instance是代理对象即该方法是钩子方法）。这次是SomeFlag 将调用DirectExecute和方法。

我在调用方法时使用代理对象（Instance var），因为我想要＆＃34; Self＆＃34;指向它。这样，如果method1调用同一个类的其他虚方法，则后者也将在一个线程中自动执行。

为了实现这一点，我需要将标志存储在某个地方，即指示OnBefore的第二个呼叫要做什么。我的问题是如何/在哪里存储＆＃34; SomeFlag＆＃34;所以在两次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事件执行＆＃34;脏＆＃34;为你工作。非常接近C＃中的Await方法。

这是主要的想法！

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

Answer 1

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

我在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;

由于你是异步调用它，我将函数处理掉了 - 否则你必须检查Method的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参数都不适用于此方法。

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

1 个答案: