typeinfoutils.pas

SrcDecompiler is about creating a Delphi program decompiler. The program is written for Delphi 4 or

        Result := Result + ')';
        // Add the function Result if Exit.
        if TypeData.MethodKind in [mkFunction, mkClassFunction] then
          Result := Result + ': ' + PShortString(ParamRecord)^;
        Result := Result + ' of object';
      end;
    tkDynArray:
      begin
        if DynArrayTypeData^.elType = nil then
        begin
          if DynArrayTypeData^.elSize mod 4 = 0 then
            Result := 'array of ' + GetSizeName(DynArrayTypeData^.elSize)
          else
            Result := 'packed array of ' + GetSizeName(DynArrayTypeData^.elSize);
        end
        else
          Result := Format('array of %s', [GetTypeInfoName(DynArrayTypeData^.elType^)]);
      end;
    tkRecord:
      begin
        Result := 'packed record ';
        I := 0;
        for J := 0 to RecordTypeData^.FieldCount -1 do
        begin
          if I <> RecordTypeData^.Fields[J].Offset then
            Result := Result + Format('f%d: %s; ', [I, GetSizeName(RecordTypeData^.Fields[J].Offset - I)]);
          I := RecordTypeData^.Fields[J].Offset;
          Result := Result + Format('f%d: %s; ', [I, GetTypeInfoName(RecordTypeData^.Fields[J].TypeInfo^)]);
          I := I + GetVarSize(RecordTypeData^.Fields[J].TypeInfo^);
        end;
        if I <> RecordTypeData.Size then
          Result := Result + Format('f%d: %s; ', [I, GetSizeName(RecordTypeData.Size - I)]);
        Result := Result + 'end';
      end;
    tkInterface:
      Result := 'interface(' + TypeData.IntfParent^^.Name + ') [''' + GUIDToString(TypeData.Guid) + '''] end';
    tkArray:
      begin
        I := GetVarSize(ArrayTypeData.ItemType^);
        if ArrayTypeData.ArraySize mod I <> 0 then
          raise ETypeInfoError.CreateFmt(SInvalidArraySize, [ArrayTypeData.ArraySize, Pointer(TypeInfo), I]);
        Result := Format('array[0..%d] of %s', [ArrayTypeData.ArraySize div I -1, GetTypeInfoName(ArrayTypeData.ItemType^)]);
      end;
    else
      raise ETypeInfoError.Create('type Info defenition not yet supported');
  end;
end;

function GetTypeInfoSize(TypeInfo: PTypeInfo): Integer;
var
  TypeData: PTypeData;
  PropInfo: PPropInfo;
  J: PChar;
  I: Integer;
begin
  Result := SizeOf(TTypeKind) + Length(TypeInfo.Name) + 1;
  TypeData := GetTypeData(TypeInfo);
  case TypeInfo.Kind of
    tkUnknown, tkLString, tkWString, tkVariant: ;
    tkInteger, tkChar, tkWChar: Result := Result + SizeOf(TOrdType) +
       2 * SizeOf(Longint);
    tkEnumeration:
      begin         
        Result := Result + SizeOf(TOrdType) + 2 * SizeOf(Longint) +
           SizeOf(Pointer);
        if TypeData.BaseType^ = TypeInfo then
        begin
          J := @TypeData.NameList;
          // following from the typeinfo from byteBool MaxValue, the numbers of
          // items in the namelist should be the differnce between MinValue and MaxValue
          // As Cardinals.
          for I := 0 to abs(Cardinal(TypeData.MinValue) - Cardinal(TypeData.MaxValue)) do
          begin
            Result := Result + Byte(J[0]) +1;
            J := J + Byte(J[0]) +1;
          end;
        end;
      end;
    tkSet: Result := Result + SizeOf(Pointer);
    tkFloat: Result := Result + SizeOf(TFloatType);
    tkString: Result := Result + SizeOf(Byte);
    tkClass:
      begin
         Result := Result + SizeOf(TClass) + SizeOf(Pointer) +
           SizeOf(Smallint) + Length(TypeData.UnitName) + 1 + SizeOf(Word);
         PropInfo := PPropInfo(Integer(TypeData) + SizeOf(TClass) + SizeOf(Pointer) +
           SizeOf(Smallint) + Length(TypeData.UnitName) + 1 + SizeOf(Word));
         for I := 0 to PWord(Integer(PropInfo) - SizeOf(Word))^ -1 do
         begin
           Result := Result + 4 * SizeOf(Pointer) + SizeOf(Integer) + SizeOf(longint) +
              SizeOf(Smallint) + Length(PropInfo.Name) + 1;
           PropInfo := PPropInfo(Integer(PropInfo) + 4 * SizeOf(Pointer) + SizeOf(Integer) + SizeOf(longint) +
              SizeOf(Smallint) + Length(PropInfo.Name) + 1);
         end;
      end;
    tkMethod:
      begin
        J := PChar(TypeData) + SizeOf(TMethodKind) + SizeOf(Byte);
        for I := 0 to TypeData.ParamCount -1 do
        begin
          J := J + SizeOf(TParamFlags);
          J := J + Byte(J[0]) + 1;
          J := J + Byte(J[0]) + 1;
        end;
        if TypeData.MethodKind in [mkFunction, mkClassFunction, mkSafeFunction] then
          J := J + Byte(J[0]) + 1;
        Result := Result + J - PChar(TypeData);
      end;
    tkInterface:
      begin
        Result := Result + SizeOf(Pointer) + SizeOf(TIntfFlagsBase) +
           SizeOf(TGUID) + Length(TypeData.IntfUnit) + 1 + SizeOf(Word);
        PropInfo := PPropInfo(Integer(TypeData) + SizeOf(Pointer) +
          SizeOf(TIntfFlagsBase) + SizeOf(TGUID) + Length(TypeData.IntfUnit) + 1 + SizeOf(Word));
        for I := 0 to PWord(Integer(PropInfo) - SizeOf(Word))^ -1 do
        begin
          Result := Result + 4 * SizeOf(Pointer) + SizeOf(Integer) + SizeOf(longint) +
             SizeOf(Smallint) + Length(PropInfo.Name) + 1;
          PropInfo := PPropInfo(Integer(PropInfo) + 4 * SizeOf(Pointer) + SizeOf(Integer) + SizeOf(longint) +
             SizeOf(Smallint) + Length(PropInfo.Name) + 1);
        end;
      end;
    tkInt64: Result := Result + 2 * SizeOf(Int64);
    tkDynArray: Result := Result + SizeOf(TDynArrayTypeData);
    tkRecord:
      begin
        Result := Result + 2 * SizeOf(Integer) +
          PInteger(Integer(TypeData) + SizeOf(Integer))^ * SizeOf(TRecordField);
      end;
    tkArray: Result := Result + 2* SizeOf(Integer) + SizeOf(Pointer);
    else
      raise ETypeInfoError.Create('Unkwno Type Info Size');
  end;
end;

function GetVarSize(TypeInfo: PTypeInfo): Integer;
const
{$IFDEF VER120}
  OrdTypeSize: array[TOrdType] of Integer = (1, 1, 2, 2, 4);
{$ELSE}
  OrdTypeSize: array[TOrdType] of Integer = (1, 1, 2, 2, 4, 4);
{$ENDIF}
  FloatTypeSize: array[TFloatType] of Integer = (4, 8, 10, 8, 8);
begin
  case TypeInfo^.Kind of
    tkLString, tkWString, tkString, tkClass, tkInterface, tkDynArray:
        Result := 4;
    tkInteger, tkChar, tkEnumeration, tkSet, tkWChar:
        Result := OrdTypeSize[GetTypeData(TypeInfo).OrdType];
    tkFloat:
        Result := FloatTypeSize[GetTypeData(TypeInfo).FloatType];
    tkMethod, tkInt64: Result := 8;
    tkRecord: Result := PRecordTypeData(GetTypeData(TypeInfo)).Size;
    tkArray: Result := PArrayTypeData(GetTypeData(TypeInfo)).ArraySize;
    tkVariant: Result := SizeOf(TVarData);
    else
      raise ETypeInfoError.Create('Unknown Variant type');
  end;
end;

function GetMethodTypeParameters(TypeInfo: PTypeInfo): string;
var
  TypeData: PTypeData;
  ParamRecord: PParamRecord;
  I: Integer;
  X: PShortString;
begin
  TypeData := GetTypeData(TypeInfo);
  ParamRecord := @TypeData.ParamList;
  for I := 0 to TypeData.ParamCount -1 do
  begin
    X := Pointer(Integer(@ParamRecord^.ParamName) + Length(ParamRecord^.ParamName) +1);
    // classifie the parameter.
    if pfVar in ParamRecord.Flags then
      Result := Result + 'var ';
    if pfConst in ParamRecord.Flags then
      Result := Result + 'const ';
    if pfOut in ParamRecord.Flags then
      Result := Result + 'out ';
    // Add the param name.
    Result := Result + ParamRecord^.ParamName + ': ';
    // add the param type;
    if pfArray in ParamRecord.Flags then
      Result := Result + 'array of ';
    Result := Result + X^;
    // add a semicolon and space if this isn't the last parameter.
    if I < TypeData.ParamCount -1 then
      Result := Result + '; ';
    // go to the next param record.
    ParamRecord := PParamRecord(Integer(ParamRecord) + SizeOf(TParamFlags) +
        (Length(ParamRecord^.Paramname) +1) + (Length(X^) + 1));
  end;
end;

function GetMethodTypeResult(TypeInfo: PTypeInfo): string;
var
  I: Integer;
  J: PChar;
  TypeData: PTypeData;
begin
  TypeData := GetTypeData(TypeInfo);
  if TypeData.MethodKind in [mkFunction, mkClassFunction] then
  begin
    J := PChar(TypeData) + SizeOf(TMethodKind) + SizeOf(Byte);
    for I := 0 to TypeData.ParamCount -1 do
    begin
      J := J + SizeOf(TParamFlags);
      J := J + Byte(J[0]) + 1;
      J := J + Byte(J[0]) + 1;
    end;
    Result := J + 1;
  end;
end;

end.