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
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;