Как я могу определить, реализуется ли абстрактный метод?

Я использую очень большую стороннюю библиотеку delphi без исходного кода, эта библиотека имеет несколько классов с абстрактными методами. Мне нужно определить, когда метод abtract реализуется классом Descendant во время выполнения, чтобы избежать EAbstractError: Abstract Error и отображает пользовательское сообщение для пользователя или вместо него использует другой класс.

например, в этом коде, я хочу проверить выполнение во время выполнения MyAbstractMethod.

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;

Как я могу определить, реализуется ли абстрактный метод в классе Descendant во время выполнения?

Ответы

Ответ 1

вы можете использовать Rtti, GetDeclaredMethods получить список всех методов, объявленных в отраженном (текущем) типе. Таким образом, вы можете проверить, присутствует ли метод в списке, возвращаемом этой функцией.

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;

или вы можете сравнить свойство Parent.Name TRttiMethod и проверить соответствие имя текущего класса.

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;

Ответ 2

Посмотрите на реализацию метода TStream.Seek() в исходном коде VCL. Он выполняет подобный тип проверки по возврату потомков, как вы ищите, и не требует поиска TRttiContext для этого, просто простую петлю через записи родительского/дочернего vtable.

Ответ 3

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;