8

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

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

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;

も参照してください

4

3 に答える 3

10

これはRTTIで実行できますが、Delphi 5では実行できません。特定の基準に一致するすべてのクラスを検索するには、最初にすべてのクラスを検索できる必要があります。そのために必要なRTTI APIは、Delphi2010で導入されました。あなたはそれを次のようにするでしょう：

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;
于 2010-09-26T03:19:30.787 に答える
9

ええ、はい、方法はありますが、あなたはそれを気に入らないでしょう。（どうやら、私はこのような免責事項が必要です。それ以外の点では完全に役立つコメントが、非常に知識が豊富であるが、それほど寛容ではない「シニア」SOメンバーによって反対票を投じられるのを防ぐためです。）

参考：以下の説明は、Delphi5が最新で最高だったときに実際に書いたコードの概要です。それ以来、そのコードは新しいDelphiバージョン（現在はDelphi 2010まで）に移植され、引き続き機能します。

手始めに、クラスはVMTとそれに付随する関数（およびコンパイラのバージョンと設定によっては、いくつかのtype-in​​fo）の組み合わせにすぎないことを知っておく必要があります。ご存知かもしれませんが、TClassタイプで識別されるクラスは、そのクラスのVMTのメモリアドレスへのポインタにすぎません。言い換えると、クラスのVMTのアドレスがわかっている場合は、それもTClassポインターです。

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

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

だからここにあなたがしなければならないチェックがあります（この正確な順序で！）：

  1. アドレスはTObjectのアドレスと同じですか？もしそうなら、このアドレスはVMTであり、これで完了です。
  2. TClass（address）.ClassInfo;を読み取ります。割り当てられている場合：
    1. それはコードセグメント内にあるはずです（いいえ、それについては詳しく説明しません-グーグルで検索してください）
    2. このClassInfoの最後のバイト（SizeOf（TTypeInfo）+ SizeOf（TTypeData）を追加することによって決定される）も、そのコードセグメント内にある必要があります
    3. このClassInfo（タイプPTypeInfo）では、KindフィールドをtkClassに設定する必要があります
    4. このClassInfoでGetTypeDataを呼び出すと、PTypeDataが生成されます
      1. これも有効なコードセグメントに含まれる必要があります
      2. 最後のバイト（SizeOf（TTypeData）を追加することで決定）もそのコードセグメント内にある必要があります
      3. このTypeDataのうち、ClassTypeフィールドはテスト対象のアドレスと同じである必要があります。
  3. 次に、オフセットvmtSelfPtrでVMTを読み取り、これによってアドレスがテストされるかどうかをテストします（それ自体を指す必要があります）
  4. vmtClassNameを読み取り、それが有効なクラス名を指しているかどうかを確認します（ポインターが有効なセグメントに存在することを再度確認し、文字列の長さが許容可能であり、IsValidIdentがTrueを返す必要があることを確認します）
  5. vmtParentを読む-有効なコードセグメントにも含まれる必要があります
  6. TClassにキャストし、ClassParentを読み取ります。これも有効なコードセグメントに含まれるはずです。
  7. vmtInstanceSizeを読み取ります。これは、> =TObject.InstanceSizeおよび<=MAX_INSTANCE_SIZE（自分で決定）である必要があります。
  8. ClassParentからvmtInstanceSizeを読み取ります。また、> = TObject.InstanceSizeおよび<=以前に読み取ったインスタンスサイズである必要があります（親クラスが子クラスより大きくなることはありません）
  9. オプションで、インデックス0以降のすべてのVMTエントリが有効なコードポインタであるかどうかを確認できます（ただし、VMTのエントリ数を決定するのは少し問題があります...これを示すインジケータはありません）。
  10. ClassParentを使用してこれらのチェックを繰り返します。（これは上記のTObjectテストに到達するか、惨めに失敗するはずです！）

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

これをすべて実装して頑張ってください。これを正しく行うのに約1週間かかりました。

それがあなたのためにどのようにうまくいくか教えてください。乾杯！

于 2010-09-26T19:35:01.990 に答える
2

Ian、Masonが言うように、TRttiContext.GetTypes関数は型情報を提供するすべてのRTTIオブジェクトのリストを取得します。ただし、この関数はDelphi2010で導入されました。

回避策として、クラスから基本クラスを継承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.

アップデート

申し訳ありませんが、TClassFinderクラスはDelphi6で導入されたようです

于 2010-09-26T04:08:54.240 に答える