Finden aller Klassen zur Laufzeit

[tgvoelker]

Ich bin, wie einige andere auch, an die Problemstellung geraten, sämtliche von einer bestimmten Klasse abgeleiteten Klassen ermitteln zu wollen. Bis dahin hatte ich mit Registrierroutinen gearbeitet, die ich dann manuell im Initialization-Abschnitt der jeweiligen Unit aufgerufen hatte - immer wieder dieselben Schritte bei jeder eingebundenen Unit. Aus dem Ansatz, die ganze Sache etwas einfacher zu machen, kam dann die Fragestellung, ob es nicht möglich sei, alle Klassen in einem Programm zu dessen Laufzeit zu enumerieren.

Ein Projekt (Delphi 2009), welches das Konzept zeigt, ist im Anhang.

[jaenicke]

Das geht über die RTTI aber wesentlich einfacher. :wink:

Eine Demo ist bei Delphi dabei, die genau das (und mehr) macht:
http://radstudiodemos.svn.sourceforg.../rtti_browser/
Darüber kannst du auch z.B. die Methoden der Klassen abrufen und welche Parameter die bekommen usw.

[tgvoelker]

Die entsprechenden Funktionen der RTTI sind erst ab D2010 verfügbar.

[himitsu]

Wobei du auf diese Weise auch immer mit False-Positives rechnen mußt, falls zufällig etwas Anderes der getesteten Struktur entspricht
und wenn mal jemand auf die Idee kommt etwas an den Strukturen zu ändern (in neueren/anderen Delphis oder FreePascal/Lazarus :stupid: ) ............


Aber ja, im Prinzip könnte man so alles Mögliche finden.

[tgvoelker]

Zitat:

Zitat von himitsu (Beitrag 1173496)

Wobei du auf diese Weise auch immer mit False-Positives rechnen mußt

Die werden wie folgt ausgeschlossen:

1. Prüfung: Zeigt ein ausgerichteter Pointer auf die eigene Adresse+Offset 88?
2. Prüfung: Entspricht der Klassenname beim Offset 32 dem, was der als TObjectClass gecastete Pointer aus (1) als "ClassName" zurückgibt? ==> EAccessError, wenn keine Klasse
3. Prüfung (redundant): über InheritsFrom(TObject).

Wenn die Methodenzeiger für GetClassName und InheritsFrom auf irgendwas zeigen, dann knallt es - ergo: keine Klasse.

[shmia]

Wenn jetzt die (hardcore) Funktionen getrennt vom Formular in einer eigenen Unit wären, dann würde ich den Code gerne zu meine Bibliothek hinzufügen. :wink:

[tgvoelker]

Code:

  procedure EnumForms;
  var pAddr:Cardinal;
      pPC:^Cardinal;
      pPS:^ShortString;
      pS,pCN:ShortString;
      pClass:TClass;
      pExcept,pB:Boolean;
  Begin
//nächste Zeile bereitet die Listen vor, zu denen später hinzugefügt wird
    SetUpLists;
    pExcept:=False;
    pAddr:=Cardinal(TObject)+vmtSelfPtr;
    while not pExcept do Begin
      try
        pPC:=Pointer(pAddr);
        if pPC^<>(pAddr-vmtSelfPtr) then Begin Inc(pAddr,4);Continue; End;
        pPC:=Pointer(pAddr-vmtSelfPtr+vmtClassName);
        try
          pPS:=Pointer(pPC^);
        except
          pExcept:=True;
          Continue;
        end;
        try
          pS:=pPS^;
          pClass:=Pointer(pAddr-vmtSelfPtr);
          pCN:=pClass.ClassName;
          pB:=pClass.InheritsFrom(TObject);
        except
          Inc(pAddr,4);
          Continue;
        end;
        if (pCN=pS)and(pB) then Begin
//hier prüfe ich auf Forms und füge die zu best. Listen hinzu. Der Part ist also variabel
          if pClass.InheritsFrom(TForm) And (pClass<>TForm) And (pClass<>TReferenceForm) then Begin
            if pClass.InheritsFrom(TReferenceForm) then PRefFormList.Add(pClass.ClassName);
            PFormList.AddObject(pClass.ClassName,TFormListDesc.Create(TFormClass(pClass)));
          End;
//Ende Prüfung
          pAddr:=Cardinal(pPS)+Length(pS)+1;
          if pAddr mod 4>0 Then pAddr:=((pAddr shr 2) shl 2)+4;
        End Else Inc(pAddr,4);
      except
        pExcept:=True;
      end;
    End;
  End;