Delphi: Au cours FIND exécution qui descendent d'une classe de base donnée?

Question

Y at-il à façon, lors de l'exécution, de trouver toutes les classes qui descendent d'une classe de base particulière?

Par exemple, faire semblant il y a une classe:

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

ou faire semblant il y a une classe:

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

ou faire semblant il y a une classe:

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

ou faire semblant il y a une classe:

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

Lors de l'exécution je veux trouver toutes les classes qui descendent de TTestCase pour que je puisse faire des choses avec eux.

RTTI peut être interrogé pour ces informations?

Vous pouvez également: Est-il possible à Delphes pour marcher chaque classe? Je peux alors appeler simplement:

RunClass: TClass;

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

Voir aussi

• Trouver toutes les classes qui dérivent à partir d'une classe de base en python donnée
• Java: A exécution, trouver toutes les classes dans l'application qui étendent une classe de base

Answer 1

Eh bien, oui, il y a un moyen, mais tu ne vas pas aimer ça. (Appearantly, je besoin d'un avertissement comme celui-ci, pour empêcher mon commentaire contraire parfaitement helpfull se downvoted par le oh-so knowledgable, mais ne pardonnent pas 'senior' de membres.)

Pour votre information: La description qui suit est une vue d'ensemble de haut niveau d'un morceau de code, j'ai écrit quand Delphi 5 était le dernier et le plus grand. Depuis lors, ce code a été porté sur de nouvelles versions Delphi (actuellement jusqu'à Delphi 2010) et fonctionne toujours!

Pour commencer, vous devez savoir qu'une classe est rien de plus qu'une combinaison d'un VMT et les fonctions d'accompagnement (et peut-être un certain type-info, selon le compilateur version et -settings). Comme vous le savez probablement, une classe - identifiée par le type TClass - est juste un pointeur vers l'adresse mémoire de ce cours de VMT. En d'autres termes: Si vous connu l'adresse du VMT d'une classe, qui est le pointeur TClass ainsi

.

Avec ce morceau de connaissances coincé fermement dans votre esprit, vous pouvez réellement scan votre exécutable mémoire, et pour chaque test d'adresse si elle « ressemble » TMV. Toutes les adresses qui semblent être une boîte VMT que d'être ajouté à la liste, ce qui un aperçu complet de toutes les classes contenues dans votre exécutable! (En fait, ce même vous donne accès aux classes déclarées uniquement dans la mise en œuvre transversale d'une unité, et les classes linkedin de composants et bibliothèques qui sont distribués sous forme de binaires!)

Bien sûr, il y a un risque que certaines adresses semblent être un VMT valide, mais sont en fait d'autres données aléatoires (ou code) - mais avec les tests que je suis venu avec, cela n'a jamais arrivé à moi encore (en environ 6 ans d'exécuter ce code dans plus de dix applications maintenu activement).

Alors, voici les chèques que vous devriez faire (dans cet ordre exact!):

1. L'adresse égale à l'adresse de TObject? Si oui, cette adresse est un VMT et nous fait!
2. Lire TClass (adresse) .ClassInfo; S'il est assigné:
   1. il devrait tomber à l'intérieur d'un segment de code (non, je ne vais pas entrer dans les détails sur ce - juste google it up)
   2. le dernier octet de ce ClassInfo (déterminé par addition d'sizeof (TTypeInfo) + sizeof (TTypeData)) devrait tomber à l'intérieur que le code du segment
   3. ce ClassInfo (qui est de type PTypeInfo) devrait avoir son ensemble de champs Type à tkClass
   4. Appel GetTypeData sur ce ClassInfo, entraînant une PTypeData
      1. Cela devrait également tomber à l'intérieur d'un segment de code valide
      2. Il est le dernier octet (déterminé en ajoutant SizeOf (TTypeData)) devraient également entrer dans ce code segment
      3. De ce TypeData son domaine ClassType doit être égale à l'adresse testée.
3. Maintenant, lisez le VMT à être au vmtSelfPtr offset et test si ce résultat dans l'adresse à l'essai (doit pointer vers lui-même)
4. Lire vmtClassName et vérifier si cette pointe vers un nom de classe valide (pointeur de contrôle Résider dans un segment valide à nouveau, que la longueur de la chaîne est acceptable, et IsValidIdent doit retourner vrai)
5. Lire vmtParent - il devrait aussi tomber dans un segment de code valide
6. Rabattre à un TClass et lire ClassParent - il devrait aussi tomber dans un segment de code valide
7. Lire vmtInstanceSize, il doit être> = TObject.InstanceSize et <= MAX_INSTANCE_SIZE (le vôtre pour déterminer)
8. Lire vmtInstanceSize de lui est ClassParent, il devrait aussi être> = TObject.InstanceSize et <= la taille de l'instance lu précédemment (classes parent ne peut jamais être plus grande que les classes d'enfants)
9. En option, vous pouvez vérifier si toutes les entrées VMT de l'index 0 et vers le haut sont des pointeurs de code valides (bien que ce soit un problème de bits pour déterminer le nombre d'entrées dans une VMT ... il n'y a pas d'indicateur pour cela).
10. Recurse ces contrôles avec le ClassParent. (Cela devrait atteindre le test TObject ci-dessus, ou échouer lamentablement!)

Si toutes ces vérifications tiennent, le test d'adresse est un VMT valide (en ce qui me concerne) et peut êtreajouté à la liste.

Bonne chance la mise en œuvre tout cela, il m'a fallu environ une semaine pour obtenir ce droit.

S'il vous plaît dire comment cela fonctionne pour vous. Vive!

Answer 2

Il peut être fait avec RTTI, mais pas dans Delphi 5. Afin de trouver toutes les classes correspondant à certains critères, vous devez d'abord être en mesure de trouver toutes les classes , et les API RTTI nécessaire de le faire ont été introduits en Delphi 2010. Vous le feriez quelque chose comme ceci:

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, comme Mason dit la fonction TRttiContext.GetTypes obtenir la liste des tous les objets RTTI qui fournissent des informations de type. mais cette fonction a été introduite en Delphi 2010.

Pour contourner ce problème, vous pouvez hériter votre classe de base de la TPersistent classe et enregistrer manuellement chaque classe en utilisant la fonction RegisterClass (je sais que ce Wich est ennuyeux).

puis en utilisant l'objet TClassFinder vous pouvez récupérer toutes les classes enregistrées.

voir cet exemple

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

Je suis désolé, mais apparemment la classe TClassFinder a été introduit en Delphi 6