TVirtualMethodInterceptor - Wie kann ich zwei Methoden vergleichen?

[Der schöne Günther]

Angenommen ich nehme mir einen System.Rtti.TVirtualMethodInterceptor für eine fiktive Klasse

Delphi-Quellcode:

TMyObject

mit u. A. einer

Delphi-Quellcode:

public procedure doStuff(); virtual;

.

Der Interceptor geht ja hin und "proxified" ja grundsätzlich erst einmal ALLE Methoden derer er habhaft werden kann. In meinen OnBefore, OnAfter und OnException-Events (soweit gesetzt) muss ich ja nun erst einmal prüfen, ob ich gerade überhaupt meine "doStuff"-Methode intercepte. Bislang ist mir nichts besseres eingefallen als ein simpler String-Vergleich wie

Delphi-Quellcode:

if (Method.Name = 'doStuff') then

.

Gibt es hier keinen besseren Weg (kein String, schnellerer Vergleich), beispielsweise irgendwelche Zeiger zu vergleichen?

Delphi-Quellcode:

Method.CodeAddress

liefert mir leider nichts was ich sonst irgendwo wiederfinde...


PS: Die Interception-Mechanismen in z.B. Spring4D habe ich bislang nur überflogen. Kann ich dort im Vorhinein sagen dass ich nur bestimmte Methoden (z.B. mit einem Attribut) intercepten will und nicht gleich alle? Das ist doch sicher kein unnormaler Anwendungsfall. Bislang müsste ich dafür die System.Rtti.pas modifizieren.

[himitsu]

Abgesehn davon, dass so das Programm auch extrem ausgebremst werden kann, wenn alles Intercepted ist, anstatt nur das gewollte.

Ich hatte mir da mal die Adressen der VMT gespeichert, den TVirtualMethodInterceptor auf die Klasse losgelassen und am Ende einfach alle Adressen wieder zurückgesetzt, welche ich nicht wollte.

Der TVirtualMethodInterceptor ist schon ein krankes Teil.
Es wäre ja nett, wenn da nicht alles so krankhaft weggekapselt wäre und man die Teilfunktionen auch einzeln nutzen könnte.

[Zacherl]

Einzelne Methoden zu hooken geht auch ohne RTTI recht trivial und zudem noch deutlich performanter.

Im Grunde musst du nur über die VMT der zu hookenden Instanz iterieren und dort den Zeiger auf deine Zielfuntkion suchen. Sobald du Diesen gefunden hast, sicherst du ihn und schreibst stattdessen den Zeiger zu deiner Callback-Funktion. Innerhalb der Callback-Funktion kannst du nun ganz dynamisch entscheiden, ob du die originale Funktion aufrufen willst (und sogar deren Parameter modifizieren, etc.).

[Der schöne Günther]

Was mir am TVirtualMethodInterceptor so sympathisch war: Er ist eine Abstraktion. Ich habe bis heute keine Ahnung was in einer VMT so üblicherweise drinsteht. Er tut fast 100%ig was er soll - Nur ein bisschen sehr schwerfällig und übermotiviert.

Als ersten Schritt wollte ich den String-Vergleich rausbekommen, denn kein Delphi-Refactoring-Tool der Welt erwischt so etwas, sollte die Methode einmal umbenannt werden (oder?).

[Zacherl]

Zitat:

Zitat von Der schöne Günther (Beitrag 1379815)

Als ersten Schritt wollte ich den String-Vergleich rausbekommen, denn kein Delphi-Refactoring-Tool der Welt erwischt so etwas, sollte die Methode einmal umbenannt werden (oder?).

Vollkommen korrekt, ja.

Die Delphi VMT ist COM-kompatibel, was bedeutet, dass sie einfach als

Delphi-Quellcode:

array of Pointer

implementiert ist und auch immer sein wird. Hierbei zeigt das erste Element auf die erste virtuelle Methode, das zweite Element auf die zweite virtuelle Methode, etc.

Hab mal aus dem Kopf ganz schnell was zusammengehackt:

Delphi-Quellcode:

type
  TBaseClass = class
  public
    procedure Virt1(const S: String); virtual;
    procedure Virt2(const S: String); virtual;
    procedure Virt3(const S: String); virtual;
  end;

  TDerivedClass = class(TBaseClass)
  public
    procedure Virt2(const S: String); override;
  end;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    class var FOriginalVirt2: procedure(Self: TBaseClass; const S: String);
    class procedure CallbackVirt2(Self: TBaseClass; const S: String); static;
  public
    procedure Hook(Instance: TObject; Target, Callback: Pointer; var OriginalFunc: Pointer);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TBaseClass }

procedure TBaseClass.Virt1(const S: String);
begin
  ShowMessage('A1: ' + S);
end;

procedure TBaseClass.Virt2(const S: String);
begin
  ShowMessage('A2: ' + S);
end;

procedure TBaseClass.Virt3(const S: String);
begin
  ShowMessage('A3: ' + S);
end;

{ TDerivedClass }

procedure TDerivedClass.Virt2(const S: String);
begin
  ShowMessage('B2: ' + S);
end;

class procedure TForm1.CallbackVirt2(Self: TBaseClass; const S: String);
begin
  FOriginalVirt2(Self, '[Intercepted]' + S);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  C: TBaseClass;
begin
  C := TDerivedClass.Create;
  try
    C.Virt2('test');
    // Wichtig ist hier `TDerivedClass.Virt2` und nicht `TBaseClass.Virt2` zu verwenden!
    Hook(C, @TDerivedClass.Virt2, @CallbackVirt2, @FOriginalVirt2);
    C.Virt2('test');
  finally
    C.Free;
  end;
end;

procedure TForm1.Hook(Instance: TObject; Target, Callback: Pointer; var OriginalFunc: Pointer);
type
  PVMT = ^TVMT;
  TVMT = array[0..0] of Pointer;
var
  VMT: PVMT;
  I: Integer;
  OldProtect: DWord;
begin
  VMT := Pointer(Pointer(Instance)^);
  I := 0;
  // Achtung: Endlosschleife, wenn Target nicht existiert!
  while (VMT^[I] <> Target) do
  begin
    Inc(I);
  end;
  ShowMessage(I.ToString);
  OriginalFunc := VMT^[I];
  VirtualProtect(VMT, I * SizeOf(Pointer), PAGE_READWRITE, OldProtect);
  VMT^[I] := Callback;
  VirtualProtect(VMT, I * SizeOf(Pointer), OldProtect, OldProtect);
end;

[backdraft]

Zitat:

Zitat von Zacherl (Beitrag 1379817)

Zitat:

Zitat von Der schöne Günther (Beitrag 1379815)

Als ersten Schritt wollte ich den String-Vergleich rausbekommen, denn kein Delphi-Refactoring-Tool der Welt erwischt so etwas, sollte die Methode einmal umbenannt werden (oder?).

Vollkommen korrekt, ja.

Die Delphi VMT ist COM-kompatibel, was bedeutet, dass sie einfach als

Delphi-Quellcode:

array of Pointer

implementiert ist und auch immer sein wird. Hierbei zeigt das erste Element auf die erste virtuelle Methode, das zweite Element auf die zweite virtuelle Methode, etc.

Hab mal aus dem Kopf ganz schnell was zusammengehackt:

Würde auch ein "inherited" in der FOriginalVirt2 funktionieren?
Könnte man sich so auch in den Destructor hängen von einer Klasse?