类的继承---跨过中间类，继承祖先类的方法(80分)

看这个.
{ Virtual method table entries }

vmtSelfPtr = -76;
vmtIntfTable = -72;
vmtAutoTable = -68;
vmtInitTable = -64;
vmtTypeInfo = -60;
vmtFieldTable = -56;
vmtMethodTable = -52;
vmtDynamicTable = -48;
vmtClassName = -44;
vmtInstanceSize = -40;
[red]vmtParent = -36;[/red]
vmtSafeCallException = -32;
vmtAfterConstruction = -28;
vmtBeforeDestruction = -24;
vmtDispatch = -20;
vmtDefaultHandler = -16;
vmtNewInstance = -12;
vmtFreeInstance = -8;
vmtDestroy = -4;

vmtQueryInterface = 0;
vmtAddRef = 4;
vmtRelease = 8;
vmtCreateObject = 12;

xeen：
您能解释一下吗？
这些数据对解决那个问题有什么关系，我刚学Deplhi不久啊！

Up

这样呢？
Inherited TA.函数名 ；

说明，前面那个是虚拟方法表在内存中的情况，可以清楚的看到self指针就指向了
虚拟方法表的入口，而self指针则位于虚拟方法表的入口地址-76的位置。当然这不
具有通用性，因为在将来的delphi版本这个位置可能会变.

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

A = class
public
procedure Fun
virtual;
end;

B = class(A)
public
procedure Fun
override;
end;

C = class(B)
public
procedure Fun
override;
end;




var
Form1: TForm1;

implementation

{$R *.dfm}

procedure A.Fun;
begin
ShowMessage('A');
end;

procedure B.Fun;
begin
ShowMessage('B');
end;

procedure C.Fun;
var
pointer;
begin
[red] p := Pointer(classparent.ClassParent)
//获得祖父类虚拟方法表入口地址;
if integer(p) <> 0 then
a(integer(p)-76).Fun
//取得self指针，强制类型转换.[/red]
end;
procedure TForm1.Button1Click(Sender: TObject);
var cc:c;
begin
cc := c.Create;
cc.Fun;
cc.Free;
end;

end.

试试这个.
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TA = class(Tobject)
public
procedure fun;overload;dynamic;
end;

TB = class(TA)
public
procedure fun;overload;dynamic;
end;

TC = class(TB)
public
procedure fun;overload;dynamic;
end;

TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TA.fun;
begin
ShowMessage('A');
end;

procedure TB.fun;
begin
inherited;
ShowMessage('B');
end;

procedure TC.fun;
begin
inherited;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
c : TA;
begin
c := TC.Create;
(c as TA).fun;
c.Free;
end;

end.

To xbl:
procedure TC.Fun;
begin
asm
TA.Fun;
end;
end;
这个方法可以吗？我试过不行呀
总觉得你用C++的想法来设计DELPHI的程序，
这样不太好的。我觉得是不是因为C++有多重继承，所以可以这样使用。
DELPHI里面没有多重继承，所以不能跨级调用父类的父类中的功能。
这样类设计也显得不够清晰

To xeen:
你的方法可以，请问我把以下代码：
if integer(p) <> 0 then
a(integer(p)-76).Fun
//取得self指针，强制类型转换
做了修改
if integer(p) <> 0 then
b(integer(p)-76).Fun
//取得self指针，强制类型转换
似乎也可以正确运行，显示为A的结果，为什么呀？

To:ygpft:
integer(p)-76 已经是类A的虚拟方法表的入口地址了。只要类型相容，无论转
成哪种类调用都是类A的方法。
这就和原来无论调用a(self).fun,b(self).fun的结果都一样一个原因.

卡色：
这样不行，我试过了。

ljhuacn：
这样我也知道，但这不是我想要的，我是想在类 C 中调用类 A 的方法。

xeen：
这种方法很好，我回去仔细看看，我对 VMT 不太熟悉，我想问一下您：
那些 VMT 数据是从哪里得到的？ 您能再仔细讲讲吗？

ygpfr：
可以的，
在网吧上网，写得快，我少写了'Call'， Sorry ^-^
procedure TC.Fun;
begin
asm
Call TA.Fun;
end;
end;

当有参数时，也可以了，只是要保存一下：
procedure TC.Fun(s: string);
begin
asm
push eax
mov eax, self
call TA.Fun
pop eax
end;
end;

但这种方法不是很好，还是 xeen 的方法最好了，我现在还没有看懂，
回去再仔细想想！

doxpix：
Sorry，刚才没看到您的回复！
我正是要访问私有变量，所以。。。问题就来了！
xeen 的方法应该可以，我先回去试一下,我现在也没有看懂！

vmt 的数据在lib目录的class单元里,delphi 中生成的所有对象在内存中
的格局都是这样的:self指针指向虚拟方法表的入口,self之上就是RTTI信息。
所以delphi实现RTTI是与C++不同的,C++靠宏。Delphi则依靠编译器，是与
delphi当前版本的编译器紧密相关的。
不过反正做Pascal编译器的就Borland一家.....

修改父类的私有变量很简单， 就以你上面的例子：
procedure TC.Fun(S: string);
var
p: PString;
begin
p := pointer(integer(self)+TObject.InstanceSize);
// p 现在指向TA.FNode
p^ := 'A'+s;
showmessage(p^);
end;
上述方法只能修改变量， 不能调用私有或protected的静态方法.

关于vmt的方法， 我只有一种思路， 还没有实现：
1.通过TC的实例找到TC.Fun入口处于VMT中的偏移量。
2.建立一个TA的实例， 通过TA实例的VMT+偏移量找到TA.Fun的入口。 用汇编将TC.Self压栈， 同时将参数压栈， 然后调用刚才找到的入口从而完成对TA.Fun的调用.
也许也可以通过TMethod方式达到上述目的（不过没试过带参数的调用是否可行）， 大概代码是类似这样的吧：
type Tcallfun=procedure (s: string) of object;
procedure TC.Fun(s: string);
var
m: TMethod;
begin
m.code:=找到的TA.Fun的地址;
m.data := Self;
TCallFun(m)(s);
end;

Another_eYes：
您的方法看起来和 xeen 的很相似，还没有看明白，我正在看TObject 是怎么样创建
一个对象，VMT 到底是怎么回事，先回去想想。

TO Another_eYes
>>p := pointer(integer(self)+TObject.InstanceSize);
这个self是不是指的 TA.Fun的地址，我对指针不熟悉。

to wumeng: 这个self指的是TC的实例所在的地址，在那里数据是这样排列的：
TC.VMT入口地址
TObject所有的Private,protected,public变量
TA所有private,protected,public变量
TB所有private,protected,public变量
TC所有private,protected,public变量
...(是否还有其他的就不知道了)

这样的话要获得TA某个private变量的地址只要跳过它前面的所有变量的偏移量即可。
Integer(self)->入口地址
+
TObject.InstanceSize-->跳过所有TObject的变量和VMT
这时指针已经指向TA第一个private变量了。这里恰好正是我们关心的FNode
接下来对这个指针所在的数据进行操作所修改的就是TA的Private变量值了。

to xbl:
每个类都有一个VMT, 即使
TB=class(TA)
end;
这么定义TB和TA的VMT也是不同的。　但继承类里所有的虚拟方法相对于VMT入口所在的位置是相同的。
因此TC.Fun和TA.Fun相对于VMT的偏移是一样的。我们只要找到TC.VMT中这个偏移量，　然后找到TA.VMT的入口再加上这个偏移量调用的就是TA.Fun了。
由于方法调用和普通函数调用有一个最大区别就是它隐含传入了一个self参数。方法里操作数据的来源就是这个Self地址所决定的。　如果我们能替换这个传入的self，　我们就能跨级调用父类中的方法了。
我想到一个简单的主意，不知道是否可行：
type TCallFun= procedure (s: string) of object;
procedure TC.Fun(s: string);
var
a: TA;
m: TMethod;
begin
a := ta.create;
m.code := addr(a.fun);
m.data := self;
TCallFun(m)(s);
a.free;
end;

xbl的问题我们是这样处理的：
1.
A,B两个类与C在不同的单元内，那么C中Fun不要override，因为A,B中的Fun是在Public或
Protected中，所以C的Fun中也可以用Inherited Fun，即在C中调用父类（即B）中的Fun。
如果要跨过B直接调用A中的Fun，我们一般定义一个参考类，如：
TARef＝class(A)
public
procedure Fun;
end;
...
procedure TARef.Fun;
begin
Inherited Fun;
end;

这样在C的Fun中写为：TARef(Self).Fun即可。
2.
更多的情况，我们只是为了要在C中改变A中的私有变量，即改变不在同一单元中类的私有
变量。解决这个问题，我们也是定义一个参考类。假设A类如下：
A=class
private
X:Integer;
Y:string;
....
end;
参考类则：
TARef=class //这里老子不是A，而是A的老子
private
X:Integer;
Y:string;
...
end;
其实就是将A的定义搬过来，只是改了类名（注意只要私有域，不要私有方法）。
这样在C的Fun中（或其它需要的地方）可以：
TARef(Self).X:=123;
TARef(Self).Y:='123';

不过，这种方法有一个问题就是：一旦A的定义改了，我们的源程序也得改。这也是
每次Delphi升级时我们的程序必须检查的地方。
各位参考一下吧，有问题再提

非常谢谢大家！
现在问题已经解决了，只是对有些地方还不是很理解。

Another_eYes：
我对有些地方不是很理解，您能不能再给我解释一下：
1 有关偏移量的，现在如果我改变一下 TA,TB,TC 的声明，您说如何去计算偏移量呢？
假设我现在想在TC的 fun 中修改 FNum5，该怎么作呢 ？
type
TA = class(Tobject)
private
FNum1: string;
FNum2: Integer;
FNum3: Float;
FNum4: DateTime;
FNum5: string;
FNum6: string

public
procedure fun;overload;dynamic;
end;

TB = class(TA)
public
procedure fun;overload;dynamic;
end;

TC = class(TB)
public
procedure fun;overload;dynamic;
end;


2 VMT 在Delhi6的 system.pas 里面有，上面xeen也说了，它的每一项到底是什么意思？
您看，后面出现了 vmtQueryInterface,vmtAddRef,vmtRelease,vmtCreateObject,
我好像记得 QueryInterface,AddRef,Release 是接口 IUnknown 的三个基本
方法，在类 TInterfaceObject 里面实现了，不知道在这里是什么意思，您能解释
一下吗？
{ Virtual method table entries }

vmtSelfPtr = -76;
vmtIntfTable = -72;
vmtAutoTable = -68;
vmtInitTable = -64;
vmtTypeInfo = -60;
vmtFieldTable = -56;
vmtMethodTable = -52;
vmtDynamicTable = -48;
vmtClassName = -44;
vmtInstanceSize = -40;
vmtParent = -36;
vmtSafeCallException = -32;
vmtAfterConstruction = -28;
vmtBeforeDestruction = -24;
vmtDispatch = -20;
vmtDefaultHandler = -16;
vmtNewInstance = -12;
vmtFreeInstance = -8;
vmtDestroy = -4;

vmtQueryInterface = 0;
vmtAddRef = 4;
vmtRelease = 8;
vmtCreateObject = 12;

xeen：
我开始有点明白了，只是还有一些比较朦胧的地方。
我想再问一下您：
如果我修改一下那3个类，增加一些成员，并在函数中加入一些参数，
您看看如何去计算那个偏移量，如何去调用祖先类的 Fun 方法？
type
TA = class(Tobject)
private
FNum1: string;
FNum2: Integer;
FNum3: Float;
FNum4: DateTime;
FNum5: string;
FNum6: string

public
function temp1(X: string: string
virtual;
procedure temp2(X: Integer
Y: TDateTime): string
virtual;
procedure fun(X: string
Y: Integer
Z: TDateTime);virtual;
end;

TB = class(TA)
private
FNote1: string;
FNote2: TDateTime;
FNote3: Integer;
protected
X1: Integer;
public
function temp3(S: string): string
virtual;
procedure temp4(I: Integer): string
virtual;
procedure fun(X: string
Y: Integer
Z: TDateTime);override;
end;

TC = class(TB)
private
FNote4: string;
FNote5: TDateTime;
FNote6: Integer

protected
X2: string;
public
function temp5(S: string): string

procedure temp6(S: string)
string;
procedure fun(X: string
Y: Integer
Z: TDateTime);override;
end;

Another_eYes：
我前面写错了，类声明应该是：
type
TA = class(Tobject)
private
FNum1: string;
FNum2: Integer;
FNum3: Float;
FNum4: DateTime;
FNum5: string;
FNum6: string

public
function temp1(X: string: string
virtual;
procedure temp2(X: Integer
Y: TDateTime): string
virtual;
procedure fun(X: string
Y: Integer
Z: TDateTime);virtual;
end;

TB = class(TA)
private
FNote1: string;
FNote2: TDateTime;
FNote3: Integer;
protected
X1: Integer;
public
function temp3(S: string): string
virtual;
procedure temp4(I: Integer): string
virtual;
procedure fun(X: string
Y: Integer
Z: TDateTime);override;
end;

TC = class(TB)
private
FNote4: string;
FNote5: TDateTime;
FNote6: Integer

protected
X2: string;
public
function temp5(S: string): string

procedure temp6(S: string)
string;
procedure fun(X: string
Y: Integer
Z: TDateTime);override;
end;

Shuzi：
我刚刚开始学 Delphi 不久，我不是很理解，您能解释一下吗？