Delphi 类与对象内存结构浅析(附件2)

最新推荐文章于 2023-05-16 10:37:34 发布

starsky2006

最新推荐文章于 2023-05-16 10:37:34 发布

阅读量1.3k

点赞数

分类专栏： VCL架构文章标签： delphi integer interface function class 存储

本文链接：https://blog.csdn.net/starsky2006/article/details/5497153

版权

VCL架构专栏收录该内容

4 篇文章 1 订阅

订阅专栏

*类的公开属性（代码）

示例：访问类的published属性

说明：vmtFieldTable（Published Field表）指向Published Field表有序排列，只存储当前类的PublishedField表，得到父类的Published Field表需要往上遍历。

注意：只有类型是类或接口的数据成员才可定义为published的访问级别

代码：

type

TMyObject = class(TObject)

private

FField1: Integer;

FField2: string;

FField3: array[0..2] of Integer;

published

Button1: TButton;

Memo1: TMemo;

Label1: TLabel;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

AObject: TMyObject;

//---

procedure _ShowDMTInfo(ALines: TStrings; AClass: TClass);

var

AClassAddress,AFTAddress: Integer;

AFieldCount,AFieldIndex,AFieldOffset,AFieldNameLen: Integer;

APos,i: Integer;

AFieldName: ShortString;

begin

AClassAddress := Integer(AClass);

with ALines do

begin

Add(Format('类名: %s ', [AClass.ClassName]));

//---

AFTAddress := Integer(PPointer(AClassAddress + vmtFieldTable)^);

if AFTAddress = 0 then

Exit;

//---

APos := 0;

AFieldCount := PWord(AFTAddress + APos)^;

Add(Format('偏移量: %d 属性数量: %d', [APos,AFieldCount]));

Inc(APos,6);

//---

for i := 0 to AFieldCount - 1 do

begin

AFieldOffset := PInteger(AFTAddress + APos)^;

Inc(APos,4);

//---

AFieldIndex := PWord(AFTAddress + APos)^;

Inc(APos,2);

//---

AFieldNameLen := PByte(AFTAddress + APos)^;

Inc(APos,1);

//---

AFieldName := PShortString(AFTAddress + APos - 1)^;

Inc(APos,AFieldNameLen);

//---

Add(Format('属性偏移量:%d 属性索引:%d 属性名长度: %d 属性名：%s', [AFieldOffset,AFieldIndex,AFieldNameLen,AFieldName]));

end;

//---

procedure _ShowDMTInfo1(ALines: TStrings; AObject: TMyObject; const AFieldNames: array of string);

var

AObjectAddress,AFieldAddress: Integer;

i: Integer;

begin

with ALines do

begin

Add(Format('类名: %s ', [AObject.ClassName]));

//---

AObjectAddress := Integer(AObject);

Add(Format('对象地址: %s ', [IntToHex(AObjectAddress,2)]));

//---

for i := Low(AFieldNames) to High(AFieldNames) do

begin

AFieldAddress := Integer(AObject.FieldAddress(AFieldNames[i]));

Add(Format('属性名：%s 属性地址:%s 偏移量:%d', [AFieldNames[i],IntToHex(AFieldAddress,2),AFieldAddress - AObjectAddress]));

end;

begin

_ShowDMTInfo(Self.Memo1.Lines,TMyObject);

//---

AObject := TMyObject.Create;

_ShowDMTInfo1(Self.Memo1.Lines,AObject, ['Button1', 'Memo1', 'Label1']);

AObject.Free;

end;

内存：

*类的接口（代码）

示例：访问类的接口表

说明：vmtIntfTable（接口表的指针）指向一块PInterfaceTable类型的接口信息表空间，vmtIntfTable只保存当前类所实现的接口表信息，不保存父类的接口表信息，创建对象时会根据vmtParent父类指针遍历获取所有父类的接口表信息插入对象内存空间。

代码：

type

IMyInterface = interface(IUnknown)

['{06F3EA2C-E9C2-410E-97BE-D88ADF775EC3}']

function GetField1: Integer;

procedure Test;

//---

property Field1: Integer read GetField1;

end;

TMyObject = class(TInterfacedObject,IMyInterface)

private

function GetField1: Integer;

public

procedure Test;

end;

function TMyObject.GetField1: Integer;

begin

Result := 0;

end;

procedure TMyObject.Test;

begin

ShowMessage('TMyObject 方法');

end;

procedure TForm1.Button1Click(Sender: TObject);

//---

procedure _ShowInfo(ALines: TStrings; AClass: TClass);

var

IntfTable: PInterfaceTable;

I: Integer;

AText: string;

AClassAddress: Integer;

begin

AClassAddress := Integer(AClass);

with ALines do

begin

Add(Format('类名: %s ', [AClass.ClassName]));

//---

//IntfTable := AClass.GetInterfaceTable;

IntfTable := PPointer(AClassAddress + vmtIntfTable)^;

if IntfTable = nil then

Exit;

//---

with IntfTable^ do

begin

for I := 0 to EntryCount - 1 do

begin

with Entries[I] do

begin

Add(Format('接口GUID:%s 接口虚方法表地址:%s 接口偏移地址:%d 接口获取标志：%d', [

GUIDToString(IID),IntToHex(Integer(VTable),2),IOffset,ImplGetter]));

end;

//---

procedure _ShowInfo1(ALines: TStrings; AObject: TObject);

var

AClass: TClass;

AObjectAddress,i: Integer;

IntfTable: PInterfaceTable;

begin

with ALines do

begin

Add(Format('类名: %s ', [AObject.ClassName]));

//---

AObjectAddress := Integer(AObject);

Add(Format('对象地址: %s ', [IntToHex(AObjectAddress,2)]));

//---

AClass := AObject.ClassType;

while AClass <> nil do

begin

IntfTable := AClass.GetInterfaceTable;

if IntfTable <> nil then

begin

with IntfTable^ do

begin

for I := 0 to EntryCount - 1 do

with Entries[I] do

begin

Add(Format('偏移量:%d 接口虚方法表地址:%s', [IOffset,IntToHex(PInteger(AObjectAddress + IOffset)^,2)]));

end;

//---

AClass := AClass.ClassParent;

end;

var

AObject: TMyObject;

begin

_ShowInfo(Self.Memo1.Lines,TInterfacedObject);

_ShowInfo(Self.Memo1.Lines,TMyObject);

//---

AObject := TMyObject.Create;

_ShowInfo1(Self.Memo1.Lines,AObject);

AObject.Free;

end;

*对象创建（代码）

运行期是如何创建对象的呢，过程如下：

（1）、首先读取InstanceSize对象实例内存大小分配内存

class function TObject.NewInstance: TObject;

begin

Result := InitInstance(_GetMem(InstanceSize));

end;

（2）、然后初始化对象的数据结构，将属性置为空，将接口方法表(包括父类的)插入对象内存空间

class function TObject.InitInstance(Instance: Pointer): TObject;

{$IFDEF PUREPASCAL}

var

IntfTable: PInterfaceTable;

ClassPtr: TClass;

I: Integer;

begin

FillChar(Instance^, InstanceSize, 0);

PInteger(Instance)^ := Integer(Self); //将类地址存放在开始的四个字节中

ClassPtr := Self;

while ClassPtr <> nil do

begin

IntfTable := ClassPtr.GetInterfaceTable;

if IntfTable <> nil then

for I := 0 to IntfTable.EntryCount-1 do

with IntfTable.Entries[I] do

begin

if VTable <> nil then

PInteger(@PChar(Instance)[IOffset])^ := Integer(VTable); //根据接口表提供的偏移地址，在对象的相应位置存储接口的虚方法表的地址

end;

ClassPtr := ClassPtr.ClassParent;

end;

Result := Instance;

end;

（3）、随后会调用类的构造方法完成创建。

*对象的接口（代码）

示例：访问对象的接口表

说明：对象空间记录接口表地址,包括直属类和父类的。

代码：

type

IMyInterface = interface(IUnknown)

['{06F3EA2C-E9C2-410E-97BE-D88ADF775EC3}']

procedure Test;

function GetField1: Integer;

//---

property Field1: Integer read GetField1;

end;

TMyObject = class(TInterfacedObject,IMyInterface)

private

function GetField1: Integer;

public

procedure Test;

end;

function TMyObject.GetField1: Integer;

begin

Result := 0;

end;

procedure TMyObject.Test;

begin

ShowMessage('TMyObject 方法');

end;

procedure TForm1.Button1Click(Sender: TObject);

var

AObject: TMyObject;

//---

procedure _ShowInfo(ALines: TStrings; AObject: TMyObject);

var

AObjectAddress,AInterfaceAddress,AIntfTableAddress: Integer;

AInterfaceEntry: PInterfaceEntry;

begin

with ALines do

begin

Add(Format('类名: %s ', [AObject.ClassName]));

//---

AObjectAddress := Integer(AObject);

Add(Format('对象地址: %s ', [IntToHex(AObjectAddress,2)]));

//---

AInterfaceEntry := AObject.GetInterfaceEntry(StringToGUID('{00000000-0000-0000-C000-000000000046}'));

if AInterfaceEntry <> nil then

begin

AInterfaceAddress := AObjectAddress + AInterfaceEntry.IOffset;

AIntfTableAddress := PInteger(AInterfaceAddress)^;

Add(Format('偏移量：%d 接口地址：%s 接口表地址：%s', [AInterfaceEntry.IOffset,IntTohex(AInterfaceAddress,2),IntTohex(AIntfTableAddress,2)]));

end;

//---

AInterfaceEntry := AObject.GetInterfaceEntry(StringToGUID('{06F3EA2C-E9C2-410E-97BE-D88ADF775EC3}'));

if AInterfaceEntry <> nil then

begin

AInterfaceAddress := AObjectAddress + AInterfaceEntry.IOffset;

AIntfTableAddress := PInteger(AInterfaceAddress)^;

Add(Format('偏移量：%d 接口地址：%s 接口表地址：%s', [AInterfaceEntry.IOffset,IntTohex(AInterfaceAddress,2),IntTohex(AIntfTableAddress,2)]));

end;

//---

procedure _ShowInfo1(ALines: TStrings; AObject: TMyObject);

var

AInterface: IInterface;

AMyInterface: IMyInterface;

AObjectAddress,AInterfaceAddress,AIntfTableAddress: Integer;

begin

with ALines do

begin

Add(Format('类名: %s ', [AObject.ClassName]));

//---

AObjectAddress := Integer(AObject);

Add(Format('对象地址: %s ', [IntToHex(AObjectAddress,2)]));

//---

AInterface := AObject;

AInterfaceAddress := Integer(AInterface);

AIntfTableAddress := PInteger(AInterfaceAddress)^;

Add(Format('偏移量：%d 接口地址：%s 接口表地址：%s', [AInterfaceAddress - AObjectAddress,IntTohex(AInterfaceAddress,2),IntTohex(AIntfTableAddress,2)]));

//---

AMyInterface := AObject;

AInterfaceAddress := Integer(AMyInterface);

AIntfTableAddress := PInteger(AInterfaceAddress)^;

Add(Format('偏移量：%d 接口地址：%s 接口表地址：%s', [AInterfaceAddress - AObjectAddress,IntTohex(AInterfaceAddress,2),IntTohex(AIntfTableAddress,2)]));

end;

begin

AObject := TMyObject.Create;

//---

_ShowInfo(self.Memo1.Lines,AObject);

_ShowInfo1(self.Memo1.Lines,AObject);

//---

//AObject.Free;

end;

示例：访问对象的接口表中的方法地址

说明：对象的接口表中的方法地址并不是实际对应的方法地址，而是跳转到实际方法的一段汇编指令代码的代码地址。所有接口都默认继承自Interface接口。

代码：

type

IMyInterface = interface(IUnknown)

['{06F3EA2C-E9C2-410E-97BE-D88ADF775EC3}']

procedure Test;

function GetField1: Integer;

//---

property Field1: Integer read GetField1;

end;

TMyObject = class(TInterfacedObject,IMyInterface)

private

function GetField1: Integer;

public

procedure Test;

end;

function TMyObject.GetField1: Integer;

begin

Result := 0;

end;

procedure TMyObject.Test;

begin

ShowMessage('TMyObject 方法');

end;

procedure TForm1.Button1Click(Sender: TObject);

type

TFakeEvent1 = procedure(const AInterface: IInterface);

var

AObject: TMyObject;

AMyInterface: IMyInterface;

AObjectAddress,AInterfaceAddress,AIntfTableAddress,AIntfMethodAddress: Integer;

AEvent1:Pointer;

begin

AObject := TMyObject.Create;

AMyInterface := AObject;

//---

AObjectAddress := Integer(AObject);

AInterfaceAddress := Integer(AMyInterface);

AIntfTableAddress := PInteger(AInterfaceAddress)^;

AIntfMethodAddress := PInteger(AIntfTableAddress + $0C)^;

//---

AEvent1 := Pointer(AIntfMethodAddress);

TFakeEvent1(AEvent1)(AMyInterface);

end;

内存：

ImyInterface接口表内容如下

ImyInterface接口Test方法的跳转指令如下

Interface接口表内容如下

Interface接口QueryInterface方法的跳转指令如下

示例：通过接口调用方法

说明：看一下正常的接口是如何调用的。

代码：

type

IMyInterface = interface(IUnknown)

['{06F3EA2C-E9C2-410E-97BE-D88ADF775EC3}']

procedure Test;

function GetField1: Integer;

//---

property Field1: Integer read GetField1;

end;

TMyObject = class(TInterfacedObject,IMyInterface)

private

function GetField1: Integer;

public

procedure Test;

end;

function TMyObject.GetField1: Integer;

begin

Result := 0;

end;

procedure TMyObject.Test;

begin

ShowMessage('TMyObject 方法');

end;

procedure TForm1.Button1Click(Sender: TObject);

var

AObject: TMyObject;

AMyInterface:IMyInterface;

begin

AObject := TMyObject.Create;

//---

AMyInterface := AObject;

AObject.Test;

AMyInterface.Test;

AMyInterface := nil;

end;

汇编：

procedure TForm1.Button1Click(Sender: TObject);

…………

begin

…………

AMyInterface.Test;

mov eax,[ebp - $0c] ; eax存储为AMyInterface接口指针

mov edx,[eax] ; edx 存储为AMyInterface接口表地址

call dword ptr [edx + $c] ; [edx + $c] 为接口表中Test方法的跳转指令的地址

…………

end;

add eax,-$0C ; eax-$0C为对象地址

jmp TMyObject.Test

*对象的成员（汇编）

示例：通过asm访问类的私有变量。

说明：A.FA 的实际地址是 A 指向的地址(也就是对象内存位置，而不是 A 的地址)加上 FA 相对于对象头部的偏移地址。

代码：

type

TA = class

private

FA: Integer;

public

procedure SetA(Value: Integer);

end;

procedure TA.SetA(Value: Integer);

begin

FA := Value;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

A: TA;

tmpInt: Integer;

begin

A := TA.Create;

A.SetA(101);

//---

tmpInt := 0;

asm

MOV EAX, A //--A 是指向对象的指针，这句把对象在内存中的地址存入 EAX

MOV EAX, TA(EAX).FA; //--通知编译器 EBX 指向的是 TA class;TA(EAX).FA 就是 EAX 加上 FA 的偏移处的内容，这是 Delphi 语法支持的。

MOV tmpInt, EAX;

end;

ShowMessage(IntToStr(tmpInt));

//---

{tmpInt := 0;

asm

MOV EAX, A; //--A 是指向对象的指针，这句把对象在内存中的地址存入 EAX

MOV EAX, [EAX + 4]; //--这时 EAX + 4 当前对象的第一变量

//MOV EAX, [EAX] + 8 //--访问第二个变量，依此类推

//MOV EAX, [EAX] //--得到指向VMT的指针

MOV tmpInt, EAX;

end;

ShowMessage(IntToStr(tmpInt));}

//---

{tmpInt := 0;

asm

MOV EAX, A;

MOV tmpInt, EAX;

end;

ShowMessage(IntToStr(TA(tmpInt).FA)); }

//--

A.Free;

end;

示例：访问类的属性

说明：看一下正常的属性如何调用的。

代码：

type

TMyObject = class(TObject)

private

FField1: Integer;

FField2: string;

Public

property Field1: Integer read FField1 write FField1;

property Field2: string read FField2 write FField2;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

AObject: TMyObject;

begin

AObject := TMyObject.Create;

AObject.Field1 := 10;

AObject.Field2 := '10';

AObject.Free;

end;

汇编：

procedure TForm1.Button1Click(Sender: TObject);

var

AObject: TMyObject;

begin

…………

AObject.Field1 := 10;

mov eax,[ebp - $08] ; eax存储为Aobject对象指针

mov [eax + $04],$0000000a ; eax + $04为FField1字段位置

AObject.Field2 := '10';

mov eax,[ebp - $08] ; eax存储为Aobject对象指针

add eax, $08 ; eax存储为FField2字段位置

mov edx,$0045dcc8 ; edx存储为字符串地址

call @LSrtAsg ; 调用LSrtAsg方法

…………

end;

starsky2006

关注

0
点赞
踩
3

收藏

觉得还不错? 一键收藏
0
评论
复制链接

分享到 QQ

分享到新浪微博

扫一扫

专栏目录