// *************************************************************************** // // Delphi MVC Framework // // Copyright (c) 2010-2017 Daniele Teti and the DMVCFramework Team // // https://github.com/danieleteti/delphimvcframework // // *************************************************************************** // // Licensed under the Apache License, Version 2.0 (the "License"); // you may not use this file except in compliance with the License. // You may obtain a copy of the License at // // http://www.apache.org/licenses/LICENSE-2.0 // // Unless required by applicable law or agreed to in writing, software // distributed under the License is distributed on an "AS IS" BASIS, // WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. // See the License for the specific language governing permissions and // limitations under the License. // // *************************************************************************** } unit MVCFramework.Serializer.JSON; interface {$I dmvcframework.inc} uses MVCFramework.Serializer.Intf , Data.DB , System.Rtti , System.SysUtils , System.Classes , MVCFramework.TypesAliases, MVCFramework.DuckTyping, System.TypInfo ; type TMVCJSONSerUnSer = class(TInterfacedObject, IMVCSerializer) private class var CTX: TRTTIContext; { following methods are used internally by the serializer/unserializer to handle with the ser/unser logic } function SerializeFloatProperty(AObject: TObject; ARTTIProperty: TRttiProperty): TJSONValue; overload; deprecated; function SerializeFloatProperty(AElementType: TRTTIType; AValue: TValue): TJSONValue; overload; function SerializeFloatField(AObject: TObject; ARttiField: TRttiField): TJSONValue; function SerializeEnumerationProperty(AObject: TObject; ARTTIProperty: TRttiProperty): TJSONValue; overload; deprecated; function SerializeEnumerationProperty(AElementType: TRTTIType; AValue: TValue): TJSONValue; overload; function SerializeTValue(AElementType: TRTTIType; AValue: TValue; AAttributes: TArray) : TJSONValue; function SerializeEnumerationField(AObject: TObject; ARttiField: TRttiField): TJSONValue; function DeserializeFloat(ARTTIType: TRTTIType; AJSONValue: TJSONValue): TValue; function DeserializeEnumeration(ARTTIType: TRTTIType; AJSONValue: TJSONValue; AItemName: String): TValue; function DeserializeRecord(ARTTIType: TRTTIType; AJSONValue: TJSONValue; AAttributes: TArray; AItemName: String): TValue; function DeserializeTValue(AJValue: TJSONValue; AAttributes: TArray; AItemName: String): TValue; function DeserializeTValueWithDynamicType(AJValue: TJSONValue; AItemName: String): TValue; procedure DeSerializeStringStream(aStream: TStream; const aSerializedString: string; aEncoding: string); procedure DeSerializeBase64StringStream(aStream: TStream; const aBase64SerializedString: string); function ObjectToJSONObject(AObject: TObject; AIgnoredProperties: array of string): TJSONObject; function ObjectToJSONObjectFields(AObject: TObject): TJSONObject; function PropertyExists(JSONObject: TJSONObject; PropertyName: string): boolean; function GetPair(JSONObject: TJSONObject; PropertyName: string): TJSONPair; function JSONObjectToObject(Clazz: TClass; AJSONObject: TJSONObject): TObject; function SerializeRTTIElement(ElementType: TRTTIType; ElementAttributes: TArray; Value: TValue; out OutputValue: TJSONValue): boolean; procedure InternalJSONObjectToObject(AJSONObject: TJSONObject; AObject: TObject); function SerializeTValueAsFixedNullableType(AValue: TValue; AValueTypeInfo: PTypeInfo): TJSONValue; procedure InternalDeserializeObject(ASerializedObject: string; AObject: TObject; AStrict: boolean); protected { IMVCSerializer } function SerializeObject(AObject: TObject; AIgnoredProperties: array of string): string; function SerializeObjectStrict(AObject: TObject): String; function SerializeDataSet(ADataSet: TDataSet; AIgnoredFields: array of string): string; function SerializeCollection(AList: TObject; AIgnoredProperties: array of string): String; function SerializeCollectionStrict(AList: TObject): String; { IMVCDeserializer } procedure DeserializeObject(ASerializedObject: string; AObject: TObject); procedure DeserializeObjectStrict(ASerializedObject: String; AObject: TObject); procedure DeserializeCollection(ASerializedObjectList: string; AList: IMVCList; AClazz: TClass); end; implementation uses ObjectsMappers, MVCFramework.Patches, MVCFramework.RTTIUtils, MVCFramework.Serializer.Commons, Winapi.Windows; { TMVCJSONSerializer } procedure TMVCJSONSerUnSer.DeSerializeStringStream(aStream: TStream; const aSerializedString: string; aEncoding: string); begin end; function TMVCJSONSerUnSer.DeserializeTValue(AJValue: TJSONValue; AAttributes: TArray; AItemName: String): TValue; var lAttr: TValueAsType; begin if TSerializerHelpers.AttributeExists(AAttributes, lAttr) then begin case lAttr.TValueTypeInfo.Kind of tkUString, tkString, tkLString, tkWString: begin Result := (AJValue as TJSONString).Value; end; tkInteger: begin Result := (AJValue as TJSONNumber).AsInt; end; tkInt64: begin Result := (AJValue as TJSONNumber).AsInt64; end; tkEnumeration: begin raise EMVCDeserializationException.Create('Booleans and enumerations are not supported'); end; else raise EMVCDeserializationException.CreateFmt('Type non supported for TValue at item: ', [AItemName]); end; end else begin Result := DeserializeTValueWithDynamicType(AJValue, AItemName); end; end; function TMVCJSONSerUnSer.DeserializeTValueWithDynamicType( AJValue: TJSONValue; AItemName: String): TValue; var lJTValueValue: TJSONValue; lTypeKind: TTypeKind; lStrType: string; begin lStrType := AJValue.GetValue('type').Value; lJTValueValue := AJValue.GetValue('value'); lTypeKind := TSerializerHelpers.StringToTypeKind(lStrType); case lTypeKind of tkInteger: begin Result := (lJTValueValue as TJSONNumber).AsInt; end; tkEnumeration: begin Result := lJTValueValue is TJSONTrue; end; tkFloat: begin Result := (lJTValueValue as TJSONNumber).AsDouble; end; tkString, tkLString, tkWString, tkUString: begin Result := lJTValueValue.Value; end; tkInt64: begin Result := (lJTValueValue as TJSONNumber).AsInt64; end; else raise EMVCDeserializationException.CreateFmt('Type non supported for TValue %s at: ', [lStrType, AItemName]); end; end; function TMVCJSONSerUnSer.GetPair(JSONObject: TJSONObject; PropertyName: string): TJSONPair; var pair: TJSONPair; begin if not Assigned(JSONObject) then raise EMapperException.Create('JSONObject is nil'); pair := JSONObject.Get(PropertyName); Result := pair; end; procedure TMVCJSONSerUnSer.InternalDeserializeObject(ASerializedObject: string; AObject: TObject; AStrict: boolean); var lJSON: TJSONValue; begin lJSON := TJSONObject.ParseJSONValue(ASerializedObject); try if lJSON <> nil then begin if lJSON is TJSONObject then begin if AStrict then begin // InternalJSONObjectToObjectFields(TJSONObject(lJSON), AObject) end else InternalJSONObjectToObject(TJSONObject(lJSON), AObject) end else begin raise EMVCDeserializationException.CreateFmt('Serialized string is a %s, expected JSON Object', [lJSON.ClassName]); end; end else begin raise EMVCDeserializationException.Create('Serialized string is not a valid JSON'); end; finally lJSON.Free; end; end; procedure TMVCJSONSerUnSer.InternalJSONObjectToObject(AJSONObject: TJSONObject; AObject: TObject); var lRttiType: TRTTIType; lProperties: TArray; lProperty: TRttiProperty; f: string; jvalue: TJSONValue; v: TValue; o: TObject; list: IWrappedList; I: Integer; cref: TClass; attr: MapperItemsClassType; Arr: TJSONArray; n: TJSONNumber; SerStreamASString: string; _attrser: MapperSerializeAsString; ListMethod: TRttiMethod; ListItem: TValue; ListParam: TRttiParameter; lPropName: string; lTypeSerializer: IMVCTypeSerializer; lOutputValue: TValue; begin { TODO -oDaniele -cGeneral : Refactor this method } if not Assigned(AJSONObject) then raise EMapperException.Create('JSON Object cannot be nil'); lRttiType := CTX.GetType(AObject.ClassInfo); lProperties := lRttiType.GetProperties; for lProperty in lProperties do begin if ((not lProperty.IsWritable) and (lProperty.PropertyType.TypeKind <> tkClass)) or (TSerializerHelpers.HasAttribute(lProperty)) then Continue; lPropName := lProperty.Name; f := TSerializerHelpers.GetKeyName(lProperty, lRttiType); if Assigned(AJSONObject.Get(f)) then jvalue := AJSONObject.Get(f).JsonValue else Continue; lTypeSerializer := TMVCSerializersRegistry.GetTypeSerializer('application/json', lProperty.PropertyType.Handle); if lTypeSerializer <> nil then begin lTypeSerializer.DeserializeInstance( lProperty.PropertyType, lProperty.GetAttributes, TObject(jvalue), lOutputValue); lProperty.SetValue(TObject(AObject), lOutputValue); end else begin case lProperty.PropertyType.TypeKind of tkEnumeration: begin lProperty.SetValue(TObject(AObject), DeserializeEnumeration(lProperty.PropertyType, jvalue, lPropName)); end; tkInteger, tkInt64: lProperty.SetValue(TObject(AObject), StrToIntDef(jvalue.Value, 0)); tkFloat: begin lProperty.SetValue(TObject(AObject), DeserializeFloat(lProperty.PropertyType, jvalue)); end; tkString, tkLString, tkWString, tkUString: begin lProperty.SetValue(TObject(AObject), jvalue.Value); end; tkRecord: begin lProperty.SetValue(TObject(AObject), DeserializeRecord(lProperty.PropertyType, jvalue, lProperty.GetAttributes, lPropName)); end; tkClass: // try to restore child properties... but only if the collection is not nil!!! begin o := lProperty.GetValue(TObject(AObject)).AsObject; if Assigned(o) then begin if jvalue is TJSONNull then begin { TODO -oDaniele -cGeneral : How to handle this case at best? } // FreeAndNil(o); // lRttiProp.SetValue(AObject, nil); end else if o is TStream then begin if jvalue is TJSONString then begin SerStreamASString := TJSONString(jvalue).Value; end else raise EMapperException.Create('Expected JSONString in ' + AJSONObject.Get(f).JsonString.Value); if TSerializerHelpers.HasAttribute(lProperty, _attrser) then begin TSerializerHelpers.DeSerializeStringStream(TStream(o), SerStreamASString, _attrser.Encoding); end else begin TSerializerHelpers.DeSerializeBase64StringStream(TStream(o), SerStreamASString); end; end else if TDuckTypedList.CanBeWrappedAsList(o) then begin // restore collection if jvalue is TJSONArray then begin Arr := TJSONArray(jvalue); // look for the MapperItemsClassType on the property itself or on the property type if Mapper.HasAttribute(lProperty, attr) or Mapper.HasAttribute(lProperty.PropertyType, attr) then begin cref := attr.Value; list := WrapAsList(o); for I := 0 to Arr.Count - 1 do begin list.Add(Mapper.JSONObjectToObject(cref, Arr.Items[I] as TJSONObject)); end; end else // Ezequiel J. Müller convert regular list begin ListMethod := CTX.GetType(o.ClassInfo).GetMethod('Add'); if (ListMethod <> nil) then begin for I := 0 to Arr.Count - 1 do begin ListItem := TValue.Empty; for ListParam in ListMethod.GetParameters do case ListParam.ParamType.TypeKind of tkInteger, tkInt64: ListItem := StrToIntDef(Arr.Items[I].Value, 0); tkFloat: ListItem := TJSONNumber(Arr.Items[I].Value).AsDouble; tkString, tkLString, tkWString, tkUString: ListItem := Arr.Items[I].Value; end; if not ListItem.IsEmpty then ListMethod.Invoke(o, [ListItem]); end; end; end; end else raise EMapperException.Create('Cannot restore ' + f + ' because the related json property is not an array'); end else // try to deserialize into the property... but the json MUST be an object begin if jvalue is TJSONObject then begin InternalJSONObjectToObject(TJSONObject(jvalue), o); end else if jvalue is TJSONNull then begin FreeAndNil(o); lProperty.SetValue(AObject, nil); end else raise EMapperException.Create('Cannot deserialize property ' + lProperty.Name); end; end; end; end; // case end; end; end; function TMVCJSONSerUnSer.JSONObjectToObject(Clazz: TClass; AJSONObject: TJSONObject): TObject; var AObject: TObject; begin AObject := TRTTIUtils.CreateObject(Clazz.QualifiedClassName); try InternalJSONObjectToObject(AJSONObject, AObject); Result := AObject; except on E: Exception do begin FreeAndNil(AObject); raise EMVCDeserializationException.Create(E.Message); end; end; end; function TMVCJSONSerUnSer.ObjectToJSONObject(AObject: TObject; AIgnoredProperties: array of string): TJSONObject; var lType: TRTTIType; lProperties: TArray; lProperty: TRttiProperty; f: string; JSONObject: TJSONObject; Arr: TJSONArray; list: IMVCList; Obj, o: TObject; DoNotSerializeThis: boolean; I: Integer; ThereAreIgnoredProperties: boolean; ts: TTimeStamp; sr: TStringStream; SS: TStringStream; _attrser: MapperSerializeAsString; SerEnc: TEncoding; lTypeSerializer: IMVCTypeSerializer; lJSONValue: TJSONValue; lSerializedJValue: TJSONValue; begin ThereAreIgnoredProperties := Length(AIgnoredProperties) > 0; JSONObject := TJSONObject.Create; lType := CTX.GetType(AObject.ClassInfo); lProperties := lType.GetProperties; for lProperty in lProperties do begin // f := LowerCase(_property.Name); f := TSerializerHelpers.GetKeyName(lProperty, lType); outputdebugstring(pchar(f)); // Delete(f, 1, 1); if ThereAreIgnoredProperties then begin DoNotSerializeThis := false; for I := low(AIgnoredProperties) to high(AIgnoredProperties) do if SameText(f, AIgnoredProperties[I]) then begin DoNotSerializeThis := True; Break; end; if DoNotSerializeThis then Continue; end; if TSerializerHelpers.HasAttribute(lProperty) then Continue; lTypeSerializer := TMVCSerializersRegistry.GetTypeSerializer('application/json', lProperty.PropertyType.Handle); if lTypeSerializer <> nil then begin lJSONValue := nil; lTypeSerializer.SerializeInstance( lProperty.PropertyType, lProperty.GetAttributes, lProperty.GetValue(AObject), TObject(lJSONValue)); JSONObject.AddPair(f, lJSONValue); end else begin { if serializable then serialize, otherwise ignore it } if SerializeRTTIElement(lProperty.PropertyType, lProperty.GetAttributes, lProperty.GetValue(AObject), lSerializedJValue) then JSONObject.AddPair(f, lSerializedJValue); end; end; Result := JSONObject; end; function TMVCJSONSerUnSer.ObjectToJSONObjectFields(AObject: TObject): TJSONObject; var _type: TRTTIType; _fields: TArray; _field: TRttiField; f: string; JSONObject: TJSONObject; Arr: TJSONArray; list: IWrappedList; Obj, o: TObject; DoNotSerializeThis: boolean; I: Integer; JObj: TJSONObject; lSerializedJValue: TJSONValue; begin JSONObject := TJSONObject.Create; try // add the $dmvc.classname property to allows a strict deserialization JSONObject.AddPair(DMVC_CLASSNAME, AObject.QualifiedClassName); _type := CTX.GetType(AObject.ClassInfo); _fields := _type.GetFields; for _field in _fields do begin f := TSerializerHelpers.GetKeyName(_field, _type); if SerializeRTTIElement(_field.FieldType, _field.GetAttributes, _field.GetValue(AObject), lSerializedJValue) then JSONObject.AddPair(f, lSerializedJValue); // case _field.FieldType.TypeKind of // tkInteger, tkInt64: // JSONObject.AddPair(f, TJSONNumber.Create(_field.GetValue(AObject) // .AsInteger)); // tkFloat: // begin // JSONObject.AddPair(f, SerializeFloatField(AObject, _field)); // end; // tkString, tkLString, tkWString, tkUString: // JSONObject.AddPair(f, _field.GetValue(AObject).AsString); // tkEnumeration: // begin // JSONObject.AddPair(f, SerializeEnumerationField(AObject, _field)); // end; // tkClass: // begin // o := _field.GetValue(AObject).AsObject; // if Assigned(o) then // begin // if TDuckTypedList.CanBeWrappedAsList(o) then // begin // list := WrapAsList(o); // JObj := TJSONObject.Create; // JSONObject.AddPair(f, JObj); // JObj.AddPair(DMVC_CLASSNAME, o.QualifiedClassName); // Arr := TJSONArray.Create; // JObj.AddPair('items', Arr); // for Obj in list do // begin // Arr.AddElement(ObjectToJSONObjectFields(Obj)); // end; // end // else // begin // JSONObject.AddPair(f, // ObjectToJSONObjectFields(_field.GetValue(AObject).AsObject)); // end; // end // else // JSONObject.AddPair(f, TJSONNull.Create); // end; // end; end; Result := JSONObject; except FreeAndNil(JSONObject); raise; end; end; function TMVCJSONSerUnSer.SerializeFloatProperty(AObject: TObject; ARTTIProperty: TRttiProperty): TJSONValue; begin if ARTTIProperty.PropertyType.QualifiedName = 'System.TDate' then begin if ARTTIProperty.GetValue(AObject).AsExtended = 0 then Result := TJSONNull.Create else Result := TJSONString.Create (ISODateToString(ARTTIProperty.GetValue(AObject).AsExtended)) end else if ARTTIProperty.PropertyType.QualifiedName = 'System.TDateTime' then begin if ARTTIProperty.GetValue(AObject).AsExtended = 0 then Result := TJSONNull.Create else Result := TJSONString.Create (ISODateTimeToString(ARTTIProperty.GetValue(AObject).AsExtended)) end else if ARTTIProperty.PropertyType.QualifiedName = 'System.TTime' then Result := TJSONString.Create(ISOTimeToString(ARTTIProperty.GetValue(AObject) .AsExtended)) else Result := TJSONNumber.Create(ARTTIProperty.GetValue(AObject).AsExtended); end; function TMVCJSONSerUnSer.SerializeObject(AObject: TObject; AIgnoredProperties: array of string): string; var lJSON: TJSONObject; begin lJSON := ObjectToJSONObject(AObject, AIgnoredProperties); try Result := lJSON.ToJSON; finally lJSON.Free; end; end; function TMVCJSONSerUnSer.SerializeObjectStrict(AObject: TObject): String; begin end; function TMVCJSONSerUnSer.SerializeRTTIElement(ElementType: TRTTIType; ElementAttributes: TArray; Value: TValue; out OutputValue: TJSONValue): boolean; var ts: TTimeStamp; o: TObject; list: IMVCList; Arr: TJSONArray; Obj: TObject; _attrser: MapperSerializeAsString; SerEnc: TEncoding; sr: TStringStream; SS: TStringStream; lAttribute: MapperSerializeAsString; lAtt: TCustomAttribute; lEncodingName: string; buff: TBytes; lStreamAsString: string; begin OutputValue := nil; Result := false; case ElementType.TypeKind of tkInteger, tkInt64: begin OutputValue := TJSONNumber.Create(Value.AsInteger); end; tkFloat: begin OutputValue := SerializeFloatProperty(ElementType, Value); end; tkString, tkLString, tkWString, tkUString: begin OutputValue := TJSONString.Create(Value.AsString); end; tkEnumeration: begin OutputValue := SerializeEnumerationProperty(ElementType, Value); end; tkRecord: begin if ElementType.QualifiedName = 'System.Rtti.TValue' then begin OutputValue := SerializeTValue(ElementType, Value, ElementAttributes); end else if ElementType.QualifiedName = 'System.SysUtils.TTimeStamp' then begin ts := Value.AsType; OutputValue := TJSONNumber.Create(TimeStampToMsecs(ts)); end; end; tkClass: begin o := Value.AsObject; if Assigned(o) then begin list := TDuckTypedList.Wrap(o); if Assigned(list) then begin OutputValue := TJSONArray.Create; for Obj in list do if Assigned(Obj) then // nil element into the list are not serialized TJSONArray(OutputValue).AddElement(ObjectToJSONObject(Obj, [])); end // else if o is TStream then // begin // if TSerializerHelpers.AttributeExists(ElementAttributes, _attrser) then // begin // // serialize the stream as a normal string... // TStream(o).Position := 0; // lEncodingName := _attrser.Encoding; // SerEnc := TEncoding.GetEncoding(lEncodingName); // try // SetLength(buff, TStream(o).Size); // TStream(o).Read(buff, TStream(o).Size); // lStreamAsString := SerEnc.GetString(buff); // SetLength(buff, 0); // Result := TJSONString.Create(UTF8Encode(lStreamAsString)); // finally // SerEnc.Free; // end; // end // else // begin // // serialize the stream as Base64 encoded string... // TStream(o).Position := 0; // SS := TStringStream.Create; // try // TSerializerHelpers.EncodeStream(TStream(o), SS); // Result := TJSONString.Create(SS.DataString); // finally // SS.Free; // end; // end; // end else begin OutputValue := ObjectToJSONObject(Value.AsObject, []); end; end else begin if TSerializerHelpers.HasAttribute(ElementType) then OutputValue := TJSONString.Create('') else OutputValue := TJSONNull.Create; end; end; // tkClass end; Result := OutputValue <> nil; end; function TMVCJSONSerUnSer.SerializeTValueAsFixedNullableType(AValue: TValue; AValueTypeInfo: PTypeInfo): TJSONValue; begin // supports nulls if AValue.IsEmpty then Exit(TJSONNull.Create); // serialize the TValue internal value as specific type case AValueTypeInfo.Kind of tkString, tkUString, tkLString, tkWString: begin Result := TJSONString.Create(AValue.AsString); end; tkInteger: begin Result := TJSONNumber.Create(AValue.AsInteger); end; tkInt64: begin Result := TJSONNumber.Create(AValue.AsInt64); end; else raise EMVCSerializationException.Create('Unsupported type in SerializeTValueAsFixedType'); end; end; function TMVCJSONSerUnSer.SerializeTValue(AElementType: TRTTIType; AValue: TValue; AAttributes: TArray): TJSONValue; var lTValueDataRTTIType: TRTTIType; lValue: TValue; lAtt: TValueAsType; lJSONValue: TJSONValue; begin lValue := AValue.AsType; if TSerializerHelpers.AttributeExists(AAttributes, lAtt) then begin Result := SerializeTValueAsFixedNullableType(lValue, lAtt.TValueTypeInfo) end else begin Result := TJSONObject.Create; try if lValue.IsEmpty then begin lJSONValue := TJSONNull.Create; TJSONObject(Result).AddPair('type', TJSONNull.Create); end else begin lTValueDataRTTIType := CTX.GetType(lValue.TypeInfo); if not SerializeRTTIElement(lTValueDataRTTIType, [], lValue, lJSONValue) then raise EMVCSerializationException.Create('Cannot serialize TValue'); TJSONObject(Result).AddPair('type', TSerializerHelpers.GetTypeKindAsString(lValue.TypeInfo.Kind)); end; TJSONObject(Result).AddPair('value', lJSONValue); except Result.Free; raise; end; end; end; function TMVCJSONSerUnSer.SerializeCollection(AList: TObject; AIgnoredProperties: array of string): String; var I: Integer; JV: TJSONObject; lList: IMVCList; lJArr: TJSONArray; begin if Assigned(AList) then begin lList := WrapAsList(AList); lJArr := TJSONArray.Create; try // AList.OwnsObjects := AOwnsChildObjects; for I := 0 to lList.Count - 1 do begin JV := ObjectToJSONObject(lList.GetItem(I), AIgnoredProperties); // if Assigned(AForEach) then // AForEach(JV); lJArr.AddElement(JV); end; Result := lJArr.ToJSON; finally lJArr.Free; end; end else begin raise EMVCSerializationException.Create('List is nil'); end; end; function TMVCJSONSerUnSer.SerializeCollectionStrict(AList: TObject): String; var I: Integer; JV: TJSONObject; lList: IMVCList; lJArr: TJSONArray; begin if Assigned(AList) then begin lList := WrapAsList(AList); lJArr := TJSONArray.Create; try for I := 0 to lList.Count - 1 do begin JV := ObjectToJSONObjectFields(lList.GetItem(I)); // if Assigned(AForEach) then // AForEach(JV); lJArr.AddElement(JV); end; Result := lJArr.ToJSON; finally lJArr.Free; end; end else begin raise EMVCSerializationException.Create('List is nil'); end; end; function TMVCJSONSerUnSer.PropertyExists(JSONObject: TJSONObject; PropertyName: string): boolean; begin Result := Assigned(GetPair(JSONObject, PropertyName)); end; function TMVCJSONSerUnSer.SerializeDataSet(ADataSet: TDataSet; AIgnoredFields: array of string): string; begin end; function TMVCJSONSerUnSer.SerializeEnumerationField(AObject: TObject; ARttiField: TRttiField): TJSONValue; begin if ARttiField.FieldType.QualifiedName = 'System.Boolean' then begin if ARttiField.GetValue(AObject).AsBoolean then Result := TJSONTrue.Create else Result := TJSONFalse.Create; end else begin Result := TJSONNumber.Create(ARttiField.GetValue(AObject).AsOrdinal); end; end; function TMVCJSONSerUnSer.SerializeEnumerationProperty(AElementType: TRTTIType; AValue: TValue): TJSONValue; begin if AElementType.QualifiedName = 'System.Boolean' then begin if AValue.AsBoolean then Result := TJSONTrue.Create else Result := TJSONFalse.Create; end else begin Result := TJSONNumber.Create(AValue.AsOrdinal); end; end; function TMVCJSONSerUnSer.SerializeEnumerationProperty(AObject: TObject; ARTTIProperty: TRttiProperty): TJSONValue; begin if ARTTIProperty.PropertyType.QualifiedName = 'System.Boolean' then begin if ARTTIProperty.GetValue(AObject).AsBoolean then Result := TJSONTrue.Create else Result := TJSONFalse.Create; end else begin Result := TJSONNumber.Create(ARTTIProperty.GetValue(AObject).AsOrdinal); end; end; function TMVCJSONSerUnSer.SerializeFloatField(AObject: TObject; ARttiField: TRttiField): TJSONValue; begin if ARttiField.FieldType.QualifiedName = 'System.TDate' then begin if ARttiField.GetValue(AObject).AsExtended = 0 then Result := TJSONNull.Create else Result := TJSONString.Create(ISODateToString(ARttiField.GetValue(AObject) .AsExtended)) end else if ARttiField.FieldType.QualifiedName = 'System.TDateTime' then begin if ARttiField.GetValue(AObject).AsExtended = 0 then Result := TJSONNull.Create else Result := TJSONString.Create (ISODateTimeToString(ARttiField.GetValue(AObject).AsExtended)) end else if ARttiField.FieldType.QualifiedName = 'System.TTime' then Result := TJSONString.Create(ISOTimeToString(ARttiField.GetValue(AObject) .AsExtended)) else Result := TJSONNumber.Create(ARttiField.GetValue(AObject).AsExtended); end; function TMVCJSONSerUnSer.SerializeFloatProperty(AElementType: TRTTIType; AValue: TValue): TJSONValue; begin if AElementType.QualifiedName = 'System.TDate' then begin if AValue.AsExtended = 0 then Result := TJSONNull.Create else Result := TJSONString.Create (ISODateToString(AValue.AsExtended)) end else if AElementType.QualifiedName = 'System.TDateTime' then begin if AValue.AsExtended = 0 then Result := TJSONNull.Create else Result := TJSONString.Create (ISODateTimeToString(AValue.AsExtended)) end else if AElementType.QualifiedName = 'System.TTime' then Result := TJSONString.Create(ISOTimeToString(AValue.AsExtended)) else Result := TJSONNumber.Create(AValue.AsExtended); end; { TMVCJSONDeserializer } procedure TMVCJSONSerUnSer.DeserializeCollection(ASerializedObjectList: string; AList: IMVCList; AClazz: TClass); var I: Integer; lJArr: TJSONArray; lJValue: TJSONValue; begin if Trim(ASerializedObjectList) = '' then raise EMVCDeserializationException.Create('Invalid serialized data'); lJValue := TJSONObject.ParseJSONValue(ASerializedObjectList); try if (lJValue = nil) or (not(lJValue is TJSONArray)) then raise EMVCDeserializationException.Create('Serialized data is not a valid JSON Array'); lJArr := TJSONArray(lJValue); for I := 0 to lJArr.Count - 1 do begin AList.Add(JSONObjectToObject(AClazz, lJArr.Items[I] as TJSONObject)); end; finally lJValue.Free; end; end; function TMVCJSONSerUnSer.DeserializeEnumeration(ARTTIType: TRTTIType; AJSONValue: TJSONValue; AItemName: String): TValue; var lOutputValue: TValue; begin if ARTTIType.QualifiedName = 'System.Boolean' then begin if AJSONValue is TJSONTrue then Result := True else if AJSONValue is TJSONFalse then Result := false else raise EMapperException.CreateFmt('Invalid value for property %s', [AItemName]); end else // it is an enumerated value but it's not a boolean. begin TValue.Make((AJSONValue as TJSONNumber).AsInt, ARTTIType.Handle, lOutputValue); Result := lOutputValue; end; end; function TMVCJSONSerUnSer.DeserializeFloat(ARTTIType: TRTTIType; AJSONValue: TJSONValue): TValue; begin if ARTTIType.QualifiedName = 'System.TDate' then begin if AJSONValue is TJSONNull then Result := 0 else Result := ISOStrToDateTime(AJSONValue.Value + ' 00:00:00'); end else if ARTTIType.QualifiedName = 'System.TDateTime' then begin if AJSONValue is TJSONNull then Result := 0 else Result := ISOStrToDateTime(AJSONValue.Value); end else if ARTTIType.QualifiedName = 'System.TTime' then begin if not(AJSONValue is TJSONNull) then if AJSONValue is TJSONString then Result := ISOStrToTime(AJSONValue.Value) else raise EMVCDeserializationException.CreateFmt ('Cannot deserialize [%s], expected [%s] got [%s]', [ARTTIType.QualifiedName, 'TJSONString', AJSONValue.ClassName]); end else { if _field.PropertyType.QualifiedName = 'System.Currency' then } begin if not(AJSONValue is TJSONNull) then if AJSONValue is TJSONNumber then Result := TJSONNumber(AJSONValue).AsDouble else raise EMVCDeserializationException.CreateFmt ('Cannot deserialize [%s], expected [%s] got [%s]', [ARTTIType.QualifiedName, 'TJSONNumber', AJSONValue.ClassName]); end; end; procedure TMVCJSONSerUnSer.DeSerializeBase64StringStream(aStream: TStream; const aBase64SerializedString: string); begin end; procedure TMVCJSONSerUnSer.DeserializeObject(ASerializedObject: string; AObject: TObject); begin InternalDeserializeObject(ASerializedObject, AObject, false); end; procedure TMVCJSONSerUnSer.DeserializeObjectStrict(ASerializedObject: String; AObject: TObject); begin InternalDeserializeObject(ASerializedObject, AObject, True); end; function TMVCJSONSerUnSer.DeserializeRecord(ARTTIType: TRTTIType; AJSONValue: TJSONValue; AAttributes: TArray; AItemName: String): TValue; var lJNumber: TJSONNumber; begin if ARTTIType.QualifiedName = 'System.Rtti.TValue' then begin Result := DeserializeTValue(AJSONValue, AAttributes, AItemName); end else if ARTTIType.QualifiedName = 'System.SysUtils.TTimeStamp' then begin lJNumber := AJSONValue as TJSONNumber; Result := TValue.From(MSecsToTimeStamp(lJNumber.AsInt64)); end else raise EMVCDeserializationException.CreateFmt('Type %s not supported for %s', [ARTTIType.QualifiedName, AItemName]); end; initialization TMVCSerializersRegistry.RegisterSerializer('application/json', TMVCJSONSerUnSer.Create); finalization TMVCSerializersRegistry.UnRegisterSerializer('application/json'); end.