TVirtualMethodInterceptor (Delphi)
Contents
[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.