typeinfoutils.pas

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

unit TypeInfoUtils;

interface

uses
  TypInfo, SysUtils;

type
{ record type data }
  TRecordField = record
    TypeInfo: PPTypeInfo;
    Offset: Integer;
  end;

  PRecordFields = ^TRecordFields;
  TRecordFields = array[0..30000] of TRecordField;

  PRecordTypeData = ^TRecordTypeData;
  TRecordTypeData = packed record
    Size: Integer;
    FieldCount: Integer;
    Fields: TRecordFields;
  end;

  PArrayTypeData = ^TArrayTypeData;
  TArrayTypeData = packed record
    ArraySize: Integer;
    ItemSize: Integer;
    ItemType: ^PTypeInfo;
  end;

  { See system }
  PDynArrayTypeData = ^TDynArrayTypeData;
  TDynArrayTypeData = packed record
    elSize: Longint;
    elType: ^PTypeInfo;
    varType: Integer;
  end;

  PParamRecord = ^TParamRecord;
  TParamRecord = record
    Flags: TParamFlags;
    ParamName: ShortString;
    TypeName: ShortString;
  end;

  PPropData = ^TPropData;

  ETypeInfoError = class(Exception);

function GetPropData(TypeData: PTypeData): PPropData;
procedure NextPropInfo(var PropInfo: PPropInfo);

function GetSizeName(Size: Integer): string;
function GetTypeInfoName(TypeInfo: PTypeInfo): string;
function GetTypeDef(TypeInfo: PTypeInfo): string;
function GetTypeInfoSize(TypeInfo: PTypeInfo): Integer;
function GetVarSize(TypeInfo: PTypeInfo): Integer;

{ Method types }
function GetMethodTypeParameters(TypeInfo: PTypeInfo): string;
function GetMethodTypeResult(TypeInfo: PTypeInfo): string;

implementation

uses
  ComObj;

function GetPropData(TypeData: PTypeData): PPropData;
begin
  Result := Pointer(Integer(TypeData) + SizeOf(TClass) + SizeOf(PPTypeInfo) +
    SizeOf(Smallint) + Length(TypeData^.UnitName) + 1);
end;

procedure NextPropInfo(var PropInfo: PPropInfo);
begin
  PropInfo := Pointer(Integer(PropInfo) + SizeOf(TPropInfo) - 255 + Length(PropInfo^.Name));
end;

type
  PWord = ^Word;
  PInteger = ^Integer;

function GetSizeName(Size: Integer): string;
const
  TypeName: array[1..4] of string = ('shortint', 'smallint', '', 'integer');
var
  ArraySize: Integer;
begin
  if Size <= 0 then
    raise ETypeInfoError.Create('Negative Size');
  if (Size = 1) or (Size = 2) or (Size = 4) then
    Result := TypeName[Size]
  else
  begin
    ArraySize := 4;
    while Size mod ArraySize <> 0 do
      Size := ArraySize div 2;
    Result := Format('array[0..%d] of %s', [Size div ArraySize -1, TypeName[ArraySize]])
  end;
end;
    
function GetTypeInfoName(TypeInfo: PTypeInfo): string;
begin
  Result := TypeInfo^.Name;
  if Result[1] = '.' then
    Result := GetTypeDef(TypeInfo);
end;

function GetTypeDef(TypeInfo: PTypeInfo): string;
var
  TypeData: PTypeData;
  DynArrayTypeData: PDynArrayTypeData absolute TypeData;
  ArrayTypeData: PArrayTypeData absolute TypeData;
  RecordTypeData: PRecordTypeData absolute TypeData;
  ParamRecord: PParamRecord;
  BaseTypeData: PTypeData;
  I, J: Integer;
  X: PShortString;
const
{$IFDEF VER120}
  OrdTypeName: array[TOrdType] of string = ('ShortInt', 'Byte', 'Smallint',
    'Word', 'Integer');
{$ELSE}
  OrdTypeName: array[TOrdType] of string = ('ShortInt', 'Byte', 'Smallint',
    'Word', 'Integer', 'Cardinal');
{$ENDIF}
  FloatTypeName: array [TFloatType] of string = ('Single', 'Double', 'Extended',
     'Comp', 'Currency');
  ProcName: array[TMethodKind] of string = ('procedure', 'function',
     'constructor', 'destructor', 'class procedure', 'class function',
     'what', 'what what');
resourcestring
  SInvalidArraySize = 'Array size (%d) of typeinfo at %p should be a multiple of the item size (%d)';
begin
  typeData := GetTypeData(TypeInfo);
  case TypeInfo^.Kind of
    tkLString: Result := 'string';
    tkWString: Result := 'WideString';
    tkVariant: Result := 'Variant';
    tkInteger, tkInt64: begin
                          if (TypeData.OrdType = otSLong) and
                             (Low(Integer) = TypeData.MinValue) then
                            Result := Format('Low(Integer)..%d', [TypeData.MaxValue])
                          else
                            Result := Format('%d..%d', [TypeData.MinValue, TypeData.MaxValue]);
                        end;
    tkChar, tkWChar: Result := Format('#%d..#%d', [TypeData.MinValue, TypeData.MaxValue]);
    tkEnumeration:
      if TypeData^.BaseType^ = TypeInfo then
      begin
        X := @TypeData^.NameList;
        Result := '(';
        for I := TypeData^.MinValue to TypeData^.MaxValue -1 do
        begin
          Result := Result + X^ + ', ';
          Inc(Integer(X), Length(X^) +1);
        end;
        Result := Result + X^ + ')';
      end
      else
      begin
        if TypeData^.BaseType^^.Kind = tkEnumeration then
        begin
          BaseTypeData := GetTypeData(TypeData^.BaseType^);
          X := @BaseTypeData^.NameList;
          for I := BaseTypeData^.MinValue to BaseTypeData^.MaxValue do
          begin
            // Add the name with the name of the min value.
            if TypeData^.MinValue = I then
              Result := Result + X^ + ' .. ';
            // Add the name with the name of the max value.
            if TypeData^.MaxValue = I then
            begin
              Result := Result + X^;
              Break;
            end;
            Inc(Integer(X), Length(X^) +1);
          end;
        end
        else
          raise ETypeInfoError.Create('Unsupported type');
      end;
    tkSet: Result := 'set of ' + GetTypeInfoName(TypeData^.CompType^);
    tkFloat: Result := FloatTypeName[TypeData^.FloatType];
    tkString: Result := Format('string[%d]', [TypeData^.MaxLength]);
    tkMethod:
      begin
        // set the name of the method type
        Result := ProcName[TypeData.MethodKind];
        Result := Result + '(';
        // Add all the params
        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;