Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Algorithmen, Datenstrukturen und Klassendesign (https://www.delphipraxis.net/78-algorithmen-datenstrukturen-und-klassendesign/)
-   -   TVirtualMethodInterceptor (https://www.delphipraxis.net/196994-tvirtualmethodinterceptor.html)

Der schöne Günther 6. Jul 2018 18:25

TVirtualMethodInterceptor
 
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
Delphi-Quellcode:
TVirtualMethodInterceptor
aus
Delphi-Quellcode:
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
Delphi-Quellcode:
ShowMessage('After base method');
. Für die
Delphi-Quellcode:
OnBefore
oder
Delphi-Quellcode:
OnException
-Handler des
Delphi-Quellcode:
TVirtualMethodInterceptor
verhält es sich ebenso.


Wie kann ich feststellen dass
Delphi-Quellcode:
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
Delphi-Quellcode:
Method.Name
echt unschön ist.
Delphi-Quellcode:
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
Delphi-Quellcode:
Addr(TBase.testMethod)
überhaupt richtig ist. Angenommen, ich überlade testMethod(). Auf was Zeigt Addr(TBase.testMethod) dann eigentlich?

TiGü 10. Jul 2018 14:28

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

:gruebel:

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 10. Jul 2018 14:59

AW: TVirtualMethodInterceptor
 
Zitat:

Zitat von TiGü (Beitrag 1406861)
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
Delphi-Quellcode:
obj.ClassType = TSub
vor und nach dem Proxify.

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

himitsu 10. Jul 2018 15:43

AW: TVirtualMethodInterceptor
 
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.


Alle Zeitangaben in WEZ +1. Es ist jetzt 02:07 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz