// *************************************************************************** // // Delphi MVC Framework // // Copyright (c) 2010-2021 Daniele Teti and the DMVCFramework Team // // https://github.com/danieleteti/delphimvcframework // // Collaborators with this file: Ezequiel Juliano Müller (ezequieljuliano@gmail.com) // // *************************************************************************** // // 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.JsonDataObjects; {$I dmvcframework.inc} {$WARN SYMBOL_DEPRECATED OFF} interface uses System.Classes, System.Rtti, System.TypInfo, System.Variants, System.Generics.Collections, Data.SqlTimSt, Data.FmtBcd, Data.DB, MVCFramework.Commons, MVCFramework.Serializer.Intf, MVCFramework.Serializer.Abstract, MVCFramework.DuckTyping, MVCFramework.Serializer.Commons, System.JSON, JsonDataObjects, System.SysUtils; type TMVCDataSetField = record FieldName: string; DataType: TFieldType; I: Integer; end; TMVCDataSetFields = TList; TJSONObjectHelper = class helper for TJsonObject public procedure LoadFromString(const Value: string; Encoding: TEncoding = nil; Utf8WithoutBOM: Boolean = True); end; TMVCJsonDataObjectsSerializer = class(TMVCAbstractSerializer, IMVCSerializer, IMVCJSONSerializer) private fStringDictionarySerializer: IMVCTypeSerializer; function TryMapNullableFloat(var Value: TValue; const JSONDataObject: TJsonObject; const AttribName: string): Boolean; public function GetDataSetFields(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase = ncAsIs): TMVCDataSetFields; procedure ObjectToJsonObject(const AObject: TObject; const AJsonObject: TJDOJsonObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); procedure InternalObjectToJsonObject(const AObject: TObject; const AJsonObject: TJDOJsonObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction; const Links: IMVCLinks; const Serializer: IMVCTypeSerializer); function ConvertObjectToJsonValue(const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ADataSetSerializationCallback: TMVCDataSetFieldSerializationAction; const ASerializationAction: TMVCSerializationAction; out AJsonDataType: TJsonDataType): TJsonBaseObject; procedure AddTValueToJsonArray(const Value: TValue; const JSON: TJDOJsonArray); procedure ListToJsonArray(const AList: IMVCList; const AJsonArray: TJDOJsonArray; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction = nil); procedure TValueToJSONObjectProperty(const AJsonObject: TJDOJsonObject; const AName: string; const AValue: TValue; const AType: TMVCSerializationType; const AIgnored: TMVCIgnoredList; const ACustomAttributes: TArray); function TryNullableToJSON(const AValue: TValue; const AJsonObject: TJDOJsonObject; const AName: string): Boolean; procedure JsonObjectToObject(const AJsonObject: TJDOJsonObject; const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); procedure JsonDataValueToAttribute(const AObject: TObject; const ARttiMember: TRttiMember; const AJsonObject: TJDOJsonObject; const AName: string; var AValue: TValue; const AType: TMVCSerializationType; const AIgnored: TMVCIgnoredList; const ACustomAttributes: TArray); procedure JsonArrayToList(const AJsonArray: TJDOJsonArray; const AList: IMVCList; const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); procedure DataSetToJsonObject(const ADataSet: TDataSet; const AJsonObject: TJDOJsonObject; const ANameCase: TMVCNameCase; const AIgnoredFields: TMVCIgnoredList; const ADataSetFields: TMVCDataSetFields; const ASerializationCallback: TMVCDataSetFieldSerializationAction = nil); procedure DataSetRowToJsonArrayOfValues(const ADataSet: TDataSet; const AJsonArray: TJDOJsonArray; const AIgnoredFields: TMVCIgnoredList; const ADataSetFields: TMVCDataSetFields); procedure DataSetToJsonArray(const ADataSet: TDataSet; const AJsonArray: TJDOJsonArray; const ANameCase: TMVCNameCase; const AIgnoredFields: TMVCIgnoredList; const ASerializationCallback: TMVCDataSetFieldSerializationAction = nil); procedure DataSetToJsonArrayOfValues(const ADataSet: TDataSet; const AJsonArray: TJDOJsonArray; const AIgnoredFields: TMVCIgnoredList); procedure JsonObjectToDataSet(const AJsonObject: TJDOJsonObject; const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase); procedure JsonArrayToDataSet(const AJsonArray: TJDOJsonArray; const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase); function JsonArrayToArray(const AJsonArray: TJDOJsonArray): TValue; { IMVCSerializer } function SerializeObject(const AObject: TObject; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = []; const ASerializationAction: TMVCSerializationAction = nil) : string; overload; function SerializeObject(const AObject: IInterface; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = []; const ASerializationAction: TMVCSerializationAction = nil) : string; overload; function SerializeObjectToJSON(const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): TJDOJsonObject; function SerializeCollection(const AList: TObject; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = []; const ASerializationAction: TMVCSerializationAction = nil) : string; overload; function SerializeCollection(const AList: IInterface; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = []; const ASerializationAction: TMVCSerializationAction = nil) : string; overload; function SerializeDataSet(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList = []; const ANameCase: TMVCNameCase = ncAsIs; const ASerializationAction: TMVCDatasetSerializationAction = nil): string; function SerializeDataSetRecord(const DataSet: TDataSet; const IgnoredFields: TMVCIgnoredList; const NameCase: TMVCNameCase = ncAsIs; const SerializationAction: TMVCDatasetSerializationAction = nil): string; procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = []; const ARootNode: string = ''); overload; procedure DeserializeObject(const ASerializedObject: string; const AObject: IInterface; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = []); overload; procedure DeserializeCollection(const ASerializedList: string; const AList: TObject; const AClazz: TClass; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = []; const ARootNode: string = ''); overload; procedure DeserializeCollection(const ASerializedList: string; const AList: IInterface; const AClazz: TClass; const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = []); overload; procedure DeserializeDataSet(const ASerializedDataSet: string; const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase = ncAsIs); procedure InternalSerializeDataSet(const ADataSet: TDataSet; const AJsonArray: TJsonArray; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase; const ASerializationAction: TMVCDatasetSerializationAction); procedure InternalSerializeDataSetRecord(const DataSet: TDataSet; const JSONObject: TJsonObject; const IgnoredFields: TMVCIgnoredList; const NameCase: TMVCNameCase; const SerializationAction: TMVCDatasetSerializationAction); procedure DeserializeDataSetRecord(const ASerializedDataSetRecord: string; const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase = ncAsIs); class function ParseObject(const AString: string): TJDOJsonObject; class function ParseArray(const AString: string): TJDOJsonArray; class function Parse(const AString: string): T; public procedure AfterConstruction; override; end; TJDOLinks = class(TMVCLinks) public procedure FillJSONArray(const AJsonArray: TJsonArray); end; procedure TValueToJSONObjectProperty(const Value: TValue; const JSON: TJDOJsonObject; const KeyName: string); function StrToJSONObject(const AValue: string; ARaiseExceptionOnError: Boolean = False): TJDOJsonObject; inline; function StrToJSONArray(const AValue: string; ARaiseExceptionOnError: Boolean = False): TJDOJsonArray; inline; procedure JsonObjectToObject(const AJsonObject: TJDOJsonObject; const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); overload; procedure JsonObjectToObject(const AJsonObject: TJDOJsonObject; const AObject: TObject); overload; procedure JsonArrayToList(const AJsonArray: TJDOJsonArray; const AList: IMVCList; const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); const JDO_TYPE_DESC: array [TJsonDataType.jdtNone .. TJsonDataType.jdtObject] of string = ('None', 'String', 'Int', 'Long', 'ULong', 'Float', 'DateTime', 'UtcDateTime', 'Bool', 'Array', 'Object'); implementation uses MVCFramework.Serializer.JsonDataObjects.CustomTypes, MVCFramework.Logger, MVCFramework.DataSet.Utils, MVCFramework.Nullables; function SelectRootNodeOrWholeObject(const RootNode: string; const JSONObject: TJsonObject): TJsonObject; inline; begin if RootNode.IsEmpty then begin Result := JSONObject end else begin Result := JSONObject.O[RootNode]; end; end; { TMVCJsonDataObjectsSerializer } procedure TMVCJsonDataObjectsSerializer.AfterConstruction; var lStreamSerializer: IMVCTypeSerializer; lDataSetHolderSerializer: TMVCDataSetHolderSerializer; fObjectDictionarySerializer: TMVCObjectDictionarySerializer; begin inherited AfterConstruction; lDataSetHolderSerializer := TMVCDataSetHolderSerializer.Create; GetTypeSerializers.Add(TypeInfo(TDataSetHolder), lDataSetHolderSerializer); lStreamSerializer := TMVCStreamSerializerJsonDataObject.Create; GetTypeSerializers.Add(TypeInfo(TStream), lStreamSerializer); GetTypeSerializers.Add(TypeInfo(TStringStream), lStreamSerializer); GetTypeSerializers.Add(TypeInfo(TFileStream), lStreamSerializer); GetTypeSerializers.Add(TypeInfo(TMemoryStream), lStreamSerializer); fStringDictionarySerializer := TMVCStringDictionarySerializer.Create; GetTypeSerializers.Add(TypeInfo(TMVCStringDictionary), fStringDictionarySerializer); GetTypeSerializers.Add(TypeInfo(TGUID), TMVCGUIDSerializer.Create); fObjectDictionarySerializer := TMVCObjectDictionarySerializer.Create(self); GetTypeSerializers.Add(TypeInfo(TMVCObjectDictionary), fObjectDictionarySerializer); GetTypeSerializers.Add(TypeInfo(TMVCListOfString {TList}), TMVCListOfStringSerializer.Create); GetTypeSerializers.Add(TypeInfo(TMVCListOfInteger {TList}), TMVCListOfIntegerSerializer.Create); GetTypeSerializers.Add(TypeInfo(TMVCListOfBoolean {TList}), TMVCListOfBooleanSerializer.Create); GetTypeSerializers.Add(TypeInfo(TMVCListOfDouble {TList}), TMVCListOfDoubleSerializer.Create); end; procedure TMVCJsonDataObjectsSerializer.TValueToJSONObjectProperty(const AJsonObject: TJDOJsonObject; const AName: string; const AValue: TValue; const AType: TMVCSerializationType; const AIgnored: TMVCIgnoredList; const ACustomAttributes: TArray); var ChildJsonObject: TJDOJsonObject; ChildValue: TValue; ChildObject, Obj: TObject; ValueTypeAtt: MVCValueAsTypeAttribute; CastValue, CastedValue: TValue; I: Integer; LEnumAsAttr: MVCEnumSerializationAttribute; LEnumSerType: TMVCEnumSerializationType; LEnumMappedValues: TList; LEnumName: string; lJSONValue: TJsonBaseObject; lJsonDataType: TJsonDataType; lTypeInfo: PTypeInfo; begin if SameText(AName, 'RefCount') then begin Exit; end; if AValue.IsEmpty then begin AJsonObject[AName] := Null; Exit; end; lTypeInfo := AValue.TypeInfo; // AValue.TypeInfo does not show the correct TypeInfo of the class instantiated for the object or interface ChildObject := nil; if AValue.Kind in [tkClass, tkInterface] then begin if not AValue.IsEmpty and (AValue.Kind = tkInterface) then ChildObject := TObject(AValue.AsInterface) else if AValue.Kind = tkClass then ChildObject := AValue.AsObject; if Assigned(ChildObject) then lTypeInfo := ChildObject.ClassInfo; end; if GetTypeSerializers.ContainsKey(lTypeInfo) then begin GetTypeSerializers.Items[lTypeInfo].SerializeAttribute(AValue, AName, AJsonObject, ACustomAttributes); Exit; end; case AValue.Kind of tkInteger: AJsonObject.I[AName] := AValue.AsInteger; tkInt64: AJsonObject.L[AName] := AValue.AsInt64; tkChar, tkString, tkWChar, tkLString, tkWString, tkUString: AJsonObject.S[AName] := AValue.AsString; tkFloat: begin if (AValue.TypeInfo = System.TypeInfo(TDate)) then begin if (AValue.AsExtended = 0) then AJsonObject[AName] := Null else AJsonObject.S[AName] := DateToISODate(AValue.AsExtended); end else if (AValue.TypeInfo = System.TypeInfo(TDateTime)) then begin if (AValue.AsExtended = 0) then AJsonObject[AName] := Null else AJsonObject.S[AName] := DateTimeToISOTimeStamp(AValue.AsExtended); end else if (AValue.TypeInfo = System.TypeInfo(TTime)) then begin if (AValue.AsExtended = 0) then AJsonObject[AName] := Null else AJsonObject.S[AName] := TimeToISOTime(AValue.AsExtended); end else AJsonObject.F[AName] := AValue.AsExtended; end; tkVariant: AJsonObject[AName] := AValue.AsVariant; tkEnumeration: begin if (AValue.TypeInfo = System.TypeInfo(Boolean)) then begin if AValue.AsBoolean then AJsonObject.B[AName] := True else AJsonObject.B[AName] := False end else begin LEnumSerType := estEnumName; LEnumMappedValues := nil; if TMVCSerializerHelper.AttributeExists(ACustomAttributes, LEnumAsAttr) then begin LEnumSerType := LEnumAsAttr.SerializationType; LEnumMappedValues := LEnumAsAttr.MappedValues; end; case LEnumSerType of estEnumName: begin LEnumName := GetEnumName(AValue.TypeInfo, AValue.AsOrdinal); AJsonObject.S[AName] := LEnumName; end; estEnumOrd: begin AJsonObject.I[AName] := AValue.AsOrdinal; end; estEnumMappedValues: begin if (LEnumMappedValues.Count - 1) < AValue.AsOrdinal then raise EMVCException.Create('Enumerator value is not mapped in MappedValues'); AJsonObject.S[AName] := LEnumMappedValues[AValue.AsOrdinal]; end; end; end; end; tkClass, tkInterface: begin // ChildObject := nil; // if not AValue.IsEmpty and (AValue.Kind = tkInterface) then // ChildObject := TObject(AValue.AsInterface) // else if AValue.Kind = tkClass then // ChildObject := AValue.AsObject; if Assigned(ChildObject) then begin lJSONValue := ConvertObjectToJsonValue(ChildObject, GetSerializationType(ChildObject, AType), AIgnored, nil, nil, lJsonDataType); case lJsonDataType of jdtArray: begin AJsonObject.A[AName] := TJsonArray(lJSONValue); end; jdtObject: begin AJsonObject.O[AName] := TJsonObject(lJSONValue); end else begin lJSONValue.Free; RaiseSerializationError('Invalid JSON Data Type'); end; end; end else begin if TMVCSerializerHelper.AttributeExists(ACustomAttributes) then AJsonObject.S[AName] := EmptyStr else AJsonObject[AName] := Null; end; end; tkRecord: begin if AValue.TypeInfo.NameFld.ToString.StartsWith('Nullable') then begin if TryNullableToJSON(AValue, AJsonObject, AName) then begin Exit; end; end; if (AValue.TypeInfo = System.TypeInfo(TTimeStamp)) then begin AJsonObject.F[AName] := TimeStampToMsecs(AValue.AsType); end else if (AValue.TypeInfo = System.TypeInfo(TValue)) then begin if TMVCSerializerHelper.AttributeExists(ACustomAttributes, ValueTypeAtt) then begin CastValue := AValue.AsType; if CastValue.TryCast(ValueTypeAtt.ValueTypeInfo, CastedValue) then TValueToJSONObjectProperty(AJsonObject, AName, CastedValue, stDefault, [], []) else raise EMVCSerializationException.CreateFmt ('Cannot serialize property or field "%s" of TypeKind tkRecord (TValue with MVCValueAsTypeAttribute).', [AName]); end else begin ChildValue := AValue.AsType; ChildJsonObject := AJsonObject.O[AName]; ChildJsonObject.S['type'] := TMVCSerializerHelper.GetTypeKindAsString(ChildValue.TypeInfo.Kind); TValueToJSONObjectProperty(ChildJsonObject, 'value', ChildValue, stDefault, [], []); end; end else raise EMVCSerializationException.CreateFmt ('Cannot serialize property or field "%s" of TypeKind tkRecord.', [AName]); end; tkSet: raise EMVCSerializationException.CreateFmt('Cannot serialize property or field "%s" of TypeKind tkSet.', [AName]); tkArray, tkDynArray: begin if AValue.GetArrayLength > 0 then begin for I := 0 to AValue.GetArrayLength - 1 do begin case AValue.GetArrayElement(I).Kind of tkChar, tkString, tkWChar, tkLString, tkWString, tkUString: AJsonObject.A[AName].Add(AValue.GetArrayElement(I).AsString); tkInteger: AJsonObject.A[AName].Add(AValue.GetArrayElement(I).AsInteger); tkInt64: AJsonObject.A[AName].Add(AValue.GetArrayElement(I).AsInt64); tkFloat: AJsonObject.A[AName].Add(AValue.GetArrayElement(I).AsExtended); tkEnumeration: AJsonObject.A[AName].Add(AValue.GetArrayElement(I).AsBoolean); tkClass: begin Obj := AValue.GetArrayElement(I).AsObject; if Obj = nil then begin AJsonObject.A[AName].Add(TJsonObject(nil)); end else begin lJSONValue := ConvertObjectToJsonValue(Obj, GetSerializationType(Obj), [], nil, nil, lJsonDataType); case lJsonDataType of jdtArray: begin AJsonObject.A[AName].Add(TJsonArray(lJSONValue)); end; jdtObject: begin AJsonObject.A[AName].Add(TJsonObject(lJSONValue)); end; else begin lJSONValue.Free; RaiseSerializationError('Invalid JSON Type for ' + AName); end; end; end; end; else begin raise EMVCSerializationException.CreateFmt ('Cannot serialize property or field "%s" of TypeKind tkArray or tkDynArray.', [AName]); end; end; end; end; end; tkUnknown: raise EMVCSerializationException.CreateFmt ('Cannot serialize property or field "%s" of TypeKind tkUnknown.', [AName]); end; end; function TMVCJsonDataObjectsSerializer.ConvertObjectToJsonValue(const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ADataSetSerializationCallback: TMVCDataSetFieldSerializationAction; const ASerializationAction: TMVCSerializationAction; out AJsonDataType: TJsonDataType): TJsonBaseObject; var lList: IMVCList; I: Integer; lValue: TValue; lObj: TObject; lJSONValue: TJsonBaseObject; lJsonDataType: TJsonDataType; lLinks: IMVCLinks; begin Result := nil; try if AObject is TDataSet then begin Result := TJsonArray.Create; AJsonDataType := jdtArray; DataSetToJsonArray(TDataSet(AObject), TJsonArray(Result), TMVCNameCase.ncLowerCase, [], ADataSetSerializationCallback); end else if AObject is TJsonObject then begin AJsonDataType := jdtObject; Result := TJsonObject(TJsonObject(AObject).Clone); end else if AObject is TJsonArray then begin AJsonDataType := jdtArray; Result := TJsonArray(TJsonArray(AObject).Clone); end else if AObject = nil then begin AJsonDataType := jdtObject; Result := nil; end else begin lList := TDuckTypedList.Wrap(AObject); if Assigned(lList) then begin Result := TJsonArray.Create; // ChildJsonArray := AJsonObject.A[AName]; AJsonDataType := jdtArray; for I := 0 to lList.Count - 1 do begin if lList.ItemIsObject(I, lValue) then begin lObj := lValue.AsObject; // ChildList.GetItem(I); if Assigned(lObj) then begin lJSONValue := ConvertObjectToJsonValue(lObj, GetSerializationType(lObj, AType), AIgnoredAttributes, nil, ASerializationAction, lJsonDataType); case lJsonDataType of jdtObject: begin TJsonArray(Result).Add(TJsonObject(lJSONValue)); end; jdtArray: begin TJsonArray(Result).Add(TJsonArray(lJSONValue)); end; else begin RaiseSerializationError('Invalid JSON type'); end; end; end else begin TJsonArray(Result).Add(TJsonObject(nil)); end; end else begin AddTValueToJsonArray(lValue, TJsonArray(Result)); end; end; end else begin Result := TJsonObject.Create; AJsonDataType := jdtObject; lLinks := TMVCLinks.Create; InternalObjectToJsonObject(AObject, TJsonObject(Result), GetSerializationType(AObject, AType), AIgnoredAttributes, ASerializationAction, lLinks, nil); end; end; except FreeAndNil(Result); raise; end; end; procedure TMVCJsonDataObjectsSerializer.DataSetRowToJsonArrayOfValues(const ADataSet: TDataSet; const AJsonArray: TJDOJsonArray; const AIgnoredFields: TMVCIgnoredList; const ADataSetFields: TMVCDataSetFields); var lMS: TMemoryStream; lSS: TStringStream; lNestedDataSet: TDataSet; lChildJsonArray: TJDOJsonArray; lField: TMVCDataSetField; lDataSetFieldsDetail: TMVCDataSetFields; begin Assert(Assigned(ADataSetFields)); for lField in ADataSetFields do begin begin if ADataSet.Fields[lField.I].IsNull then begin AJsonArray.Add(TJsonObject(nil)); end else begin case lField.DataType of ftBoolean: AJsonArray.Add(ADataSet.Fields[lField.I].AsBoolean); ftInteger, ftSmallint, ftShortint, ftByte: AJsonArray.Add(ADataSet.Fields[lField.I].AsInteger); ftLargeint, ftAutoInc, ftLongword: AJsonArray.Add(ADataSet.Fields[lField.I].AsLargeInt); {$IFDEF TOKYOORBETTER} ftGuid: AJsonArray.Add(GUIDToString(ADataSet.Fields[lField.I].AsGuid)); {$ENDIF} ftSingle, ftFloat: AJsonArray.Add(ADataSet.Fields[lField.I].AsFloat); ftString, ftMemo: AJsonArray.Add(ADataSet.Fields[lField.I].AsString); ftWideString, ftWideMemo: AJsonArray.Add(ADataSet.Fields[lField.I].AsWideString); ftDate: AJsonArray.Add(DateToISODate(ADataSet.Fields[lField.I].AsDateTime)); ftDateTime: AJsonArray.Add(DateTimeToISOTimeStamp(ADataSet.Fields[lField.I].AsDateTime)); ftTime: AJsonArray.Add(SQLTimeStampToStr('hh:nn:ss', ADataSet.Fields[lField.I].AsSQLTimeStamp)); ftTimeStamp: AJsonArray.Add(DateTimeToISOTimeStamp(SQLTimeStampToDateTime(ADataSet.Fields[lField.I].AsSQLTimeStamp))); ftCurrency: AJsonArray.Add(ADataSet.Fields[lField.I].AsCurrency); ftFMTBcd, ftBCD: AJsonArray.Add(BcdToDouble(ADataSet.Fields[lField.I].AsBcd)); ftGraphic, ftBlob, ftStream, ftOraBlob: begin lMS := TMemoryStream.Create; try TBlobField(ADataSet.Fields[lField.I]).SaveToStream(lMS); lMS.Position := 0; lSS := TStringStream.Create; try TMVCSerializerHelper.EncodeStream(lMS, lSS); AJsonArray.Add(lSS.DataString); finally lSS.Free; end; finally lMS.Free; end; end; ftDataSet: begin lNestedDataSet := TDataSetField(ADataSet.Fields[lField.I]).NestedDataSet; lDataSetFieldsDetail := GetDataSetFields(lNestedDataSet, AIgnoredFields, GetNameCase(lNestedDataSet, ncAsIs)); try case GetDataType(ADataSet.Owner, ADataSet.Fields[lField.I].Name, dtArray) of dtArray: begin lChildJsonArray := AJsonArray.AddArray; lNestedDataSet.First; while not lNestedDataSet.Eof do begin DataSetRowToJsonArrayOfValues(lNestedDataSet, lChildJsonArray, AIgnoredFields, lDataSetFieldsDetail); lNestedDataSet.Next; end; end; dtObject: begin lChildJsonArray := AJsonArray.AddArray; DataSetRowToJsonArrayOfValues(lNestedDataSet, lChildJsonArray, AIgnoredFields, lDataSetFieldsDetail); end; end; finally lDataSetFieldsDetail.Free; end; end; else raise EMVCSerializationException.CreateFmt('Cannot find type for field "%s"', [lField.FieldName]); end; end; end; end; end; procedure TMVCJsonDataObjectsSerializer.DataSetToJsonArray(const ADataSet: TDataSet; const AJsonArray: TJDOJsonArray; const ANameCase: TMVCNameCase; const AIgnoredFields: TMVCIgnoredList; const ASerializationCallback: TMVCDataSetFieldSerializationAction); var LJObj: TJDOJsonObject; lDataSetFields: TMVCDataSetFields; begin lDataSetFields := GetDataSetFields(ADataSet, AIgnoredFields, ANameCase); try while not ADataSet.Eof do begin LJObj := AJsonArray.AddObject; DataSetToJsonObject(ADataSet, LJObj, ANameCase, AIgnoredFields, lDataSetFields, ASerializationCallback); ADataSet.Next; end; finally lDataSetFields.Free; end; end; procedure TMVCJsonDataObjectsSerializer.DataSetToJsonArrayOfValues(const ADataSet: TDataSet; const AJsonArray: TJDOJsonArray; const AIgnoredFields: TMVCIgnoredList); var LJArr: TJDOJsonArray; lDataSetFields: TMVCDataSetFields; begin lDataSetFields := GetDataSetFields(ADataSet, AIgnoredFields, ncAsIs); try while not ADataSet.Eof do begin LJArr := AJsonArray.AddArray; DataSetRowToJsonArrayOfValues(ADataSet, LJArr, AIgnoredFields, lDataSetFields); ADataSet.Next; end; finally lDataSetFields.Free; end; end; procedure TMVCJsonDataObjectsSerializer.DataSetToJsonObject(const ADataSet: TDataSet; const AJsonObject: TJDOJsonObject; const ANameCase: TMVCNameCase; const AIgnoredFields: TMVCIgnoredList; const ADataSetFields: TMVCDataSetFields; const ASerializationCallback: TMVCDataSetFieldSerializationAction); var lMS: TMemoryStream; lSS: TStringStream; lNestedDataSet: TDataSet; lChildJsonArray: TJDOJsonArray; lChildJsonObject: TJDOJsonObject; lField: TMVCDataSetField; lDataSetFieldsDetail: TMVCDataSetFields; lHandled: Boolean; lFName: string; begin Assert(Assigned(ADataSetFields)); for lField in ADataSetFields do begin begin if Assigned(ASerializationCallback) then begin lHandled := False; ASerializationCallback(ADataSet.Fields[lField.I], AJsonObject, lHandled); if lHandled then begin continue; end; end; lFName := TMVCSerializerHelper.ApplyNameCase(ANameCase, lField.FieldName); if ADataSet.Fields[lField.I].IsNull then AJsonObject[lFName] := Null else begin case lField.DataType of ftBoolean: AJsonObject.B[lFName] := ADataSet.Fields[lField.I].AsBoolean; ftInteger, ftSmallint, ftShortint, ftByte, ftWord: AJsonObject.I[lFName] := ADataSet.Fields[lField.I].AsInteger; ftLargeint, ftAutoInc, ftLongword: AJsonObject.L[lFName] := ADataSet.Fields[lField.I].AsLargeInt; {$IFDEF TOKYOORBETTER} ftGuid: AJsonObject.S[lFName] := GUIDToString(ADataSet.Fields[lField.I].AsGuid); {$ENDIF} ftSingle, ftFloat: AJsonObject.F[lFName] := ADataSet.Fields[lField.I].AsFloat; ftString, ftMemo: AJsonObject.S[lFName] := ADataSet.Fields[lField.I].AsString; ftWideString, ftWideMemo: AJsonObject.S[lFName] := ADataSet.Fields[lField.I].AsWideString; ftDate: AJsonObject.S[lFName] := DateToISODate(ADataSet.Fields[lField.I].AsDateTime); ftDateTime: AJsonObject.S[lFName] := DateTimeToISOTimeStamp(ADataSet.Fields[lField.I].AsDateTime); ftTime: AJsonObject.S[lFName] := SQLTimeStampToStr('hh:nn:ss', ADataSet.Fields[lField.I].AsSQLTimeStamp); ftTimeStamp: AJsonObject.S[lFName] := DateTimeToISOTimeStamp (SQLTimeStampToDateTime(ADataSet.Fields[lField.I].AsSQLTimeStamp)); ftCurrency: AJsonObject.F[lFName] := ADataSet.Fields[lField.I].AsCurrency; ftFMTBcd, ftBCD: AJsonObject.F[lFName] := BcdToDouble(ADataSet.Fields[lField.I].AsBcd); ftGraphic, ftBlob, ftStream, ftOraBlob: begin lMS := TMemoryStream.Create; try TBlobField(ADataSet.Fields[lField.I]).SaveToStream(lMS); lMS.Position := 0; lSS := TStringStream.Create; try TMVCSerializerHelper.EncodeStream(lMS, lSS); AJsonObject.S[lFName] := lSS.DataString; finally lSS.Free; end; finally lMS.Free; end; end; ftDataSet: begin lNestedDataSet := TDataSetField(ADataSet.Fields[lField.I]).NestedDataSet; lDataSetFieldsDetail := GetDataSetFields(lNestedDataSet, AIgnoredFields, GetNameCase(lNestedDataSet, ANameCase)); try case GetDataType(ADataSet.Owner, ADataSet.Fields[lField.I].Name, dtArray) of dtArray: begin lChildJsonArray := AJsonObject.A[lField.FieldName]; lNestedDataSet.First; while not lNestedDataSet.Eof do begin DataSetToJsonObject(lNestedDataSet, lChildJsonArray.AddObject, GetNameCase(lNestedDataSet, ANameCase), AIgnoredFields, lDataSetFieldsDetail, ASerializationCallback); lNestedDataSet.Next; end; end; dtObject: begin lChildJsonObject := AJsonObject.O[lField.FieldName]; DataSetToJsonObject(lNestedDataSet, lChildJsonObject, GetNameCase(lNestedDataSet, ANameCase), AIgnoredFields, lDataSetFieldsDetail, ASerializationCallback); end; end; finally lDataSetFieldsDetail.Free; end; end; else raise EMVCSerializationException.CreateFmt('Cannot find type for field "%s"', [lField.FieldName]); end; end; end; end; end; procedure TMVCJsonDataObjectsSerializer.DeserializeCollection(const ASerializedList: string; const AList: TObject; const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ARootNode: string); var JsonArray: TJDOJsonArray; JsonBase: TJDOJsonBaseObject; JSONObject: TJDOJsonObject; ObjList: IMVCList; begin if (ASerializedList = EmptyStr) then raise EMVCException.Create(HTTP_STATUS.BadRequest, 'Invalid body'); if not Assigned(AList) then Exit; if GetTypeSerializers.ContainsKey(AList.ClassInfo) then begin if ARootNode.IsEmpty then begin JsonArray := TJDOJsonArray.Parse(ASerializedList) as TJDOJsonArray; end else begin try JsonBase := TJDOJsonObject.Parse(ASerializedList); if not(JsonBase is TJDOJsonObject) then begin raise EMVCSerializationException.CreateFmt('Invalid JSON. Expected %s got %s', [TJDOJsonObject.ClassName, JsonBase.ClassName]); end; JSONObject := TJDOJsonObject(JsonBase); except on E: EJsonParserException do begin raise EMVCException.Create(HTTP_STATUS.BadRequest, E.Message); end; end; JsonArray := JSONObject.A[ARootNode] as TJDOJsonArray; end; try GetTypeSerializers.Items[AList.ClassInfo].DeserializeRoot(JsonArray, AList, []); Exit; finally JsonArray.Free; end; end; ObjList := TDuckTypedList.Wrap(AList); if Assigned(ObjList) then begin JsonBase := TJDOJsonObject.Parse(ASerializedList); try try if ARootNode.IsEmpty then begin if not(JsonBase is TJDOJsonArray) then begin raise EMVCSerializationException.CreateFmt('Invalid JSON. Expected %s got %s', [TJDOJsonArray.ClassName, JsonBase.ClassName]); end; JsonArray := TJDOJsonArray(JsonBase); end else begin if not(JsonBase is TJDOJsonObject) then begin raise EMVCSerializationException.CreateFmt('Invalid JSON. Expected %s got %s', [TJDOJsonObject.ClassName, JsonBase.ClassName]); end; JSONObject := TJDOJsonObject(JsonBase); JsonArray := JSONObject.A[ARootNode] as TJDOJsonArray; end; except on E: EJsonParserException do begin raise EMVCException.Create(HTTP_STATUS.BadRequest, E.Message); end; end; JsonArrayToList(JsonArray, ObjList, AClazz, AType, AIgnoredAttributes); finally JsonBase.Free; end; end; end; procedure TMVCJsonDataObjectsSerializer.DeserializeCollection(const ASerializedList: string; const AList: IInterface; const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); begin DeserializeCollection(ASerializedList, TObject(AList), AClazz, AType, AIgnoredAttributes); end; procedure TMVCJsonDataObjectsSerializer.DeserializeDataSet(const ASerializedDataSet: string; const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase); var lJsonArray: TJDOJsonArray; begin if (ASerializedDataSet = EmptyStr) then raise EMVCException.Create(HTTP_STATUS.BadRequest, 'Invalid body'); if not Assigned(ADataSet) then Exit; try lJsonArray := TJDOJsonArray.Parse(ASerializedDataSet) as TJDOJsonArray; except on E: EJsonParserException do begin raise EMVCException.Create(HTTP_STATUS.BadRequest, 'Invalid body'); end; end; try JsonArrayToDataSet(lJsonArray, ADataSet, AIgnoredFields, ANameCase); finally lJsonArray.Free; end; end; procedure TMVCJsonDataObjectsSerializer.DeserializeDataSetRecord(const ASerializedDataSetRecord: string; const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase); var lJsonBase: TJDOJsonBaseObject; begin if (ASerializedDataSetRecord = EmptyStr) or (not Assigned(ADataSet)) then Exit; lJsonBase := TJDOJsonObject.Parse(ASerializedDataSetRecord); try if lJsonBase is TJsonObject then begin if not(ADataSet.State in [dsInsert, dsEdit]) then begin ADataSet.Edit; end; JsonObjectToDataSet(TJsonObject(lJsonBase), ADataSet, AIgnoredFields, ANameCase); ADataSet.Post; end else begin raise EMVCSerializationException.Create('Cannot deserialize, expected json object'); end; finally lJsonBase.Free; end; end; procedure TMVCJsonDataObjectsSerializer.DeserializeObject(const ASerializedObject: string; const AObject: IInterface; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); begin DeserializeObject(ASerializedObject, TObject(AObject), AType, AIgnoredAttributes); end; function TMVCJsonDataObjectsSerializer.JsonArrayToArray(const AJsonArray: TJDOJsonArray): TValue; var I: Integer; lStrArr: TArray; lIntArr: TArray; lLongArr: TArray; lDoubleArr: TArray; lBoolArr: TArray; begin for I := 0 to Pred(AJsonArray.Count) do begin case AJsonArray.types[0] of jdtString: lStrArr := lStrArr + [AJsonArray.Items[I].Value]; jdtInt: lIntArr := lIntArr + [AJsonArray.Items[I].IntValue]; jdtLong: lLongArr := lLongArr + [AJsonArray.Items[I].LongValue]; jdtFloat: lDoubleArr := lDoubleArr + [AJsonArray.Items[I].FloatValue]; jdtBool: lBoolArr := lBoolArr + [AJsonArray.Items[I].BoolValue]; end; end; if Length(lStrArr) > 0 then Result := TValue.From < TArray < string >> (lStrArr) else if Length(lIntArr) > 0 then Result := TValue.From < TArray < Integer >> (lIntArr) else if Length(lLongArr) > 0 then Result := TValue.From < TArray < Int64 >> (lLongArr) else if Length(lBoolArr) > 0 then Result := TValue.From < TArray < Boolean >> (lBoolArr) else Result := TValue.From < TArray < Double >> (lDoubleArr); end; procedure TMVCJsonDataObjectsSerializer.JsonArrayToDataSet(const AJsonArray: TJDOJsonArray; const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase); var I: Integer; begin for I := 0 to Pred(AJsonArray.Count) do begin ADataSet.Append; JsonObjectToDataSet(AJsonArray.Items[I].ObjectValue, ADataSet, AIgnoredFields, ANameCase); ADataSet.Post; end; end; procedure TMVCJsonDataObjectsSerializer.JsonArrayToList(const AJsonArray: TJDOJsonArray; const AList: IMVCList; const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); var I: Integer; Obj: TObject; begin for I := 0 to Pred(AJsonArray.Count) do begin Obj := TMVCSerializerHelper.CreateObject(AClazz.QualifiedClassName); Assert(AJsonArray.Items[I].Typ = jdtObject, 'Cannot deserialize non object type in ' + AClazz.QualifiedClassName + '. [HINT] Move data structure to objects or use manual deserialization.'); JsonObjectToObject(AJsonArray.Items[I].ObjectValue, Obj, GetSerializationType(Obj, AType), AIgnoredAttributes); AList.Add(Obj); end; end; procedure TMVCJsonDataObjectsSerializer.JsonDataValueToAttribute( const AObject: TObject; const ARttiMember: TRttiMember; const AJsonObject: TJDOJsonObject; const AName: string; var AValue: TValue; const AType: TMVCSerializationType; const AIgnored: TMVCIgnoredList; const ACustomAttributes: TArray); var ChildObject: TObject; ChildList: IMVCList; ChildListOfAtt: MVCListOfAttribute; LEnumAsAttr: MVCEnumSerializationAttribute; lOwnedAttribute: MVCOwnedAttribute; LEnumMappedValues: TList; LEnumSerType: TMVCEnumSerializationType; LClazz: TClass; LMappedValueIndex: Integer; lOutInteger: Integer; lOutInteger64: Int64; lTypeInfo: PTypeInfo; lJSONExists: Boolean; lJSONIsNull: Boolean; lChildObjectAssigned: Boolean; begin ChildObject := nil; lTypeInfo := AValue.TypeInfo; if AValue.Kind in [tkClass, tkInterface] then begin if not AValue.IsEmpty then begin if AValue.Kind = tkInterface then ChildObject := TObject(AValue.AsInterface) else ChildObject := AValue.AsObject; end; if Assigned(ChildObject) then begin lTypeInfo := ChildObject.ClassInfo end; if TMVCSerializerHelper.AttributeExists(ACustomAttributes, lOwnedAttribute) then begin { Now, can happens the following situations: ChildObject JSON Outcome ----------- --------- ---------------------------------------------------- 1) Created Exists The JSON is loaded in the object (default) 2) Created NotExists Leave unchanged 3) Created is Null If ChildObject is Owned must be destroyed 4) nil Exists If ChildObject is Owned, create it and load the json 5) nil NotExists Leave unchanged 6) nil is Null Leave unchanged --> So, we'll manage only case 3 and 4 <-- } lJSONExists := AJsonObject.Contains(AName); lJSONIsNull := lJSONExists and AJsonObject.IsNull(AName); lChildObjectAssigned := ChildObject <> nil; //case 3 if lChildObjectAssigned and lJSONIsNull then begin ChildObject.Free; case AType of stUnknown, stDefault, stProperties: TRttiProperty(ARttiMember).SetValue(AObject, nil); stFields: TRttiField(ARttiMember).SetValue(AObject, nil); end; end //case 4 else if (not lChildObjectAssigned) and lJSONExists and (not lJSONIsNull) then begin if lOwnedAttribute.ClassRef <> nil then begin ChildObject := TMVCSerializerHelper.CreateObject(lOwnedAttribute.ClassRef.QualifiedClassName); end else begin case AType of stUnknown, stDefault, stProperties: ChildObject := TMVCSerializerHelper.CreateObject(TRttiProperty(ARttiMember).PropertyType); stFields: ChildObject := TMVCSerializerHelper.CreateObject(TRttiField(ARttiMember).FieldType); end; end; lTypeInfo := ChildObject.ClassInfo; case AType of stUnknown, stDefault, stProperties: TRttiProperty(ARttiMember).SetValue(AObject, ChildObject); stFields: TRttiField(ARttiMember).SetValue(AObject, ChildObject); end; end; //end cases end; end; if GetTypeSerializers.ContainsKey(lTypeInfo) then begin case AJsonObject[AName].Typ of jdtNone: Exit; jdtObject: begin /// JsonDataObjects assumes values null as jdtObject if AJsonObject[AName].ObjectValue <> nil then GetTypeSerializers.Items[lTypeInfo].DeserializeAttribute(AValue, AName, AJsonObject[AName].ObjectValue, ACustomAttributes); end; jdtArray: GetTypeSerializers.Items[lTypeInfo].DeserializeAttribute(AValue, AName, AJsonObject[AName].ArrayValue, ACustomAttributes); else GetTypeSerializers.Items[lTypeInfo].DeserializeAttribute(AValue, AName, AJsonObject, ACustomAttributes); end; Exit; end; case AJsonObject[AName].Typ of jdtNone: Exit; jdtString: begin if (AValue.TypeInfo = System.TypeInfo(TDate)) then AValue := TValue.From(ISODateToDate(AJsonObject[AName].Value)) else if (AValue.TypeInfo = System.TypeInfo(TDateTime)) then AValue := TValue.From(ISOTimeStampToDateTime(AJsonObject[AName].Value)) else if (AValue.TypeInfo = System.TypeInfo(TTime)) then AValue := TValue.From(ISOTimeToTime(AJsonObject[AName].Value)) else if (AValue.Kind = tkRecord) and (AValue.TypeInfo <> TypeInfo(TValue)) then { nullables } begin if AValue.TypeInfo = TypeInfo(NullableString) then begin AValue := TValue.From(NullableString(AJsonObject[AName].Value)) end else if AValue.TypeInfo = TypeInfo(NullableTDate) then begin AValue := TValue.From(NullableTDate(ISODateToDate(AJsonObject[AName].Value))) end else if AValue.TypeInfo = TypeInfo(NullableTDateTime) then begin AValue := TValue.From (NullableTDateTime(ISOTimeStampToDateTime(AJsonObject[AName].Value))) end else if AValue.TypeInfo = TypeInfo(NullableTTime) then begin AValue := TValue.From(NullableTTime(ISOTimeToTime(AJsonObject[AName].Value))) end else raise EMVCSerializationException.CreateFmt('Cannot deserialize property "%s" from string', [AName]); end else if (AValue.Kind = tkEnumeration) then begin LEnumSerType := estEnumName; LEnumMappedValues := nil; if TMVCSerializerHelper.AttributeExists(ACustomAttributes, LEnumAsAttr) then begin LEnumSerType := LEnumAsAttr.SerializationType; LEnumMappedValues := LEnumAsAttr.MappedValues; end; if LEnumSerType = estEnumName then begin TValue.Make(GetEnumValue(AValue.TypeInfo, AJsonObject[AName].Value), AValue.TypeInfo, AValue) end else begin LMappedValueIndex := LEnumMappedValues.IndexOf(AJsonObject[AName].Value); if LMappedValueIndex < 0 then raise EMVCSerializationException.CreateFmt('Cannot deserialize property "%s" from mapped values', [AName]); TValue.Make(GetEnumValue(AValue.TypeInfo, GetEnumName(AValue.TypeInfo, LMappedValueIndex)), AValue.TypeInfo, AValue) end; end else if (AValue.Kind = tkInteger) and (TryStrToInt(AJsonObject[AName].Value, lOutInteger)) then begin AValue := lOutInteger; end else if (AValue.Kind = tkInt64) and (TryStrToInt64(AJsonObject[AName].Value, lOutInteger64)) then begin AValue := lOutInteger64; end else AValue := TValue.From(AJsonObject[AName].Value); end; jdtInt: begin if (AValue.Kind = tkEnumeration) then begin TValue.Make(GetEnumValue(AValue.TypeInfo, GetEnumName(AValue.TypeInfo, AJsonObject[AName].IntValue)), AValue.TypeInfo, AValue) end else if (AValue.Kind <> tkRecord) then { nullables } begin AValue := TValue.From(AJsonObject[AName].IntValue); end else begin if AValue.TypeInfo = TypeInfo(NullableInt32) then AValue := TValue.From(NullableInt32(AJsonObject[AName].IntValue)) else if AValue.TypeInfo = TypeInfo(NullableUInt32) then AValue := TValue.From(NullableUInt32(AJsonObject[AName].IntValue)) else if AValue.TypeInfo = TypeInfo(NullableInt16) then AValue := TValue.From(NullableInt16(AJsonObject[AName].IntValue)) else if AValue.TypeInfo = TypeInfo(NullableUInt16) then AValue := TValue.From(NullableUInt16(AJsonObject[AName].IntValue)) else if AValue.TypeInfo = TypeInfo(NullableInt64) then AValue := TValue.From(NullableInt64(AJsonObject[AName].LongValue)) else if AValue.TypeInfo = TypeInfo(NullableUInt64) then AValue := TValue.From(NullableUInt64(AJsonObject[AName].LongValue)) else if not TryMapNullableFloat(AValue, AJsonObject, AName) then raise EMVCDeserializationException.CreateFmt('Cannot deserialize integer value for "%s"', [AName]); end; end; jdtLong, jdtULong: begin if (AValue.TypeInfo = System.TypeInfo(TTimeStamp)) then begin AValue := TValue.From(MSecsToTimeStamp(AJsonObject[AName].LongValue)) end else if (AValue.Kind <> tkRecord) then { nullables } begin AValue := TValue.From(AJsonObject[AName].LongValue); end else begin if AValue.TypeInfo = TypeInfo(NullableInt64) then AValue := TValue.From(NullableInt64(AJsonObject[AName].LongValue)) else if AValue.TypeInfo = TypeInfo(NullableUInt64) then AValue := TValue.From(NullableUInt64(AJsonObject[AName].LongValue)) else if not TryMapNullableFloat(AValue, AJsonObject, AName) then raise EMVCDeserializationException.CreateFmt('Cannot deserialize long integer value for "%s"', [AName]); end; end; jdtFloat: if (AValue.Kind <> tkRecord) then { nullables } begin AValue := TValue.From(AJsonObject[AName].FloatValue); end else begin if not TryMapNullableFloat(AValue, AJsonObject, AName) then raise EMVCDeserializationException.CreateFmt('Cannot deserialize floating-point value for "%s"', [AName]); end; jdtDateTime: if (AValue.Kind <> tkRecord) then { nullables } begin AValue := TValue.From(AJsonObject[AName].DateTimeValue); end else begin if AValue.TypeInfo = TypeInfo(NullableTDate) then AValue := TValue.From(NullableTDate(AJsonObject[AName].DateTimeValue)) else if AValue.TypeInfo = TypeInfo(NullableTDateTime) then AValue := TValue.From(NullableTDateTime(AJsonObject[AName].DateTimeValue)) else if AValue.TypeInfo = TypeInfo(NullableTTime) then AValue := TValue.From(NullableTTime(AJsonObject[AName].DateTimeValue)) else raise EMVCDeserializationException.CreateFmt('Cannot deserialize date or time value for "%s"', [AName]); end; jdtBool: if (AValue.Kind <> tkRecord) then { nullables } begin AValue := TValue.From(AJsonObject[AName].BoolValue); end else begin if AValue.TypeInfo = TypeInfo(NullableBoolean) then AValue := TValue.From(NullableBoolean(AJsonObject[AName].BoolValue)) else raise EMVCDeserializationException.CreateFmt('Cannot deserialize boolean value for "%s"', [AName]); end; jdtObject: begin if (AValue.TypeInfo = System.TypeInfo(TValue)) then AValue := TValue.FromVariant(AJsonObject[AName].O['value'].VariantValue) else begin // dt: if a key is null, jsondataobjects assign it the type jdtObject if AJsonObject[AName].ObjectValue <> nil then begin case AValue.Kind of tkInterface: begin //ChildObject := TObject(AValue.AsInterface); JsonObjectToObject(AJsonObject.O[AName], ChildObject, GetSerializationType(ChildObject, AType), AIgnored); end; tkClass: begin //ChildObject := AValue.AsObject; JsonObjectToObject(AJsonObject.O[AName], ChildObject, GetSerializationType(ChildObject, AType), AIgnored); end; tkString, tkUString: begin AValue := AJsonObject.O[AName].ToJSON(); end; tkRecord: begin if AValue.TypeInfo = TypeInfo(NullableString) then begin AValue := TValue.From(NullableString(AJsonObject.O[AName].ToJSON())); end else begin raise EMVCDeserializationException.CreateFmt('Cannot deserialize object value for "%s"', [AName]); end; end end; end; end; end; jdtArray: begin if AValue.Kind = tkInterface then ChildObject := TObject(AValue.AsInterface) else ChildObject := AValue.AsObject; if Assigned(ChildObject) then begin if ChildObject is TDataSet then JsonArrayToDataSet(AJsonObject.A[AName], ChildObject as TDataSet, AIgnored, ncLowerCase) else if GetTypeSerializers.ContainsKey(ChildObject.ClassInfo) then begin GetTypeSerializers.Items[ChildObject.ClassInfo].DeserializeAttribute(AValue, AName, AJsonObject, ACustomAttributes); end else begin ChildList := TDuckTypedList.Wrap(ChildObject); if TMVCSerializerHelper.AttributeExists(ACustomAttributes, ChildListOfAtt) then LClazz := ChildListOfAtt.Value else LClazz := GetObjectTypeOfGenericList(AValue.TypeInfo); if Assigned(LClazz) then JsonArrayToList(AJsonObject.A[AName], ChildList, LClazz, AType, AIgnored) else raise EMVCDeserializationException.CreateFmt ('You can not deserialize a list "%s" without the MVCListOf attribute.', [AName]); end; end else if AValue.isArray then begin AValue := JsonArrayToArray(AJsonObject.A[AName]); end; end; end; end; procedure TMVCJsonDataObjectsSerializer.JsonObjectToDataSet(const AJsonObject: TJDOJsonObject; const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase); var Field: TField; lName: string; SS: TStringStream; SM: TMemoryStream; NestedDataSet: TDataSet; begin if (ADataSet.State in [dsInsert, dsEdit]) then begin for Field in ADataSet.Fields do begin lName := GetNameAs(ADataSet.Owner, Field.Name, Field.FieldName); if (IsIgnoredAttribute(AIgnoredFields, lName)) or (IsIgnoredComponent(ADataSet.Owner, Field.Name)) then continue; lName := TMVCSerializerHelper.ApplyNameCase(GetNameCase(ADataSet, ANameCase), lName { Field.FieldName } ); // case GetNameCase(ADataSet, ANameCase) of // ncLowerCase: // name := LowerCase(Field.FieldName); // ncUpperCase: // name := UpperCase(Field.FieldName); // end; if not AJsonObject.Contains(lName) then continue; if (AJsonObject[lName].Typ = jdtObject) and (AJsonObject.Values[lName].ObjectValue = nil) then // Nullable Type begin Field.Clear; continue; end; case Field.DataType of TFieldType.ftBoolean: Field.AsBoolean := AJsonObject.B[lName]; TFieldType.ftInteger, TFieldType.ftSmallint, TFieldType.ftShortint, TFieldType.ftByte, TFieldType.ftLongword, TFieldType.ftWord, TFieldType.ftAutoInc: Field.AsInteger := AJsonObject.I[lName]; TFieldType.ftLargeint: Field.AsLargeInt := AJsonObject.L[lName]; TFieldType.ftCurrency: Field.AsCurrency := AJsonObject.F[lName]; TFieldType.ftSingle: Field.AsSingle := AJsonObject.F[lName]; TFieldType.ftFloat, TFieldType.ftFMTBcd, TFieldType.ftBCD: Field.AsFloat := AJsonObject.F[lName]; ftString, ftWideString, ftMemo, ftWideMemo: Field.AsWideString := AJsonObject.S[lName]; TFieldType.ftDate: Field.AsDateTime := ISODateToDate(AJsonObject.S[lName]); TFieldType.ftDateTime, TFieldType.ftTimeStamp: Field.AsDateTime := ISOTimeStampToDateTime(AJsonObject.S[lName]); TFieldType.ftTime: Field.AsDateTime := ISOTimeToTime(AJsonObject.S[lName]); {$IFDEF TOKYOORBETTER} TFieldType.ftGuid: Field.AsGuid := StringToGUID(AJsonObject.S[lName]); {$ENDIF} TFieldType.ftGraphic, TFieldType.ftBlob, TFieldType.ftStream: begin SS := TStringStream.Create(AJsonObject.S[lName]); try SS.Position := 0; SM := TMemoryStream.Create; try TMVCSerializerHelper.DecodeStream(SS, SM); TBlobField(Field).LoadFromStream(SM); finally SM.Free; end; finally SS.Free; end; end; TFieldType.ftDataSet: begin NestedDataSet := TDataSetField(Field).NestedDataSet; NestedDataSet.First; while not NestedDataSet.Eof do NestedDataSet.Delete; case GetDataType(ADataSet.Owner, Field.Name, dtArray) of dtArray: begin JsonArrayToDataSet(AJsonObject.A[lName], NestedDataSet, AIgnoredFields, ANameCase); end; dtObject: begin NestedDataSet.Edit; JsonObjectToDataSet(AJsonObject.O[lName], NestedDataSet, AIgnoredFields, ANameCase); NestedDataSet.Post; end; end; end; else raise EMVCDeserializationException.CreateFmt('Cannot find type for field "%s"', [Field.FieldName]); end; end; end; end; procedure TMVCJsonDataObjectsSerializer.JsonObjectToObject(const AJsonObject: TJDOJsonObject; const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); var lObjType: TRttiType; lProp: TRttiProperty; lFld: TRttiField; lAttributeValue: TValue; lKeyName: string; lErrMsg: string; begin if AObject = nil then begin Exit; end; if AObject is TJsonObject then begin if not Assigned(AObject) then begin raise EMVCDeserializationException.Create(AObject.ClassName + ' is not assigned'); end; TJsonObject(AObject).Assign(AJsonObject); Exit; end; lProp := nil; lFld := nil; lObjType := GetRttiContext.GetType(AObject.ClassType); case AType of stDefault, stProperties: begin try for lProp in lObjType.GetProperties do begin {$IFDEF AUTOREFCOUNT} if TMVCSerializerHelper.IsAPropertyToSkip(lProp.Name) then continue; {$ENDIF} if ((not TMVCSerializerHelper.HasAttribute(lProp)) and (not IsIgnoredAttribute(AIgnoredAttributes, lProp.Name)) and (lProp.IsWritable or lProp.GetValue(AObject).IsObject)) then begin lAttributeValue := lProp.GetValue(AObject); lKeyName := TMVCSerializerHelper.GetKeyName(lProp, lObjType); JsonDataValueToAttribute( AObject, lProp, AJsonObject, lKeyName, lAttributeValue, AType, AIgnoredAttributes, lProp.GetAttributes); if (not lAttributeValue.IsEmpty) and (not lAttributeValue.IsObject) and lProp.IsWritable then begin lProp.SetValue(AObject, lAttributeValue); end; end; end; except on E: EInvalidCast do begin if lProp <> nil then begin lErrMsg := Format('Invalid class typecast for property "%s" [Expected: %s, Actual: %s]', [lKeyName, lProp.PropertyType.ToString(), JDO_TYPE_DESC[AJsonObject[lKeyName].Typ]]); end else begin lErrMsg := Format('Invalid class typecast for property "%s" [Actual: %s]', [lKeyName, JDO_TYPE_DESC[AJsonObject[lKeyName].Typ]]); end; raise EMVCException.Create(HTTP_STATUS.BadRequest, lErrMsg); end; end; end; stFields: begin try for lFld in lObjType.GetFields do if (not TMVCSerializerHelper.HasAttribute(lFld)) and (not IsIgnoredAttribute(AIgnoredAttributes, lFld.Name)) then begin lAttributeValue := lFld.GetValue(AObject); lKeyName := TMVCSerializerHelper.GetKeyName(lFld, lObjType); JsonDataValueToAttribute( AObject, lFld, AJsonObject, lKeyName, lAttributeValue, AType, AIgnoredAttributes, lFld.GetAttributes); if (not lAttributeValue.IsEmpty) and (not lAttributeValue.IsObject) then lFld.SetValue(AObject, lAttributeValue); end; except on E: EInvalidCast do begin if lFld <> nil then begin lErrMsg := Format('Invalid class typecast for field "%s" [Expected: %s, Actual: %s]', [lKeyName, lFld.FieldType.ToString(), JDO_TYPE_DESC[AJsonObject[lKeyName].Typ]]); end else begin lErrMsg := Format('Invalid class typecast for field "%s" [Actual: %s]', [lKeyName, JDO_TYPE_DESC[AJsonObject[lKeyName].Typ]]); end; raise EMVCException.Create(HTTP_STATUS.BadRequest, lErrMsg); end; end; end; end; end; procedure TMVCJsonDataObjectsSerializer.ListToJsonArray(const AList: IMVCList; const AJsonArray: TJDOJsonArray; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction); var I: Integer; lDict: IMVCLinks; lSer: IMVCTypeSerializer; lJsonDataType: TJsonDataType; lJSONValue: TJsonBaseObject; begin if not Assigned(AList) then raise EMVCSerializationException.Create('List not assigned'); if Assigned(ASerializationAction) then begin lDict := TJDOLinks.Create; for I := 0 to Pred(AList.Count) do begin lDict.Clear; InternalObjectToJsonObject(AList.GetItem(I), AJsonArray.AddObject, AType, AIgnoredAttributes, ASerializationAction, lDict, lSer); end; end else begin for I := 0 to Pred(AList.Count) do begin lJSONValue := ConvertObjectToJsonValue(AList.GetItem(I), AType, AIgnoredAttributes, nil, ASerializationAction, lJsonDataType); case lJsonDataType of jdtArray: begin AJsonArray.Add(lJSONValue as TJsonArray); end; jdtObject: begin AJsonArray.Add(lJSONValue as TJsonObject); end; else begin lJSONValue.Free; RaiseSerializationError('Invalid JSON Data Type'); end end; // InternalObjectToJsonObject(AList.GetItem(I), AJsonArray.AddObject, AType, AIgnoredAttributes, nil, nil, // nil); end; end; end; procedure TMVCJsonDataObjectsSerializer.ObjectToJsonObject(const AObject: TObject; const AJsonObject: TJDOJsonObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); begin InternalObjectToJsonObject(AObject, AJsonObject, AType, AIgnoredAttributes, nil, nil, nil); end; procedure TMVCJsonDataObjectsSerializer.InternalObjectToJsonObject(const AObject: TObject; const AJsonObject: TJDOJsonObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction; const Links: IMVCLinks; const Serializer: IMVCTypeSerializer); var ObjType: TRttiType; Prop: TRttiProperty; Fld: TRttiField; begin { TODO -oDanieleT -cGeneral : Find a way to automatically add HATEOS } if AObject = nil then begin Exit; end; ObjType := GetRttiContext.GetType(AObject.ClassType); case AType of stDefault, stProperties: begin for Prop in ObjType.GetProperties do begin {$IFDEF AUTOREFCOUNT} if TMVCSerializerHelper.IsAPropertyToSkip(Prop.Name) then continue; {$ENDIF} if (not TMVCSerializerHelper.HasAttribute(Prop)) and (not IsIgnoredAttribute(AIgnoredAttributes, Prop.Name)) then TValueToJSONObjectProperty(AJsonObject, TMVCSerializerHelper.GetKeyName(Prop, ObjType), Prop.GetValue(AObject), AType, AIgnoredAttributes, Prop.GetAttributes); end; end; stFields: begin for Fld in ObjType.GetFields do begin if (not TMVCSerializerHelper.HasAttribute(Fld)) and (not IsIgnoredAttribute(AIgnoredAttributes, Fld.Name)) then TValueToJSONObjectProperty(AJsonObject, TMVCSerializerHelper.GetKeyName(Fld, ObjType), Fld.GetValue(AObject), AType, AIgnoredAttributes, Fld.GetAttributes); end; end; end; if Assigned(ASerializationAction) then begin ASerializationAction(AObject, Links); TJDOLinks(Links).FillJSONArray(AJsonObject.A[TMVCConstants.HATEOAS_PROP_NAME]); end; end; procedure TMVCJsonDataObjectsSerializer.InternalSerializeDataSet(const ADataSet: TDataSet; const AJsonArray: TJsonArray; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase; const ASerializationAction: TMVCDatasetSerializationAction); var BookMark: TBookmark; lLinks: IMVCLinks; LJObj: TJsonObject; lDataSetFields: TMVCDataSetFields; begin lLinks := nil; if Assigned(ASerializationAction) then begin lLinks := TJDOLinks.Create; end; lDataSetFields := GetDataSetFields(ADataSet, AIgnoredFields, ANameCase); try BookMark := ADataSet.BookMark; try ADataSet.First; while not ADataSet.Eof do begin LJObj := AJsonArray.AddObject; DataSetToJsonObject(ADataSet, LJObj, ncAsIs { already applied } , AIgnoredFields, lDataSetFields); if Assigned(ASerializationAction) then begin lLinks.Clear; ASerializationAction(ADataSet, lLinks); TJDOLinks(lLinks).FillJSONArray(LJObj.A[TMVCConstants.HATEOAS_PROP_NAME]); end; ADataSet.Next; end; finally if ADataSet.BookmarkValid(BookMark) then ADataSet.GotoBookmark(BookMark); ADataSet.FreeBookmark(BookMark); end; finally lDataSetFields.Free; end; end; procedure TMVCJsonDataObjectsSerializer.InternalSerializeDataSetRecord(const DataSet: TDataSet; const JSONObject: TJsonObject; const IgnoredFields: TMVCIgnoredList; const NameCase: TMVCNameCase; const SerializationAction: TMVCDatasetSerializationAction); var lNameCase: TMVCNameCase; lDataSetFields: TList; lLinks: IMVCLinks; begin lNameCase := GetNameCase(DataSet, NameCase); lDataSetFields := GetDataSetFields(DataSet, IgnoredFields, lNameCase); try DataSetToJsonObject(DataSet, JSONObject, ncAsIs { lNameCase } , IgnoredFields, lDataSetFields); lLinks := TJDOLinks.Create; if Assigned(SerializationAction) then begin SerializationAction(DataSet, lLinks); TJDOLinks(lLinks).FillJSONArray(JSONObject.A[TMVCSerializerHelper.ApplyNameCase(lNameCase, TMVCConstants.HATEOAS_PROP_NAME)]); end; finally lDataSetFields.Free; end; end; class function TMVCJsonDataObjectsSerializer.Parse(const AString: string): T; begin Result := TJDOJsonObject.Parse(AString) as T; if not Assigned(Result) then raise EMVCDeserializationException.Create('Cannot parse string as ' + T.ClassName); end; class function TMVCJsonDataObjectsSerializer.ParseArray(const AString: string): TJDOJsonArray; begin Result := Parse(AString); end; class function TMVCJsonDataObjectsSerializer.ParseObject(const AString: string): TJDOJsonObject; begin Result := Parse(AString); end; function TMVCJsonDataObjectsSerializer.SerializeCollection(const AList: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string; var JsonArray: TJDOJsonArray; ObjList: IMVCList; Obj: TObject; lLinks: IMVCLinks; lSer: IMVCTypeSerializer; lObjType: TRttiType; begin Result := EmptyStr; if not Assigned(AList) then Exit; if AList is TJsonBaseObject then Exit(TJsonBaseObject(AList).ToJSON(True)); lObjType := GetRttiContext.GetType(AList.ClassType); if GetTypeSerializers.ContainsKey(lObjType.Handle) then begin GetTypeSerializers.Items[lObjType.Handle].SerializeRoot(AList, TObject(JsonArray), []); try Result := JsonArray.ToJSON(True); finally JsonArray.Free; end; Exit; end; ObjList := TDuckTypedList.Wrap(AList); if Assigned(ObjList) then begin JsonArray := TJDOJsonArray.Create; try if Assigned(ASerializationAction) then begin if not GetTypeSerializers.TryGetValue(TypeInfo(TMVCStringDictionary), lSer) then begin raise EMVCSerializationException.Create ('Cannot serialize _links without TMVCStringDictionary custom serializer'); end; lLinks := TJDOLinks.Create; for Obj in ObjList do begin lLinks.Clear; InternalObjectToJsonObject(Obj, JsonArray.AddObject, GetSerializationType(Obj, AType), AIgnoredAttributes, ASerializationAction, lLinks, lSer); end; end else begin for Obj in ObjList do begin if Obj <> nil then begin ObjectToJsonObject(Obj, JsonArray.AddObject, GetSerializationType(Obj, AType), AIgnoredAttributes) end else begin JsonArray.Add(TJsonObject(nil)); end; end; end; Result := JsonArray.ToJSON(True); finally JsonArray.Free; end; end; end; function TMVCJsonDataObjectsSerializer.SerializeCollection(const AList: IInterface; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string; begin Result := SerializeCollection(TObject(AList), AType, AIgnoredAttributes, ASerializationAction); end; function TMVCJsonDataObjectsSerializer.SerializeDataSet(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase; const ASerializationAction: TMVCDatasetSerializationAction): string; var JsonArray: TJDOJsonArray; begin Result := EmptyStr; if (not Assigned(ADataSet)) then Exit('null'); if ADataSet.IsEmpty then Exit('[]'); // https://github.com/danieleteti/delphimvcframework/issues/219 JsonArray := TJsonArray.Create; try InternalSerializeDataSet(ADataSet, JsonArray, AIgnoredFields, ANameCase, ASerializationAction); Result := JsonArray.ToJSON(True); finally JsonArray.Free; end; end; function TMVCJsonDataObjectsSerializer.SerializeDataSetRecord(const DataSet: TDataSet; const IgnoredFields: TMVCIgnoredList; const NameCase: TMVCNameCase = ncAsIs; const SerializationAction: TMVCDatasetSerializationAction = nil): string; var lJSONObject: TJDOJsonObject; begin Result := EmptyStr; if (not Assigned(DataSet)) or DataSet.IsEmpty then Exit('null'); lJSONObject := TJDOJsonObject.Create; try InternalSerializeDataSetRecord(DataSet, lJSONObject, IgnoredFields, NameCase, SerializationAction); Result := lJSONObject.ToJSON(True); finally lJSONObject.Free; end; end; function TMVCJsonDataObjectsSerializer.SerializeObject(const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string; var LJObj: TJDOJsonObject; lObjType: TRttiType; lDict: IMVCLinks; begin Result := EmptyStr; if not Assigned(AObject) then Exit('null'); if AObject is TJsonBaseObject then Exit(TJsonBaseObject(AObject).ToJSON(True)); if AObject is TDataSet then Exit(self.SerializeDataSet(TDataSet(AObject), AIgnoredAttributes)); if AObject is System.JSON.TJsonValue then Exit(System.JSON.TJsonValue(AObject).ToJSON); lObjType := GetRttiContext.GetType(AObject.ClassType); if GetTypeSerializers.ContainsKey(lObjType.Handle) then begin GetTypeSerializers.Items[lObjType.Handle].SerializeRoot(AObject, TObject(LJObj), []); try Result := LJObj.ToJSON(True); finally LJObj.Free; end; Exit; end; LJObj := TJDOJsonObject.Create; try if Assigned(ASerializationAction) then begin lDict := TJDOLinks.Create; InternalObjectToJsonObject(AObject, LJObj, GetSerializationType(AObject, AType), AIgnoredAttributes, ASerializationAction, lDict, fStringDictionarySerializer); end else begin InternalObjectToJsonObject(AObject, LJObj, GetSerializationType(AObject, AType), AIgnoredAttributes, nil, nil, nil); end; Result := LJObj.ToJSON(True); finally LJObj.Free; end; end; function TMVCJsonDataObjectsSerializer.SerializeObject(const AObject: IInterface; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): string; var LIgnoredAttrs: TList; begin if not Assigned(AObject) then Exit('null'); LIgnoredAttrs := TList.Create; try LIgnoredAttrs.AddRange(AIgnoredAttributes); // if Assigned(GetRttiContext.GetType(TObject(AObject).ClassType).GetProperty('RefCount')) then // LIgnoredAttrs.Add('RefCount'); Result := SerializeObject(TObject(AObject), AType, TMVCIgnoredList(LIgnoredAttrs.ToArray), ASerializationAction); finally LIgnoredAttrs.Free; end; end; function TMVCJsonDataObjectsSerializer.SerializeObjectToJSON(const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ASerializationAction: TMVCSerializationAction): TJDOJsonObject; var JSONObject: TJDOJsonObject; ObjType: TRttiType; begin if not Assigned(AObject) then Exit(TJDOJsonObject.Create); if AObject is TJsonBaseObject then Exit(TJsonBaseObject(AObject).Clone as TJDOJsonObject); if AObject is TDataSet then begin raise Exception.Create('Not supported yet'); end; if AObject is TJsonValue then begin Exit(TJDOJsonObject.Parse(TJsonValue(AObject).ToJSON) as TJDOJsonObject); end; ObjType := GetRttiContext.GetType(AObject.ClassType); if GetTypeSerializers.ContainsKey(ObjType.Handle) then begin GetTypeSerializers.Items[ObjType.Handle].SerializeRoot(AObject, TObject(JSONObject), []); try Result := JSONObject; except JSONObject.Free; raise; end; Exit; end; Result := TJDOJsonObject.Create; try ObjectToJsonObject(AObject, Result, GetSerializationType(AObject, AType), AIgnoredAttributes); except Result.Free; raise; end; end; function TMVCJsonDataObjectsSerializer.TryMapNullableFloat(var Value: TValue; const JSONDataObject: TJsonObject; const AttribName: string): Boolean; begin Result := True; if Value.TypeInfo = TypeInfo(NullableSingle) then Value := TValue.From(NullableSingle(JSONDataObject[AttribName].FloatValue)) else if Value.TypeInfo = TypeInfo(NullableCurrency) then Value := TValue.From(NullableCurrency(JSONDataObject[AttribName].FloatValue)) else if Value.TypeInfo = TypeInfo(NullableDouble) then Value := TValue.From(NullableDouble(JSONDataObject[AttribName].FloatValue)) else if Value.TypeInfo = TypeInfo(NullableExtended) then Value := TValue.From(NullableExtended(JSONDataObject[AttribName].FloatValue)) else Result := False; end; function TMVCJsonDataObjectsSerializer.TryNullableToJSON(const AValue: TValue; const AJsonObject: TJDOJsonObject; const AName: string): Boolean; begin Result := False; if (AValue.TypeInfo = System.TypeInfo(NullableString)) then begin if AValue.AsType().HasValue then begin AJsonObject.S[AName] := AValue.AsType().Value; end else begin AJsonObject.Values[AName] := nil; end; Exit(True); end; if (AValue.TypeInfo = System.TypeInfo(NullableInt32)) then begin if AValue.AsType().HasValue then begin AJsonObject.I[AName] := AValue.AsType().Value; end else begin AJsonObject.Values[AName] := nil; end; Exit(True); end; if (AValue.TypeInfo = System.TypeInfo(NullableInt64)) then begin if AValue.AsType().HasValue then begin AJsonObject.L[AName] := AValue.AsType().Value; end else begin AJsonObject.Values[AName] := nil; end; Exit(True); end; if (AValue.TypeInfo = System.TypeInfo(NullableInt16)) then begin if AValue.AsType().HasValue then begin AJsonObject.I[AName] := AValue.AsType().Value; end else begin AJsonObject.Values[AName] := nil; end; Exit(True); end; if (AValue.TypeInfo = System.TypeInfo(NullableTDate)) then begin if AValue.AsType().HasValue then begin AJsonObject.S[AName] := DateToISODate(AValue.AsType().Value); end else begin AJsonObject.Values[AName] := nil; end; Exit(True); end; if (AValue.TypeInfo = System.TypeInfo(NullableTDateTime)) then begin if AValue.AsType().HasValue then begin AJsonObject.S[AName] := DateTimeToISOTimeStamp(AValue.AsType().Value); end else begin AJsonObject.Values[AName] := nil; end; Exit(True); end; if (AValue.TypeInfo = System.TypeInfo(NullableTTime)) then begin if AValue.AsType().HasValue then begin AJsonObject.S[AName] := TimeToISOTime(AValue.AsType().Value); end else begin AJsonObject.Values[AName] := nil; end; Exit(True); end; if (AValue.TypeInfo = System.TypeInfo(NullableBoolean)) then begin if AValue.AsType().HasValue then begin AJsonObject.B[AName] := AValue.AsType().Value; end else begin AJsonObject.Values[AName] := nil; end; Exit(True); end; if (AValue.TypeInfo = System.TypeInfo(NullableCurrency)) then begin if AValue.AsType().HasValue then begin AJsonObject.F[AName] := AValue.AsType().Value; end else begin AJsonObject.Values[AName] := nil; end; Exit(True); end; if (AValue.TypeInfo = System.TypeInfo(NullableSingle)) then begin if AValue.AsType().HasValue then begin AJsonObject.F[AName] := AValue.AsType().Value; end else begin AJsonObject.Values[AName] := nil; end; Exit(True); end; if (AValue.TypeInfo = System.TypeInfo(NullableDouble)) then begin if AValue.AsType().HasValue then begin AJsonObject.F[AName] := AValue.AsType().Value; end else begin AJsonObject.Values[AName] := nil; end; Exit(True); end; if (AValue.TypeInfo = System.TypeInfo(NullableExtended)) then begin if AValue.AsType().HasValue then begin AJsonObject.F[AName] := AValue.AsType().Value; end else begin AJsonObject.Values[AName] := nil; end; Exit(True); end; { from here all nullable integers } if (AValue.TypeInfo = System.TypeInfo(NullableUInt16)) then begin if AValue.AsType().HasValue then begin AJsonObject.I[AName] := AValue.AsType().Value; end else begin AJsonObject.Values[AName] := nil; end; Exit(True); end; if (AValue.TypeInfo = System.TypeInfo(NullableUInt32)) then begin if AValue.AsType().HasValue then begin AJsonObject.I[AName] := AValue.AsType().Value; end else begin AJsonObject.Values[AName] := nil; end; Exit(True); end; if (AValue.TypeInfo = System.TypeInfo(NullableUInt64)) then begin if AValue.AsType().HasValue then begin AJsonObject.I[AName] := AValue.AsType().Value; end else begin AJsonObject.Values[AName] := nil; end; Exit(True); end; end; procedure TMVCJsonDataObjectsSerializer.DeserializeObject(const ASerializedObject: string; const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ARootNode: string); var JSONObject: TJDOJsonObject; JsonBase: TJsonBaseObject; begin if (ASerializedObject = EmptyStr) then raise EMVCException.Create(HTTP_STATUS.BadRequest, 'Invalid body'); if not Assigned(AObject) then Exit; try JsonBase := TJDOJsonObject.Parse(ASerializedObject); if not(JsonBase is TJDOJsonObject) then begin raise EMVCSerializationException.CreateFmt('Invalid JSON. Expected %s got %s', [TJDOJsonObject.ClassName, JsonBase.ClassName]); end; JSONObject := TJDOJsonObject(JsonBase); except on E: EJsonParserException do begin raise EMVCException.Create(HTTP_STATUS.BadRequest, E.Message); end; end; try if GetTypeSerializers.ContainsKey(AObject.ClassInfo) then begin GetTypeSerializers.Items[AObject.ClassInfo].DeserializeRoot(SelectRootNodeOrWholeObject(ARootNode, JSONObject), AObject, []) end else begin JsonObjectToObject(SelectRootNodeOrWholeObject(ARootNode, JSONObject), AObject, GetSerializationType(AObject, AType), AIgnoredAttributes); end; finally JSONObject.Free; end; end; function TMVCJsonDataObjectsSerializer.GetDataSetFields(const ADataSet: TDataSet; const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase = ncAsIs): TMVCDataSetFields; var I: Integer; lField: TMVCDataSetField; begin Result := TMVCDataSetFields.Create; for I := 0 to ADataSet.Fields.Count - 1 do begin { gets the name as defined by NameAs attribute } lField.FieldName := GetNameAs(ADataSet.Owner, ADataSet.Fields[I].Name, ADataSet.Fields[I].FieldName); { apply the name case to the field name } lField.FieldName := TMVCSerializerHelper.ApplyNameCase(ANameCase, lField.FieldName); lField.DataType := ADataSet.Fields[I].DataType; lField.I := I; if (not IsIgnoredAttribute(AIgnoredFields, ADataSet.Fields[I].FieldName)) and (not IsIgnoredComponent(ADataSet.Owner, ADataSet.Fields[I].Name)) then Result.Add(lField); end; end; procedure TMVCJsonDataObjectsSerializer.AddTValueToJsonArray(const Value: TValue; const JSON: TJDOJsonArray); var lOrdinalValue: Int64; lValueAsObj: TObject; lTypeName: string; lJSONValue: TJsonBaseObject; lJsonDataType: TJsonDataType; begin if Value.IsEmpty then begin JSON.Add(TJsonObject(nil)); Exit; end; case Value.Kind of tkInteger: begin JSON.Add(Value.AsInteger); end; tkFloat: begin {$IFDEF NEXTGEN} lTypeName := PChar(Pointer(Value.TypeInfo.Name)); {$ELSE} lTypeName := string(Value.TypeInfo.Name); {$ENDIF} if (lTypeName = 'TDate') or (lTypeName = 'TDateTime') or (lTypeName = 'TTime') then begin JSON.Add(DateTimeToISOTimeStamp(Value.AsExtended)); end else begin JSON.Add(Value.AsExtended); end; end; tkString, tkUString, tkWChar, tkLString, tkWString: begin JSON.Add(Value.AsString); end; tkInt64: begin JSON.Add(Value.AsInt64); end; tkEnumeration: begin if (Value.TypeInfo = System.TypeInfo(Boolean)) then begin JSON.Add(Value.AsBoolean); end else begin Value.TryAsOrdinal(lOrdinalValue); JSON.Add(lOrdinalValue); end; end; tkClass, tkInterface: begin if Value.Kind = tkInterface then lValueAsObj := TObject(Value.AsInterface) else lValueAsObj := Value.AsObject; lJSONValue := ConvertObjectToJsonValue(lValueAsObj, GetSerializationType(lValueAsObj), [], nil, nil, lJsonDataType); case lJsonDataType of jdtArray: begin JSON.Add(TJsonArray(lJSONValue)); end; jdtObject: begin JSON.Add(TJsonObject(lJSONValue)); end; else begin lJSONValue.Free; RaiseSerializationError('Invalid JSON Type') end; end; end; else raise EMVCException.Create('Invalid type'); end; end; procedure TValueToJSONObjectProperty(const Value: TValue; const JSON: TJDOJsonObject; const KeyName: string); var lSer: TMVCJsonDataObjectsSerializer; lMVCList: IMVCList; lOrdinalValue: Int64; lValueAsObj: TObject; lValueAsObjQualifClassName, lTypeName: string; begin if Value.IsEmpty then begin JSON.Values[KeyName] := nil; Exit; end; case Value.Kind of tkInteger: begin JSON.I[KeyName] := Value.AsInteger; end; tkFloat: begin {$IFDEF NEXTGEN} lTypeName := PChar(Pointer(Value.TypeInfo.Name)); {$ELSE} lTypeName := string(Value.TypeInfo.Name); {$ENDIF} if (lTypeName = 'TDate') or (lTypeName = 'TDateTime') or (lTypeName = 'TTime') then begin JSON.D[KeyName] := Value.AsExtended; end else begin JSON.F[KeyName] := Value.AsExtended; end; end; tkString, tkUString, tkWChar, tkLString, tkWString: begin JSON.S[KeyName] := Value.AsString; end; tkInt64: begin JSON.I[KeyName] := Value.AsInt64; end; tkEnumeration: begin if (Value.TypeInfo = System.TypeInfo(Boolean)) then begin JSON.B[KeyName] := Value.AsBoolean; end else begin Value.TryAsOrdinal(lOrdinalValue); JSON.I[KeyName] := lOrdinalValue; end; end; tkClass, tkInterface: begin if Value.Kind = tkInterface then lValueAsObj := TObject(Value.AsInterface) else lValueAsObj := Value.AsObject; lValueAsObjQualifClassName := lValueAsObj.QualifiedClassName.ToLower; if (lValueAsObj is TJDOJsonObject) or (lValueAsObj is TJsonObject) {$IFDEF RIOORBETTER} or { this is for a bug in delphi103rio } (lValueAsObjQualifClassName = 'jsondataobjects.tjsonobject') or { this is for a bug in delphi103rio } (lValueAsObj.QualifiedClassName = 'jsondataobjects.tjdojsonobject') {$ENDIF} then begin JSON.O[KeyName] := TJDOJsonObject.Create; JSON.O[KeyName].Assign(TJDOJsonObject(Value.AsObject)); end else if (lValueAsObj is TJDOJsonArray) or (lValueAsObj is TJsonArray) {$IFDEF RIOORBETTER} or { this is for a bug in delphi103rio } (lValueAsObj.QualifiedClassName = 'jsondataobjects.tjsonarray') or { this is for a bug in delphi103rio } (lValueAsObj.QualifiedClassName = 'jsondataobjects.tjdojsonarray') {$ENDIF} then begin JSON.A[KeyName] := TJDOJsonArray.Create; JSON.A[KeyName].Assign(TJDOJsonArray(Value.AsObject)); end else if lValueAsObj is TDataSet then begin lSer := TMVCJsonDataObjectsSerializer.Create; try JSON.A[KeyName] := TJDOJsonArray.Create; lSer.DataSetToJsonArray(TDataSet(lValueAsObj), JSON.A[KeyName], TMVCNameCase.ncLowerCase, []); finally lSer.Free; end; end else if TDuckTypedList.CanBeWrappedAsList(lValueAsObj, lMVCList) then begin lSer := TMVCJsonDataObjectsSerializer.Create; try JSON.A[KeyName] := TJDOJsonArray.Create; lSer.ListToJsonArray(lMVCList, JSON.A[KeyName], TMVCSerializationType.stDefault, nil); finally lSer.Free; end; end else begin lSer := TMVCJsonDataObjectsSerializer.Create; try JSON.O[KeyName] := lSer.SerializeObjectToJSON(lValueAsObj, TMVCSerializationType.stProperties, [], nil); finally lSer.Free; end; end; end; else raise EMVCException.Create('Invalid type'); end; end; function StrToJSONObject(const AValue: string; ARaiseExceptionOnError: Boolean): TJDOJsonObject; var lJSON: TJDOJsonObject; begin lJSON := nil; try lJSON := TJDOJsonObject.Parse(AValue) as TJDOJsonObject; if ARaiseExceptionOnError and (lJSON = nil) then begin raise EMVCException.Create('Invalid JSON'); end; Result := lJSON; except on E: Exception do begin lJSON.Free; raise EMVCDeserializationException.Create('Invalid JSON Object - ' + E.Message); end; end; end; function StrToJSONArray(const AValue: string; ARaiseExceptionOnError: Boolean): TJDOJsonArray; var lJSON: TJDOJsonArray; begin lJSON := nil; try lJSON := TJDOJsonObject.Parse(AValue) as TJDOJsonArray; if ARaiseExceptionOnError and (lJSON = nil) then begin raise EMVCException.Create('Invalid JSON'); end; Result := lJSON; except on E: Exception do begin lJSON.Free; raise EMVCDeserializationException.Create('Invalid JSON Array - ' + E.Message); end; end; end; procedure JsonObjectToObject(const AJsonObject: TJDOJsonObject; const AObject: TObject); begin JsonObjectToObject(AJsonObject, AObject, TMVCSerializationType.stDefault, nil) end; procedure JsonArrayToList(const AJsonArray: TJDOJsonArray; const AList: IMVCList; const AClazz: TClass; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); var lSer: TMVCJsonDataObjectsSerializer; I: Integer; lObj: TObject; begin lSer := TMVCJsonDataObjectsSerializer.Create; try for I := 0 to AJsonArray.Count - 1 do begin lObj := AClazz.Create; try lSer.JsonObjectToObject(AJsonArray[I].ObjectValue, lObj, TMVCSerializationType.stDefault, nil); except lObj.Free; raise; end; end; // lSer.JsonArrayToList(AJsonArray, AList, AClazz, AType, AIgnoredAttributes); finally lSer.Free; end; end; procedure JsonObjectToObject(const AJsonObject: TJDOJsonObject; const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); var lSer: TMVCJsonDataObjectsSerializer; begin lSer := TMVCJsonDataObjectsSerializer.Create; try lSer.JsonObjectToObject(AJsonObject, AObject, AType, AIgnoredAttributes); finally lSer.Free; end; end; procedure MVCStringDictionaryListToJSONArray(const aStringDictionaryList: TMVCStringDictionaryList; const AJsonArray: TJsonArray); var lStringDictionary: TMVCStringDictionary; begin if aStringDictionaryList = nil then Exit; for lStringDictionary in aStringDictionaryList do begin TMVCStringDictionarySerializer.Serialize(lStringDictionary, AJsonArray.AddObject); end; end; { TJDOLinks } procedure TJDOLinks.FillJSONArray(const AJsonArray: TJsonArray); begin MVCStringDictionaryListToJSONArray(LinksData, AJsonArray); end; { TJSONObjectHelper } procedure TJSONObjectHelper.LoadFromString(const Value: string; Encoding: TEncoding; Utf8WithoutBOM: Boolean); var lSS: TStringStream; begin if Assigned(Encoding) then begin lSS := TStringStream.Create(Value, Encoding); end else begin lSS := TStringStream.Create(Value); end; try lSS.Position := 0; LoadFromStream(lSS, Encoding, Utf8WithoutBOM); finally lSS.Free; end; end; end.