I'm having trouble deserializing an object containing a interface field from json using SuperObject (serialization works fine) on DXE2. Consider the following:
ITest = interface(IInterface)
['{9E5623FF-1BC9-4FFA-919D-80C45EE24F38}']
function GetField3() : string;
procedure SetField3(Value: string);
property FField3: string read GetField3 write SetField3;
end;
TTest = class(TInterfacedObject, ITest)
private
FField3: string;
function GetField3() : string;
procedure SetField3(Value: string);
public
property Field3: string read GetField3 write SetField3;
constructor Create(Field3: string);
end;
TMyClass = class(TObject)
public
FField1: string;
FField2: string;
FTest: ITest;
constructor Create(Field1: string; Field2: string; Test: ITest);
end;
// TTest-stuff omitted for brevity.
constructor TMyClass.Create(Field1, Field2: string; Test: ITest);
begin
FField1 := Field1;
FField2 := Field2;
FTest := Test;
end;
var
MyClass: TMyClass;
MyClass2: TMyClass;
JSONObj: ISuperObject;
SuperContext: TSuperRttiContext;
begin
MyClass := TMyClass.Create('Test1', 'Test2', TTest.Create('Test3'));
SuperContext := TSuperRttiContext.Create();
JSONObj := SuperContext.AsJson<TMyClass>(MyClass);
WriteLn(JSONObj.AsString);
MyClass2 := SuperContext.AsType<TMyClass>(JSONObj);
MyClass2.Free();
ReadLn;
end.
When execution gets to TSuperRttiContext.FromJson.FromClass checking the FTest-field, the doo-doo hits the propeller in the ceiling (or table mounted, if you prefer that). At this point, Result := FromJson(f.FieldType.Handle, GetFieldDefault(f, obj.AsObject[GetFieldName(f)]), v); is called, which leads us into the interesting part of the SuperObject.pas code. I'll duplicated it here for brevity.
procedure FromInterface;
const soguid: TGuid = '{4B86A9E3-E094-4E5A-954A-69048B7B6327}';
var
o: ISuperObject;
begin
if CompareMem(#(GetTypeData(TypeInfo).Guid), #soguid, SizeOf(TGUID)) then
begin
if obj <> nil then
TValue.Make(#obj, TypeInfo, Value) else
begin
o := TSuperObject.Create(stNull);
TValue.Make(#o, TypeInfo, Value);
end;
Result := True;
end else
Result := False;
end;
The value assigned to soguid is that of ISuperObject, so clearly the two won't match (I'm testing for ITest, remember?). And so I'm a little lost of what to make of this. Is it illegal to deserialize any object composed of one or more interface fields?
This seems like such a common use case, that I find it hard to believe. I can appreciate the fact that knowing what implementation of a given interface to choose may be non-trivial. Yet, I see from the comment in the preamble, that interfaced objects are supposed to be supported - http://code.google.com/p/superobject/source/browse/trunk/superobject.pas#47.
Sure would be great if anyone have solved this out there. Thanks! :)
Related
I have this class:
unit untPerson;
interface
type TPerson = class
private
fName : string;
fEmail : string;
fAge : integer;
published
property Name : string read fName write fName;
property Email : string read fEmail write fEmail;
property Age : integer read fAge write fAge;
end;
implementation
end.
And i need to serialize to Json using this code
TJson.ObjectToJsonString(objPerson, []);
But i need to skip Age if equal 0.
if objPerson.Age = 0 then
result := '{"name":"Lucas", "email":"lucas#github.com"}'
else
result := '{"name":"Lucas", "email":"lucas#github.com", "age":30}';
How Can I Do?
if objPerson.Age = 0 then
result := '{"name":"Lucas", "email":"lucas#github.com"}'
else
result := '{"name":"Lucas", "email":"lucas#github.com", "age":30}';
You can't dynamically ignore properties by using code: TJson.ObjectToJsonString(objPerson, []);.
You can put empty string by custom TJSONInterceptor, like Remy Lebeau says in comments(https://en.delphipraxis.net/topic/6155-tjson-suppressemptyvalues-for-empty-integer-double-and-class-fields/), but to exclude it from json you need to put option joIgnoreEmptyStrings: TJson.ObjectToJsonString(objPerson, [joIgnoreEmptyStrings]);.
One more way to do it: use custom converter (descendant of TJsonConverter), but problem is that you can’t use TJson.ObjectToJsonString in this case, because it have precompiled code with creating JSONMarshal using specifically TJSONConverter class without possibility of overriding: TJSONMarshal.Create(TJSONConverter.Create, true, CFRegConverters);. So you need to reimplement all chain of call TJSON.ObjectToJsonString -> ObjectToJsonValue -> TJSONConverters.GetJSONMarshaler -> TJSONMarshal.Create(TJSONConverter.Create, true, CFRegConverters);. And after that you must use this custom implementation.
Easiest way – to add custom method directly to class:
TPerson = class
private
fName : string;
fEmail : string;
fAge : integer;
published
function ToJsonString : string; virtual;
class function FromJsonString(const AJsonStr : string) : TPerson;
property Name : string read fName write fName;
property Email : string read fEmail write fEmail;
property Age : integer read fAge write fAge;
end;
In this case – you can use any custom logic, but the same code: TJson.ObjectToJsonString(objPerson, []);.will does not work correctly. You must use these new methods.
And last – you can try to find some other 3rd party JSON serializers.
As an alternative solution, mORMot have this diamond, and you can always use ObjectToJson to serialize very fast any TObject in a centralized way:
program TestJson;
{$APPTYPE CONSOLE}
{$R *.res}
uses
Syncommons, mORMot;
type TPerson = class
private
fName : string;
fEmail : string;
fAge : integer;
public
class procedure ClassWriter(const aSerializer: TJSONSerializer;
aValue: TObject; aOptions: TTextWriterWriteObjectOptions);
published
property Name : string read fName write fName;
property Email : string read fEmail write fEmail;
property Age : integer read fAge write fAge;
end;
{ TPerson }
class procedure TPerson.ClassWriter(const aSerializer: TJSONSerializer;
aValue: TObject; aOptions: TTextWriterWriteObjectOptions);
var Person: TPerson absolute aValue;
begin
if Person.Age=0 then
aSerializer.AddJSONEscape(['Name',Person.Name,
'Email',Person.Email
])
else
aSerializer.AddJSONEscape(['Name',Person.Name,
'Email',Person.Email,
'Age',Person.Age
]);
end;
var Person : TPerson;
begin
TJSONSerializer.RegisterCustomSerializer(TPerson,nil,TPerson.ClassWriter);
Person := TPerson.Create;
try
Person.Name := 'Jon';
Person.Email := 'jon#gmail.com';
Person.Age := 10;
writeln(ObjectToJson(Person)); // Result {"Name":"Jon","Email":"jon#gmail.com","Age":10}
Person.Age := 0;
writeln(ObjectToJson(Person)); // Result {"Name":"Jon","Email":"jon#gmail.com"}
finally
Person.Free;
end;
readln;
end.
Please, find further details in the amazing documentation
TApplicationWrapper = class(TObjectWrapper)
private
function GetMyFonk(): string;
procedure SetMyFonk(myCmd: string);
published
property myFonk: String read GetMyFonk write SetMyFonk;
...
function TApplicationWrapper.GetMyFonk(): string;
begin
ShowMessage('GetMyFonk is Run');
Result :='';
end;
procedure TApplicationWrapper.SetMyFonk(myCmd: string);
begin
ShowMessage('SetMyFonk is Run');
end;
The program works this way. But I want to assign parameters to the GetMyFonk() function.
function GetMyFonk (myCommand : String ): string;
I get an error message.
[dcc32 Error] altPanellerU.pas(74): E2008 Incompatible types
How can I assign a value to the function?
Your property simply does not support a getter function that takes parameters. For every parameter you want to add to the getter, you must add a corresponding parameter to the property and the setter, eg:
TApplicationWrapper = class(TObjectWrapper)
private
function GetMyFonk(myCommand : String): string;
procedure SetMyFonk(myCommand : String; Value : string);
published
property myFonk[myCommand : String] : String read GetMyFonk write SetMyFonk;
...
function TApplicationWrapper.GetMyFonk(myCommand : String): string;
begin
ShowMessage('GetMyFonk is Run w/ ' + myCommand);
Result :='';
end;
procedure TApplicationWrapper.SetMyFonk(myCommand : String; Value: string);
begin
ShowMessage('SetMyFonk is Run w/ ' + myCommand);
end;
And then you would have to access the property like this:
App: TApplicationWrapper;
...
S := App.MyFonk['command'];
...
App.MyFonk['command'] := S;
This is discussed in more detail in Embarcadero's documentation:
Properties (Delphi)
See the section on "Array Properties".
I have a class in Delphi which I export in jsonmarshalled file.
I am skipping some Fields using the JSONMarshalledAttribute, which resides in the unit: REST.JSON.Types. More literature here
[JSONMarshalledAttribute(False)]
Field1: double;
[JSONMarshalledAttribute(False)]
Field2: double;
So far this works great.
My question is: Can I change the JSONMarshalledAttribute to True during runtime?
EDIT 1:
As requested here is the code:
Suppose we have a Form2:TForm and within the form as follows...:
Interface(I am skipping the attributes of the form....)
type
TmyClass = class(Tobject)
private
[JSONMarshalledAttribute(false)]
FName: string;
FVal1: double;
public
property Name: string read FName write FName;
property Val1: double read FVal1 write FVal1;
end;
and then in the implementation:
procedure TForm2.Button2Click(Sender: Tobject);
var
LArray: TJSONArray;
begin
MyClass := TmyClass.Create;
MyClass.name := 'myNAme';
LArray := myMarshaler(MyClass, 'FName', True);
end;
and the actual function that returns a TJSONArray:
function TForm2.myMarshaler(myclass: TmyClass; Field: string; Marshal: Boolean)
: TJSONArray;
var
Marshaler: TJSONMarshal;
JSONObject: TJSONObject;
LArray: TJSONArray;
begin
Marshaler := TJSONMarshal.Create(TJSONConverter.Create);
try
Marshaler.RegisterJSONMarshalled(myclass, Field,Marshal);
// Marshaler.DateFormat := jdfUnix;
JSONObject := Marshaler.Marshal(myclass) as TJSONObject;
LArray := TJSONArray.Create;
LArray.AddElement(JSONObject);
result := LArray;
finally
FreeAndNil(Marshaler);
end;
end;
That will not work because Marshaler.RegisterJSONMarshalled requires a TClass as an argument type, but I want to input my own custom classes which are derived from TObject.
and this is the error:
[dcc32 Error] Unit2.pas(134): E2250 There is no overloaded version of >'RegisterJSONMarshalled' that can be called with these arguments
How do I fix this?
You can not change the attribute, but you can overwrite it.
According to the documentation, it should work with:
Marshaler.RegisterJSONMarshalled(TYourClass, 'Field1', true);
Therefore, you can not use the class function TJson.ObjectToJsonObject(...), - you'll have to create the marshaller (from the unit REST.JsonReflect) yourself. Example:
var
Marshaler: TJSONMarshal;
JSONObject: TJSOnObject;
begin
Marshaler := TJSONMarshal.Create(TJSONConverter.Create);
try
Marshaler.RegisterJSONMarshalled(TYourClass, 'Field1');
Marshaler.DateFormat :=jdfUnix;
JSONObject := Marshaler.Marshal(AObject) as TJSOnObject;
Result := JSONObject;
finally
FreeAndNil(Marshaler);
end;
end;
To remove the overwritten value you can call UnregisterJSONMarshalled.
Update to clarify how to this method is called:
The declared method signature is:
RegisterJSONMarshalled(clazz: TClass; Field: string; Marshal: Boolean);
So there are three parameters to pass in:
Marshaler.RegisterJSONMarshalled(myclass.ClassType, Field, Marshal);
or even more simpler:
Marshaler.RegisterJSONMarshalled(TMyClass, Field, Marshal);
You have to pass in the class type of your class.
No you cannot change attributes at runtime. You'll have to find a different approach to handle the dynamic nature of your marshaling.
I am using Delphi Xe5 and I have a component that essentially uses IDTCPCLient (sockets) to talk with are server and retrieve data in the form of JSON. I have spared you all the connection code , etc. It works. The returned JSon works as well. The trouble I am having is converting my JSON into a StringList, which I then use to write out a list of values to a listbox and store the rest of the JSON data objects in the TSTrings OBjects property.
I have a number of funny things happen.
1.) I can't for the life of me get the List property to work properly. I use this list to store my JSON. A string value and then the entire object for each item in the list. You will notice that in the JSONToStringList method, I clear the stringlist (it is commented out, becuase when it isn't, my program hangs)
2.) I get dupplicate values in my list after calling the method more than once for multiple JSON sets needed
TConnector = class(TComponent)
private
{ Private declarations }
FList: TStrings;
procedure SetList(const Value: TStrings);
protected
{ Protected declarations }
public
{ Public declarations }
Constructor Create( AOwner : TComponent ); override;
Destructor Destroy; Override;
Procedure GenerateJSON;
Procedure JSONToStringList(aJSonKey: String);
published
{ Published declarations }
property List: TStrings Read FList Write SetList;
end;
Constructor TConnector.Create(AOwner: TComponent);
begin
inherited;
FList:= TStringList.Create(True);
end;
destructor TConnector.Destroy;
begin
if FList <> nil then
FreeAndNil(FList);
inherited;
end;
Procedure TConnector.GenerateJSON;
begin
if ResponseStream<>nil then
Begin
FreeAndNil(ResponseJSON_V);
ResponseJSON_V := TJSONObject.ParseJSONValue(StreamToArray(ResponseStream),0) as TJSONValue;
End;
end;
procedure TConnector.JSONToStringList(aJSonKey: String);
Var
zLJsonValue : TJSONValue;
zLJSONArray: TJSONArray;
zLJsonObject : TJSONObject;
zI : Integer;
begin
if ResponseJSON_V is TJSONArray then
begin
zLJSONArray:= ResponseJSON_V as TJSONArray;
zLJsonObject := zLJSONArray.Get(0) as TJSONObject;
end
else
if ResponseJSON_V is TJSONObject then
begin
zLJSONArray:= nil;
zLJsonObject := ResponseJSON_V as TJSONObject;
end
else
Exit;
if zLJSONArray<>nil then
begin
***//FList.Clear;***
for zLJsonValue in zLJSONArray do
begin
zLJsonObject := zLJsonValue as TJSONObject;
for zI := 0 to zLJsonObject.Size-1 do
begin
if zLJsonObject.Get(zI).JsonString.Value = aJSonKey then
begin
FList.AddObject(zLJsonObject.Get(zI).JSONValue.Value, zLJsonObject);
end;
end;
end;
end
else
begin
FList.Clear;
for zI := 0 to zLJsonObject.Size-1 do
begin
if zLJsonObject.Get(zI).JsonString.Value = aJSonKey then
FList.AddObject(zLJsonObject.Get(zI).JSONValue.Value, TJSONPair(zLJsonObject.Get(zI)));
end;
end;
end;
I hope this is all understandable. Please let me know if you need to see more. Please feel free to correct anything else you see bad in my code. I am always learning :) - thank you for your help
If FList.Clear hangs then it's most likely memory corruption issue. First two thing I would suspect is that you have not called a constructor or that part of the memory has been overwritten by something else.
Can the duplicate values in the list be cause by the fact that you commented out FList.Clear. Anyway, I suggest using a debugger to see what goes in to the list or log everything added to/removed from the list. This should give you the idea where unneeded values in the list are coming from.
As a general advice you don't need to check if object is not nil before freeing it. The check is made in Free (or in the Free part of the FreeAndNil) anyway.
It turns out , that the FList property should not have been published, but rather made public instead. Which makes since, cause the list is only filled and emptied at runtime, never at design time.
TLiveConnector = class(TComponent)
private
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
List: TStrings;
published
end;
Not sure exactly why that is the case, but it seem to work just fine now
Calling List.Clear instead of FList.Clear;
your code cannot work ... U define a param called "aJSonKey" and u call it "ResponseJSON_V " into the procedure.
Moreover u call this "ResponseJSON_V" into GenerateJSON proc when there is no property called that way.
I have the following code that serializes a dynamic array of classes. For some reason SuperObject serializes on the private variables instead of the class property names. Can anyone please advise how to fix this behaviour in SuperObject?
class function TJSON.AsJSON<T>(AObject: T; Indent: Boolean = False): string;
var
Ctx: TSuperRttiContext;
begin
Ctx := TSuperRttiContext.Create;
try
Result := Ctx.AsJson<T>(AObject).AsJSon(Indent);
finally
Ctx.Free;
end;
end;
type
TMyClass = class
private
FName_: String;
FAge_: Integer;
public
property Name: String read FName_ write FName_;
property Age: Integer read FAge_ write FAge_;
end;
procedure TFormTest.Button27Click(Sender: TObject);
var
MyClassArray: TArray<TMyClass>;
MyClass1, MyClass2: TMyClass;
begin
MyClass1 := TMyClass.Create;
MyClass1.Name := 'Joe';
MyClass1.Age := 10;
MyClass2 := TMyClass.Create;
MyClass2.Name := 'Dan';
MyClass2.Age := 13;
SetLength(MyClassArray, 2);
MyClassArray[0] := MyClass1;
MyClassArray[1] := MyClass2;
Memo1.Text := TJSON.AsJSON<TArray<TMyClass>>(MyClassArray);
end;
The above code generates the following JSON:
[{"FName_":"Joe","FAge_":10},{"FName_":"Dan","FAge_":13}]
what I am after is the following JSON:
[{"Name":"Joe","Age":10},{"Name":"Dan","Age":13}]
I think it's not possible at this time and that you probably hit this issue. Even Delphi XE2 Datasnap serializes private fields at JSON marshalling and in my view it's just a consequence of a deeper visibility given to the new extended RTTI without considering the limits.
As far as I know, RTTI operates only on published properties (I may be wrong), but I think that you should simply switch your properties access level to published to get the desired JSON string.