delphi - メソッドポインタの RTTI 情報

Question

についての RTTI 情報を取得することは可能TMethodですか?

インスタンスを取得できます

Instance := TObject(Method.Data);

インスタンスの RTTI タイプを取得できますが、どうすれば正しいものを取得できますTRttiMethodか? メソッド ポインターを使用して渡されたメソッドの属性を確認したいと考えています。

Answer 1

このアプローチは理論的には機能し、実際に機能する良い変更がありますが、TRttiMethod.

• TMethod記録によれば、そうではData: PointerありませんTObject。TObjectこれは、としてData!以外のものを持つ可能性があることを意味します。Dataが ではない場合TObject、そこから RTTI を抽出しようとすると実行時エラーが発生するため、これは重大な問題です。
• すべてのメソッドに RTTI があるわけではありません。デフォルトでは、プライベート エリアのメソッドには RTTI がなく、 を使用し{$RTTI}てパブリックまたはパブリッシュ メンバーの RTTI の生成を停止することもできます。

これら 2 つの問題は、Delphi での通常のタイプのイベント実装 (オブジェクト インスペクタでイベントの名前をダブルクリックしてコードを入力する) では問題にはなりませんが、繰り返しますが、あなたがそうではないと思います。 「バニラ」の実装について話しています。デフォルトのイベント ハンドラーを属性で装飾する人はあまりいません。

上記のすべてを示すコード:

program Project15;

{$APPTYPE CONSOLE}

uses
  SysUtils, RTTI;

type
  // Closure/Event type
  TEventType = procedure of object;

  // An object that has a method compatible with the declaration above
  TImplementation = class
  private
    procedure PrivateImplementation;
  public
    procedure HasRtti;

    procedure GetPrivateImpEvent(out Ev:TEventType);
  end;

  TRecord = record
    procedure RecordProc;
  end;

  // an object that has a compatible method but provides no RTTI
  {$RTTI EXPLICIT METHODS([])}
  TNoRttiImplementation = class
  public
    procedure NoRttiAvailable;
  end;

procedure TImplementation.GetPrivateImpEvent(out Ev:TEventType);
begin
  Ev := PrivateImplementation;
end;

procedure TImplementation.HasRtti;
begin
  WriteLn('HasRtti');
end;

procedure TNoRttiImplementation.NoRttiAvailable;
begin
  WriteLn('No RTTI Available');
end;

procedure TRecord.RecordProc;
begin
  WriteLn('This is written from TRecord.RecordProc');
end;

procedure TImplementation.PrivateImplementation;
begin
  WriteLn('PrivateImplementation');
end;

procedure TotalyFakeImplementation(Instance:Pointer);
begin
  WriteLn('Totaly fake implementation, TMethod.Data is nil');
end;

procedure SomethingAboutMethod(X: TEventType);
var Ctx: TRttiContext;
    Typ: TRttiType;
    Method: TRttiMethod;
    Found: Boolean;
begin
  WriteLn('Invoke the method to prove it works:');
  X;
  // Try extract information about the event
  Ctx := TRttiContext.Create;
  try
    Typ := Ctx.GetType(TObject(TMethod(X).Data).ClassType);
    Found := False;
    for Method in Typ.GetMethods do
      if Method.CodeAddress = TMethod(X).Code then
      begin
        // Got the Method!
        WriteLn('Found method: ' + Typ.Name + '.' + Method.Name);
        Found := True;
      end;
    if not Found then
      WriteLn('Method not found.');
  finally Ctx.Free;
  end;
end;

var Ev: TEventType;
    R: TRecord;

begin
  try
    try
      WriteLn('First test, using a method that has RTTI available:');
      SomethingAboutMethod(TImplementation.Create.HasRtti);
      WriteLn;

      WriteLn('Second test, using a method that has NO rtti available:');
      SomethingAboutMethod(TNoRttiImplementation.Create.NoRttiAvailable);
      WriteLn;

      WriteLn('Third test, private method, default settings:');
      TImplementation.Create.GetPrivateImpEvent(Ev);
      SomethingAboutMethod(Ev);
      WriteLn;

      WriteLn('Assign event handler using handler from a record');
      try
        SomethingAboutMethod(R.RecordProc);
      except on E:Exception do WriteLn(E.Message);
      end;
      WriteLn;

      WriteLn('Assign event handler using static procedure');
      try
        TMethod(Ev).Data := nil;
        TMethod(Ev).Code := @TotalyFakeImplementation;
        SomethingAboutMethod(Ev);
      except on E:Exception do WriteLn(E.Message);
      end;
      WriteLn;

    except
      on E: Exception do Writeln(E.ClassName, ': ', E.Message);
    end;
  finally ReadLn;
  end;
end.