7


4

Delphi:実行時に、指定された基本クラスから派生するクラスを見つけますか?

実行時に、特定の基本クラスから派生するすべてのクラスを見つける方法はありますか?

たとえば、クラスがあるふりをします。

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;

3 Answer


9


RTTIで実行できますが、Delphi 5ではできません。 特定の条件に一致するすべてのクラスを検索するには、まず_すべてのクラスを検索する_必要があり、それに必要なRTTI APIはDelphi 2010で導入されました。 あなたはそれをこのようにするでしょう:

function FindAllDescendantsOf(basetype: TClass): TList;
var
  ctx: TRttiContext;
  lType: TRttiType;
begin
  result := TList.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;


9


まあ、はい、方法がありますが、あなたはそれを好きになるつもりはありません。 (どうやら、このような免責条項が必要です。そうすれば、他の点では完全に役立つコメントが、非常に知識のある、しかしそれほど寛容ではない「シニア」SOメンバーによって落とされることを防ぐためです。)

参考までに、以下の説明は、Delphi 5が最新かつ最高のときに実際に書いたコードの概要です。 それ以来、そのコードは新しいDelphiバージョン(現在はDelphi 2010まで)に移植され、引き続き機能しています!

まず第一に、クラスはVMTとそれに付随する関数の組み合わせにすぎないことを知る必要があります(コンパイラのバージョンと設定に応じて、おそらくタイプ情報もあります)。 おそらくご存知のように、クラス-TClass型で識別されるクラスは、そのクラスのVMTのメモリアドレスへのポインタにすぎません。 つまり、クラスのVMTのアドレスがわかっている場合、それはTClassポインターでもあります。

その知識があなたの心にしっかりと固まっているので、実際に実行可能メモリをスキャンし、各アドレスごとに、VMTのように見えるかどうかをテストできます。 VMTと思われるすべてのアドレスをリストに追加すると、実行可能ファイルに含まれるすべてのクラスの完全な概要が得られます。 (実際には、ユニットのimplementationセクションでのみ宣言されたクラス、およびバイナリとして配布されるコンポーネントとライブラリからリンクされたクラスにアクセスすることさえできます!)

確かに、一部のアドレスは有効なVMTであるように見えるが、実際にはランダムな他のデータ(またはコード)であるというリスクがあります-しかし、私が思いついたテストでは、これは私にまだ起こったことはありません(約6年後) 10以上のアクティブに維持されているアプリケーションでこのコードを実行します)。

そのため、ここで行う必要のあるチェックを(この正確な順序で!):

  1. アドレスはTObjectのアドレスと同じですか? その場合、このアドレスは VMT、これで完了です!

  2. TClass(address).ClassInfoを読み取ります。割り当てられている場合:

  3. コードセグメント内に収まるはずです(いいえ、詳細は説明しません) それ-ただグーグルアップ)

  4. このClassInfoの最後のバイト(追加して決定 SizeOf(TTypeInfo)+ SizeOf(TTypeData))もそのコードセグメント内にある必要があります

  5. このClassInfo(PTypeInfo型)にはKindが必要です。 tkClassに設定されたフィールド

  6. このClassInfoでGetTypeDataを呼び出すと、PTypeDataが生成されます

  7. これも有効なコードセグメント内に含まれる必要があります

  8. 最後のバイト(SizeOf(TTypeData)を追加することで決定)も そのコードセグメント内に収まる

  9. このTypeDataのClassTypeフィールドはアドレスと等しくなければなりません テスト中。

  10. 次に、オフセットvmtSelfPtrにあるVMTを読み取り、これをテストします テストされるアドレスになります(それ自体を指す必要があります)

  11. vmtClassNameを読み取り、それが有効なクラス名を指しているかどうかを確認します(チェック 文字列の長さが許容され、IsValidIdentがTrueを返す必要があることを示す、有効なセグメントに再び存在するポインタ

  12. vmtParentを読み取ります-有効なコードセグメントにも含まれている必要があります

  13. TClassにキャストし、ClassParentを読み取ります。 有効なコードセグメント

  14. vmtInstanceSizeを読み取ります。> = TObject.InstanceSizeおよび⇐ MAX_INSTANCE_SIZE(決定するあなたのもの)

  15. ClassParentからvmtInstanceSizeを読み取ります。これも> =である必要があります。 TObject.InstanceSizeおよび⇐以前に読み込まれたインスタンスサイズ(親クラスが子クラスより大きくなることはありません)

  16. オプションで、インデックス0および 上向きは有効なコードポインターです(ただし、VMTのエントリ数を決定するのは少し問題がありますが…​ これを示すインジケータはありません)。

  17. ClassParentでこれらのチェックを繰り返します。 (これは 上記のTObjectテスト、または惨めな失敗!)

これらすべてのチェックが成立する場合、テストアドレスは有効なVMTであり(関係する限り)、リストに追加できます。

これをすべて実装していただければ幸いです。これを正しく行うには約1週間かかりました。

どのように機能するか教えてください。 乾杯!


2


Ian、Masonがhttp://docwiki.embarcadero.com/VCL/en/RTTI.TRttiContext.GetTypes [TRttiContext.GetTypes]関数が型情報を提供するすべてのRTTIオブジェクトのリストを取得すると言うように . ただし、この関数はDelphi 2010で導入されました。

回避策として、http://docwiki.embarcadero.com/VCL/en/Classes.TPersistent [TPersistent]クラスから基本クラスを継承し、http://docwiki.embarcadero.comを使用してすべてのクラスを手動で登録できます。 /VCL/en/Classes.RegisterClass [RegisterClass]関数(これは迷惑だと思います)。

次に、http://docwiki.embarcadero.com/VCL/en/Classes.TClassFinder [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`クラスが導入されました