TVirtualMethodInterceptor (Delphi)
Contents
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.
Uses
- System.Rtti.TVirtualMethodInterceptor.OnBefore ( fr | de | ja )
- System.Rtti.TVirtualMethodInterceptor.Proxify ( fr | de | ja )
- System.Rtti.TRttiMethod ( fr | de | ja )