delphimvcframework/sources/MVCFramework.Serializer.JSON.pas

1012 lines
33 KiB
ObjectPascal
Raw Normal View History

2017-02-09 19:33:59 +01:00
// ***************************************************************************
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2017 Daniele Teti and the DMVCFramework Team
//
// https://github.com/danieleteti/delphimvcframework
//
// Collaborators with this file: Ezequiel Juliano M<>ller (ezequieljuliano@gmail.com)
//
2017-02-09 19:33:59 +01:00
// ***************************************************************************
//
// 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.
//
// ***************************************************************************
2017-02-09 19:33:59 +01:00
2017-02-07 14:08:36 +01:00
unit MVCFramework.Serializer.JSON;
{$I dmvcframework.inc}
2017-02-07 14:08:36 +01:00
interface
uses
System.JSON,
System.SysUtils,
System.Classes,
System.Rtti,
System.TypInfo,
System.Variants,
System.Generics.Collections,
System.StrUtils,
2017-03-29 14:49:35 +02:00
Data.SqlTimSt,
Data.FmtBcd,
Data.DB,
MVCFramework.Serializer.Intf,
MVCFramework.Serializer.Abstract,
MVCFramework.Serializer.Commons,
MVCFramework.DuckTyping;
2017-02-07 14:08:36 +01:00
type
2017-03-02 12:57:40 +01:00
TMVCJSONSerializer = class(TMVCAbstractSerializer, IMVCSerializer)
public
procedure ObjectToJSONObject(
const AObject: TObject;
const AJSONObject: TJSONObject;
const AType: TMVCSerializationType;
2017-03-29 14:49:35 +02:00
const AIgnoredAttributes: TMVCIgnoredList
);
procedure AttributeToJSONDataValue(
const AJSONObject: TJSONObject;
const AName: string;
const AValue: TValue;
const AType: TMVCSerializationType;
2017-03-29 14:49:35 +02:00
const AIgnored: TMVCIgnoredList;
const ACustomAttributes: TArray<TCustomAttribute>
);
procedure JSONObjectToObject(
const AJSONObject: TJSONObject;
const AObject: TObject;
const AType: TMVCSerializationType;
2017-03-29 14:49:35 +02:00
const AIgnoredAttributes: TMVCIgnoredList
);
procedure JSONDataValueToAttribute(
const AJSONObject: TJSONObject;
const AName: string;
var AValue: TValue;
const AType: TMVCSerializationType;
2017-03-29 14:49:35 +02:00
const AIgnored: TMVCIgnoredList;
const ACustomAttributes: TArray<TCustomAttribute>
);
procedure JSONArrayToList(
const AJSONArray: TJSONArray;
const AList: IMVCList;
const AClazz: TClass;
const AType: TMVCSerializationType;
2017-03-29 14:49:35 +02:00
const AIgnoredAttributes: TMVCIgnoredList
);
procedure DataSetToJSONObject(
const ADataSet: TDataSet;
const AJSONObject: TJSONObject;
const ANameCase: TMVCNameCase;
const AIgnoredFields: TMVCIgnoredList
);
procedure JSONObjectToDataSet(
const AJSONObject: TJSONObject;
const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList;
const ANameCase: TMVCNameCase
);
procedure JSONArrayToDataSet(
const AJSONArray: TJSONArray;
const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList;
const ANameCase: TMVCNameCase
);
{ IMVCSerializer }
function SerializeObject(
const AObject: TObject;
const AType: TMVCSerializationType = stDefault;
const AIgnoredAttributes: TMVCIgnoredList = [];
const ASerializationAction: TMVCSerializationAction = nil
): string;
function SerializeCollection(
const AList: TObject;
const AType: TMVCSerializationType = stDefault;
const AIgnoredAttributes: TMVCIgnoredList = []
): string;
function SerializeDataSet(
const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList = [];
const ANameCase: TMVCNameCase = ncAsIs
): string;
function SerializeDataSetRecord(
const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList = [];
const ANameCase: TMVCNameCase = ncAsIs
): string;
procedure DeserializeObject(
const ASerializedObject: string;
const AObject: TObject;
const AType: TMVCSerializationType = stDefault;
const AIgnoredAttributes: TMVCIgnoredList = []
);
procedure DeserializeCollection(
const ASerializedList: string;
const AList: TObject;
const AClazz: TClass;
const AType: TMVCSerializationType = stDefault;
const AIgnoredAttributes: TMVCIgnoredList = []
);
procedure DeserializeDataSet(
const ASerializedDataSet: string;
const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList = [];
const ANameCase: TMVCNameCase = ncAsIs
);
procedure DeserializeDataSetRecord(
const ASerializedDataSetRecord: string;
const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList = [];
const ANameCase: TMVCNameCase = ncAsIs
);
2017-03-02 12:57:40 +01:00
procedure AfterConstruction; override;
end;
2017-02-07 14:08:36 +01:00
implementation
uses
MVCFramework.Serializer.JSON.CustomTypes;
2017-02-07 14:08:36 +01:00
{ TMVCJSONSerializer }
2017-03-02 12:57:40 +01:00
procedure TMVCJSONSerializer.AfterConstruction;
begin
inherited AfterConstruction;
GetTypeSerializers.Add(System.TypeInfo(TStream), TStreamSerializerJSON.Create);
GetTypeSerializers.Add(System.TypeInfo(TStringStream), TStreamSerializerJSON.Create);
GetTypeSerializers.Add(System.TypeInfo(TMemoryStream), TStreamSerializerJSON.Create);
end;
procedure TMVCJSONSerializer.AttributeToJSONDataValue(
const AJSONObject: TJSONObject; const AName: string;
const AValue: TValue; const AType: TMVCSerializationType;
2017-03-29 14:49:35 +02:00
const AIgnored: TMVCIgnoredList;
const ACustomAttributes: TArray<TCustomAttribute>);
2017-02-09 11:24:18 +01:00
var
ChildJSONObject: TJSONObject;
ChildJSONArray: TJSONArray;
ChildValue: TValue;
ChildObject, Obj: TObject;
ChildList: IMVCList;
ChildJSONValue: TJSONValue;
ValueTypeAtt: MVCValueAsTypeAttribute;
CastValue, CastedValue: TValue;
2017-02-09 11:24:18 +01:00
begin
if AValue.IsEmpty then
2017-02-09 11:24:18 +01:00
begin
AJSONObject.AddPair(AName, TJSONNull.Create);
Exit;
end;
2017-03-02 12:57:40 +01:00
if GetTypeSerializers.ContainsKey(AValue.TypeInfo) then
2017-02-09 11:24:18 +01:00
begin
ChildJSONValue := nil;
2017-03-02 12:57:40 +01:00
GetTypeSerializers.Items[AValue.TypeInfo].Serialize(AValue, TObject(ChildJSONValue), ACustomAttributes);
if Assigned(ChildJSONValue) then
begin
if ChildJSONValue is TJSONValue then
AJSONObject.AddPair(AName, ChildJSONValue)
else
raise EMVCSerializationException.CreateFmt('Can not serialize %s the serializer does not have a valid TJSONValue type.', [AName]);
end;
Exit;
2017-02-09 11:24:18 +01:00
end;
case AValue.Kind of
2017-02-09 11:24:18 +01:00
tkInteger:
AJSONObject.AddPair(AName, TJSONNumber.Create(AValue.AsInteger));
tkInt64:
AJSONObject.AddPair(AName, TJSONNumber.Create(AValue.AsInt64));
tkChar, tkString, tkWChar, tkLString, tkWString, tkUString:
AJSONObject.AddPair(AName, TJSONString.Create(AValue.AsString));
tkFloat:
2017-02-09 11:24:18 +01:00
begin
if (AValue.TypeInfo = System.TypeInfo(TDate)) then
begin
if (AValue.AsExtended = 0) then
AJSONObject.AddPair(AName, TJSONNull.Create)
else
AJSONObject.AddPair(AName, TJSONString.Create(DateToISODate(AValue.AsExtended)));
end
else if (AValue.TypeInfo = System.TypeInfo(TDateTime)) then
begin
if (AValue.AsExtended = 0) then
AJSONObject.AddPair(AName, TJSONNull.Create)
else
AJSONObject.AddPair(AName, TJSONString.Create(DateTimeToISOTimeStamp(AValue.AsExtended)));
end
else if (AValue.TypeInfo = System.TypeInfo(TTime)) then
begin
if (AValue.AsExtended = 0) then
AJSONObject.AddPair(AName, TJSONNull.Create)
else
AJSONObject.AddPair(AName, TJSONString.Create(TimeToISOTime(AValue.AsExtended)));
end
else
AJSONObject.AddPair(AName, TJSONNumber.Create(AValue.AsExtended));
2017-02-09 11:24:18 +01:00
end;
tkVariant:
AJSONObject.AddPair(AName, AValue.AsVariant);
2017-02-09 11:24:18 +01:00
tkEnumeration:
begin
if (AValue.TypeInfo = System.TypeInfo(Boolean)) then
begin
if AValue.AsBoolean then
AJSONObject.AddPair(AName, {$IFDEF JSONBOOL}TJSONBool.Create(True){$ELSE}TJSONTrue.Create{$ENDIF})
else
AJSONObject.AddPair(AName, {$IFDEF JSONBOOL}TJSONBool.Create(False){$ELSE}TJSONFalse.Create{$ENDIF});
end
else
begin
AJSONObject.AddPair(AName, GetEnumName(AValue.TypeInfo, AValue.AsOrdinal));
end;
2017-02-09 11:24:18 +01:00
end;
tkClass:
2017-02-09 11:24:18 +01:00
begin
ChildObject := AValue.AsObject;
if Assigned(ChildObject) then
begin
ChildList := TDuckTypedList.Wrap(ChildObject);
if Assigned(ChildList) then
begin
ChildJSONArray := TJSONArray.Create;
for Obj in ChildList do
if Assigned(Obj) then
begin
ChildJSONObject := TJSONObject.Create;
ObjectToJSONObject(Obj, ChildJSONObject, GetSerializationType(Obj, AType), AIgnored);
ChildJSONArray.AddElement(ChildJSONObject);
end;
AJSONObject.AddPair(AName, ChildJSONArray);
end
else
begin
ChildJSONObject := TJSONObject.Create;
ObjectToJSONObject(ChildObject, ChildJSONObject, GetSerializationType(ChildObject, AType), AIgnored);
AJSONObject.AddPair(AName, ChildJSONObject);
end;
end
else
begin
if TMVCSerializerHelpful.AttributeExists<MVCSerializeAsStringAttribute>(ACustomAttributes) then
AJSONObject.AddPair(AName, TJSONString.Create(EmptyStr))
else
AJSONObject.AddPair(AName, TJSONNull.Create);
end;
2017-02-09 11:24:18 +01:00
end;
tkRecord:
2017-02-09 11:24:18 +01:00
begin
if (AValue.TypeInfo = System.TypeInfo(TTimeStamp)) then
begin
AJSONObject.AddPair(AName, TJSONNumber.Create(TimeStampToMsecs(AValue.AsType<TTimeStamp>)));
end
else if (AValue.TypeInfo = System.TypeInfo(TValue)) then
begin
if TMVCSerializerHelpful.AttributeExists<MVCValueAsTypeAttribute>(ACustomAttributes, ValueTypeAtt) then
begin
CastValue := AValue.AsType<TValue>;
if CastValue.TryCast(ValueTypeAtt.ValueTypeInfo, CastedValue) then
AttributeToJSONDataValue(AJSONObject, AName, CastedValue, stDefault, [], [])
else
raise EMVCSerializationException.CreateFmt('Can not serialize %s of TypeKind tkRecord (TValue with MVCValueAsTypeAttribute).', [AName]);
end
else
begin
ChildValue := AValue.AsType<TValue>;
ChildJSONObject := TJSONObject.Create;
ChildJSONObject.AddPair('type', TMVCSerializerHelpful.GetTypeKindAsString(ChildValue.TypeInfo.Kind));
AttributeToJSONDataValue(ChildJSONObject, 'value', ChildValue, stDefault, [], []);
AJSONObject.AddPair(AName, ChildJSONObject);
end;
end
else
raise EMVCSerializationException.CreateFmt('Can not serialize %s of TypeKind tkRecord.', [AName]);
2017-02-09 11:24:18 +01:00
end;
tkSet:
raise EMVCSerializationException.CreateFmt('Can not serialize %s of TypeKind tkSet.', [AName]);
tkArray:
raise EMVCSerializationException.CreateFmt('Can not serialize %s of TypeKind tkArray.', [AName]);
tkUnknown:
raise EMVCSerializationException.CreateFmt('Can not serialize %s of TypeKind tkUnknown.', [AName]);
2017-02-09 11:24:18 +01:00
end;
end;
2017-03-29 14:49:35 +02:00
procedure TMVCJSONSerializer.DataSetToJSONObject(
const ADataSet: TDataSet; const AJSONObject: TJSONObject;
const ANameCase: TMVCNameCase; const AIgnoredFields: TMVCIgnoredList);
var
I: Integer;
FieldName: string;
MS: TMemoryStream;
SS: TStringStream;
NestedDataSet: TDataSet;
ChildJSONArray: TJSONArray;
ChildJSONObject: TJSONObject;
begin
for I := 0 to ADataSet.FieldCount - 1 do
begin
FieldName := GetNameAs(ADataSet.Owner, ADataSet.Fields[I].Name, ADataSet.Fields[I].FieldName);
if (not IsIgnoredAttribute(AIgnoredFields, FieldName)) and (not IsIgnoredComponent(ADataSet.Owner, ADataSet.Fields[I].Name)) then
begin
case ANameCase of
ncUpperCase: FieldName := UpperCase(FieldName);
ncLowerCase: FieldName := LowerCase(FieldName);
2017-03-29 14:49:35 +02:00
end;
if ADataSet.Fields[I].IsNull then
AJSONObject.AddPair(FieldName, TJSONNull.Create)
else
begin
case ADataSet.Fields[I].DataType of
ftBoolean:
begin
{$IFDEF JSONBOOL}
AJSONObject.AddPair(FieldName, TJSONBool.Create(ADataSet.Fields[I].AsBoolean));
{$ELSE}
if ADataSet.Fields[I].AsBoolean then
AJSONObject.AddPair(FieldName, TJSONTrue.Create)
else
AJSONObject.AddPair(FieldName, TJSONFalse.Create);
{$ENDIF}
end;
2017-03-29 14:49:35 +02:00
ftInteger, ftSmallint, ftShortint:
AJSONObject.AddPair(FieldName, TJSONNumber.Create(ADataSet.Fields[I].AsInteger));
ftLargeint, ftAutoInc:
2017-03-29 14:49:35 +02:00
AJSONObject.AddPair(FieldName, TJSONNumber.Create(ADataSet.Fields[I].AsLargeInt));
ftSingle, ftFloat:
AJSONObject.AddPair(FieldName, TJSONNumber.Create(ADataSet.Fields[I].AsFloat));
ftString, ftWideString, ftMemo, ftWideMemo:
AJSONObject.AddPair(FieldName, TJSONString.Create(ADataSet.Fields[I].AsWideString));
ftDate:
AJSONObject.AddPair(FieldName, TJSONString.Create(DateToISODate(ADataSet.Fields[I].AsDateTime)));
ftDateTime:
AJSONObject.AddPair(FieldName, TJSONString.Create(DateTimeToISOTimeStamp(ADataSet.Fields[I].AsDateTime)));
ftTime, ftTimeStamp:
AJSONObject.AddPair(FieldName, TJSONString.Create(SQLTimeStampToStr('hh:nn:ss', ADataSet.Fields[I].AsSQLTimeStamp)));
ftCurrency:
AJSONObject.AddPair(FieldName, TJSONNumber.Create(ADataSet.Fields[I].AsCurrency));
2017-03-29 14:49:35 +02:00
ftFMTBcd, ftBCD:
AJSONObject.AddPair(FieldName, TJSONNumber.Create(BcdToDouble(ADataSet.Fields[I].AsBcd)));
ftGraphic, ftBlob, ftStream:
begin
MS := TMemoryStream.Create;
try
TBlobField(ADataSet.Fields[I]).SaveToStream(MS);
MS.Position := 0;
SS := TStringStream.Create;
try
TMVCSerializerHelpful.EncodeStream(MS, SS);
AJSONObject.AddPair(FieldName, TJSONString.Create(SS.DataString));
finally
SS.Free;
end;
finally
MS.Free;
end;
end;
ftDataSet:
begin
NestedDataSet := TDataSetField(ADataSet.Fields[I]).NestedDataSet;
case GetDataType(ADataSet.Owner, ADataSet.Fields[I].Name, dtArray) of
dtArray:
begin
ChildJSONArray := TJSONArray.Create;
NestedDataSet.First;
while not NestedDataSet.Eof do
begin
ChildJSONObject := TJSONObject.Create;
DataSetToJSONObject(NestedDataSet, ChildJSONObject, GetNameCase(NestedDataSet, ANameCase), AIgnoredFields);
ChildJSONArray.AddElement(ChildJSONObject);
NestedDataSet.Next;
end;
AJSONObject.AddPair(FieldName, ChildJSONArray);
end;
dtObject:
begin
ChildJSONObject := TJSONObject.Create;
DataSetToJSONObject(NestedDataSet, ChildJSONObject, GetNameCase(NestedDataSet, ANameCase), AIgnoredFields);
AJSONObject.AddPair(FieldName, ChildJSONObject);
end;
end;
end;
else
raise EMVCSerializationException.CreateFmt('Cannot find type for field "%s"', [FieldName]);
end;
end;
end;
end;
end;
procedure TMVCJSONSerializer.DeserializeCollection(
const ASerializedList: string; const AList: TObject;
const AClazz: TClass; const AType: TMVCSerializationType;
const AIgnoredAttributes: TMVCIgnoredList);
var
JSONArray: TJSONArray;
ObjList: IMVCList;
begin
if (ASerializedList = EmptyStr) then
Exit;
if not Assigned(AList) then
Exit;
ObjList := TDuckTypedList.Wrap(AList);
if Assigned(ObjList) then
begin
JSONArray := TJSONObject.ParseJSONValue(ASerializedList) as TJSONArray;
try
JSONArrayToList(JSONArray, ObjList, AClazz, AType, AIgnoredAttributes);
finally
JSONArray.Free;
end;
end;
end;
procedure TMVCJSONSerializer.DeserializeDataSet(
const ASerializedDataSet: string;
const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList;
const ANameCase: TMVCNameCase);
var
JSONArray: TJSONArray;
2017-02-07 14:08:36 +01:00
begin
if (ASerializedDataSet = EmptyStr) or (not Assigned(ADataSet)) then
Exit;
JSONArray := TJSONObject.ParseJSONValue(ASerializedDataSet) as TJSONArray;
try
JSONArrayToDataSet(JSONArray, ADataSet, AIgnoredFields, ANameCase);
finally
JSONArray.Free;
end;
end;
2017-02-07 14:08:36 +01:00
procedure TMVCJSONSerializer.DeserializeDataSetRecord(
const ASerializedDataSetRecord: string;
const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList;
const ANameCase: TMVCNameCase);
var
JSONObject: TJSONObject;
begin
if (ASerializedDataSetRecord = EmptyStr) or (not Assigned(ADataSet)) then
Exit;
JSONObject := TJSONObject.ParseJSONValue(ASerializedDataSetRecord) as TJSONObject;
try
ADataSet.Edit;
JSONObjectToDataSet(JSONObject, ADataSet, AIgnoredFields, ANameCase);
ADataSet.Post;
finally
JSONObject.Free;
end;
end;
procedure TMVCJSONSerializer.DeserializeObject(
const ASerializedObject: string; const AObject: TObject;
const AType: TMVCSerializationType;
const AIgnoredAttributes: TMVCIgnoredList);
var
JSONObject: TJSONObject;
ObjType: TRttiType;
ObjValue: TValue;
begin
if (ASerializedObject = EmptyStr) then
Exit;
if not Assigned(AObject) then
Exit;
JSONObject := TJSONObject.ParseJSONValue(ASerializedObject) as TJSONObject;
try
2017-03-02 12:57:40 +01:00
ObjType := GetRttiContext.GetType(AObject.ClassType);
if GetTypeSerializers.ContainsKey(ObjType.Handle) then
begin
ObjValue := TValue.From<TObject>(AObject);
2017-03-02 12:57:40 +01:00
GetTypeSerializers.Items[ObjType.Handle].Deserialize(JSONObject, ObjValue, []);
Exit;
end;
JSONObjectToObject(JSONObject, AObject, GetSerializationType(AObject, AType), AIgnoredAttributes);
finally
JSONObject.Free;
end;
end;
procedure TMVCJSONSerializer.JSONArrayToDataSet(
const AJSONArray: TJSONArray; 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] as TJSONObject, ADataSet, AIgnoredFields, ANameCase);
ADataSet.Post;
end;
end;
procedure TMVCJSONSerializer.JSONArrayToList(const AJSONArray: TJSONArray;
const AList: IMVCList; const AClazz: TClass;
const AType: TMVCSerializationType;
2017-03-29 14:49:35 +02:00
const AIgnoredAttributes: TMVCIgnoredList);
2017-02-10 14:19:55 +01:00
var
I: Integer;
Obj: TObject;
2017-02-10 14:19:55 +01:00
begin
for I := 0 to Pred(AJSONArray.Count) do
2017-02-10 14:19:55 +01:00
begin
Obj := TMVCSerializerHelpful.CreateObject(AClazz.QualifiedClassName);
JSONObjectToObject(AJSONArray.Items[I] as TJSONObject, Obj, GetSerializationType(Obj, AType), AIgnoredAttributes);
AList.Add(Obj);
end;
end;
procedure TMVCJSONSerializer.JSONDataValueToAttribute(
const AJSONObject: TJSONObject; const AName: string; var AValue: TValue;
2017-03-29 14:49:35 +02:00
const AType: TMVCSerializationType; const AIgnored: TMVCIgnoredList;
const ACustomAttributes: TArray<TCustomAttribute>);
var
ChildObject: TObject;
ChildList: IMVCList;
ChildListOfAtt: MVCListOfAttribute;
begin
if not Assigned(AJSONObject.Values[AName]) then
Exit;
2017-03-02 12:57:40 +01:00
if GetTypeSerializers.ContainsKey(AValue.TypeInfo) then
begin
2017-03-02 12:57:40 +01:00
GetTypeSerializers.Items[AValue.TypeInfo].Deserialize(AJSONObject.Values[AName], AValue, ACustomAttributes);
Exit;
end;
case AnsiIndexStr(AJSONObject.Values[AName].ClassName, ['TJSONString', 'TJSONNumber', 'TJSONBool', 'TJSONTrue', 'TJSONFalse', 'TJSONObject', 'TJSONArray']) of
0 { TJSONString } :
2017-02-09 19:33:59 +01:00
begin
if (AValue.TypeInfo = System.TypeInfo(TDate)) then
AValue := TValue.From<TDate>(ISODateToDate(AJSONObject.Values[AName].Value))
else if (AValue.TypeInfo = System.TypeInfo(TDateTime)) then
AValue := TValue.From<TDateTime>(ISOTimeStampToDateTime(AJSONObject.Values[AName].Value))
else if (AValue.TypeInfo = System.TypeInfo(TTime)) then
AValue := TValue.From<TTime>(ISOTimeToTime(AJSONObject.Values[AName].Value))
else if (AValue.Kind = tkEnumeration) then
TValue.Make(GetEnumValue(AValue.TypeInfo, AJsonObject.Values[AName].Value), AValue.TypeInfo, AValue)
else
AValue := TValue.From<string>(AJSONObject.Values[AName].Value);
2017-02-09 19:33:59 +01:00
end;
1 { TJSONNumber } :
begin
if (AValue.Kind = tkEnumeration) then
TValue.Make(TJSONNumber(AJSONObject.Values[AName]).AsInt64, AValue.TypeInfo, AValue)
else if (AValue.TypeInfo = System.TypeInfo(TTimeStamp)) then
AValue := TValue.From<TTimeStamp>(MSecsToTimeStamp(TJSONNumber(AJSONObject.Values[AName]).AsInt64))
else if (AValue.Kind = tkFloat) then
AValue := TValue.From<Double>(TJSONNumber(AJSONObject.Values[AName]).AsDouble)
else
AValue := TValue.From<Int64>(TJSONNumber(AJSONObject.Values[AName]).AsInt64);
end;
2 { TJSONBool } , 3 { TJSONTrue } , 4 { TJSONFalse } :
begin
{$IFDEF JSONBOOL}
AValue := TValue.From<Boolean>(TJSONBool(AJSONObject.Values[AName]).AsBoolean);
{$ELSE}
AValue := TValue.From<Boolean>(AJSONObject.Values[AName] is TJSONTrue);
{$ENDIF}
end;
5 { TJSONObject } :
begin
if (AValue.TypeInfo = System.TypeInfo(TValue)) then
AValue := TValue.FromVariant(TJSONObject(AJSONObject.Values[AName]).Values['value'].Value)
else
begin
ChildObject := AValue.AsObject;
if Assigned(ChildObject) then
JSONObjectToObject(AJSONObject.Values[AName] as TJSONObject, ChildObject, GetSerializationType(ChildObject, AType), AIgnored);
end;
2017-02-09 11:24:18 +01:00
end;
6 { TJSONArray } :
2017-02-09 11:24:18 +01:00
begin
ChildObject := AValue.AsObject;
if Assigned(ChildObject) then
begin
ChildList := TDuckTypedList.Wrap(ChildObject);
if TMVCSerializerHelpful.AttributeExists<MVCListOfAttribute>(ACustomAttributes, ChildListOfAtt) then
JSONArrayToList(AJSONObject.Values[AName] as TJSONArray, ChildList, ChildListOfAtt.Value, AType, AIgnored)
else
raise EMVCDeserializationException.CreateFmt('You can not deserialize a list %s without the attribute MVCListClassTypeAttribute.', [AName]);
end;
2017-02-09 11:24:18 +01:00
end;
-1: Exit;
2017-02-09 11:24:18 +01:00
end;
end;
procedure TMVCJSONSerializer.JSONObjectToDataSet(
const AJSONObject: TJSONObject; const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList; const ANameCase: TMVCNameCase);
var
Field: TField;
Name: string;
Jv: TJSONValue;
SS: TStringStream;
SM: TMemoryStream;
NestedDataSet: TDataSet;
begin
if (ADataSet.State in [dsInsert, dsEdit]) then
begin
for Field in ADataSet.Fields do
begin
name := GetNameAs(ADataSet.Owner, Field.Name, Field.FieldName);
if (IsIgnoredAttribute(AIgnoredFields, name)) or (IsIgnoredComponent(ADataSet.Owner, Field.Name)) then
Continue;
case GetNameCase(ADataSet, ANameCase) of
ncLowerCase: name := LowerCase(Field.FieldName);
ncUpperCase: name := UpperCase(Field.FieldName);
end;
Jv := AJSONObject.Get(name).JsonValue;
if not Assigned(Jv) then
Continue;
if Jv is TJSONNull then
begin
Field.Clear;
Continue;
end;
case field.DataType of
TFieldType.ftBoolean:
begin
{$IFDEF JSONBOOL}
Field.AsBoolean := (Jv as TJSONBool).AsBoolean;
{$ELSE}
if Jv is TJSONTrue then
Field.AsBoolean := true
else if Jv is TJSONFalse then
Field.AsBoolean := false
else
raise EMVCDeserializationException.Create('Invalid boolean value');
{$ENDIF}
end;
TFieldType.ftInteger, TFieldType.ftSmallint, TFieldType.ftShortint:
Field.AsInteger := (Jv as TJSONNumber).AsInt;
TFieldType.ftLargeint:
Field.AsLargeInt := (Jv as TJSONNumber).AsInt64;
TFieldType.ftCurrency:
Field.AsCurrency := (Jv as TJSONNumber).AsDouble;
TFieldType.ftSingle:
Field.AsSingle := (Jv as TJSONNumber).AsDouble;
TFieldType.ftFloat, TFieldType.ftFMTBcd, TFieldType.ftBCD:
Field.AsFloat := (Jv as TJSONNumber).AsDouble;
ftString, ftWideString, ftMemo, ftWideMemo:
Field.AsWideString := (Jv as TJSONString).Value;
TFieldType.ftDate:
Field.AsDateTime := ISODateToDate((Jv as TJSONString).Value);
TFieldType.ftDateTime:
Field.AsDateTime := ISOTimeStampToDateTime((Jv as TJSONString).Value);
TFieldType.ftTimeStamp, TFieldType.ftTime:
Field.AsDateTime := ISOTimeToTime((Jv as TJSONString).Value);
TFieldType.ftGraphic, TFieldType.ftBlob, TFieldType.ftStream:
begin
SS := TStringStream.Create((Jv as TJSONString).Value);
try
SS.Position := 0;
SM := TMemoryStream.Create;
try
TMVCSerializerHelpful.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(Jv as TJSONArray, NestedDataSet, AIgnoredFields, ANameCase);
end;
dtObject:
begin
NestedDataSet.Edit;
JsonObjectToDataSet(Jv as TJSONObject, 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 TMVCJSONSerializer.JSONObjectToObject(
const AJSONObject: TJSONObject; const AObject: TObject;
const AType: TMVCSerializationType;
2017-03-29 14:49:35 +02:00
const AIgnoredAttributes: TMVCIgnoredList);
2017-02-09 11:24:18 +01:00
var
ObjType: TRttiType;
Prop: TRttiProperty;
Fld: TRttiField;
AttributeValue: TValue;
begin
2017-03-02 12:57:40 +01:00
ObjType := GetRttiContext.GetType(AObject.ClassType);
case AType of
stDefault, stProperties:
2017-02-09 11:24:18 +01:00
begin
for Prop in ObjType.GetProperties do
if (Prop.IsWritable or Prop.GetValue(AObject).IsObject) and (not TMVCSerializerHelpful.HasAttribute<MVCDoNotSerializeAttribute>(Prop)) and (not IsIgnoredAttribute(AIgnoredAttributes, Prop.Name)) then
begin
AttributeValue := Prop.GetValue(AObject);
JSONDataValueToAttribute(AJsonObject, TMVCSerializerHelpful.GetKeyName(Prop, ObjType), AttributeValue, AType, AIgnoredAttributes, Prop.GetAttributes);
if (not AttributeValue.IsEmpty) and Prop.IsWritable then
Prop.SetValue(AObject, AttributeValue);
end;
end;
stFields:
2017-02-09 11:24:18 +01:00
begin
for Fld in ObjType.GetFields do
if (not TMVCSerializerHelpful.HasAttribute<MVCDoNotSerializeAttribute>(Fld)) and (not IsIgnoredAttribute(AIgnoredAttributes, Fld.Name)) then
begin
AttributeValue := Fld.GetValue(AObject);
JSONDataValueToAttribute(AJsonObject, TMVCSerializerHelpful.GetKeyName(Fld, ObjType), AttributeValue, AType, AIgnoredAttributes, Fld.GetAttributes);
if not AttributeValue.IsEmpty then
Fld.SetValue(AObject, AttributeValue);
end;
2017-02-09 11:24:18 +01:00
end;
end;
end;
procedure TMVCJSONSerializer.ObjectToJSONObject(const AObject: TObject;
const AJSONObject: TJSONObject; const AType: TMVCSerializationType;
2017-03-29 14:49:35 +02:00
const AIgnoredAttributes: TMVCIgnoredList);
var
ObjType: TRttiType;
Prop: TRttiProperty;
Fld: TRttiField;
begin
2017-03-02 12:57:40 +01:00
ObjType := GetRttiContext.GetType(AObject.ClassType);
case AType of
stDefault, stProperties:
begin
for Prop in ObjType.GetProperties do
if (not TMVCSerializerHelpful.HasAttribute<MVCDoNotSerializeAttribute>(Prop)) and (not IsIgnoredAttribute(AIgnoredAttributes, Prop.Name)) then
AttributeToJSONDataValue(AJsonObject, TMVCSerializerHelpful.GetKeyName(Prop, ObjType), Prop.GetValue(AObject), AType, AIgnoredAttributes, Prop.GetAttributes);
end;
stFields:
begin
for Fld in ObjType.GetFields do
if (not TMVCSerializerHelpful.HasAttribute<MVCDoNotSerializeAttribute>(Fld)) and (not IsIgnoredAttribute(AIgnoredAttributes, Fld.Name)) then
AttributeToJSONDataValue(AJsonObject, TMVCSerializerHelpful.GetKeyName(Fld, ObjType), Fld.GetValue(AObject), AType, AIgnoredAttributes, Fld.GetAttributes);
end;
2017-02-07 14:08:36 +01:00
end;
end;
function TMVCJSONSerializer.SerializeCollection(
const AList: TObject;
const AType: TMVCSerializationType;
const AIgnoredAttributes: TMVCIgnoredList): string;
var
JSONArray: TJSONArray;
JSONObject: TJSONObject;
ObjList: IMVCList;
Obj: TObject;
begin
Result := EmptyStr;
if not Assigned(AList) then
Exit;
if AList is TJSONValue then
Exit(TJSONValue(AList).ToJSON);
2017-02-09 19:33:59 +01:00
ObjList := TDuckTypedList.Wrap(AList);
if Assigned(ObjList) then
2017-02-09 19:33:59 +01:00
begin
JSONArray := TJSONArray.Create;
try
for Obj in ObjList do
if Assigned(Obj) then
begin
JSONObject := TJSONObject.Create;
ObjectToJsonObject(Obj, JSONObject, GetSerializationType(Obj, AType), AIgnoredAttributes);
JSONArray.AddElement(JSONObject);
end;
Result := JSONArray.ToJSON;
finally
JSONArray.Free;
end;
2017-02-09 19:33:59 +01:00
end;
end;
function TMVCJSONSerializer.SerializeDataSet(
const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList;
const ANameCase: TMVCNameCase): string;
2017-03-29 14:49:35 +02:00
var
JSONArray: TJSONArray;
JSONObject: TJSONObject;
BookMark: TBookmark;
2017-02-10 14:19:55 +01:00
begin
2017-03-29 14:49:35 +02:00
Result := EmptyStr;
if (not Assigned(ADataSet)) or (ADataSet.IsEmpty) then
Exit;
JSONArray := TJSONArray.Create;
try
BookMark := ADataSet.Bookmark;
2017-03-29 14:49:35 +02:00
ADataSet.First;
while not ADataSet.Eof do
begin
JSONObject := TJSONObject.Create;
DataSetToJSONObject(ADataSet, JSONObject, GetNameCase(ADataSet, ANameCase), AIgnoredFields);
JSONArray.AddElement(JSONObject);
ADataSet.Next;
end;
Result := JSONArray.ToJSON;
finally
JSONArray.Free;
if ADataSet.BookmarkValid(BookMark) then
ADataSet.GotoBookmark(BookMark);
ADataSet.FreeBookmark(BookMark);
2017-03-29 14:49:35 +02:00
end;
2017-02-10 14:19:55 +01:00
end;
function TMVCJSONSerializer.SerializeDataSetRecord(
const ADataSet: TDataSet;
const AIgnoredFields: TMVCIgnoredList;
const ANameCase: TMVCNameCase): string;
2017-03-29 14:49:35 +02:00
var
JSONObject: TJSONObject;
begin
2017-03-29 14:49:35 +02:00
Result := EmptyStr;
if (not Assigned(ADataSet)) or (ADataSet.IsEmpty) then
Exit;
JSONObject := TJSONObject.Create;
try
DataSetToJSONObject(ADataSet, JSONObject, GetNameCase(ADataSet, ANameCase), AIgnoredFields);
Result := JSONObject.ToJSON;
finally
JSONObject.Free;
end;
end;
function TMVCJSONSerializer.SerializeObject(
const AObject: TObject;
const AType: TMVCSerializationType;
const AIgnoredAttributes: TMVCIgnoredList;
const ASerializationAction: TMVCSerializationAction
): string;
2017-02-07 14:08:36 +01:00
var
JSONObject: TJSONObject;
ChildJSONValue: TJSONValue;
ObjType: TRttiType;
begin
Result := EmptyStr;
2017-02-07 14:08:36 +01:00
if AObject = nil then
Exit('null');
if AObject is TJSONValue then
Exit(TJSONValue(AObject).ToJSON);
2017-03-02 12:57:40 +01:00
ObjType := GetRttiContext.GetType(AObject.ClassType);
if GetTypeSerializers.ContainsKey(ObjType.Handle) then
begin
ChildJSONValue := nil;
2017-03-02 12:57:40 +01:00
GetTypeSerializers.Items[ObjType.Handle].Serialize(AObject, TObject(ChildJSONValue), []);
if Assigned(ChildJSONValue) then
begin
try
if ChildJSONValue is TJSONValue then
Result := ChildJSONValue.ToJSON
else
raise EMVCSerializationException.Create('Can not serialize the serializer does not have a valid TJSONValue type.');
finally
ChildJSONValue.Free;
end;
end;
Exit;
end;
JSONObject := TJSONObject.Create;
try
ObjectToJSONObject(AObject, JSONObject, GetSerializationType(AObject, AType), AIgnoredAttributes);
Result := JSONObject.ToJSON;
finally
JSONObject.Free;
end;
end;
2017-02-08 11:42:05 +01:00
2017-02-07 14:08:36 +01:00
end.