TVirtualMethodInterceptor (Delphi)

最新推荐文章于 2023-10-23 15:27:30 发布

转载最新推荐文章于 2023-10-23 15:27:30 发布 · 277 阅读

delphi 专栏收录该内容

44 篇文章

订阅专栏

本文详细介绍了在Delphi中如何使用TVirtualMethodInterceptor类来动态地从一个类派生，覆盖方法并改变实例的运行时类型。通过示例代码展示了如何拦截虚拟方法调用，包括在销毁过程中调用的方法。

TVirtualMethodInterceptor (Delphi)

[hide]

Description

Use the TVirtualMethodInterceptor class to derive from a class at run time, override methods (but not add new instance fields), and then change the run-time type of an instance to this new derived class.

Notice that all the virtual methods are intercepted, including those called during destruction, not just the one declared here. (The destructor itself is not included.)

Code

uses
  SysUtils,
  Rtti;

type
  TFoo = class
    // Frob doubles x and returns the new x + 10
    function Frob(var x: Integer): Integer; virtual;
  end;

function TFoo.Frob(var x: Integer): Integer;
begin
  x := x * 2;
  Result := x + 10;
end;

procedure WorkWithFoo(Foo: TFoo);
var
  a, b: Integer;
begin
  a := 10;
  Writeln('  [WorkWithFoo] before: a = ', a);
  try
    b := Foo.Frob(a);
    Writeln('  [WorkWithFoo] Result = ', b);
    Writeln('  [WorkWithFoo] after:  a = ', a);
  except
    on e: Exception do
      Writeln('  Exception: ', e.ClassName);
  end;
end;

procedure P;
var
  foo: TFoo;
  vmi: TVirtualMethodInterceptor;
begin
  vmi := nil;
  foo := TFoo.Create;
  try
    Writeln('Before hackery:');
    WorkWithFoo(foo);

    vmi := TVirtualMethodInterceptor.Create(foo.ClassType);

    vmi.OnBefore := procedure(Instance: TObject; Method: TRttiMethod;
      const Args: TArray<TValue>; out DoInvoke: Boolean; out Result: TValue)
    var
      i: Integer;
    begin
      Write('[OnBefore] Calling ', Method.Name, ' with args: ');
      for i := 0 to Length(Args) - 1 do
        Write(Args[i].ToString, ' ');
      Writeln;
    end;

    // Change foo's metaclass pointer to our new dynamically derived
    // and intercepted descendant
    vmi.Proxify(foo);

    Writeln('After interception:');
    WorkWithFoo(foo);
  finally
    foo.Free;
    vmi.Free;
  end;
end;

begin
  P;
  readln; // To see what's in console before it goes away.
end.