访问祖先类的虚方法（直接访问祖先类的VMT，但是这种方法在新版本中未必可靠）

访问祖先类的虚方法

问题提出

       在子类覆盖的虚方法中，可以用inherited调用父类的实现，但有时候我们并不需要父类的实现，而是想跃过父类直接调用祖先类的方法。

举个例子，假设有三个类，实现如下：

type

  TClassA = class

    procedure Proc; virtual;

  end;

  TClassB = class(TClassA)

    procedure Proc; override;

  end;

  TClassC = class(TClassB)

    procedure Proc; override;

  end;

implementation

procedure TClassA.Proc;

begin

  ShowMessage('Proc of class A');

end;

procedure TClassB.Proc;

begin

  ShowMessage('Proc of class B');

end;

procedure TClassC.Proc;

begin

  ShowMessage('Proc of class C');

end;

用如下代码调用虚方法Proc：

var

  C: TClassA;

begin

  C := TClassC.Create;

  C.Proc;

  C.Free;

end;

我们知道最终调用的是TClassC.Proc；如果在TClassC.Proc中加上Inherited，则TClassB.Proc可以得到调用；但是现在，若想在TClassC.Proc中直接调用TClassA.Proc，该怎么办呢？

解决之道

如果是C++，只需要这样写：TClassC::Proc。

在Delphi却没有办法做到，Delphi不允许我们跃级调用祖先类的方法。尽管如此，还是能从另一个角度来寻求解决的办法。

解决之道就是VMT，每一个类就是一个指向VMT的指针，而VMT的作用其实就是用来保存虚方法的。在VMT的正方向上，列着从祖先类起的所有虚方法，只需要偏移TClassA的VMT到Proc，然后调用之即可。

来看看这个问题是怎么得解决的：

procedure TClassC.Proc;

type

  TProc = procedure of object;

var

  M: TMethod;

begin

  M.Code := PPointer(TClassA)^;

  M.Data := Self;

  TProc(M)();

  ShowMessage('Proc of class C');

end;

执行一次调用，可以看到先弹出：Proc of class A；然后弹出：Proc of class C。这说明TClassA.Proc在TClassC.Proc中被调用到了。

 

请注意上面的代码，TClassA的VMT上的第0偏移就是Proc的地址，而TClassA继承自TObject，TObject本身也有一些虚方法的，比如AfterConstruction，那么这些是存放在哪里呢？

秘密就在VMT的负偏移上，在System单元中声明了虚表的结构偏移，在负方向上有AfterConstruction的进入点。需要指出的是，System单元中声明了结构偏移正方向的几个已经过时了，第0偏移(vmtQueryInterface)不是存放QueryInterface,而是存放第一个虚方法（除TObject外）。

下面是从帮助上拷下来的VMT布局：

Offset            Type       Description

-76  Pointer    pointer to virtual method table (or nil)

-72  Pointer    pointer to interface table (or nil)

-68  Pointer    pointer to Automation information table (or nil)

-64  Pointer    pointer to instance initialization table (or nil)

-60  Pointer    pointer to type information table (or nil)

-56  Pointer    pointer to field definition table (or nil)

-52  Pointer    pointer to method definition table (or nil)

-48  Pointer    pointer to dynamic method table (or nil)

-44  Pointer    pointer to short string containing class name

-40  Cardinal  instance size in bytes

-36  Pointer    pointer to a pointer to ancestor class (or nil)

-32  Pointer    pointer to entry point of SafecallException method (or nil)

-28  Pointer    entry point of AfterConstruction method

-24  Pointer    entry point of BeforeDestruction method

-20  Pointer    entry point of Dispatch method

-16  Pointer    entry point of DefaultHandler method

-12  Pointer    entry point of NewInstance method

-8    Pointer    entry point of FreeInstance method

-4    Pointer    entry point of Destroy destructor

0     Pointer    entry point of first user-defined virtual method

4     Pointer    entry point of second user-defined virtual method

后记

       利用虚表调用虚方法的做法，终究不是安全的，因为Borland(CodeGear)没有向你保证每一个Delphi版本的VMT布局都是一样的。

       因此，使用这个方法的时候要慎之又慎。

http://blog.csdn.net/linzhengqun/article/details/1755493

-------------------------------------------------------------------------------

我将这个例子改造，变成2个虚函数：

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;
type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TClassA = class
    procedure Proc; virtual;
    procedure second; virtual;
  end;
 
  TClassB = class(TClassA)
    procedure Proc; override;
    procedure second; override;
  end;
 
  TClassC = class(TClassB)
    procedure Proc; override;
    procedure second; override;
  end;

var
  Form1: TForm1;

implementation
{$R *.dfm}

procedure TClassA.Proc;
begin
  ShowMessage('Proc of class A');
end;
procedure TClassB.Proc;
begin
  ShowMessage('Proc of class B');
end;

procedure TClassA.second;
begin
  ShowMessage('second of class A');
end;
procedure TClassB.second;
begin
  ShowMessage('second of class B');
end;

procedure TClassC.Proc;
type
  TProc = procedure of object;
var
  M: TMethod;
  P: Pointer;
begin
  P := PPointer(TClassA)^;
  M.Code := p;
  M.Data := Self;
  TProc(M)();
  ShowMessage('Proc of class C');
end;

procedure TClassC.second;
type
  TProc = procedure of object;
var
  M: TMethod;
  p: Pointer;
begin
//  P := PPointer(TClassA)^;
//  P := Pointer(Integer(p)+4); // 错误：这里试图取得VMT的第二个函数
  p:= PPointer(integer(TClassA) + 4)^; 
  M.Code := P;
  M.Data := Self;
  TProc(M)();
  ShowMessage('second of class C');
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  C: TClassA;
begin
  C := TClassC.Create;
  C.Proc;
  C.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  C: TClassA;
begin
  C := TClassC.Create;
  C.Second;
  C.Free;
end;

end.

// 另外改成P := PPointer(TClassC)^; 也不行，这是为什么？

[石家庄]王烨 2016/3/21 14:36:41
第二个声明一个 procedure of object，然后又去用一个method强制转换
第一个方法的地址
不是VMT
也就是VMT的第一个元素的值
而且他这种方法
只能取virtual的
不能取dynamic的
而且他这种，如果带参数咋办？
用我那种吧

这样不需要按照Method方式调用