Rttiを試してみるその３

文字列で指定したクラスのインスタンスを作成する例を作ってみました。
(Button3Click）
試行錯誤のうえで作成したソースなので、とりあえず動きましたが
正しいソースかどうかは、分かりません。もっと良い方法が
あれば教えて下さい。

この手の処理はActivatorクラスのある.Netのほうが簡単だと
思います。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,Unit2;

type
  TForm2 = class(TForm)
    Button3: TButton;
    LabeledEdit1: TLabeledEdit;
    ListBox1: TListBox;
    Button1: TButton;
    Label1: TLabel;
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  protected
  public
    { Public 宣言 }

  end;

var
  Form1: TForm2;
implementation
uses
  Rtti,TypInfo;

{$R *.dfm}


procedure TForm2.Button1Click(Sender: TObject);
var
  LContext: TRttiContext;
  LType: TRttiType;
  LTypes:TArray;

begin

 LoadPackage('SakaPack.bpl');

  { Obtain the RTTI context }
  LContext := TRttiContext.Create;

  { Obtain the second package (rtl140) }
  LTypes := LContext.GetTypes();

  { Enumerate all types in the rtl140 package }

   //for LPackage in LPackages do
 //begin
      for LType in LTypes do
      begin
         ListBox1.Items.Add(LType.QualifiedName);
      end;
   //end;
   ListBox1.Items.SaveToFile('P.Txt');

end;

procedure TForm2.Button3Click(Sender: TObject);
var
 ctx : TRttiContext;
 rtm : TRttiMethod;
 rst : TValue;
 SakaInf : ISakaTest;
   rtt : TRttiType;
   Args : Array of TValue;


begin

   //とりあえず別パッケージで動的ロード化とする
   LoadPackage('SakaPack.bpl');

 ctx := TRttiContext.Create;

   //文字列で型情報を探す場合は、FindTypeを使う
   //完全一致なのでユニット名を含めて指定
   rtt := ctx.FindType('Unit2.' + LabeledEdit1.Text);

   //コンストラクタはとりあえずCreateであることが前提
   rtm := rtt.GetMethod('Create');

 if rtm <> nil then
 begin
      if rtm.IsConstructor then
      begin
         //1. クラスの場合は、TRttiInstanceTypeで戻ってくるのでキャスト
         //2. MetaaclassTypeプロパティで実際のクラスがとれるみたい。
         rst := rtm.Invoke(TRttiInstanceType(rtt).MetaclassType,Args);
         if rst.IsObject Then
         begin
            SakaInf := TSakaTest(rst.AsObject) As ISakaTest;
            Label1.Caption := SakaInf.SayMessage();
         end;
            //Label1.Caption := obj.ClassName;
      end;
   end;


end;

end.

でUnit2で使ったソースがこちら

unit Unit2;

interface
 uses classes;

   {$RTTI EXPLICIT METHODS([vcPublic])}
 Type ISakaTest = interface(IInterface)
  ['{FAAA20A5-E078-4E22-96C2-139E7E57CBFB}']
  function SayMessage : String;
 end;

   {$RTTI EXPLICIT METHODS([vcPublished,vcPublic])}
   Type TSakaTest = Class(TInterfacedPersistent, ISakaTest)
    function SayMessage : String; virtual;
   End;

   {$RTTI EXPLICIT METHODS([vcPublished,vcPublic])}
 Type TSakaTest1 = Class(TSakaTest)
      Public
       function  SayMessage : String; override;
   End;

   {$RTTI EXPLICIT METHODS([vcPublished,vcPublic])}
 Type TSakaTest2 = Class(TSakaTest)
    Public
      function  SayMessage : String; override;
   End;

var
  SakaTest : ISakaTest;

implementation

//uses
 //Classes;



{ TSakaTest1 }

function TSakaTest1.SayMessage: String;
begin
 Result := 'Hello Delphi First';
end;

{ TSakaTest2 }

function TSakaTest2.SayMessage: String;
begin
 Result := 'Hello Delphi Second';
end;

{ TSakaTset }

function TSakaTest.SayMessage: String;
begin
 Result := '';
end;

initialization
   RegisterClass(TSakaTest);
   RegisterClass(TSakaTest1);
   RegisterClass(TSakaTest2);

end.