TVirtualMethodInterceptor

[TiGü]

Kurios, Instance.ClassType zeigt im Debugger TSub an, meint aber zur Laufzeit, dass es nicht TSub ist?

Delphi-Quellcode:

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.

[Uwe Raabe]

Zitat von TiGü:

Kurios, Instance.ClassType zeigt im Debugger TSub an, meint aber zur Laufzeit, dass es nicht TSub ist?[/DELPHI]

Ja, das ist so, wenn ein Interceptor ins Spiel kommt. Teste doch spaßeshalber mal obj.ClassType = TSub vor und nach dem Proxify.

Man kann das aber trotzdem realisieren mit
  if Instance.ClassNameIs(TSub.ClassName) then

[himitsu]

Der Interceptor erstellt zur Laufzeit eine virtuelle Klasse, also einen Nachfahren der Klasse, wo du dich reinhookst.
Anschließend wird für "alle" virtuellen Methoden (virtual) quasi je eine generische Dummymethode erstellt, welche die Events des Interceptor aufruft.
Dann werden noch in der "kopierten" VirtualMethodTable (VMT) die Methodenzeiger überschrieben und durch die Dummymethoden ersetzt.
Und in dem gehookten Objekt wird nun noch die eigene Klassenreferenz (die vom Create) gegen die neue Klasse ausgetauscht.

Und schwups, schon ist deine Instanz eine "andere" Klasse.
Also quasi so, als wenn du TSub nochmal ableitest und dein Objekt damit erstellt hast, aber alle deine Prüfungen kennen nur TSup und TBase, aber nicht die letzte Ableitung.