是否可以获取有关TMethod
?
我可以通过
获取实例Instance := TObject(Method.Data);
所以我可以获得实例的RTTI类型,但是如何才能获得正确的TRttiMethod
?我想检查使用方法指针传入的方法的属性。
答案 0 :(得分:3)
这种方法在理论上有效,并且在实践中会有很好的改变,但有一些事情可能会阻止你掌握TRttiMethod
。
TMethod
记录显示Data: Pointer
,而非TObject
。这意味着可能有TObject
以外的其他内容作为Data
!这是一个严重的问题,因为如果Data
不是TObject
,那么尝试从中提取RTTI将导致运行时错误。{$RTTI}
来停止为公共或已发布成员生成RTTI。对于Delphi中常见的事件实现类型(在Object Inspector中双击事件的名称并填写代码),这两个问题不会成为问题,但我再也不认为你在谈论“vanila”的实现。没有多少人会使用Attributes来装饰默认事件处理程序!
演示以上所有内容的代码:
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.