// *************************************************************************** // // 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) 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 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): TJDOJsonObject; function StrToJSONArray(const AValue: string): TJDOJsonArray; 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(TList), TMVCListOfStringSerializer.Create); GetTypeSerializers.Add(TypeInfo(TList), TMVCListOfIntegerSerializer.Create); GetTypeSerializers.Add(TypeInfo(TList), TMVCListOfBooleanSerializer.Create); GetTypeSerializers.Add(TypeInfo(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; begin if SameText(AName, 'RefCount') then begin Exit; end; if AValue.IsEmpty then begin AJsonObject[AName] := Null; Exit; end; if GetTypeSerializers.ContainsKey(AValue.TypeInfo) then begin GetTypeSerializers.Items[AValue.TypeInfo].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; ObjList := TDuckTypedList.Wrap(AList); if Assigned(ObjList) 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 JsonArrayToList(JsonArray, ObjList, AClazz, AType, AIgnoredAttributes); finally JsonArray.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 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; LEnumMappedValues: TList; LEnumSerType: TMVCEnumSerializationType; LClazz: TClass; LMappedValueIndex: Integer; lOutInteger: Integer; lOutInteger64: Int64; begin if GetTypeSerializers.ContainsKey(AValue.TypeInfo) 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[AValue.TypeInfo].DeserializeAttribute(AValue, AName, AJsonObject[AName].ObjectValue, ACustomAttributes); end; jdtArray: GetTypeSerializers.Items[AValue.TypeInfo].DeserializeAttribute(AValue, AName, AJsonObject[AName].ArrayValue, ACustomAttributes); else GetTypeSerializers.Items[AValue.TypeInfo].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(AValue.TypeInfo) 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(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(AJsonObject, lKeyName, lAttributeValue, AType, AIgnoredAttributes, lFld.GetAttributes); if not lAttributeValue.IsEmpty 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; begin Result := EmptyStr; if not Assigned(AList) then Exit; if AList is TJsonBaseObject then Exit(TJsonBaseObject(AList).ToJSON(True)); 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 = ncAsIs; const ASerializationAction: TMVCDatasetSerializationAction = nil): 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): TJDOJsonObject; var lJSON: TJDOJsonObject; begin lJSON := nil; try lJSON := TJDOJsonObject.Parse(AValue) as TJDOJsonObject; Result := lJSON; except on E: Exception do begin lJSON.Free; raise EMVCDeserializationException.Create('Invalid JSON Object'); end; end; end; function StrToJSONArray(const AValue: string): TJDOJsonArray; var lJSON: TJDOJsonArray; begin lJSON := nil; try lJSON := TJDOJsonObject.Parse(AValue) as TJDOJsonArray; Result := lJSON; except on E: Exception do begin lJSON.Free; raise EMVCDeserializationException.Create('Invalid JSON Array'); 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.