TVirtualMethodInterceptor

[Der schöne Günther]

Es wird wieder etwas esoterisch. Angenommen ich habe folgende zwei Klassen:

Delphi-Quellcode:

   TBase = class
      procedure testMethod(); virtual;
   end;

   TSub = class(TBase)
      procedure testMethod(); override;
   end;

und lasse einen TVirtualMethodInterceptor aus System.Rtti darauf los:

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
begin
   obj := TSub.Create();
   interceptor := TVirtualMethodInterceptor.Create( obj.ClassType() );
   interceptor.OnAfter := interceptAfter;
   interceptor.Proxify(obj);

   obj.testMethod();
end;

procedure TForm1.interceptAfter(Instance: TObject; Method: TRttiMethod; const Args: TArray<TValue>; var Result: TValue);
begin
   if Method.CodeAddress = Addr(TBase.testMethod) then
      ShowMessage('After base method');
   if Method.CodeAddress = Addr(TSub.testMethod) then
      ShowMessage('After sub method');
end;

Dann bekomme ich leider ein ShowMessage('After base method'); . Für die OnBefore oder OnException -Handler des TVirtualMethodInterceptor verhält es sich ebenso.


Wie kann ich feststellen dass TSub.testMethod() ausgeführt wird? Ich hatte den Compiler im Verdacht dass er mir hier das inlined und es in Wirklichkeit keine virtuelle Methode ist. Wirklich prüfen und beweisen könnte ich das aber wahrscheinlich nur wenn ich mit Assemblercode lesen könnte.


PS: Leicht ähnliches Thema: https://www.delphipraxis.net/193681-...rgleichen.html
Meine Motivation ist dass halt bei einer bestimmten Methode dazwischen grätschen will und der String-Vergleich mit Method.Name echt unschön ist. Method.CodeAddress sieht da gleich viel besser aus, das funktioniert ja auch wenn jemand die Methode umbenennt.


PPS: Ich bin mir generell unsicher ob das Statement Addr(TBase.testMethod) überhaupt richtig ist. Angenommen, ich überlade testMethod(). Auf was Zeigt Addr(TBase.testMethod) dann eigentlich?

[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.