Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Delphi Hook auf Propertys, Konstruktoren, Destruktoren? (https://www.delphipraxis.net/101858-hook-auf-propertys-konstruktoren-destruktoren.html)

SubData 19. Okt 2007 07:48


Hook auf Propertys, Konstruktoren, Destruktoren?
 
Aloa...

Ich hab da mal ein kleines Problem mit Hooks.
Ein Hook auf eine normale Prozedur oder Funktion ist kein Problem (uAllCollection, CodeHook, etc.)
Auch wenn ich die Adressen von Hand patche funktioniert der ganze Kram wie gewünscht,
was aber absolut nicht laufen will sind Hooks auf Propertys, Konstruktoren, Destruktoren.

Beispiel:

Delphi-Quellcode:
type
  TTableEx = class(TTable)
  public
    constructor Create(AOwner: TComponent);
    destructor Destroy;
    procedure Free;
    procedure SetRange(const StartValues, EndValues: array of const);
  end;

var
//  geht nicht
  TableExConstProc : function (Self: TObject; AOwner: TComponent): TObject;
//  geht auch nicht
//  TableExConstProc : procedure (Self: TObject; AOwner: TComponent);
//  nich compilierbar...
//  TableExConstProc : constructor (Self: TObject; AOwner: TComponent);
  TableExDestProc  : procedure (Self: TObject); register;
  TableExFreeProc  : procedure (Self: TObject);
  TableExRangeProc : procedure (Self: TObject; const StartValues, EndValues: array of const);


implementation


constructor TTableEx.Create(AOwner: TComponent);
begin
  OutputDebugString('CreateEx');
  Result := TableExConstProc(Self, AOwner);
end;

procedure TTableEx.DestroyEx;
begin
  OutputDebugString('DestroyEx');
  TableExDestProc(Self);
end;

procedure TTableEx.Free;
begin
  OutputDebugString('FreeEx');
  TableExFreeProc(Self);
end;

procedure TTableEx.SetRange(const StartValues, EndValues: array of const);
begin
  OutputDebugString('SetRangeEx');
  TableExRangeProc(Self, StartValues, EndValues);
end;


procedure Hook;
begin
  HookCode(@TTable.SetRange, @TTableEx.SetRange, @TableExRangeProc);
  HookCode(@TTable.Create, @TTableEx.Create, @TableExConstProc);
  HookCode(@TTable.Destroy, @TTableEx.Destroy, @TableExDestProc);
  HookCode(@TTable.Free, @TTableEx.Free, @TableExFreeProc);
end;
Ein Hook auf SetRange funktioniert ohne Probleme.
Ein Hook auf Free funktioniert ebenfalls, hookt nur leider nicht TTable.Free, da nicht vorhanden, sondern TObject.Free, was nicht ganz in meinem Sinne ist.

Ein Hook auf den Konstruktor funktioniert nicht.
Oder liegt das einfach nur an einer falschen Definition der Prozedur-Variablen?

Habs natürlich auch mit den entsprechenden Directiven versucht (register, etc).
Leider ebenfalls ohne Erfolg.

Ist der interne Aufbau eines Konstruktors denn so abstrakt, dass ein Hook nicht funktionieren kann?

Mit Propertys hab ich ebenfalls das Problem, dass in dem Fall ja Setter und Getter unterschiedlich sind.


Danke schonmal an alle, die sich darüber den Kopf zerbrechen ;>


Edit:
Mir geht es natürlich darum, dass der eigentlich Aufruf ja hinterher wieder umgeleitet wird auf die originale Prozedur.
Der reine Hook in eine andere Richtung funktioniert natürlich ebenfalls mit den Konstruktoren / Destruktoren.

SubData 22. Okt 2007 10:42

Re: Hook auf Propertys, Konstruktoren, Destruktoren?
 
Ein Teil des Problems ist mittlerweile gelöst.

Delphi-Quellcode:
procedure Hook;
var
  p : procedure (Self: TObject; Value: String);
begin
  p := GetPropInfo(TTable, 'TableName').SetProc;
  HookCode(@p, @TTableEx.SetEx, @TableExSetProc);
end;
Damit lässt sich zumindest ein Hook auf eine Property realisieren.
Leider nicht auf Konstruktoren / Destruktoren.

Falls da noch jemand was zu hat, wäre ich sehr dankbar :)

shmia 22. Okt 2007 17:50

Re: Hook auf Propertys, Konstruktoren, Destruktoren?
 
Dass das hooken von .Free nichts bringt, hast du ja schon gesehen.
Also musst du .Destroy abfangen.
Diese Methode ist aber in der VMT abgelegt.
Ich hätte hier 2 (ungetestete!!!) Varianten anzubieten:
Delphi-Quellcode:
function GetDestructor(AClass:TClass):Pointer;
asm
        TEST   EAX,EAX
        JE     @@exit
        MOV    EAX, [EAX].vmtDestroy
@@exit:
end;


function GetDestructor2(AClass:TClass):Pointer;
begin
   if Assigned(AClass) then
   begin
      Result := Pointer(AClass);
      Result := Pointer(PInteger(PChar(Result)+vmtDestroy)^);
   end
   else
      Result := nil;
end;

SubData 22. Okt 2007 18:40

Re: Hook auf Propertys, Konstruktoren, Destruktoren?
 
Hm... Den Pointer auf den Destruktor zu bekommen ist ja nichtmal das Problem.
@Destroy liefert mir ja, was ich möchte.
Das Problem ist aber nach dem Patch auf meine eigene Destroy Prozedur wieder auf den originalen Destruktor zu springen...

Rein von der Optik her, dürfte dein Code dabei auch nicht helfen, aber ich werds morgen mal ausgiebig testen :)

Auf jeden Fall vielen Dank!

jbg 22. Okt 2007 18:58

Re: Hook auf Propertys, Konstruktoren, Destruktoren?
 
Konstruktoren und Destruktoren haben einen verstecken Parameter im DL Register.
Eine einfachere Variante wäre "AfterConstruction" und "BeforeDestruction" zu hooken.

SubData 22. Okt 2007 19:10

Re: Hook auf Propertys, Konstruktoren, Destruktoren?
 
Hm, das heißt man könnte gar keine Funktion so definieren, dass sie einem Konstruktor / Destruktor gleicht?
Die Idee mit den Events wäre natürlich eine Alternative.

Warum bin ich da nicht drauf gekommen? :wall:

jbg 22. Okt 2007 19:23

Re: Hook auf Propertys, Konstruktoren, Destruktoren?
 
Zitat:

Zitat von SubData
Hm, das heißt man könnte gar keine Funktion so definieren, dass sie einem Konstruktor / Destruktor gleicht?

Das schon. Man muss aber das DL Register sichern, um es weiter reichen zu können.

Zitat:

Die Idee mit den Events wäre natürlich eine Alternative.
Das sind doch keine Events sondern "nur" virtuelle Methoden. :wink:

SubData 22. Okt 2007 22:20

Re: Hook auf Propertys, Konstruktoren, Destruktoren?
 
Zitat:

Zitat von jbg
Das sind doch keine Events sondern "nur" virtuelle Methoden. :wink:

Äh, ja, ein wenig missverständlich ausgedrückt.
Es ist im Grunde ja ein "Ereignis", nämlich "Konstruktion abgeschlossen" ...

Ich hoffe du verstehst, was ich meine ;>


Alle Zeitangaben in WEZ +1. Es ist jetzt 18:58 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