在运行时,是否存在查找从特定基类下降的所有类的过程?
例如,假装有一个班级:
TLocalization = class(TObject)
...
public
function GetLanguageName: string;
end;
或假装有一个班级:
TTestCase = class(TObject)
...
public
procedure Run; virtual;
end;
或假装有一个班级:
TPlugIn = class(TObject)
...
public
procedure Execute; virtual;
end;
或假装有一个班级:
TTheClassImInterestedIn = class(TObject)
...
public
procedure Something;
end;
在运行时,我想找到所有来自TTestCase
的类,以便我可以使用它们。
是否可以查询RTTI以获取此类信息?
另外: Delphi中有没有办法让每个班级走路?然后我可以简单地打电话:
RunClass: TClass;
if (RunClass is TTestCase) then
begin
TTestCase(RunClass).Something;
end;
答案 0 :(得分:9)
可以使用RTTI完成,但不能在Delphi 5中完成。为了找到符合特定条件的所有类,首先需要能够查找所有类和RTTI API在Delphi 2010中引入了必要的功能。您可以这样做:
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;
答案 1 :(得分:9)
嗯,是的,有办法,但你不会喜欢它。 (显然,我需要这样的免责声明,以防止我的其他完全有帮助的评论被那些知识渊博,但不那么宽容的'高级'SO成员所淹没。)
仅供参考:以下描述是我在Delphi 5最新版本时实际编写的一段代码的高级概述。最大的。从那时起,该代码被移植到更新的Delphi版本(目前直到Delphi 2010)并且仍然有效!
对于初学者,您需要知道一个类只不过是VMT和附带函数的组合(可能还有一些类型信息,具体取决于编译器版本和设置)。您可能知道,类(由TClass类型标识)只是指向该类VMT的内存地址的指针。换句话说:如果你知道类的VMT的地址,那也就是TClass指针。
有了这条知识牢牢记在你的脑海中,你实际上可以扫描你的可执行内存,并且如果它看起来像是一个VMT,则可以进行每个地址测试。所有似乎都是VMT的地址都可以添加到列表中,从而可以完整地概述可执行文件中包含的所有类! (实际上,这甚至可以让您访问仅在单元的实现部分中声明的类,以及从作为二进制文件分发的组件和库链接的类!)
当然,有些地址似乎是一个有效的VMT,但实际上是一些随机的其他数据(或代码) - 但是我已经提出了测试,这在我身上从未发生过(在在超过十个主动维护的应用程序中运行此代码大约6年。)
所以这是你应该做的检查(按照这个确切的顺序!):
如果所有这些检查都成立,那么测试地址就是一个有效的VMT(据我所知),可以添加到列表中。
祝你好运实现这一切,我花了大约一个星期来做到这一点。
请告诉你它是如何运作的。干杯!
答案 2 :(得分:2)
Ian,正如Mason所说,TRttiContext.GetTypes
函数获取提供类型信息的所有RTTI对象的列表。但是这个功能是在Delphi 2010中引入的。
作为解决方法,您可以从TPersistent
类继承基类,然后使用RegisterClass
函数手动注册每个类(我知道这很烦人)。
然后使用TClassFinder
对象,您可以检索所有已注册的类。
参见此示例
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.
<强>更新强>
对不起,但显然在Delphi 6中引入了TClassFinder
类