存储任意数据到对象实例

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（方法1） - > 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再次开火（因为实例是proxified对象 即该方法是钩状方法）。这次SomeFlag是 DirectExecute并且该方法将被调用。

我在调用方法时使用了proxified对象（Instance var），因为我想让“Self”指向它。这样，如果method1调用同一类的其他虚拟方法，那么稍后也将在线程中自动执行。

为了做到这一点，我需要将标志存储在某处，即表示OnBefore的第二次调用该做什么。 我的问题是如何/在哪里存储“SomeFlag”，以便在OnBefore的两次调用期间可访问？ 该解决方案应该是跨平台的。建议/其他解决方案也是受欢迎的。

我想它可以通过VMT修补（link1,link2,link3）完成，但VirtualProtect是Windows的唯一功能，因此违反了跨平台的要求。

任何想法高度赞赏。

这是什么一回事：

想象一下，你可以有这种类的德尔福：

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＃中的等待方法。

这是主要思想！

UPDATE： 我重新编辑的整个问题，使之更加清晰。

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; 

既然你调用这个异步我离开处理的功能了 - 否则你必须检查方法的返回类型来传递正确的手柄，这里我们只是通过零。

对于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参数是一个没有去采用这种方法的原因很明显。