Delphi: At runtime find classes that descend from a given base class?

Question

Is there at way, at runtime, to find all classes that descend from a particular base class?

For example, pretend there is a class:

TLocalization = cl         


        

Answer 1

It can be done with RTTI, but not in Delphi 5. In order to find all classes that match a certain criteria, you first need to be able to find all classes, and the RTTI APIs necessary to do that were introduced in Delphi 2010. You'd do it something like this:

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 2

Ian, as Mason says the TRttiContext.GetTypes function get the list of all RTTI objects that provide type information . but this function was introduced in Delphi 2010.

As workaround you can inherit your base class from the TPersistent class and then register manually every class using the RegisterClass function (i know wich this is annoying).

then using the TClassFinder object you can retrieve all the registered classes.

see this sample

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

I'm sorry, but apparently the TClassFinder class was introduced in Delphi 6

Answer 3

Well, yes, there is a way, but you're not going to like it. (Appearantly, I need a disclaimer like this, to prevent my otherwise perfectly helpfull comment getting downvoted by the oh-so knowledgable, but not so forgiving 'senior' SO members.)

FYI : The following description is a high-level overview of a piece of code I actually wrote when Delphi 5 was the latest & greatest. Since then, that code was ported over to newer Delphi versions (currently up until Delphi 2010) and still works!

For starters, you need to know that a class is nothing more than a combination of a VMT and the accompanying functions (and maybe some type-info, depending on compiler-version and -settings). As you probably know, a class - as identified by the type TClass - is just a pointer to the memory address of that classes' VMT. In other words : If you known the address of the VMT of a class, that's the TClass pointer as well.

With that piece of knowledge stuck firmly in your mind, you can actually scan your executable memory, and for each address test if it 'looks like' a VMT. All addresses that seem to be a VMT can than be added to a list, resulting in a complete overview of all classes contained in your executable! (Actually, this even gives you access to classes declared solely in the implementation-section of a unit, and classes linked-in from components & libraries that are distributed as binaries!)

Sure, there's a risk that some addresses seem to be a valid VMT, but are actually some random other data (or code) - but with the tests I've come up with, this has never happened to me yet (in about 6 years running this code in more than ten actively maintained applications).

So here's the checks you should do (in this exact order!) :

1. Is the address equal to the address of TObject? If so, this address is a VMT and we're done!
2. Read TClass(address).ClassInfo; If it's assigned :
   1. it should fall inside a code-segment (no, I won't go into details on that - just google it up)
   2. the last byte of this ClassInfo (determined by adding SizeOf(TTypeInfo) + SizeOf(TTypeData)) should also fall inside that code-segment
   3. this ClassInfo (which is of type PTypeInfo) should have it's Kind field set to tkClass
   4. Call GetTypeData on this ClassInfo, resulting in a PTypeData
      1. This should also fall inside a valid code segment
      2. It's last byte (determined by adding SizeOf(TTypeData)) should also fall inside that code-segment
      3. Of this TypeData it's ClassType field should be equal to the address being tested.
3. Now read the VMT-to-be at the offset vmtSelfPtr and test if this results in the address being tested (should point to itself)
4. Read vmtClassName and check if that points to a valid classname (check pointer to reside in a valid segment again, that the string length is acceptable, and IsValidIdent should return True)
5. Read vmtParent - it should also fall in a valid code segment
6. Now cast to a TClass and read ClassParent - it should also fall in a valid code segment
7. Read vmtInstanceSize, it should be >= TObject.InstanceSize and <= MAX_INSTANCE_SIZE (yours to determine)
8. Read vmtInstanceSize from it's ClassParent, it should also be >= TObject.InstanceSize and <= the previously read instance size (parent classes can never be larger than child classes)
9. Optionally, you could check if all VMT entries from index 0 and upwards are valid code pointers (although it's a bit problematic to determine the number of entries in a VMT... there's no indicator for this).
10. Recurse these checks with the ClassParent. (This should reach the TObject test above, or fail miserably!)

If all these checks hold, the test-address is a valid VMT (as far as I'm concerned) and can be added to the list.

Good luck implementing this all, it took me about a week to get this right.

Please tell how it works out for you. Cheers!