unit Unit3;
interface
uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs, System.Rtti;
type
TBase =
class
procedure testMethod();
virtual;
end;
TSub =
class(TBase)
procedure testMethod();
override;
end;
TForm3 =
class(TForm)
procedure FormCreate(Sender: TObject);
private
obj: TSub;
interceptor: TVirtualMethodInterceptor;
procedure interceptAfter(Instance: TObject; Method: TRttiMethod;
const Args: TArray<TValue>;
var Result: TValue);
{ Private declarations }
public
{ Public declarations }
end;
var
Form3: TForm3;
implementation
{$R *.dfm}
procedure TForm3.FormCreate(Sender: TObject);
var
clazz: TClass;
begin
obj := TSub.Create();
clazz := obj.ClassType();
interceptor := TVirtualMethodInterceptor.Create(clazz);
interceptor.OnAfter := interceptAfter;
interceptor.Proxify(obj);
obj.testMethod();
end;
procedure TForm3.interceptAfter(Instance: TObject; Method: TRttiMethod;
const Args: TArray<TValue>;
var Result: TValue);
var
Ptr1, Ptr2, Ptr3, Ptr4: Pointer;
obj: TSub;
MyMethod: TMethod;
begin
Ptr1 := Method.CodeAddress;
if Instance.ClassType = TBase
then
begin
Ptr2 := Addr(TBase.testMethod);
if Ptr1 = Ptr2
then
ShowMessage('
After base method');
end;
if Instance.ClassType = TSub
then
begin
Ptr3 := Addr(TSub.testMethod);
if Ptr1 = Ptr3
then
ShowMessage('
After sub method');
end;
end;
{ TBase }
procedure TBase.testMethod;
begin
end;
{ TSub }
procedure TSub.testMethod;
begin
inherited;
end;
end.