Is there a way to convert this Record
TError = record
code: Word;
message: String;
end;
TState = record
caption: String;
address: Cardinal;
counters: TArray<Word>;
errors: TArray<TError>;
end;
to serialized Form Data string (Content-Type: application/x-www-form-urlencoded) like
caption=Foo&
address=175896&
counters[]=2&
counters[]=2&
errors[0][code]=52&
errors[0][message]=ERR_NOT_AVAILABLE
for sending via HTTP?
Maybe there is some function similar to JQuery.param()?
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.
