Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How i can determine if an abstract method is implemented?

I'm using a very large delphi third party library without source code, this library has several classes with abstract methods. I need to determine when an abtract method is implemented by a Descendant class in runtime to avoid the EAbstractError: Abstract Error and shows a custom message to the user or use another class instead.

for example in this code I want to check in runtime if the MyAbstractMethod is implemented.

type
  TMyBaseClass = class
  public
    procedure MyAbstractMethod; virtual; abstract;
  end;

  TDescendantBase = class(TMyBaseClass)
  public
  end;

  TChild = class(TDescendantBase)
  public
    procedure MyAbstractMethod; override;
  end;

  TChild2 = class(TDescendantBase)
  end;

How I can determine if an abstract method is implemented in a Descendant class in runtime?

like image 516
Salvador Avatar asked Nov 29 '11 02:11

Salvador


3 Answers

you can use the Rtti, the GetDeclaredMethods function get a list of all the methods that are declared in the reflected (current) type. So you can check if the method is present in the list returned by this function.

function MethodIsImplemented(const AClass:TClass;MethodName : string): Boolean;
var
  m   : TRttiMethod;
begin
  Result := False;
  for m in TRttiContext.Create.GetType(AClass.ClassInfo).GetDeclaredMethods do
  begin
   Result := CompareText(m.Name, MethodName)=0;
   if Result then
    break;
  end;
end;

or you can compare the Parent.Name property of the TRttiMethod and check if match with the current class name.

function MethodIsImplemented(const AClass:TClass;MethodName : string): Boolean;
var
  m   : TRttiMethod;
begin
  Result := False;
  m:=TRttiContext.Create.GetType(AClass.ClassInfo).GetMethod(MethodName);
  if m<>nil then
   Result:=CompareText(AClass.ClassName,m.Parent.Name)=0; 
end;
like image 181
RRUZ Avatar answered Oct 16 '22 10:10

RRUZ


function ImplementsAbstractMethod(AObj: TMyBaseClass): Boolean;
type
  TAbstractMethod = procedure of object;
var
  BaseClass: TClass;
  BaseImpl, Impl: TAbstractMethod;
begin
  BaseClass := TMyBaseClass;
  BaseImpl := TMyBaseClass(@BaseClass).MyAbstractMethod;
  Impl := AObj.MyAbstractMethod;
  Result := TMethod(Impl).Code <> TMethod(BaseImpl).Code;
end;
like image 5
Zoë Peterson Avatar answered Oct 16 '22 08:10

Zoë Peterson


Look at the implementation of the 32-bit version of the TStream.Seek() method in the VCL source code (in Classes.pas). It performs a check to make sure the 64-bit version of Seek() has been overridden before calling it. It doesn't involve TRttiContext lookups to do that, just a simple loop through its Parent/Child VTable entries, similar to how Zoë's answer shows.

like image 4
Remy Lebeau Avatar answered Oct 16 '22 10:10

Remy Lebeau