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

*类的公开属性（代码）

示例：访问类的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;