Delphi: Zur Laufzeit Fund Klassen, die von einer bestimmten Basisklasse absteigen?

Question

Ist auf dem Weg dorthin zur Laufzeit, alle Klassen zu finden, die von einer bestimmten Basisklasse absteigen?

Zum Beispiel so tut, gibt es eine Klasse:

TLocalization = class(TObject)
...
public
   function GetLanguageName: string;
end;

oder so tut, gibt es eine Klasse:

TTestCase = class(TObject)
...
public
   procedure Run; virtual;
end;

oder so tut, gibt es eine Klasse:

TPlugIn = class(TObject)
...
public
   procedure Execute; virtual;
end;

oder so tut, gibt es eine Klasse:

TTheClassImInterestedIn = class(TObject)
...
public
   procedure Something;
end;

Zur Laufzeit möchte ich alle Klassen finden, die von TTestCase absteigen, so dass ich Sachen tun kann mit ihnen.

Kann die RTTI für diese Informationen abgefragt werden?

Alternativ: Gibt es eine Möglichkeit in Delphi jede Klasse zu gehen? Ich kann dann rufen Sie einfach an:

RunClass: TClass;

if (RunClass is TTestCase) then
begin
   TTestCase(RunClass).Something;
end;

Siehe auch

• alle Klassen suchen, die ableiten von einer bestimmten Basisklasse in python
• Java: Bei Laufzeit, finden Sie alle Klassen in Anwendung, die eine Basisklasse
erweitern

Answer 1

Nun ja, es gibt einen Weg, aber du wirst es nicht mögen. (Appearantly, ich brauche einen Haftungsausschluss wie diese, meint sonst perfekt hilfreich Kommentar zu verhindern, durch die ach so kenntnisreich downvoted bekommen, aber nicht so nachsichtig ‚Senioren‘ SO-Mitglieder).

Zur Info: Die folgende Beschreibung ist ein High-Level Überblick über ein Stück Code, den ich schrieb eigentlich, wenn Delphi 5 die letzte war und am größten. Seitdem wurde dieser Code auf neuere Versionen Delphi portiert (derzeit bis Delphi 2010) und funktioniert immer noch!

Für den Anfang müssen Sie wissen, dass eine Klasse ist nichts anderes als eine Kombination aus einer VMT und die begleitenden Funktionen (und vielleicht einige Art-Info, je nach Compiler-Version und -Einstellungen). Wie Sie wahrscheinlich wissen, eine Klasse - als TClass vom Typ identifiziert - ist nur ein Zeiger auf die Speicheradresse, die VMT Klassen. Mit anderen Worten: Wenn Sie die Adresse des VMT einer Klasse bekannt ist, dass der TClass Zeiger als auch ist

.

Mit diesem Stück Wissen fest in Ihrem Kopf stecken, können Sie eigentlich Scan ausführbare Speicher und für jede Adresse Test, wenn es sieht aus wie "ein VMT. Alle Adressen, die eine VMT Dose zu sein scheinen als zu einer Liste hinzugefügt werden, was zu einer vollständigen Übersicht über alle Klassen enthalten ist in der ausführbaren Datei! (Eigentlich ist dies auch erhalten Sie Zugriff auf Klassen deklariert ausschließlich bei der Durchführung Schnitt einer Einheit und Klassen linked-in von Komponenten und Bibliotheken, die als Binärdateien verteilt sind!)

Sicher, es gibt ein Risiko, dass einige Adressen scheinen eine gültige VMT zu sein, sind aber tatsächlich einige zufälligen andere Daten (oder Code) - aber mit den Tests, die ich habe kommen mit, hat dies noch nie mit mir passiert (in ca. 6 Jahre diesen Code in mehr als zehn aktiv gepflegt Anwendungen ausgeführt werden).

Also hier ist die Kontrollen Sie tun sollen (in genau dieser Reihenfolge!):

1. Ist die Adresse gleich der Adresse von TObject? Wenn ja, ist diese Adresse ein VMT und wir sind fertig!
2. lesen TClass (Adresse) .ClassInfo; Wenn es zugeordnet:
   1. sollte es in einem Code-Segment fallen (nein, ich will nicht ins Detail gehen auf das - es einfach mal googlen up)
   2. das letzte Byte dieses Class (bestimmt durch Zugabe von SizeOf (TTypeInfo) + SizeOf (TTypeData)) sollte ebenfalls innerhalb dieses Code-Segment
   fallen
   3. diese Class (die vom Typ PTypeInfo ist) sollte es ist eine Art Feldsatz zu tkClass haben
   4. Anruf GetTypeData auf diesem Class, was zu einem PTypeData
      1. Dies sollte auch in einem gültigen Codesegment
      fallen
      2. Es ist letzte Byte (bestimmt durch Zugabe von SizeOf (TTypeData)) fallen sollte auch innerhalb dieser Code-Segment
      3. Von diesem Classtype Feld des Typedata es sollte auf die Adresse gleich getestet.
3. Lesen Sie jetzt die VMT-zusein am Offset vmtSelfPtr und testen, ob diese Ergebnisse in der Adresse getestet werden (sollte sich zeigen)
4. Read vmtClassName und prüfen, ob das auf einen gültigen Klassennamen (Kontroll Zeiger zu residieren in einem gültigen Segment wieder, dass die String-Länge ist akzeptabel, und IsValidIdent sollte return true)
5. Lesen vmtParent - es sollte auch in einem gültigen Codesegment
fallen
6. Nun werfen zu einem TClass und lesen Classparent - es sollte auch in einem gültigen Code-Segment fallen
7. lesen vmtInstanceSize, sollte es sein> = TObject.InstanceSize und <= MAX_INSTANCE_SIZE (Ihre eigenen bestimmen)
8. Lesen vmtInstanceSize von seinem Classparent, sollte es auch sein> = TObject.InstanceSize und <= die zuvor gelesenen Instanz Größe (Elternklassen können nie größer sein als Kind Klassen)
9. Optional können Sie auch überprüfen, ob alle VMT Einträge aus Index 0 und sind nach oben gültigen Code Zeiger (obwohl es ein bisschen problematisch ist die Anzahl der Einträge in einer VMT zu bestimmen ... es gibt keinen Indikator für diese).
10. Recurse diese Kontrollen mit dem Classparent. (Dies sollte den TObject Test oben erreichen, oder scheitert kläglich!)

Wenn alle diese Prüfungen halten, ist der Test-Adresse ist eine gültige VMT (soweit ich betroffen bin) und kann seindie Liste hinzugefügt.

Viel Glück all diese Umsetzung, es hat mich etwa eine Woche, dieses Recht zu bekommen.

Bitte sagen, wie es für Sie funktioniert. Cheers!

Answer 2

Es kann mit RTTI getan werden, aber nicht in Delphi 5. Um alle Klassen zu finden, die einem bestimmten Kriterium entsprechen, müssen Sie zunächst in der Lage sein zu alle Klassen finden , und die RTTI-APIs notwendig, das zu tun wurden in Delphi eingeführt 2010. Sie es tun würde, so etwas wie folgt aus:

function FindAllDescendantsOf(basetype: TClass): TList<TClass>;
var
  ctx: TRttiContext;
  lType: TRttiType;
begin
  result := TList<TClass>.Create;
  ctx := TRttiContext.Create;
  for lType in ctx.GetTypes do
    if (lType is TRttiInstanceType) and
       (TRttiInstanceType(lType).MetaclassType.InheritsFrom(basetype)) then
      result.add(TRttiInstanceType(lType).MetaclassType);
end;

Answer 3

Ian, wie Mason sagt der TRttiContext.GetTypes Funktion erhalten die Liste der alle RTTI-Objekte, die Typinformationen zur Verfügung stellen. aber diese Funktion wurde in Delphi eingeführt 2010.

Als Abhilfe Sie können Ihre Basisklasse von der TPersistent Klasse erben und dann registriert manuell jede Klasse mit der RegisterClass Funktion (ich weiß Weicht das ist ärgerlich).

dann mit dem TClassFinder Objekt können Sie alle registrierten Klassen abgerufen werden.

finden Sie in diesem Beispiel

type
  TForm12 = class(TForm)
    Memo1: TMemo; // a TMemo to show the classes in this example
    ButtonInhertisFrom: TButton;
    procedure FormCreate(Sender: TObject);
    procedure ButtonInhertisFromClick(Sender: TObject);
  private
    { Private declarations }
    RegisteredClasses : TStrings; //The list of classes
    procedure GetClasses(AClass: TPersistentClass); //a call procedure used by TClassFinder.GetClasses
  public
    { Public declarations }
  end;

  TTestCase = class (TPersistent) //Here is your base class 
  end;

  TTestCaseChild1 = class (TTestCase) //a child class , can be in any place in your application
  end;

  TTestCaseChild2 = class (TTestCase)//another child class
  end;

  TTestCaseChild3 = class (TTestCase)// and another child class
  end;

var
  Form12: TForm12;

implementation

{$R *.dfm}

//Function to determine if a class Inherits directly from another given class
function InheritsFromExt(Instance: TPersistentClass;AClassName: string): Boolean; 
var
  DummyClass : TClass;
begin
  Result := False;
  if Assigned(Instance) then
  begin
    DummyClass := Instance.ClassParent;
    while DummyClass <> nil do
    begin
      if SameText(DummyClass.ClassName,AClassName) then
      begin
        Result := True;
        Break;
      end;
      DummyClass := DummyClass.ClassParent;
    end;
  end;
end;

procedure TForm12.ButtonInhertisFromClick(Sender: TObject);
var
Finder       : TClassFinder;
i            : Integer;
begin
  Finder     := TClassFinder.Create();
  try
   RegisteredClasses.Clear; //Clear the list
   Finder.GetClasses(GetClasses);//Get all registered classes
   for i := 0 to RegisteredClasses.Count-1 do
     //check if inherits directly from TTestCase
     if InheritsFromExt(TPersistentClass(RegisteredClasses.Objects[i]),'TTestCase') then
     //or you can use , if (TPersistentClass(RegisteredClasses.Objects[i]).ClassName<>'TTestCase') and  (TPersistentClass(RegisteredClasses.Objects[i]).InheritsFrom(TTestCase)) then //to check if a  class derive from TTestCase not only directly
     Memo1.Lines.Add(RegisteredClasses[i]); //add the classes to the Memo 
  finally
  Finder.Free;
  end;
end;

procedure TForm12.FormCreate(Sender: TObject);
begin
  RegisteredClasses := TStringList.Create;
end;

procedure TForm12.GetClasses(AClass: TPersistentClass);//The cllaback function to fill the list of classes
begin
  RegisteredClasses.AddObject(AClass.ClassName,TObject(AClass));
end;


initialization
//Now the important part, register the classes, you can do this in any place in your app , i choose this location just for the example
  RegisterClass(TTestCase);
  RegisterClass(TTestCaseChild1);
  RegisterClass(TTestCaseChild2);
  RegisterClass(TTestCaseChild3);
end.

UPDATE

Es tut mir Leid, aber anscheinend die TClassFinder Klasse wurde in Delphi 6 eingeführt