AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

TVirtualMethodInterceptor

Ein Thema von Der schöne Günther · begonnen am 6. Jul 2018 · letzter Beitrag vom 10. Jul 2018
Antwort Antwort
TiGü

Registriert seit: 6. Apr 2011
Ort: Berlin
3.071 Beiträge
 
Delphi 10.4 Sydney
 
#1

AW: TVirtualMethodInterceptor

  Alt 10. Jul 2018, 15:28
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.
  Mit Zitat antworten Zitat
Benutzerbild von Uwe Raabe
Uwe Raabe
Online

Registriert seit: 20. Jan 2006
Ort: Lübbecke
11.604 Beiträge
 
Delphi 12 Athens
 
#2

AW: TVirtualMethodInterceptor

  Alt 10. Jul 2018, 15:59
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
Uwe Raabe
Certified Delphi Master Developer
Embarcadero MVP
Blog: The Art of Delphi Programming
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
44.318 Beiträge
 
Delphi 12 Athens
 
#3

AW: TVirtualMethodInterceptor

  Alt 10. Jul 2018, 16:43
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.
Ein Therapeut entspricht 1024 Gigapeut.
  Mit Zitat antworten Zitat
Antwort Antwort

 

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 13:17 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz