Ä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.

...:cat:...

[sakura]

Die Grundlagen

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

http://www.delphipraxis.net/specials...es/default.gif

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?

http://www.delphipraxis.net/specials...s/extended.gif

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.

...:cat:...

[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. :shock: 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 ;-)

...:cat:...

[sakura]

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

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

...:cat:...

[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 :-D Das ganze kommt aus dem Bereich Ummel (UML) ;-)

...:cat:...

[sabbelstein]

Hallo erstmal hier im Forum. :hi:

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:

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:

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.

[sabbelstein]

:duck:

mmh sorry hab ich überlesen is wohl schon spät ;)

gibts irgendwie eine andere möglichkeit jeder componente ein attribut hinzuzufügen ohne die sourcen zu ändern?

[sakura]

Wenn Du auf .NET (und Delphi.NET) umsteigst, dann ja. Da wurde das von vornherein mit ins Konzept aufgenommen. Prominentestes Beispiel ist die ToolTip Komponente. In Delphi für Win32 leider: nein.

...:cat:...

[Shaman]

Hallo zusammen

Was ist mit dem is-Operator? Der bekommt die Änderung anscheinend nicht mit und funktioniert nicht mehr.

Ich will in einem Message-Handler folgendes realisieren:

Delphi-Quellcode:

begin
  if Self is TWinControl then
    with TWinControl(Self) do
    begin
       {...}
    end;
end;

Dabei ersetze ich den Vorfahren von TWinControl.

Gruss
Shaman

[alcaeus]

Zitat:

Zitat von Shaman

...Der bekommt die Änderung anscheinend nicht mit und funktioniert nicht mehr.

Ich will in einem Message-Handler folgendes realisieren:

Kannst du bitte mal sagen WAS nicht funktioniert und WIE sich das aeussert? Ausserdem, auf welcher Delphi-Version testest du das? Bei mir funktioniert is einwandfrei

Greetz
alcaeus

[Shaman]

Also, ich ersetze den Vorfahren von TWinControl (TControl) mit:

Delphi-Quellcode:

type
  TControlEx = class(TControl)
  private
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure WMSetText(var Msg: TWMSetText); message WM_SETTEXT;
  end;

In den Prozeduren möchte ich nun prüfen, ob Self ein TWinControl ist. Doch bei der is-Abfrage bringt er mir inkompatible Typen. Aber hab grad gemerkt, mit InheritsFrom scheints zu klappen...

Gruss
Shaman

[Robert_G]

Zitat:

Zitat von Shaman

In den Prozeduren möchte ich nun prüfen, ob Self ein TWinControl ist. Doch bei der is-Abfrage bringt er mir inkompatible Typen. Aber hab grad gemerkt, mit InheritsFrom scheints zu klappen...

Der IS Operator kann ja auch nicht wissen was du da zur Laufzeit machst. ;)

[Shaman]

Stimmt ja :wall:

Merci

[maximov]

Zitat:

Zitat von Robert_G

...
Der IS Operator kann ja auch nicht wissen was du da zur Laufzeit machst. ;)

wieso nicht ? Der Is-operator ist doch der laufzeit-klassenprüf-operator.

Delphi-Quellcode:

function _IsClass(Child: TObject; Parent: TClass): Boolean;
begin
  Result := (Child <> nil) and Child.InheritsFrom(Parent);
end;

[Robert_G]

Zitat:

Zitat von maximov

Zitat:

Zitat von Robert_G

...
Der IS Operator kann ja auch nicht wissen was du da zur Laufzeit machst. ;)

wieso nicht ? Der Is-operator ist doch der laufzeit-klassenprüf-operator.

Sicher. Trotzdem kann es beim Kompilieren knallen wenn es für den Compiler absolut unmöglich erscheint, dass A von B abgeleitet ist. ;)

Nachtrag:
Bevor die nächste Frage kommt. Einfach selbst testen ;)

Delphi-Quellcode:

type
   TBase = class
   end;

     T1stDescendant = class(TBase)
   end;

   T2ndDescendant = class(TBase)
   end;
   TComparedType = class(T2ndDescendant)
   end;

var
  X : TComparedType;
begin
   if X is TBase then
      Writeln('ist TBase'); // geht

   if X is T1stDescendant then
      Writeln('ist T1stDescendant'); // knallt
end.

[maximov]

Zitat:

Zitat von Robert_G

Zitat:

Zitat von maximov

Zitat:

Zitat von Robert_G

...
Der IS Operator kann ja auch nicht wissen was du da zur Laufzeit machst. ;)

wieso nicht ? Der Is-operator ist doch der laufzeit-klassenprüf-operator.

Sicher. Trotzdem kann es beim Kompilieren knallen wenn es für den Compiler absolut unmöglich erscheint, dass A von B abgeleitet ist. ;)

Nachtrag:
Bevor die nächste Frage kommt. Einfach selbst testen ;)
...

Da is der kompiler natürlich ein bisschen übereifrig - aber recht hatta ja. Wenn man es wirkt wissen will, dann muss man ihn halt täuschen:

Delphi-Quellcode:

...
var
  X : TComparedType;
begin
   if X is TBase then
      Writeln('ist TBase'); // geht

   if TObject(X) is T1stDescendant then
      Writeln('ist T1stDescendant'); // knallt
end.

Aber das führt zu nix, da man, wie schon gesagt wurde, gleich InheritsFrom benutzen kann. Gut das wir das geklärt haben :stupid:

[Shaman]

Hm, und was ist mit virtuellen Methoden? Kann man die nicht überschreiben?

Delphi-Quellcode:

type
  TControlEx = class(TControl)
  protected
    procedure SetEnabled(Value: Boolean); override;
  end;

... wird bei mir nicht aufgerufen :?

Gruss
Shaman

[Shaman]

Ich würde einfach noch gerne wissen, was denn genau alles möglich ist. Bis jetzt konnte ich nämlich nur Message-Handler für WM_* Botschaften erweitern, und das ist doch ein biiiisschen wenig :gruebel:

Gruss
Shaman