mirror of
https://github.com/danieleteti/delphimvcframework.git
synced 2024-11-16 00:05:53 +01:00
fc72c8c49b
All protected serializers methods are now public so that is possible to use the low level serialization as was possibile with the old ObjectsMappers.
971 lines
32 KiB
ObjectPascal
971 lines
32 KiB
ObjectPascal
// ***************************************************************************
|
|
//
|
|
// 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)
|
|
//
|
|
// ***************************************************************************
|
|
//
|
|
// Licensed under the Apache License, Version 2.0 (the "License");
|
|
// you may not use this file except in compliance with the License.
|
|
// You may obtain a copy of the License at
|
|
//
|
|
// http://www.apache.org/licenses/LICENSE-2.0
|
|
//
|
|
// Unless required by applicable law or agreed to in writing, software
|
|
// distributed under the License is distributed on an "AS IS" BASIS,
|
|
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
// See the License for the specific language governing permissions and
|
|
// limitations under the License.
|
|
//
|
|
// ***************************************************************************
|
|
|
|
unit MVCFramework.Serializer.JSON;
|
|
|
|
{$I dmvcframework.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
System.JSON,
|
|
System.SysUtils,
|
|
System.Classes,
|
|
System.Rtti,
|
|
System.TypInfo,
|
|
System.Variants,
|
|
System.Generics.Collections,
|
|
System.StrUtils,
|
|
Data.SqlTimSt,
|
|
Data.FmtBcd,
|
|
Data.DB,
|
|
MVCFramework.Serializer.Intf,
|
|
MVCFramework.Serializer.Abstract,
|
|
MVCFramework.Serializer.Commons,
|
|
MVCFramework.DuckTyping;
|
|
|
|
type
|
|
|
|
TMVCJSONSerializer = class(TMVCAbstractSerializer, IMVCSerializer)
|
|
public
|
|
procedure ObjectToJSONObject(
|
|
const AObject: TObject;
|
|
const AJSONObject: TJSONObject;
|
|
const AType: TMVCSerializationType;
|
|
const AIgnoredAttributes: TMVCIgnoredList
|
|
);
|
|
procedure AttributeToJSONDataValue(
|
|
const AJSONObject: TJSONObject;
|
|
const AName: string;
|
|
const AValue: TValue;
|
|
const AType: TMVCSerializationType;
|
|
const AIgnored: TMVCIgnoredList;
|
|
const ACustomAttributes: TArray<TCustomAttribute>
|
|
);
|
|
procedure JSONObjectToObject(
|
|
const AJSONObject: TJSONObject;
|
|
const AObject: TObject;
|
|
const AType: TMVCSerializationType;
|
|
const AIgnoredAttributes: TMVCIgnoredList
|
|
);
|
|
procedure JSONDataValueToAttribute(
|
|
const AJSONObject: TJSONObject;
|
|
const AName: string;
|
|
var AValue: TValue;
|
|
const AType: TMVCSerializationType;
|
|
const AIgnored: TMVCIgnoredList;
|
|
const ACustomAttributes: TArray<TCustomAttribute>
|
|
);
|
|
procedure JSONArrayToList(
|
|
const AJSONArray: TJSONArray;
|
|
const AList: IMVCList;
|
|
const AClazz: TClass;
|
|
const AType: TMVCSerializationType;
|
|
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
|
|
);
|
|
|
|
procedure AfterConstruction; override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
MVCFramework.Serializer.JSON.CustomTypes;
|
|
|
|
{ TMVCJSONSerializer }
|
|
|
|
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;
|
|
const AIgnored: TMVCIgnoredList;
|
|
const ACustomAttributes: TArray<TCustomAttribute>);
|
|
var
|
|
ChildJSONObject: TJSONObject;
|
|
ChildJSONArray: TJSONArray;
|
|
ChildValue: TValue;
|
|
ChildObject, Obj: TObject;
|
|
ChildList: IMVCList;
|
|
ChildJSONValue: TJSONValue;
|
|
ValueTypeAtt: MVCValueAsTypeAttribute;
|
|
CastValue, CastedValue: TValue;
|
|
begin
|
|
if AValue.IsEmpty then
|
|
begin
|
|
AJSONObject.AddPair(AName, TJSONNull.Create);
|
|
Exit;
|
|
end;
|
|
|
|
if GetTypeSerializers.ContainsKey(AValue.TypeInfo) then
|
|
begin
|
|
ChildJSONValue := nil;
|
|
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;
|
|
end;
|
|
|
|
case AValue.Kind of
|
|
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:
|
|
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));
|
|
end;
|
|
|
|
tkVariant:
|
|
AJSONObject.AddPair(AName, AValue.AsVariant);
|
|
|
|
tkEnumeration:
|
|
begin
|
|
if (AValue.TypeInfo = System.TypeInfo(Boolean)) then
|
|
begin
|
|
if AValue.AsBoolean then
|
|
AJSONObject.AddPair(AName, TJSONBool.Create(True))
|
|
else
|
|
AJSONObject.AddPair(AName, TJSONBool.Create(False));
|
|
end
|
|
else
|
|
begin
|
|
AJSONObject.AddPair(AName, GetEnumName(AValue.TypeInfo, AValue.AsOrdinal));
|
|
end;
|
|
end;
|
|
|
|
tkClass:
|
|
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;
|
|
end;
|
|
|
|
tkRecord:
|
|
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]);
|
|
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]);
|
|
end;
|
|
end;
|
|
|
|
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);
|
|
end;
|
|
if ADataSet.Fields[I].IsNull then
|
|
AJSONObject.AddPair(FieldName, TJSONNull.Create)
|
|
else
|
|
begin
|
|
case ADataSet.Fields[I].DataType of
|
|
ftBoolean:
|
|
AJSONObject.AddPair(FieldName, TJSONBool.Create(ADataSet.Fields[I].AsBoolean));
|
|
|
|
ftInteger, ftSmallint, ftShortint:
|
|
AJSONObject.AddPair(FieldName, TJSONNumber.Create(ADataSet.Fields[I].AsInteger));
|
|
|
|
ftLargeint, ftAutoInc:
|
|
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));
|
|
|
|
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;
|
|
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;
|
|
|
|
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
|
|
ObjType := GetRttiContext.GetType(AObject.ClassType);
|
|
if GetTypeSerializers.ContainsKey(ObjType.Handle) then
|
|
begin
|
|
ObjValue := TValue.From<TObject>(AObject);
|
|
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;
|
|
const AIgnoredAttributes: TMVCIgnoredList);
|
|
var
|
|
I: Integer;
|
|
Obj: TObject;
|
|
begin
|
|
for I := 0 to Pred(AJSONArray.Count) do
|
|
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;
|
|
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;
|
|
|
|
if GetTypeSerializers.ContainsKey(AValue.TypeInfo) then
|
|
begin
|
|
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 } :
|
|
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);
|
|
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
|
|
AValue := TValue.From<Boolean>(TJSONBool(AJSONObject.Values[AName]).AsBoolean);
|
|
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;
|
|
end;
|
|
6 { TJSONArray } :
|
|
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;
|
|
end;
|
|
-1: Exit;
|
|
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:
|
|
Field.AsBoolean := (Jv as TJSONBool).AsBoolean;
|
|
|
|
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;
|
|
const AIgnoredAttributes: TMVCIgnoredList);
|
|
var
|
|
ObjType: TRttiType;
|
|
Prop: TRttiProperty;
|
|
Fld: TRttiField;
|
|
AttributeValue: TValue;
|
|
begin
|
|
ObjType := GetRttiContext.GetType(AObject.ClassType);
|
|
case AType of
|
|
stDefault, stProperties:
|
|
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:
|
|
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;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCJSONSerializer.ObjectToJSONObject(const AObject: TObject;
|
|
const AJSONObject: TJSONObject; const AType: TMVCSerializationType;
|
|
const AIgnoredAttributes: TMVCIgnoredList);
|
|
var
|
|
ObjType: TRttiType;
|
|
Prop: TRttiProperty;
|
|
Fld: TRttiField;
|
|
begin
|
|
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;
|
|
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);
|
|
|
|
ObjList := TDuckTypedList.Wrap(AList);
|
|
if Assigned(ObjList) then
|
|
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;
|
|
end;
|
|
end;
|
|
|
|
function TMVCJSONSerializer.SerializeDataSet(
|
|
const ADataSet: TDataSet;
|
|
const AIgnoredFields: TMVCIgnoredList;
|
|
const ANameCase: TMVCNameCase): string;
|
|
var
|
|
JSONArray: TJSONArray;
|
|
JSONObject: TJSONObject;
|
|
BookMark: TBookmark;
|
|
begin
|
|
Result := EmptyStr;
|
|
|
|
if (not Assigned(ADataSet)) or (ADataSet.IsEmpty) then
|
|
Exit;
|
|
|
|
JSONArray := TJSONArray.Create;
|
|
try
|
|
BookMark := ADataSet.Bookmark;
|
|
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);
|
|
end;
|
|
end;
|
|
|
|
function TMVCJSONSerializer.SerializeDataSetRecord(
|
|
const ADataSet: TDataSet;
|
|
const AIgnoredFields: TMVCIgnoredList;
|
|
const ANameCase: TMVCNameCase): string;
|
|
var
|
|
JSONObject: TJSONObject;
|
|
begin
|
|
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;
|
|
var
|
|
JSONObject: TJSONObject;
|
|
ChildJSONValue: TJSONValue;
|
|
ObjType: TRttiType;
|
|
begin
|
|
Result := EmptyStr;
|
|
|
|
if AObject = nil then
|
|
Exit('null');
|
|
|
|
if AObject is TJSONValue then
|
|
Exit(TJSONValue(AObject).ToJSON);
|
|
|
|
ObjType := GetRttiContext.GetType(AObject.ClassType);
|
|
if GetTypeSerializers.ContainsKey(ObjType.Handle) then
|
|
begin
|
|
ChildJSONValue := nil;
|
|
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;
|
|
|
|
end.
|