Delphi检测对象有方法时是否为纯虚函数(2)

时间：2011/9/3 15:37:00 点击：

DelphiCode:

type
  TExample=class
    N:Integer;
    procedure dynamicMethod;dynamic;
    procedure virtualMethod;virtual;
    procedure abstractMethod;virtual; abstract;
  end;

type
  ObjProc=Procedure of Object;
function IsAbstract(P:ObjProc):Boolean;
begin
  Result:=false;
  asm
    mov eax, 00402830h  //System._AbstractError的地址——没法直接获得，只能这样干了 :(
    cmp DWord(P),eax
    jnz @@exit
    mov Result, 1
  @@exit:
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  e:TExample;
  Address:DWord;
begin
  e:=TExample.Create;
  if not IsAbstract(e.dynamicMethod) then
    e.dynamicMethod;
  if not IsAbstract(e.virtualMethod) then
    e.virtualMethod;
  if not IsAbstract(e.abstractMethod) then
    e.abstractMethod;
  e.Free;
end;

{ TExample }

procedure TExample.dynamicMethod;
begin
  Inc(N);
  ShowMessage(IntToStr(N));
end;

procedure TExample.virtualMethod;
begin
  Dec(N);
  ShowMessage(IntToStr(N));
end;

你的方法在我的机子上还是出现EAbstractError 的异常。另外，您的那段汇编可否解释一下？ DelphiCode:

/////////////////////////////////////////////////////////////////////////
uses typinfo;

var
 obj:TExample;
procedure TForm1.Button2Click(Sender: TObject);
var
 propinfo:PPropInfo;
 method:TMethod;
 obj:TExample;
begin
  obj:=TExample.Create;
  with obj do begin
   OnvirtualMethod:=virtualMethod;
   OndynamicMethod :=dynamicMethod;
 //实际应用中应该不会给abstract 方法赋值，所以下一句应该注释掉
//   OnabstractMethod :=abstractMethod;
  end;
  propinfo:=GetPropInfo( obj.ClassInfo,'OnabstractMethod');
  if propinfo^.PropType^.Kind =tkmethod then begin
   method :=GetMethodProp(obj,propinfo);
  if method.Code =nil then
   showmessage('can not execute')
  else
   obj.abstractMethod(self);
  end;
 obj.Free;
end;

{ TExample }
procedure TExample.dynamicMethod(sender: tobject);
begin
showmessage('dynamicMethod');
end;

procedure TExample.virtualMethod(sender: tobject);
begin
 showmessage('virtualMethod');
end;

问题： 1. 与Delphi版本相关。因为System._AbstractError地址的关系。但这个问题解决起来并不麻烦。我已经想到了办法。下面再说。 2. 与类类定义直接相关。几乎得为每一个Abstract写出一个IsAbstract()函数。:( 因为 type ObjProc=Procedure of Object; 这种方法会导致Delphi进行强类型检测。而如果用“Untyped parameters”，也就是用 function IsAbstract(out P):Boolean; function IsAbstract(const P):Boolean; function IsAbstract(var P):Boolean; 三种之任一来定义IsAbstract()的接口，都会导致接口不兼容。因为Delphi不会对对象方法的类型是特殊处理和识别的。 DelphiCode:

type
  ObjProc=Procedure of Object;
  TAbstractObj=class(TObject)
    procedure abstractMethod;virtual; abstract;
  end;
var
  AbstractErrorAddr : pointer;

procedure GetAbstractErrorAddr(P:ObjProc);
asm
  mov EAX, DWord(P)
  mov AbstractErrorAddr, EAX
end;

function IsAbstract(P:ObjProc):Boolean;overload;
begin
  Result:=false;
  asm
    mov eax, AbstractErrorAddr  //直接使用AbstractErrorAddr
                                //请保证调用前GetAbstractErrorAddr()被调用过一次.
    cmp DWord(P),eax
    jnz @@exit
    mov Result, 1
  @@exit:
  end;
end;

begin
  with TAbstractObj.Create do
  begin
    GetAbstractErrorAddr(AbstractMethod);
    free;
  end;
  //或者如下(如果你不介意一个TObject的内存开销的话):
  //GetAbstractErrorAddr(TAbstractObj.Create.AbstractMethod);
end.