Ändern der Klassenhierarchie

[sakura]

So, jetzt mal ein etwas komplizierter Beitrag, der doch sehr einfach ist. Die meisten von Euch arbeiten ja doch mit der VCL - deswegen haben wir ja auch Delphi Nachdem ich mich ein wenig mit .NET beschäftigt habe, habe ich über die sog. Helper-Classes gelesen und fand die recht "nett". Irgendwie muss das doch auch mit den aktuellen Delphi-Versionen möglich sein, oder?

Ja, es ist, wenn auch mit ein paar Einschränkungen. So können zum Beispiel keine neuen Felder (Klassen-/Objekt-Variablen) eingefügt werden, da Delphi die Objektgröße bereits zur Kompilierungszeit festlegt. Ansonsten kann man einiges mit Hilfe der folgend beschriebenen Technik erreichen.

Zielsetzung

Alle Controls, welche intern mit der Botschaft WM_SETTEXT (TLabel, TForm, TPanel, ...) arbeiten sollen erweitert werden. Wenn der Text einer dieser Controls gesetzt wird, so soll dieser nach jedem Vorkommen Zeichenkette "[dp]" durchsucht werden. Jedes Vorkommen wird anschließend mit "Delphi-PRAXiS" ersetzt.

......

[sakura]

Die Grundlagen

Standardmäßig sieht die Klassenhierarchie in Delphi wie in der folgenden Grafik aus (stark zusammengeschrumpft!)

An der Originalstruktur können wir mit den dokumentierten Mitteln nur beschränkt etwas ändern. Voraussetzung dafür ist, das wir die Source-Codes zu sämtlichen genutzten Komponenten haben, damit wir diese neu kompilieren können. Dann ist es aber immer noch ein sich wohl nicht lohnender Aufwand, der beim nächsten Update von Delphi wieder neu gestartet werden muss. Dafür hätten wir allerdings größere Möglichkeiten. Da wir damit jedoch auch alles in Delphi zerstören könnten, lasse ich in diesem Tutorial die Finger von diesen Gedanken

Wie aber nun, können wir die folgende, veränderte Klassen-Struktur mit minimalem Aufwand erreichen?

Wie bereits erwähnt, können wir keine neuen Felder in die Klasse einfügen, aber dafür können wir immerhin das Verhalten beeinflussen.

......

[sakura]

Die Technik hinter der Lösung

Um die Klassenhierarchie zu beeinflussen, müssen wir ein wenig in die Klassenverwaltung von Delphi eindringen. Das ist gleichzeitig auch der Beweis für die von Euch, die wirklich glauben, daß Delphi für jedes Objekt auch alle Methoden einzeln vorbehält. Dem ist nämlich nicht so.

Damit wir die Klassenhierarchie der Klassen zur Laufzeit abändern können, müssen wir "lediglich" die Virtual Method Table (VMT) ein wenig manipulieren. In der Unit system.pas sind für uns die wichtigsten Konstanten deklariert, um auf die VMT zuzugreifen. Möge Borland auch in Zukunft hier keine Fehler einbauen

Delphi-Quellcode:

const
  vmtSelfPtr           = -76; // von Interesse
  vmtIntfTable         = -72;
  ...
  vmtInstanceSize      = -40;
  vmtParent            = -36; // von Interesse

Eigentlich muß nicht viel getan werden. Anhand dieser Konstanten ermitteln wir den Eintrag (Pointer) auf die Vorgängerklasse und überschreiben diese mit der aktuellen Adresse der neuen Klasse. Diese Änderung gilt von diesem Moment and für alle Klassen, welche von der veränderten Klasse abgeleitet wurden. Desweiteren gilt es auch mit sofortiger Wirkung für alle Objekte, welche dieser Klasse oder deren nachfolgenden Klassen abgeleitet wurden. Das lässt sich dadurch erklären, das Delphi immer in der VMT nachsieht, wenn vererbte Methoden aufgerufen werden. Somit können wir unseren Code einfach in die Struktur injizieren

Die folgende Prozedur erledigt genau dieses.

Delphi-Quellcode:

procedure ReplaceParentClass(clSuccessor, clNewPredecessor: TClass);
var
  OriginalProtection: Cardinal;
  pclPredecessorAddress, pclPredecessor: PPointer;
begin
  // check parameters
  if Assigned(clNewPredecessor) and Assigned(clSuccessor) then
  begin
    if clSuccessor.ClassParent = nil then
      raise Exception.Create('Successor Class has no parent to be replaced.');

    // get the class pointer to the address where the class predecessor is saved
    pclPredecessorAddress := Pointer(Integer(Pointer(clSuccessor)) + vmtParent);

    // get the class pointer of the new predecessor
    pclPredecessor := Pointer(Integer(Pointer(clNewPredecessor)) + vmtSelfPtr);

    // lock and protect the class tables against access from any other threads
    VirtualProtect(pclPredecessorAddress, SizeOf(Pointer), PAGE_READWRITE,
        @OriginalProtection);
    try
      // overwrite the predecessor information
      pclPredecessorAddress^ := pclPredecessor;
    finally
      // unlock the class tables
      VirtualProtect(pclPredecessorAddress, SizeOf(Pointer), OriginalProtection,
          nil);
    end;
  end;
end;

Was passiert hier

Als erstes sichern wir uns ab, das wir nicht den Vorgänger von TObject ändern sollen - das wäre tödlich und kann ungeahnte Auswirkungen haben. Als nächstes ermitteln wir die Speicheradresse, an welcher unsere Klasse, welche einen neuen Vorgänger erhalten soll, die Adresse von deren Vorgänger speichert. Anschließend ermitteln wir die Adresse der neuen Vorgängerklasse. Nun müssen wir noch den entsprechenden Speicherbereich manipulieren und schon sind wir fertig.

Ein kleines Demo-Projekt ist im Anhang

......

[sakura]

Na gut, vielleicht sollte ich noch kurz darauf eingehen. Ich war beim Vorbereiten des Tuts etwas voreifrig mit dem Posten

Wie bereits Eingangs erklärt, wollen wir die Text-darstellenden Komponenten dahingehend manipulieren, daß diese im Text jedes Vorkommen von "[dp]" mit "Delphi-PRAXiS" ersetzen. Dazu fangen wir einfach die Botschaft WM_SETTEXT ab. Hier die injizierte Klasse.

Delphi-Quellcode:

type
  TExtComponent = class(TComponent)
  private
    procedure WMSetText(var Msg: TWMSetText); message WM_SETTEXT;
  end;

{ TExtComponent }

procedure TExtComponent.WMSetText(var Msg: TWMSetText);
var
  TagPos: Integer;
  Dummy: String;
begin
  // get the text
  Dummy := Msg.Text;
  // look for replacement tag
  TagPos := AnsiPos('[dp]', Dummy);
  if TagPos > 0 then
  begin
    // at least one is found, lets change them!!!
    repeat
      Dummy := Copy(Dummy, 1, Pred(TagPos)) + 'Delphi-PRAXiS' + Copy(Dummy,
          TagPos + 4, MaxInt);
      TagPos := AnsiPos('[dp]', Dummy);
    until TagPos <= 0;
    // save new text
    Msg.Text := PAnsiChar(Dummy);
  end;
  // go on!
  inherited;
end;

Damit diese Klasse auch genutzt wird und der Effekt sichtbar wird, müssen wir die Klasse noch über die obige Prozedur in die Originale Hierarchie einschieben. Das geschieht am besten während der Initialisierungsphase des Programmes. Nicht vergessen, am Ende sollten wir es besser wieder rückgängig machen

Delphi-Quellcode:

initialization
  ReplaceParentClass(TControl, TExtComponent);
finalization
  ReplaceParentClass(TControl, TComponent);

......

[Luckie]

Die Pfeile sind etwas verwirrent. Müßten sie nicht von oben nach unten gehen? Jetzt sieht es so aus, als wenn TObjekt ein Nachfahre von TButton wäre.

[negaH]

Die Pfeile sollen die Class.ParentClass Hierarchie darstellen. So gesehen also richtig rum.

Gruß Hagen

[Luckie]

OK, gewonnen.

[sakura]

Luckie, dafür habe ich ModelMaker herangezogen, was auch sonst. Und da es nunmehr auch in seiner siebenten Version existiert, glabue ich schon, daß die Recht haben Das ganze kommt aus dem Bereich Ummel (UML)

......

[sabbelstein]

Hallo erstmal hier im Forum.

So nun mein anliegen:
Das Beispiel ist ja ganz nett und funktioniert soweit. Ich hab jetzt mal probiert noch neue attribute hinzuzufügen. hat aber leider nicht geklappt. eine idee?

Code:

type
  TExtComponent = class(TComponent)
  private

    procedure WMSetText(var Msg: TWMSetText); message WM_SETTEXT;
  public
    FNewAttrib:Cardinal;
  end;

danke euch

[jim_raynor]

Zitat von sabbelstein:

Ich hab jetzt mal probiert noch neue attribute hinzuzufügen. hat aber leider nicht geklappt. eine idee?

Dazu hat er doch was geschrieben:

Zitat von sakura:

Ja, es ist, wenn auch mit ein paar Einschränkungen. So können zum Beispiel keine neuen Felder (Klassen-/Objekt-Variablen) eingefügt werden, da Delphi die Objektgröße bereits zur Kompilierungszeit festlegt. Ansonsten kann man einiges mit Hilfe der folgend beschriebenen Technik erreichen.