TVirtualMethodInterceptor (Delphi)

TVirtualMethodInterceptor (Delphi)

Contents

 [hide] 

• 1 Description
• 2 Code
• 3 Uses
• 4 See Also

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.