本文深入探讨了Delphi的对象模型，包括类的公开属性、接口、对象创建过程及成员访问方式等内容。通过代码示例详细讲解了如何访问类的属性、接口表以及对象的私有变量，并解释了接口调用的原理。
*类的公开属性（代码）
示例：访问类的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;
end;
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;
end;
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; end; end; end; 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; end; end; //--- AClass := AClass.ClassParent; end; end; 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; end; 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; 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;
扫一扫
419
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
