Convert Record to Serialized Form Data for sending via HTTP

Question

Is there a way to convert this Record

TError = record
  code: Word;
  message: String;
end;

TState = record
  ca         


        

Answer 1

Ok, here is a boilerplate solution which can be adapted for your specific serialization or other use as well.

A record, TSerializer, does all the serialization job and the result is stored in a string list.

To use it, call method Serialize('state', TValue.From(state),sList); from a TSerializer instance.

You can add most types that fit into a TValue, including records, static arrays, dynamic arrays and simple classes. The unwinding of all elements are made by recursion. (Disclaimer, this is tested on XE2, but I think Delphi-2010 supports all enhanced-RTTI calls used here)

The output from your example looks like this:

record state:TState
  caption:string=Foo
  address:Cardinal=175896
  dynamic array counters:Word
    counters[0]:Word=2
    counters[1]:Word=2
  end
  dynamic array errors:TError
    record errors[0]:TError
      code:Word=52
      message:string=ERR_NOT_AVAILABLE
    end
  end
end

Here is the source unit:

unit SerializerBoilerplate;

interface

uses
  System.SysUtils, Classes, RTTI, TypInfo;

Type
  TSerializer = record
  private
    FSumIndent: string;
    procedure IncIndent;
    procedure DecIndent;
  public
    procedure Serialize(const name: string; thing: TValue;
      sList: TStrings; first: boolean = true);
  end;

implementation

procedure TSerializer.IncIndent;
begin
  FSumIndent := FSumIndent + '  ';
end;

procedure TSerializer.DecIndent;
begin
  SetLength(FSumIndent, Length(FSumIndent) - 2);
end;

procedure TSerializer.Serialize(const name: string; thing: TValue;
  sList: TStrings; first: boolean);
type
  PPByte = ^PByte;
var
  LContext: TRTTIContext;
  LField: TRTTIField;
  LProperty: TRTTIProperty;
  LRecord: TRTTIRecordType;
  LClass: TRTTIInstanceType;
  LStaticArray: TRTTIArrayType;
  LDynArray: TRTTIDynamicArrayType;
  LDimType: TRttiOrdinalType;
  LArrayIx: array of integer;
  LArrayMinIx: array of integer;
  LArrayMaxIx: array of integer;
  LNewValue: TValue;
  i: integer;
  // Generic N-dimensional array indexing
  procedure IncIx(var ArrayIx, ArrayMinIx, ArrayMaxIx: array of integer);
  var
    dimIx: integer;
  begin
    dimIx := Length(ArrayIx) - 1;
    repeat
      if (ArrayIx[dimIx] < ArrayMaxIx[dimIx]) then
      begin
        Inc(ArrayIx[dimIx]);
        break;
      end
      else
      begin
        ArrayIx[dimIx] := ArrayMinIx[dimIx];
        Dec(dimIx);
        if (dimIx < 0) then
          break;
      end;
    until (true = false);
  end;
  // Convert N-dimensional index to a string
  function IxToString(const ArrayIx: array of integer): string;
  var
    i: integer;
  begin
    Result := '';
    for i := 0 to High(ArrayIx) do
      Result := Result + '[' + IntToStr(ArrayIx[i]) + ']';
  end;
  // Get correct reference
  function GetValue(Addr: Pointer; Typ: TRTTIType): TValue;
  begin
    TValue.Make(Addr, Typ.Handle, Result);
  end;

begin
  if first then
    FSumIndent := '';

  case thing.Kind of
    { - Number calls }
    tkInteger, // Identifies an ordinal type.
    tkInt64, // Identifies the Int64/UInt64 types.
    tkPointer: // Identifies a pointer type.
      begin
        sList.Add(FSumIndent + name + ':' + thing.TypeInfo.name + '=' +
          thing.ToString);
      end;
    tkEnumeration:
      begin
        if (thing.TypeInfo = TypeInfo(boolean)) then
        begin
          sList.Add(FSumIndent + name + ':' + thing.TypeInfo.name + '=' +
            BoolToStr(thing.AsBoolean));
        end
        else begin
          // ToDO : Implement this
        end;
      end; // Identifies an enumeration type.
    tkSet: // Identifies a set type.
      begin
        // ToDO : Implement this
      end;
    { - Float calls }
    tkFloat: // Identifies a floating-point type. (plus Date,Time,DateTime)
      begin
        if (thing.TypeInfo = TypeInfo(TDate)) then
        begin
          sList.Add(FSumIndent + name + ':' + thing.TypeInfo.name + '=' +
            DateToStr(thing.AsExtended));
        end
        else if (thing.TypeInfo = TypeInfo(TTime)) then
        begin
          sList.Add(FSumIndent + name + ':' + thing.TypeInfo.name + '=' +
            TimeToStr(thing.AsExtended));
        end
        else if (thing.TypeInfo = TypeInfo(TDateTime)) then
        begin
          sList.Add(FSumIndent + name + ':' + thing.TypeInfo.name + '=' +
            DateTimeToStr(thing.AsExtended));
        end
        else
        begin
          sList.Add(FSumIndent + name + ':' + thing.TypeInfo.name + '=' +
            FloatToStr(thing.AsExtended));
        end;
        // ToDO : Handle currency
      end;

    { - String,character calls }
    tkChar, // Identifies a single-byte character.
    tkString, // Identifies a short string type.
    tkLString: // Identifies an AnsiString type.
      begin
        sList.Add(FSumIndent + name + ':' + thing.TypeInfo.name + '=' +
          thing.AsString);
      end;
    tkWString: // Identifies a WideString type.
      begin
        sList.Add(FSumIndent + name + ':' + thing.TypeInfo.name + '=' +
          thing.ToString);
      end;
    tkInterface: // Identifies an interface type.
      begin
        // ToDO : Implement this
      end;
    tkWChar, // Identifies a 2-byte (wide) character type.
    tkUString: // Identifies a UnicodeString type.
      begin
        sList.Add(FSumIndent + name + ':' + thing.TypeInfo.name + '=' +
          thing.AsString);
      end;

    tkVariant: // Identifies a Variant type.
      begin
        // ToDO : Implement this
      end;

    { - Generates recursive calls }
    tkArray: // Identifies a static array type.
      begin
        LStaticArray := LContext.GetType(thing.TypeInfo) as TRTTIArrayType;
        SetLength(LArrayIx, LStaticArray.DimensionCount);
        SetLength(LArrayMinIx, LStaticArray.DimensionCount);
        SetLength(LArrayMaxIx, LStaticArray.DimensionCount);
        sList.Add(FSumIndent + 'static array ' + name + ':' +
          LStaticArray.ElementType.name);
        IncIndent();
        for i := 0 to LStaticArray.DimensionCount - 1 do
        begin
          LDimType := LStaticArray.Dimensions[i] as TRttiOrdinalType;
          LArrayMinIx[i] := LDimType.MinValue;
          LArrayMaxIx[i] := LDimType.MaxValue;
          LArrayIx[i] := LDimType.MinValue;
        end;
        for i := 0 to LStaticArray.TotalElementCount - 1 do
        begin
          Serialize(Name + IxToString(LArrayIx),
            GetValue( PByte(thing.GetReferenceToRawData) +
              LStaticArray.ElementType.TypeSize * i,
              LStaticArray.ElementType),
            sList,false);
          IncIx(LArrayIx, LArrayMinIx, LArrayMaxIx);
        end;
        DecIndent();
        sList.Add(FSumIndent + 'end');
      end;
    tkDynArray: // Identifies a dynamic array type.
      begin
        LDynArray := LContext.GetType(thing.TypeInfo) as TRTTIDynamicArrayType;
        sList.Add(FSumIndent + 'dynamic array ' + name + ':' +
          LDynArray.ElementType.name);
        IncIndent();
        for i := 0 to thing.GetArrayLength - 1 do
        begin
          Serialize(Name + '[' + IntToStr(i) + ']',
            GetValue( PPByte(thing.GetReferenceToRawData)^ +
              LDynArray.ElementType.TypeSize * i,
              LDynArray.ElementType),
            sList,false);
        end;
        DecIndent();
        sList.Add(FSumIndent + 'end');
      end;
    tkRecord: // Identifies a record type.
      begin
        sList.Add(FSumIndent + 'record ' + name +':' +thing.TypeInfo.name);
        LRecord := LContext.GetType(thing.TypeInfo).AsRecord;
        IncIndent();
        for LField in LRecord.GetFields do
        begin
          Serialize(LField.name, LField.GetValue(thing.GetReferenceToRawData),
            sList, false);
        end;
        DecIndent();
        sList.Add(FSumIndent + 'end');
      end;
    tkClass: // Identifies a class type.
      begin
        sList.Add(FSumIndent + 'object ' + name + ':' + thing.TypeInfo.name);
        IncIndent();
        LClass := LContext.GetType(thing.TypeInfo).AsInstance;
        for LField in LClass.GetFields do
        begin
          Serialize(LField.name,
            // A hack to get a reference to the object
            // See https://stackoverflow.com/questions/2802864/rtti-accessing-fields-and-properties-in-complex-data-structures
            GetValue(PPByte(thing.GetReferenceToRawData)^ + LField.Offset,
            LField.FieldType),
            sList,false);
        end;
        // ToDO : Implement a more complete class serializer
        DecIndent();
        sList.Add(FSumIndent + 'end');
      end;

    { - Not implemented }
    tkClassRef: ; // Identifies a metaclass type.
    tkMethod: ; // Identifies a class method type.
    tkProcedure: ; // Identifies a procedural type.
    tkUnknown: ; // Identifies an unknown type that has RTTI.
  end;
end;

end.

And a test unit:

program SerializerProj;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  Classes,
  SysUtils,
  RTTI,
  SerializerBoilerplate;

Type
  TMyObj = Class
  private
    fI: integer;
    fS: string;
  end;

  TInnerRec = record
    A, B, C: string;
  end;

  TDim1 = 1 .. 3;
  TDim2 = 2 .. 5;
  TMyArr = array [TDim1, TDim2] of integer; // Must be typed dimensions

  TTestRec = record
    s: string;
    ws: WideString;
    st: ShortString;
    ansiCh: AnsiChar;
    ansiS: AnsiString;
    wChar: Char;
    B: boolean;
    i: integer;
    t: TTime;
    d: TDate;
    dt: TDateTime;
    fd: Double;
    fS: Single;
    r: TInnerRec;
    arr: TMyArr;
    dArr: array of string;
    o: TMyObj;
  end;

  TError = record
    code: Word;
    message: String;
  end;

  TState = record
    caption: String;
    address: Cardinal;
    counters: TArray<Word>;
    errors: TArray<TError>;
  end;

var
  tr: TTestRec;
  state: TState;
  sList: TStringList;
  s: string;
  Serializer: TSerializer;

begin
  state.caption := 'Foo';
  state.address := 175896;
  SetLength(state.counters,2);
  state.counters[0] := 2;
  state.counters[1] := 2;
  SetLength(state.errors,1);
  state.errors[0].code := 52;
  state.errors[0].message := 'ERR_NOT_AVAILABLE';

  tr := Default (TTestRec);
  sList := TStringList.Create;
  try
    tr.s := 'A';
    tr.ws := 'WS';
    tr.st := '[100]';
    tr.ansiCh := '@';
    tr.ansiS := '@!';
    tr.wChar := 'Ö';
    tr.B := true;
    tr.i := 100;
    tr.t := Now;
    tr.d := Now;
    tr.dt := Now;
    tr.fd := Pi;
    tr.fS := 2 * Pi;
    tr.r.A := 'AA';
    tr.r.B := 'BB';
    tr.r.C := 'CC';
    tr.arr[1, 2] := 12;
    tr.arr[1, 3] := 13;
    tr.arr[1, 4] := 14;
    tr.arr[1, 5] := 15;
    tr.arr[2, 2] := 22;
    tr.arr[2, 3] := 23;
    tr.arr[2, 4] := 24;
    tr.arr[2, 5] := 25;
    tr.arr[3, 2] := 32;
    tr.arr[3, 3] := 33;
    tr.arr[3, 4] := 34;
    tr.arr[3, 5] := 35;
    SetLength(tr.dArr, 3);
    tr.dArr[0] := 'A';
    tr.dArr[1] := 'B';
    tr.dArr[2] := 'C';
    tr.o := TMyObj.Create;
    tr.o.fI := 11;
    tr.o.fS := '22';

    Serializer.Serialize('tr', TValue.From(tr), sList);
    for s in sList do
      WriteLn(s);
    sList.Clear;
    Serializer.Serialize('state', TValue.From(state),sList);
    for s in sList do
      WriteLn(s);

    ReadLn;
  finally
    sList.Free;
  end;

end.

I had a little help studying Barry Kellys answer to the question Rtti accessing fields and properties in complex data structures.