Why does a deserialized TDictionary not work correctly? - json

I try serialize/deserialize standard delphi container using standard delphi serializer.
procedure TForm7.TestButtonClick(Sender: TObject);
var
dict: TDictionary<Integer, Integer>;
jsonValue: TJSONValue;
begin
//serialization
dict := TDictionary<Integer, Integer>.Create;
dict.Add(1, 1);
jsonValue := TJsonConverter.ObjectToJSON(dict);
dict.Free;
//deserialization
dict := TJsonConverter.JSONToObject(jsonValue) as TDictionary<Integer, Integer>;
try
Assert(dict.ContainsKey(1), 'deserialization error - key not found');
except
Assert(false, 'deserialization error - dict object broken');
end;
end;
There is a way I convert object to JSON and vice versa;
class function TJsonConverter.JSONToObject(AJSONValue: TJSONValue): TObject;
var
lUnMarshal: TJSONUnMarshal;
begin
lUnMarshal := TJSONUnMarshal.Create();
try
Result := lUnMarshal.Unmarshal(AJSONValue);
finally
lUnMarshal.Free;
end;
end;
class function TJsonConverter.ObjectToJSON(AData: TObject): TJSONValue;
var
lMarshal: TJSONMarshal;
begin
lMarshal := TJSONMarshal.Create();
try
Result := lMarshal.Marshal(AData);
finally
lMarshal.Free;
end;
end;
line:
dict := TJsonConverter.JSONToObject(jsonValue) as TDictionary<Integer, Integer>;
doesn't create dictionary correctly.
Here is how looks dict create by constructor:
[
and here is dict created by deserialization:
How can I fix it?
Edit:
Here is JSON content
{
"type" : "System.Generics.Collections.TDictionary<System.Integer,System.Integer>",
"id" : 1,
"fields" : {
"FItems" : [
[ -1, 0, 0 ],
[ -1, 0, 0 ],
[ -1, 0, 0 ],
[ 911574339, 1, 1 ]
],
"FCount" : 1,
"FGrowThreshold" : 3,
"FKeyCollection" : null,
"FValueCollection" : null
}
}

The problem is that TJSONMarshal is instantiating the dictionary using RTTI. It does that by invoking the first parameterless constructor that it can find. And, sadly, that is the the constructor defined in TObject.
Let's take a look at the constructors declared in TDictionary<K,V>. They are, at least in my XE7 version:
constructor Create(ACapacity: Integer = 0); overload;
constructor Create(const AComparer: IEqualityComparer<TKey>); overload;
constructor Create(ACapacity: Integer; const AComparer: IEqualityComparer<TKey>); overload;
constructor Create(const Collection: TEnumerable<TPair<TKey,TValue>>); overload;
constructor Create(const Collection: TEnumerable<TPair<TKey,TValue>>;
const AComparer: IEqualityComparer<TKey>); overload;
All of these constructors have parameters.
Don't be fooled by the fact that you write
TDictionary<Integer, Integer>.Create
and create an instance with FComparer assigned. That resolves to the first overload above and so the compiler re-writes that code as
TDictionary<Integer, Integer>.Create(0)
filling in the default parameter.
What you need to do is make sure that you only use classes that have parameterless constructors that properly instantiate the class. Unfortunately TDictionary<K,V> does not fit the bill.
You can however derive a sub-class that introduces a parameterless constructor, and your code should work with that class.
The following code demonstrates:
{$APPTYPE CONSOLE}
uses
System.SysUtils,
System.Generics.Collections,
System.Rtti;
type
TDictionary<K,V> = class(System.Generics.Collections.TDictionary<K,V>)
public
constructor Create;
end;
{ TDictionary<K, V> }
constructor TDictionary<K, V>.Create;
begin
inherited Create(0);
end;
type
TInstance<T: class> = class
class function Create: T; static;
end;
class function TInstance<T>.Create: T;
// mimic the way that your JSON marshalling code instantiates objects
var
ctx: TRttiContext;
typ: TRttiType;
mtd: TRttiMethod;
cls: TClass;
begin
typ := ctx.GetType(TypeInfo(T));
for mtd in typ.GetMethods do begin
if mtd.HasExtendedInfo and mtd.IsConstructor then
begin
if Length(mtd.GetParameters) = 0 then
begin
cls := typ.AsInstance.MetaclassType;
Result := mtd.Invoke(cls, []).AsType<T>;
exit;
end;
end;
end;
Result := nil;
end;
var
Dict: TDictionary<Integer, Integer>;
begin
Dict := TInstance<TDictionary<Integer, Integer>>.Create;
Dict.Add(0, 0);
Writeln(BoolToStr(Dict.ContainsKey(0), True));
Readln;
end.

Related

Delphi DataSnap TJSONInterceptor for Variant don't revert correctly

I have DataSnap Server and I have some server method to Set and Get object with variant fields
here is a n example of object I can access via DataSnap :
type
TOrder = class
private
[JSONReflect(ctObject, rtObject, TSampleVariantInterceptor, nil, true)]
FComment: Variant;
[JSONReflect(ctObject, rtObject, TSampleVariantInterceptor, nil, true)]
FNumber: Variant;
procedure SetComment(const Value: Variant);
procedure SetNumber(const Value: Variant);
public
property Number: Variant read FNumber write SetNumber;
property Comment: Variant read FComment write SetComment;
end;
implementation
{ TOrder }
procedure TOrder.SetComment(const Value: Variant);
begin
FComment := Value;
end;
procedure TOrder.SetNumber(const Value: Variant);
begin
FNumber := Value;
end;
here is my ServerMethod sample code :
TsmOrder = class(TDSServerModule)
public
...
function GetOrder(const AID: Integer): TOrder;
function SetOrder(const AOrder: TOrder): Integer;
end;
here is my unit for where is defined my TSampleVariantInterceptor
unit MarshallingUtils;
interface
uses SysUtils, Classes, DBXJSON, StrUtils, RTTI, DBXJSONReflect, Variants;
type
TSampleVariantInterceptor = class(TJSONInterceptor)
private
public
function ObjectConverter(Data: TObject; Field: String): TObject; override;
procedure ObjectReverter(Data: TObject; Field: String; Arg: TObject); override;
end;
[JSONReflect(true)]
TReflectVariantObject = class
private
FType: TVarType;
FValue: string;
public
constructor Create(ASampleVariant: Variant);
function GetVariant: Variant;
end;
implementation
const
NullVariantString = 'null';
{ TSampleVariantInterceptor }
function TSampleVariantInterceptor.ObjectConverter(Data: TObject;
Field: String): TObject;
var
LRttiContext: TRttiContext;
LVariant: Variant;
begin
LVariant := LRttiContext.GetType(Data.ClassType).GetField(Field).GetValue(Data).AsType<Variant>;
Result := TReflectVariantObject.Create(LVariant);
end;
procedure TSampleVariantInterceptor.ObjectReverter(Data: TObject; Field: String;
Arg: TObject);
var
LRttiContext: TRttiContext;
LRttiField: TRttiField;
LVariant: Variant;
begin
Assert(Arg is TReflectVariantObject);
LVariant := TReflectVariantObject(Arg).GetVariant;
LRttiField := LRttiContext.GetType(Data.ClassType).GetField(Field);
LRttiField.SetValue(Data, TValue.FromVariant(LVariant));
Arg.Free;
end;
{ TReflectVariantObject }
constructor TReflectVariantObject.Create(ASampleVariant: Variant);
begin
FType := VarType(ASampleVariant);
case FType of
varNull: FValue := NullVariantString;
else
FValue := ASampleVariant; // Convert to string
end;
end;
function TReflectVariantObject.GetVariant: Variant;
var
V: Variant;
begin
if FValue = NullVariantString then
V := Null
else
V := FValue;
VarCast(Result, V, FType);
end;
end.
My variant is well converted in my server : I can't see the null string in fiddler but in my client application my variant appear to Empty instead of Null Variant. Do I make something wrong ?

How to convert nested object into Json in Delphi 10.1 berlin

I am very much new in delphi. Presently I am facing a problem. i want to convert nested object into Json using TJson, but having memory related issue.
Here is my code.
It is just simple unit file with Person and Address class. The person class is depended on the address class.
unit uPerson;
interface
uses
REST.Json;
type
TAddress = class
private
FStreetNAme: string;
FState: string;
FPinCode: string;
published
property StreetNAme: string read FStreetNAme write FStreetNAme;
property State: string read FState write FState;
property PinCode: string read FPinCode write FPinCode;
end;
TPerson = class
private
FName: string;
FAge: Integer;
FSalary: Double;
[JSONMarshalled(True)]
FAddress: TAddress;
published
property Name: string read FName write FName;
property Age: Integer read FAge write FAge;
property Salary: Double read FSalary write FSalary;
property Address: TAddress read FAddress write FAddress;
end;
implementation
end.
Below is the main form code
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, uPerson,
REST.JSON;
type
TForm1 = class(TForm)
edtName: TLabeledEdit;
edtAge: TLabeledEdit;
edtSalary: TLabeledEdit;
edtStreet: TLabeledEdit;
edtState: TLabeledEdit;
edtPin: TLabeledEdit;
btnSave: TButton;
Memo1: TMemo;
procedure btnSaveClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Person: TPerson;
Add: TAddress;
implementation
{$R *.dfm}
procedure TForm1.btnSaveClick(Sender: TObject);
var
jsonString: string;
begin
Person := TPerson.Create;
try
Person.Name := edtName.Text;
Person.Age := Integer.Parse(edtAge.Text);
Person.Salary := double.Parse(edtSalary.Text);
Add.StreetNAme := edtStreet.Text;
Add.State := edtState.Text;
Add.PinCode := edtPin.Text;
Person.Address := Add;
jsonString := TJson.ObjectToJsonString(Person);
Memo1.Text := jsonString;
finally
Add.Free;
Person.Free;
end;
//
end;
end.
The code is compiling properly. But when try to generate the json it is giving access violation error. Here is the image - access violation error image
[Update]
Basically I am getting "access violation at 0x00409fca: write of address 0x00000004".
Thank you in advance.
I don't know anything about the JSON facilities, but I do know Delphi memory management.
And this error is expected, because you forget to create the TAddress object.
The first problem is this line:
Add.StreetNAme := edtStreet.Text;
Add is a global variable, so it initially is set to nil (since it is an object pointer). Consequently, you here try to write to a memory address very close to 0, which is precisely what you see in the exception message.
You need to create a TAddress object on the heap and assign the address of this object to the Add variable.
Just like you do for the TPerson object.
procedure TForm1.btnSaveClick(Sender: TObject);
var
jsonString: string;
begin
Person := TPerson.Create;
try
Add := TAddress.Create;
try
Person.Name := edtName.Text;
Person.Age := Integer.Parse(edtAge.Text);
Person.Salary := double.Parse(edtSalary.Text);
Add.StreetName := edtStreet.Text;
Add.State := edtState.Text;
Add.PinCode := edtPin.Text;
Person.Address := Add;
jsonString := TJson.ObjectToJsonString(Person);
Memo1.Text := jsonString;
finally
Add.Free;
end;
finally
Person.Free;
end;
end;
Also, it's not a good idea to use global variables here. Instead, use local variables. And there is no need for a separate TAddress variable at all:
var
Person: TPerson;
jsonString: string;
begin
Person := TPerson.Create;
try
Person.Address := TAddress.Create;
try
Person.Name := edtName.Text;
Person.Age := Integer.Parse(edtAge.Text);
Person.Salary := double.Parse(edtSalary.Text);
Person.Address.StreetName := edtStreet.Text;
Person.Address.State := edtState.Text;
Person.Address.PinCode := edtPin.Text;
jsonString := TJson.ObjectToJsonString(Person);
Memo1.Text := jsonString;
finally
Person.Address.Free;
end;
finally
Person.Free;
end;
end;
Furthermore, you might argue that it would be better if the TPerson constructor created a TAddress object and put a pointer to it in its Address field. Then the TPerson destructor would also be responsible for freeing this object:
unit uPerson;
interface
uses
REST.Json;
type
TAddress = class
private
FStreetNAme: string;
FState: string;
FPinCode: string;
published
property StreetNAme: string read FStreetNAme write FStreetNAme;
property State: string read FState write FState;
property PinCode: string read FPinCode write FPinCode;
end;
TPerson = class
private
FName: string;
FAge: Integer;
FSalary: Double;
[JSONMarshalled(True)]
FAddress: TAddress;
public
constructor Create;
destructor Destroy; override;
published
property Name: string read FName write FName;
property Age: Integer read FAge write FAge;
property Salary: Double read FSalary write FSalary;
property Address: TAddress read FAddress write FAddress;
end;
implementation
{ TPerson }
constructor TPerson.Create;
begin
FAddress := TAddress.Create;
end;
destructor TPerson.Destroy;
begin
FAddress.Free;
inherited;
end;
end.
and
var
Person: TPerson;
jsonString: string;
begin
Person := TPerson.Create;
try
Person.Name := 'Andreas';
Person.Age := 32;
Person.Salary := 12345;
Person.Address.StreetName := 'Street';
Person.Address.State := 'State';
Person.Address.PinCode := 'pin';
jsonString := TJson.ObjectToJsonString(Person);
Memo1.Text := jsonString;
finally
Person.Free;
end;
end;

Marshal a Record to JSON and back [duplicate]

How can an array of record be stored in JSON via SuperObject library. For example..
type
TData = record
str: string;
int: Integer;
bool: Boolean;
flt: Double;
end;
var
DataArray: Array[0..100] of TData;
Just use the superobject Marshalling TSuperRTTIContext
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
superobject,
System.SysUtils;
type
TData = record
str : string;
int : Integer;
bool : Boolean;
flt : Double;
end;
TDataArray = Array [0 .. 100] of TData;
procedure Test;
var
DataArray : TDataArray;
so : ISuperObject;
ctx : TSuperRttiContext;
begin
ctx := TSuperRttiContext.Create;
try
so := ctx.AsJson<TDataArray>( DataArray );
finally
ctx.Free;
end;
Writeln( so.AsJson );
end;
begin
try
Test;
except
on E : Exception do
Writeln( E.ClassName, ': ', E.Message );
end;
ReadLn;
end.
Make it a string first.
Your array:
//Array[0] := 'Apple';
//Array[1] := 'Orange';
//Array[2] := 'Banana';
myArrayAsStr := '"MyArray": [{ "1": "' + Array[0] +'", "2": "' + Array[1] +'"}';
Then you can just make it into JSON with SO(myArrayAsStr)
You can always generate your array as string in a different procedure but I think thats the way to do it.
Ill keep checking if there is an easier way ;)
EDIT:
SuperObject also has the following function:
function SA(const Args: array of const): ISuperObject; overload;
You will be able to convert that to a string again and add it in the total JSON string.

JSON - is it possible to marshall a method prototype in SuperObject?

in superobject, ISuperObject has a method called "AsMethod", what does it do ? how do i use it ?
lets say i have this code, how can i marshall to json the signature itself (with params) so i can easily have it ready for the SOInvoke ? thanks everyone.
for example, lets say i have procedure hey('sup', 45, false);, can i have it marshalled as {method: "hey", Arg0: "sup", Arg1: 45, Arg2: false} ?
procedure TForm1.Test(const MyType: TMyType; const s: string);
begin
case MyType of
mtTry:
showmessage('Try');
mtHey:
showmessage('Hey');
else
showmessage('Else');
end;
showmessage(s);
end;
procedure TForm1.Button1Click(Sender: TObject);
type
TTestProc = procedure (const MyType: TMyType; const s: string) of object;
var
Ctx: TSuperRttiContext;
Sig: TTestProc;
begin
Ctx := TSuperRttiContext.Create;
Ctx.AsJson<TTestProc>(Sig(mtHey, 'hey'));
// SOInvoke(Self, 'test', SO('{MyType: 1, Param: "shit"}'));
Ctx.Free;
end;

Store Array of Record in JSON

How can an array of record be stored in JSON via SuperObject library. For example..
type
TData = record
str: string;
int: Integer;
bool: Boolean;
flt: Double;
end;
var
DataArray: Array[0..100] of TData;
Just use the superobject Marshalling TSuperRTTIContext
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
superobject,
System.SysUtils;
type
TData = record
str : string;
int : Integer;
bool : Boolean;
flt : Double;
end;
TDataArray = Array [0 .. 100] of TData;
procedure Test;
var
DataArray : TDataArray;
so : ISuperObject;
ctx : TSuperRttiContext;
begin
ctx := TSuperRttiContext.Create;
try
so := ctx.AsJson<TDataArray>( DataArray );
finally
ctx.Free;
end;
Writeln( so.AsJson );
end;
begin
try
Test;
except
on E : Exception do
Writeln( E.ClassName, ': ', E.Message );
end;
ReadLn;
end.
Make it a string first.
Your array:
//Array[0] := 'Apple';
//Array[1] := 'Orange';
//Array[2] := 'Banana';
myArrayAsStr := '"MyArray": [{ "1": "' + Array[0] +'", "2": "' + Array[1] +'"}';
Then you can just make it into JSON with SO(myArrayAsStr)
You can always generate your array as string in a different procedure but I think thats the way to do it.
Ill keep checking if there is an easier way ;)
EDIT:
SuperObject also has the following function:
function SA(const Args: array of const): ISuperObject; overload;
You will be able to convert that to a string again and add it in the total JSON string.