**********************************************************************
                     CnPack For Delphi/C++Builder
                     йԼѵ
                 (C)Copyright 2001-2024 CnPack 
**********************************************************************

DelphiTypeInfoϢṹ˵
ߣХ
CnPack https://www.cnpack.org
ؼ֣RTTI, TypeInfo, TypeData, PropInfo

һ

Delphiڼ䣬һʵһָֽ룬ָڴд˶ռݵһƬ򣬶׸ֽһָָVMTиʵָֽ붼ָͬһVMTʴһVMTϾͿԴ౾ÿVMTǰ棨VMTָָĸƫƴ˸һЩϢ-44vmtClassNameָClassNameַָ룬-40vmtInstanceSizeĶʵСInstanceSizeȡרŽ-60vmtTypeInfoTypeInfo/ClassInfoָָġԵRTTIϢ

TTypeInfoṹ

TypInfoԪTTypeInfoṹдRTTIĻϢġһVMTײƫ-60vmtTypeInfoֽһTypeInfo/ClassInfoָ룬ָһTTypeInfoṹ
TTypeInfoTypInfoеĶӵע£

  TTypeInfo = record
    Kind: TTypeKind; // ϢͣΪtkClass
    Name: ShortString; // ϢʱΪ
   {TypeData: TTypeData}
  end;
  
Ȼͦ򵥣ֻԱȴǸ޴ĸӽṹΪʵϽһTTypeDataṹTTypeData ṹǸĹ壬˵Ķעͽѡһ£

  TTypeData = packed record
  ...
    case TTypeKind of
      tkClass: (
        ClassType: TClass;
        ParentInfo: PPTypeInfo; // ָ TypeInfo ṹ
        PropCount: SmallInt;    // Ŀ
        UnitName: ShortStringBase; // ڵĵԪ
       {PropData: TPropData});  
  ...
  end;
        
ṹĸԱ⣬ڼһTPropDataṹṹ洢ԵϢTPropDataĽṹע£

  TPropData = packed record
    PropCount: Word;  // Ŀ
    PropList: record end;
    {PropList: array[1..PropCount] of TPropInfo}
  end;
  
оһPropCountǸPropList飬ÿԪһṹTPropInfo
TPropInfo£

  PPropInfo = ^TPropInfo;
  TPropInfo = packed record
    PropType: PPTypeInfo;
    GetProc: Pointer;
    SetProc: Pointer;
    StoredProc: Pointer;
    Index: Integer;
    Default: Longint;
    NameIndex: SmallInt;
    // NameIndex Ǳڱе
    // һֱԵܲǴ0ʼģΪԡ
    Name: ShortString;
  end;
  
ϼṹǶ׶һľ޴Ϣȫ˳УShortStringǡ
Ҫ˵ǣдShortStringʵʳϲǹ̶ĳ255Ǹɱ䳤ַ0ֽǳȣַһλʼָľ㵽һԱַսṹڽʡڴ档

ͼʾ

ϽⲻֱۣıһͼָǵĹϵ


                              |---------|
                              |ClassInfo|---|
                              |---------|   |
Object Ref                    |---------|   |
|-------|                     | ...     |   |
|  Ref  |       Object        |---------|   |
|-------|----->|-------|0     |---------|   |
               |VMT Ptr|----->|---------|0  |
               |Field1 |      | VM 1    |   |
               |Field2 |      | VM 2    |   |
               |-------|      |---------|   |
                                            |
                                            |
|-------------------------------------------
|
|
|--->|TTypeInfo--------------------------|0
      |Kind: TTypeKind;                   |
      |Name: ShortString; //        |
      | |TTypeData------------------------|
      | |ClassType: TClass;               |
      | |ParentInfo: PPTypeInfo;          |// ָClassInfo
      | |PropCount: SmallInt;             |// ༰и
      | |UnitName: ShortStringBase;       |// 
      | | |TPropData----------------------|
      | | |PropCount: Word;               |// 
      | | | |PropList(TPropInfo array)----|
      | | | | |1PropType: PPTypeInfo;     |
      | | | | |1GetProc: Pointer;         |
      | | | | |1SetProc: Pointer;         |
      | | | | |1StoredProc: Pointer;      |
      | | | | |1Index: Integer;           |
      | | | | |1Default: Longint;         |
      | | | | |1NameIndex: SmallInt;      |
      | | | | |1Name: ShortString;        |// 
      | | | | |2PropType: PPTypeInfo;     |
      | | | | |2GetProc: Pointer;         |
      | | | | |2SetProc: Pointer;         |
      | | | | |2StoredProc: Pointer;      |
      | | | | |2Index: Integer;           |
      | | | | |2Default: Longint;         |
      | | | | |2NameIndex: SmallInt;      |
      | | | | |2Name: ShortString;        |// 
      | | | | |...                        |
      | | | | |...                        |

ġȡϢϵͳ

ڻԵRTTIϢĺԼԱĵ⡣

1.GetTypeData һ TypeInfo/ClassInfo ָõһ TypeData ָ롣

function GetTypeData(TypeInfo: PTypeInfo): PTypeData; assembler;
asm
        { ->    EAX Pointer to type info }
        { <-    EAX Pointer to type data }
        {       it's really just to skip the kind and the name  }
        XOR     EDX,EDX
        MOV     DL,[EAX].TTypeInfo.Name.Byte[0]
        LEA     EAX,[EAX].TTypeInfo.Name[EDX+1]
end;

Ƚϼ򵥣ǴTTypeInfoKindNameֱӵTypeDataָ롣еעҲ˵һ㡣

2. GetPropInfos

һϢĵַת浽һԤȷõбУڻ΢һ㣬֮ǱԼ鲢ѱÿһԵַдбСעͣ

procedure GetPropInfos(TypeInfo: PTypeInfo; PropList: PPropList); assembler;
asm
        { ->    EAX Pointer to type info        }
        {       EDX Pointer to prop list        }
        { <-    nothing                         }

        PUSH    EBX
        PUSH    ESI
        PUSH    EDI

        XOR     ECX,ECX
        MOV     ESI,EAX // ESI ָ TypeInfo
        MOV     CL,[EAX].TTypeInfo.Name.Byte[0]
        MOV     EDI,EDX
        XOR     EAX,EAX
        MOVZX   ECX,[ESI].TTypeInfo.Name[ECX+1].TTypeData.PropCount
        // õTypeData
        REP     STOSD  
        // ݱĿ(Ѿ˸)Ŀʼ0

@outerLoop:
        MOV     CL,[ESI].TTypeInfo.Name.Byte[0]
        //  Name ַ
        LEA     ESI,[ESI].TTypeInfo.Name[ECX+1]
        // ESI õһTypeDataѭʼʱǱTypeData
        // һѭʱǸTypeData
        MOV     CL,[ESI].TTypeData.UnitName.Byte[0]
        // UnitNameַĳ
        MOVZX   EAX,[ESI].TTypeData.UnitName[ECX+1].TPropData.PropCount
        // õĿ
        TEST    EAX,EAX
        JE      @parent // ѰҸദ
        LEA     EDI,[ESI].TTypeData.UnitName[ECX+1].TPropData.PropList
        // ׼дPropList

@innerLoop: // һνʱEDI ָ PropListеĵһԪأ˺ EDI 

        MOVZX   EBX,[EDI].TPropInfo.NameIndex
        // EBX  EDI ָԵ Index
        MOV     CL,[EDI].TPropInfo.Name.Byte[0]
        CMP     dword ptr [EDX+EBX*4],0
        // PropListIndexλǷѾָˡ
        JNE     @alreadySet
        MOV     [EDX+EBX*4],EDI         // û

@alreadySet:
        LEA     EDI,[EDI].TPropInfo.Name[ECX+1]
        // һNameShortStringEDIָPropListеһԪˡ
        DEC     EAX
        JNE     @innerLoop

@parent:
        MOV     ESI,[ESI].TTypeData.ParentInfo
        // ѰҸģиϢ ESI ָ TypeInfo
        XOR     ECX,ECX
        TEST    ESI,ESI
        JE      @exit
        MOV     ESI,[ESI]
        JMP     @outerLoop
@exit:
        POP     EDI
        POP     ESI
        POP     EBX

end;

塢ܽ

деһЩоܽĽҪD5/D7Ϊ׼汾IDEVCLԴزֺͱеӦҲûƩShortStringBasestring[255]Unicode汾ıԪAnsiStringʽ˫ַֽ64λ£ֶָεĿȾʹ4ֽڱ8ֽڣҪע⡣˻ӭһۡ

