|
|
@@ -1,2076 +1,2087 @@
|
|
|
-{ ***************************************************************************
|
|
|
-
|
|
|
- Copyright (c) 2015-2022 Kike Pérez
|
|
|
-
|
|
|
- Unit : Quick.JSON.Serializer
|
|
|
- Description : Json Serializer
|
|
|
- Author : Kike Pérez
|
|
|
- Version : 1.12
|
|
|
- Created : 21/05/2018
|
|
|
- Modified : 26/01/2022
|
|
|
-
|
|
|
- This file is part of QuickLib: https://github.com/exilon/QuickLib
|
|
|
-
|
|
|
- ***************************************************************************
|
|
|
-
|
|
|
- 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 Quick.Json.Serializer;
|
|
|
-
|
|
|
-{$i QuickLib.inc}
|
|
|
-
|
|
|
-interface
|
|
|
-
|
|
|
-uses
|
|
|
- {$IFDEF DEBUG_SERIALIZER}
|
|
|
- Quick.Debug.Utils,
|
|
|
- {$ENDIF}
|
|
|
- Classes,
|
|
|
- SysUtils,
|
|
|
- Rtti,
|
|
|
- TypInfo,
|
|
|
- Quick.Serializer.Intf,
|
|
|
- Quick.Base64,
|
|
|
- {$IFDEF FPC}
|
|
|
- rttiutils,
|
|
|
- fpjson,
|
|
|
- jsonparser,
|
|
|
- strUtils,
|
|
|
- //jsonreader,
|
|
|
- //fpjsonrtti,
|
|
|
- Quick.Json.fpc.Compatibility,
|
|
|
- {$ELSE}
|
|
|
- {$IFDEF DELPHIXE7_UP}
|
|
|
- System.Json,
|
|
|
- {$ELSE}
|
|
|
- Data.DBXJSON,
|
|
|
- {$ENDIF}
|
|
|
- {$IFDEF DELPHIRX10_UP}
|
|
|
-
|
|
|
- {$ENDIF}
|
|
|
- Variants,
|
|
|
- {$ENDIF}
|
|
|
- Generics.Collections,
|
|
|
- Quick.RTTI.Utils,
|
|
|
- DateUtils,
|
|
|
- Quick.Commons,
|
|
|
- Quick.JSON.Utils;
|
|
|
-
|
|
|
-type
|
|
|
-
|
|
|
- IJsonSerializer = ISerializer;
|
|
|
-
|
|
|
- EJsonSerializeError = class(Exception);
|
|
|
- EJsonDeserializeError = class(Exception);
|
|
|
-
|
|
|
- {$IFNDEF FPC}
|
|
|
- TNotSerializableProperty = class(TCustomAttribute);
|
|
|
-
|
|
|
- TCommentProperty = class(TCustomAttribute)
|
|
|
- private
|
|
|
- fComment : string;
|
|
|
- public
|
|
|
- constructor Create(const aComment: string);
|
|
|
- property Comment : string read fComment;
|
|
|
- end;
|
|
|
-
|
|
|
- TCustomNameProperty = class(TCustomAttribute)
|
|
|
- private
|
|
|
- fName : string;
|
|
|
- public
|
|
|
- constructor Create(const aName: string);
|
|
|
- property Name : string read fName;
|
|
|
- end;
|
|
|
- {$IFNDEF DELPHIXE7_UP}
|
|
|
- TJSONArrayHelper = class helper for Data.DBXJson.TJSONArray
|
|
|
- private
|
|
|
- function GetItem(aValue : Integer) : TJSONValue;
|
|
|
- public
|
|
|
- function Count : Integer;
|
|
|
- property Items[index : Integer] : TJSONValue read GetItem;
|
|
|
- procedure SetElements(aElements : TList<TJSONValue>);
|
|
|
- end;
|
|
|
-
|
|
|
- TJSONValueHelper = class helper for Data.DBXJson.TJSONValue
|
|
|
- public
|
|
|
- function ToJson : string;
|
|
|
- end;
|
|
|
-
|
|
|
- TJSONObjectHelper = class helper for Data.DBXJson.TJSONObject
|
|
|
- private
|
|
|
- function GetPair(aValue : Integer) : TJSONPair;
|
|
|
- public
|
|
|
- function Count : Integer;
|
|
|
- function GetValue(const aName : string) : TJSONValue;
|
|
|
- property Pairs[index : Integer] : TJSONPair read GetPair;
|
|
|
- end;
|
|
|
- {$ENDIF}
|
|
|
- {$ENDIF}
|
|
|
-
|
|
|
- TSerializeLevel = (slPublicProperty, slPublishedProperty);
|
|
|
-
|
|
|
- TRTTIJson = class
|
|
|
- type
|
|
|
- TGenericListType = (gtNone, gtList, gtObjectList);
|
|
|
- private
|
|
|
- fSerializeLevel : TSerializeLevel;
|
|
|
- fUseEnumNames : Boolean;
|
|
|
- fUseJsonCaseSense : Boolean;
|
|
|
- fUseBase64Stream : Boolean;
|
|
|
- fUseNullStringsAsEmpty : Boolean;
|
|
|
- function GetValue(aAddr: Pointer; aType: TRTTIType): TValue; overload;
|
|
|
- {$IFDEF FPC}
|
|
|
- function GetValue(aAddr: Pointer; aTypeInfo: PTypeInfo): TValue; overload;
|
|
|
- {$ENDIF}
|
|
|
- function IsAllowedProperty(aObject : TObject; const aPropertyName : string) : Boolean;
|
|
|
- //function GetPropertyValue(Instance : TObject; const PropertyName : string) : TValue;
|
|
|
- function GetPropertyValueFromObject(Instance : TObject; const PropertyName : string) : TValue;
|
|
|
- {$IFNDEF FPC}
|
|
|
- function GetFieldValueFromRecord(const aValue : TValue; const FieldName : string) : TValue;
|
|
|
- {$ENDIF}
|
|
|
- {$IFDEF FPC}
|
|
|
- procedure SetPropertyValue(Instance : TObject; aPropInfo : PPropInfo; aValue : TValue); overload;
|
|
|
- procedure SetPropertyValue(Instance : TObject; const PropertyName : string; aValue : TValue); overload;
|
|
|
- function FloatProperty(aObject : TObject; aPropInfo: PPropInfo): string;
|
|
|
- function GetPropType(aPropInfo: PPropInfo): PTypeInfo;
|
|
|
- procedure LoadSetProperty(aInstance : TObject; aPropInfo: PPropInfo; const aValue: string);
|
|
|
- {$ENDIF}
|
|
|
- {$IFNDEF FPC}
|
|
|
- function CreateInstance(aClass: TClass): TValue; overload;
|
|
|
- function CreateInstance(aType: TRttiType): TValue; overload;
|
|
|
- {$ENDIF}
|
|
|
- public
|
|
|
- constructor Create(aSerializeLevel : TSerializeLevel; aUseEnumNames : Boolean = True);
|
|
|
- property UseEnumNames : Boolean read fUseEnumNames write fUseEnumNames;
|
|
|
- property UseJsonCaseSense : Boolean read fUseJsonCaseSense write fUseJsonCaseSense;
|
|
|
- property UseBase64Stream : Boolean read fUseBase64Stream write fUseBase64Stream;
|
|
|
- property UseNullStringsAsEmpty : Boolean read fUseNullStringsAsEmpty write fUseNullStringsAsEmpty;
|
|
|
- function GetJsonPairValueByName(aJson : TJSONObject; const aName : string) : TJsonValue;
|
|
|
- function GetJsonPairByName(aJson : TJSONObject; const aName : string) : TJSONPair;
|
|
|
- function IsGenericList(aObject : TObject) : Boolean;
|
|
|
- function IsStream(aObject : TObject) : Boolean;
|
|
|
- function IsGenericXArray(const aClassName : string) : Boolean;
|
|
|
- function GetGenericListType(aObject : TObject) : TGenericListType;
|
|
|
- //serialize methods
|
|
|
- function SerializeValue(const aValue : TValue) : TJSONValue;
|
|
|
- function SerializeObject(aObject : TObject) : TJSONObject; overload;
|
|
|
- function SerializeStream(aObject : TObject) : TJSONValue;
|
|
|
- {$IFNDEF FPC}
|
|
|
- function SerializeDynArray(const aValue: TValue; aMaxElements : Integer = -1) : TJsonArray;
|
|
|
- function SerializeRecord(const aValue : TValue) : TJSONValue;
|
|
|
- {$ELSE}
|
|
|
- function SerializeObject(aObject : TObject; aType : TTypeKind; const aPropertyName : string) : TJSONPair;
|
|
|
- {$ENDIF}
|
|
|
- //deserialize methods
|
|
|
- function DeserializeClass(aType : TClass; const aJson : TJSONObject) : TObject;
|
|
|
- function DeserializeObject(aObject : TObject; const aJson : TJSONObject) : TObject; overload;
|
|
|
- function DeserializeProperty(aObject : TObject; const aName : string; aProperty : TRttiProperty; const aJson : TJSONObject) : TObject; overload;
|
|
|
- function DeserializeStream(aObject : TObject; const aJson : TJSONValue) : TObject;
|
|
|
- {$IFNDEF FPC}
|
|
|
- function DeserializeType(aObject : TObject; aType : TTypeKind; aTypeInfo : PTypeInfo; const aValue: string) : TValue;
|
|
|
- function DeserializeDynArray(aTypeInfo : PTypeInfo; aObject : TObject; const aJsonArray: TJSONArray) : TValue;
|
|
|
- function DeserializeRecord(const aRecord : TValue; aObject : TObject; const aJson : TJSONObject) : TValue;
|
|
|
- function DeserializeList(aObject: TObject; const aName : string; const aJson: TJSONObject) : TObject;
|
|
|
- procedure DeserializeXArray(Instance : TObject; aRecord : TValue; aProperty : TRttiProperty; const aPropertyName : string; aJson : TJsonObject);
|
|
|
- {$ELSE}
|
|
|
- function DeserializeType(aObject : TObject; aType : TTypeKind; const aPropertyName, aValue: string) : TValue;
|
|
|
- procedure DeserializeDynArray(aTypeInfo: PTypeInfo; const aPropertyName : string; aObject: TObject; const aJsonArray: TJSONArray);
|
|
|
- {$ENDIF}
|
|
|
- end;
|
|
|
-
|
|
|
- TJsonSerializer = class(TInterfacedObject,IJsonSerializer)
|
|
|
- strict private
|
|
|
- fSerializeLevel : TSerializeLevel;
|
|
|
- fUseEnumNames : Boolean;
|
|
|
- fUseJsonCaseSense : Boolean;
|
|
|
- fUseBase64Stream : Boolean;
|
|
|
- fUseNullStringsAsEmpty : Boolean;
|
|
|
- fRTTIJson : TRTTIJson;
|
|
|
- private
|
|
|
- procedure SetUseEnumNames(const Value: Boolean);
|
|
|
- procedure SetUseJsonCaseSense(const Value: Boolean);
|
|
|
- procedure SetSerializeLevel(const Value: TSerializeLevel);
|
|
|
- procedure SetUseBase64Stream(const Value: Boolean);
|
|
|
- //Only Delphi -> Workaround, use this when something passes : {Test : "Null"} but we expect : {Test : ""}
|
|
|
- procedure SetUseNullStringsAsEmpty(const Value : Boolean);
|
|
|
- public
|
|
|
- constructor Create(aSerializeLevel: TSerializeLevel; aUseEnumNames : Boolean = True; aUseNullStringsAsEmpty : Boolean = False);
|
|
|
- destructor Destroy; override;
|
|
|
- property SerializeLevel : TSerializeLevel read fSerializeLevel write SetSerializeLevel;
|
|
|
- property UseEnumNames : Boolean read fUseEnumNames write SetUseEnumNames;
|
|
|
- property UseJsonCaseSense : Boolean read fUseJsonCaseSense write SetUseJsonCaseSense;
|
|
|
- property UseBase64Stream : Boolean read fUseBase64Stream write SetUseBase64Stream;
|
|
|
- property UseNullStringsAsEmpty : Boolean read fUseNullStringsAsEmpty write SetUseNullStringsAsEmpty;
|
|
|
- function JsonToObject(aType : TClass; const aJson: string) : TObject; overload;
|
|
|
- function JsonToObject(aObject : TObject; const aJson: string) : TObject; overload;
|
|
|
- function JsonStreamToObject(aObject : TObject; aJsonStream : TStream) : TObject;
|
|
|
- function ObjectToJson(aObject : TObject; aIndent : Boolean = False): string;
|
|
|
- function ObjectToJsonString(aObject : TObject; aIndent : Boolean = False): string;
|
|
|
- procedure ObjectToJsonStream(aObject : TObject; aStream : TStream);
|
|
|
- function ValueToJson(const aValue : TValue; aIndent : Boolean = False) : string;
|
|
|
- function ValueToJsonString(const aValue : TValue; aIndent : Boolean = False) : string;
|
|
|
- function ArrayToJson<T>(aArray : TArray<T>; aIndent : Boolean = False) : string;
|
|
|
- function ArrayToJsonString<T>(aArray : TArray<T>; aIndent : Boolean = False) : string;
|
|
|
- {$IFNDEF FPC}
|
|
|
- function JsonToArray<T>(const aJson : string) : TArray<T>;
|
|
|
- function JsonToValue(const aJson: string): TValue;
|
|
|
- {$ENDIF}
|
|
|
- end;
|
|
|
-
|
|
|
- EJsonSerializerError = class(Exception);
|
|
|
-
|
|
|
- PPByte = ^PByte;
|
|
|
-
|
|
|
-resourcestring
|
|
|
- cNotSupportedDataType = 'Not supported data type "%s"';
|
|
|
- cSerializeObjectError = 'Serialize object "%s" error: %s';
|
|
|
- cSerializePropertyError = 'Property "%s" ("%s")';
|
|
|
- cNotSerializable = 'Object is not serializable';
|
|
|
- cNotValidJson = 'Not a valid Json';
|
|
|
-
|
|
|
-implementation
|
|
|
-
|
|
|
-{ TRTTIJson }
|
|
|
-
|
|
|
-{$IFNDEF FPC}
|
|
|
-function TRTTIJson.DeserializeDynArray(aTypeInfo: PTypeInfo; aObject: TObject; const aJsonArray: TJSONArray) : TValue;
|
|
|
-var
|
|
|
- rType: PTypeInfo;
|
|
|
- len: NativeInt;
|
|
|
- pArr: Pointer;
|
|
|
- rItemValue: TValue;
|
|
|
- i: Integer;
|
|
|
- objClass: TClass;
|
|
|
- ctx : TRttiContext;
|
|
|
- json : TJSONObject;
|
|
|
- rDynArray : TRttiDynamicArrayType;
|
|
|
- propObj : TObject;
|
|
|
-begin
|
|
|
- if GetTypeData(aTypeInfo).DynArrElType = nil then Exit;
|
|
|
- if not assigned(aJsonArray) then Exit;
|
|
|
-
|
|
|
- len := aJsonArray.Count;
|
|
|
- rType := GetTypeData(aTypeInfo).DynArrElType^;
|
|
|
- pArr := nil;
|
|
|
- DynArraySetLength(pArr,aTypeInfo, 1, @len);
|
|
|
- try
|
|
|
- TValue.Make(@pArr,aTypeInfo, Result);
|
|
|
- rDynArray := ctx.GetType(Result.TypeInfo) as TRTTIDynamicArrayType;
|
|
|
-
|
|
|
- for i := 0 to aJsonArray.Count - 1 do
|
|
|
- begin
|
|
|
- rItemValue := nil;
|
|
|
- case rType.Kind of
|
|
|
- tkClass :
|
|
|
- begin
|
|
|
- if aJsonArray.Items[i] is TJSONObject then
|
|
|
- begin
|
|
|
- propObj := GetValue(PPByte(Result.GetReferenceToRawData)^ +rDynArray.ElementType.TypeSize * i, rDynArray.ElementType).AsObject;
|
|
|
- if propObj = nil then
|
|
|
- begin
|
|
|
- objClass := rType.TypeData.ClassType;
|
|
|
- rItemValue := DeserializeClass(objClass, TJSONObject(aJsonArray.Items[i]));
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- DeserializeObject(propObj,TJSONObject(aJsonArray.Items[i]));
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- tkRecord :
|
|
|
- begin
|
|
|
- json := TJSONObject(aJsonArray.Items[i]);
|
|
|
- rItemValue := DeserializeRecord(GetValue(PPByte(Result.GetReferenceToRawData)^ +rDynArray.ElementType.TypeSize * i,
|
|
|
- rDynArray.ElementType),aObject,json);
|
|
|
- end;
|
|
|
- tkMethod, tkPointer, tkClassRef ,tkInterface, tkProcedure :
|
|
|
- begin
|
|
|
- //skip these properties
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- rItemValue := DeserializeType(aObject,rType.Kind,aTypeInfo,aJsonArray.Items[i].Value);
|
|
|
- end;
|
|
|
- end;
|
|
|
- if not rItemValue.IsEmpty then Result.SetArrayElement(i,rItemValue);
|
|
|
- end;
|
|
|
- //aProperty.SetValue(aObject,rValue);
|
|
|
- finally
|
|
|
- DynArrayClear(pArr,aTypeInfo);
|
|
|
- end;
|
|
|
-end;
|
|
|
-{$ELSE}
|
|
|
-procedure TRTTIJson.DeserializeDynArray(aTypeInfo: PTypeInfo; const aPropertyName : string; aObject: TObject; const aJsonArray: TJSONArray);
|
|
|
-var
|
|
|
- rType: PTypeInfo;
|
|
|
- len: NativeInt;
|
|
|
- pArr: Pointer;
|
|
|
- rItemValue: TValue;
|
|
|
- i: Integer;
|
|
|
- objClass: TClass;
|
|
|
- propObj : TObject;
|
|
|
- rValue : TValue;
|
|
|
-begin
|
|
|
- if GetTypeData(aTypeInfo).ElType2 = nil then Exit;
|
|
|
- len := aJsonArray.Count;
|
|
|
- rType := GetTypeData(aTypeInfo).ElType2;
|
|
|
- pArr := nil;
|
|
|
- DynArraySetLength(pArr,aTypeInfo, 1, @len);
|
|
|
- try
|
|
|
- TValue.Make(@pArr,aTypeInfo, rValue);
|
|
|
- for i := 0 to aJsonArray.Count - 1 do
|
|
|
- begin
|
|
|
- rItemValue := nil;
|
|
|
- case rType.Kind of
|
|
|
- tkClass :
|
|
|
- begin
|
|
|
- if aJsonArray.Items[i] is TJSONObject then
|
|
|
- begin
|
|
|
- propObj := GetValue(PPByte(rValue.GetReferenceToRawData)^ +GetTypeData(aTypeInfo).elSize * i, GetTypeData(aTypeInfo).ElType2).AsObject;
|
|
|
- if propObj = nil then
|
|
|
- begin
|
|
|
- objClass := GetTypeData(aTypeInfo).ClassType;
|
|
|
- rItemValue := DeserializeClass(objClass, TJSONObject(aJsonArray.Items[i]));
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- DeserializeObject(propObj,TJSONObject(aJsonArray.Items[i]));
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- tkRecord :
|
|
|
- begin
|
|
|
- {json := TJSONObject(aJsonArray.Items[i]);
|
|
|
- rItemValue := DeserializeRecord(GetValue(PPByte(Result.GetReferenceToRawData)^ +rDynArray.ElementType.TypeSize * i,
|
|
|
- rDynArray.ElementType),aObject,json); }
|
|
|
- end;
|
|
|
- tkMethod, tkPointer, tkClassRef ,tkInterface, tkProcedure :
|
|
|
- begin
|
|
|
- //skip these properties
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- rItemValue := DeserializeType(aObject,GetTypeData(aTypeInfo).ElType2.Kind,aPropertyName,aJsonArray.Items[i].Value);
|
|
|
- end;
|
|
|
- end;
|
|
|
- if not rItemValue.IsEmpty then rValue.SetArrayElement(i,rItemValue);
|
|
|
- end;
|
|
|
- //aProperty.SetValue(aObject,rValue);
|
|
|
- SetDynArrayProp(aObject,GetPropInfo(aObject,aPropertyName),pArr);
|
|
|
- finally
|
|
|
- DynArrayClear(pArr,aTypeInfo);
|
|
|
- end;
|
|
|
-end;
|
|
|
-{$ENDIF}
|
|
|
-
|
|
|
-{$IFNDEF FPC}
|
|
|
-function TRTTIJson.DeserializeRecord(const aRecord : TValue; aObject : TObject; const aJson : TJSONObject) : TValue;
|
|
|
-var
|
|
|
- ctx : TRttiContext;
|
|
|
- rRec : TRttiRecordType;
|
|
|
- rField : TRttiField;
|
|
|
- rValue : TValue;
|
|
|
- member : TJsonValue;
|
|
|
- jArray : TJSONArray;
|
|
|
- json : TJSONObject;
|
|
|
- objClass : TClass;
|
|
|
- propobj : TObject;
|
|
|
-begin
|
|
|
- rRec := ctx.GetType(aRecord.TypeInfo).AsRecord;
|
|
|
- for rField in rRec.GetFields do
|
|
|
- begin
|
|
|
- rValue := nil;
|
|
|
- //member := TJSONPair(aJson.GetValue(rField.Name));
|
|
|
- member := GetJsonPairValueByName(aJson,rField.Name);
|
|
|
- if member <> nil then
|
|
|
- case rField.FieldType.TypeKind of
|
|
|
- tkDynArray :
|
|
|
- begin
|
|
|
- jArray := TJSONObject.ParseJSONValue(member.ToJSON) as TJSONArray;
|
|
|
- try
|
|
|
- rValue := DeserializeDynArray(rField.FieldType.Handle,aObject,jArray);
|
|
|
- finally
|
|
|
- jArray.Free;
|
|
|
- end;
|
|
|
- end;
|
|
|
- tkClass :
|
|
|
- begin
|
|
|
- //if (member.JsonValue is TJSONObject) then
|
|
|
- begin
|
|
|
- propobj := rField.GetValue(@aRecord).AsObject;
|
|
|
- json := TJSONObject.ParseJSONValue(member.ToJson) as TJSONObject;
|
|
|
- try
|
|
|
- if propobj = nil then
|
|
|
- begin
|
|
|
- objClass := rField.FieldType.Handle^.TypeData.ClassType;// aProperty.PropertyType.Handle^.TypeData.ClassType;
|
|
|
- rValue := DeserializeClass(objClass,json);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- DeserializeObject(propobj,json);
|
|
|
- end;
|
|
|
- finally
|
|
|
- json.Free;
|
|
|
- end;
|
|
|
- end
|
|
|
- end;
|
|
|
- tkRecord :
|
|
|
- begin
|
|
|
- json := TJSONObject.ParseJSONValue(member.ToJson) as TJSONObject;
|
|
|
- try
|
|
|
- rValue := DeserializeRecord(rField.GetValue(aRecord.GetReferenceToRawData),aObject,json);
|
|
|
- finally
|
|
|
- json.Free;
|
|
|
- end;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- //rValue := DeserializeType(aObject,rField.FieldType.TypeKind,rField.FieldType.Handle,member.ToJson);
|
|
|
- //avoid return unicode escaped chars if string
|
|
|
- if rField.FieldType.TypeKind in [tkString, tkLString, tkWString, tkUString] then
|
|
|
- {$IFDEF DELPHIRX10_UP}
|
|
|
- rValue := DeserializeType(aObject,rField.FieldType.TypeKind,rField.FieldType.Handle,TJsonValue(member).value)
|
|
|
- {$ELSE}
|
|
|
- rValue := DeserializeType(aObject,rField.FieldType.TypeKind,rField.FieldType.Handle,member.Value)
|
|
|
- {$ENDIF}
|
|
|
- else rValue := DeserializeType(aObject,rField.FieldType.TypeKind,rField.FieldType.Handle,member.ToJSON);
|
|
|
- end;
|
|
|
- end;
|
|
|
- if not rValue.IsEmpty then rField.SetValue(aRecord.GetReferenceToRawData,rValue);
|
|
|
- end;
|
|
|
- Result := aRecord;
|
|
|
-end;
|
|
|
-{$ENDIF}
|
|
|
-
|
|
|
-function TRTTIJson.DeserializeStream(aObject: TObject; const aJson: TJSONValue): TObject;
|
|
|
-var
|
|
|
- stream : TStringStream;
|
|
|
-begin
|
|
|
- if fUseBase64Stream then stream := TStringStream.Create(Base64Decode(aJson.Value),TEncoding.Ansi)
|
|
|
- else stream := TStringStream.Create({$IFNDEF FPC}aJson.Value{$ELSE}string(aJson.Value){$ENDIF},TEncoding.Ansi);
|
|
|
- try
|
|
|
- TStream(aObject).CopyFrom(stream,stream.Size);
|
|
|
- finally
|
|
|
- stream.Free;
|
|
|
- end;
|
|
|
- Result := aObject;
|
|
|
-end;
|
|
|
-
|
|
|
-constructor TRTTIJson.Create(aSerializeLevel : TSerializeLevel; aUseEnumNames : Boolean = True);
|
|
|
-begin
|
|
|
- fSerializeLevel := aSerializeLevel;
|
|
|
- fUseEnumNames := aUseEnumNames;
|
|
|
- fUseJsonCaseSense := False;
|
|
|
- fUseBase64Stream := True;
|
|
|
-end;
|
|
|
-
|
|
|
-{$IFNDEF FPC}
|
|
|
-function TRTTIJson.CreateInstance(aClass: TClass): TValue;
|
|
|
-var
|
|
|
- ctx : TRttiContext;
|
|
|
- rtype : TRttiType;
|
|
|
-begin
|
|
|
- Result := nil;
|
|
|
- rtype := ctx.GetType(aClass);
|
|
|
- Result := CreateInstance(rtype);
|
|
|
-end;
|
|
|
-{$ENDIF}
|
|
|
-
|
|
|
-{$IFNDEF FPC}
|
|
|
-function TRTTIJson.CreateInstance(aType: TRttiType): TValue;
|
|
|
-var
|
|
|
- rmethod : TRttiMethod;
|
|
|
-begin
|
|
|
- Result := nil;
|
|
|
- if atype = nil then Exit;
|
|
|
- for rmethod in TRttiInstanceType(atype).GetMethods do
|
|
|
- begin
|
|
|
- if rmethod.IsConstructor then
|
|
|
- begin
|
|
|
- //create if don't have parameters
|
|
|
- if Length(rmethod.GetParameters) = 0 then
|
|
|
- begin
|
|
|
- Result := rmethod.Invoke(TRttiInstanceType(atype).MetaclassType,[]);
|
|
|
- Break;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
-end;
|
|
|
-{$ENDIF}
|
|
|
-
|
|
|
-function TRTTIJson.DeserializeClass(aType: TClass; const aJson: TJSONObject): TObject;
|
|
|
-begin
|
|
|
- Result := nil;
|
|
|
- if (aJson = nil) or ((aJson as TJSONValue) is TJSONNull) or (aJson.Count = 0) then Exit;
|
|
|
-
|
|
|
- {$IFNDEF FPC}
|
|
|
- Result := CreateInstance(aType).AsObject;
|
|
|
- {$ELSE}
|
|
|
- Result := aType.Create;
|
|
|
- {$ENDIF}
|
|
|
- try
|
|
|
- Result := DeserializeObject(Result,aJson);
|
|
|
- except
|
|
|
- on E : Exception do
|
|
|
- begin
|
|
|
- Result.Free;
|
|
|
- raise EJsonDeserializeError.CreateFmt('Deserialize error class "%s" : %s',[aType.ClassName,e.Message]);
|
|
|
- end;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-function TRTTIJson.DeserializeObject(aObject: TObject; const aJson: TJSONObject): TObject;
|
|
|
-var
|
|
|
- ctx: TRttiContext;
|
|
|
- rType: TRttiType;
|
|
|
- rProp: TRttiProperty;
|
|
|
- {$IFNDEF FPC}
|
|
|
- attr: TCustomAttribute;
|
|
|
- propvalue : TValue;
|
|
|
- {$ENDIF}
|
|
|
- propertyname : string;
|
|
|
-begin
|
|
|
- Result := aObject;
|
|
|
-
|
|
|
- if (aJson = nil) or ((aJson as TJSONValue) is TJSONNull) or (aJson.Count = 0) or (Result = nil) then Exit;
|
|
|
-
|
|
|
- try
|
|
|
- //if generic list
|
|
|
- {$IFNDEF FPC}
|
|
|
- if IsGenericList(aObject) then
|
|
|
- begin
|
|
|
- DeserializeList(aObject,'List',aJson);
|
|
|
- Exit;
|
|
|
- end
|
|
|
- else
|
|
|
- {$ENDIF}
|
|
|
- if IsStream(aObject) then
|
|
|
- begin
|
|
|
- DeserializeStream(aObject,aJson);
|
|
|
- Exit;
|
|
|
- end;
|
|
|
- //if standard object
|
|
|
- rType := ctx.GetType(aObject.ClassInfo);
|
|
|
- for rProp in rType.GetProperties do
|
|
|
- begin
|
|
|
- {$IFNDEF FPC}
|
|
|
- if ((fSerializeLevel = slPublicProperty) and (rProp.PropertyType.IsPublicType))
|
|
|
- or ((fSerializeLevel = slPublishedProperty) and ((IsPublishedProp(aObject,rProp.Name)) or (rProp.Name = 'List'))) then
|
|
|
- {$ENDIF}
|
|
|
- begin
|
|
|
- if ((rProp.IsWritable) or (rProp.Name = 'List')) and (IsAllowedProperty(aObject,rProp.Name)) then
|
|
|
- begin
|
|
|
- propertyname := rProp.Name;
|
|
|
- {$IFNDEF FPC}
|
|
|
- for attr in rProp.GetAttributes do if attr is TCustomNameProperty then propertyname := TCustomNameProperty(attr).Name;
|
|
|
- propvalue := rProp.GetValue(aObject);
|
|
|
- if rProp.Name = 'List' then
|
|
|
- begin
|
|
|
- Result := DeserializeList(Result,propertyname,aJson);
|
|
|
- end
|
|
|
- else if propvalue.IsObject then
|
|
|
- begin
|
|
|
- if propvalue.AsObject = nil then
|
|
|
- begin
|
|
|
- propvalue := CreateInstance(rProp.PropertyType);
|
|
|
- rProp.SetValue(aObject,propvalue);
|
|
|
- end;
|
|
|
- if IsGenericList(propvalue.AsObject) then DeserializeList(propvalue.AsObject,'List',TJSONObject(aJson.GetValue(propertyname)))
|
|
|
- else Result := DeserializeProperty(Result,propertyname,rProp,aJson);
|
|
|
- end
|
|
|
- else if IsGenericXArray(string(propvalue{$IFNDEF NEXTGEN}.TypeInfo.Name{$ELSE}.TypeInfo.NameFld.ToString{$ENDIF})) then
|
|
|
- begin
|
|
|
- DeserializeXArray(Result,propvalue,rProp,propertyname,aJson);
|
|
|
- end
|
|
|
- else
|
|
|
- {$ENDIF}
|
|
|
- Result := DeserializeProperty(Result,propertyname,rProp,aJson);
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- except
|
|
|
- on E : Exception do
|
|
|
- begin
|
|
|
- Result.Free;
|
|
|
- raise EJsonDeserializeError.CreateFmt('Deserialize error for object "%s" : %s',[aObject.ClassName,e.Message]);
|
|
|
- end;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-{$IFNDEF FPC}
|
|
|
-function TRTTIJson.DeserializeList(aObject: TObject; const aName : string; const aJson: TJSONObject) : TObject;
|
|
|
-var
|
|
|
- ctx : TRttiContext;
|
|
|
- rType : TRttiType;
|
|
|
- jarray : TJSONArray;
|
|
|
- member : TJsonValue;
|
|
|
- rvalue : TValue;
|
|
|
- i : Integer;
|
|
|
- n : Integer;
|
|
|
- rProp : TRttiProperty;
|
|
|
- {$IFNDEF DELPHIRX10_UP}
|
|
|
- rfield : TRttiField;
|
|
|
- {$ENDIF}
|
|
|
- genericType : TGenericListType;
|
|
|
-begin
|
|
|
- Result := aObject;
|
|
|
-
|
|
|
- rType := ctx.GetType(aObject.ClassInfo);
|
|
|
- rProp := rType.GetProperty('List');
|
|
|
- if (rProp = nil) or (aJson = nil) or (aJson.ClassType = TJSONNull) then Exit;
|
|
|
-
|
|
|
- member := nil;
|
|
|
- //check if exists List (denotes delphi json serialized) or not (normal json serialized)
|
|
|
- if aJson.ClassType = TJSONObject then member := GetJsonPairValueByName(aJson,aName);
|
|
|
- if member = nil then
|
|
|
- begin
|
|
|
- if aJson.ClassType <> TJSONArray then raise EJsonDeserializeError.CreateFmt('Not valid value for "%s" List',[aName]);
|
|
|
- jArray := TJSONObject.ParseJSONValue(aJson.ToJSON) as TJSONArray;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- if member.ClassType <> TJSONArray then raise EJsonDeserializeError.CreateFmt('Not valid value for "%s" List',[aName]);
|
|
|
- jArray := TJSONObject.ParseJSONValue(member.ToJSON) as TJSONArray;
|
|
|
- end;
|
|
|
- try
|
|
|
- rvalue := DeserializeDynArray(rProp.PropertyType.Handle,Result,jArray);
|
|
|
- //i := jarray.Count;
|
|
|
- finally
|
|
|
- jArray.Free;
|
|
|
- end;
|
|
|
-
|
|
|
- if not rValue.IsEmpty then
|
|
|
- begin
|
|
|
- {$IFDEF DELPHIRX10_UP}
|
|
|
- if (TObjectList<TObject>(aObject) <> nil) and (rvalue.IsArray) then
|
|
|
- begin
|
|
|
- genericType := GetGenericListType(aObject);
|
|
|
- if genericType = TGenericListType.gtObjectList then TObjectList<TObject>(aObject).Clear
|
|
|
- else TList<TObject>(aObject).Clear;
|
|
|
- n := rvalue.GetArrayLength - 1;
|
|
|
- for i := 0 to n do
|
|
|
- begin
|
|
|
- if genericType = TGenericListType.gtObjectList then TObjectList<TObject>(aObject).Add(rvalue.GetArrayElement(i).AsObject)
|
|
|
- else TList<TObject>(aObject).Add(rvalue.GetArrayElement(i).AsObject);
|
|
|
- end;
|
|
|
- end;
|
|
|
- {$ELSE}
|
|
|
- n := 0;
|
|
|
- for rfield in rType.GetFields do
|
|
|
- begin
|
|
|
- if rfield.Name = 'FOwnsObjects' then rfield.SetValue(aObject,True);
|
|
|
- //if rfield.Name = 'FCount' then rfield.SetValue(aObject,i);
|
|
|
- if rfield.Name = 'FItems' then
|
|
|
- begin
|
|
|
- //if TList(aObject) <> nil then TList(aObject).Clear;
|
|
|
- //rfield.GetValue(aObject).AsObject.Free;// aValue.GetReferenceToRawData)
|
|
|
- rfield.SetValue(aObject,rValue);// .SetDynArrayProp(aObject,'fItems',Result);
|
|
|
- Break;
|
|
|
- end;
|
|
|
- end;
|
|
|
- rProp := rType.GetProperty('Count');
|
|
|
- rProp.SetValue(aObject,n);
|
|
|
- {$ENDIF}
|
|
|
- end;
|
|
|
-end;
|
|
|
-{$ENDIF}
|
|
|
-
|
|
|
-{$IFNDEF FPC}
|
|
|
-procedure TRTTIJson.DeserializeXArray(Instance : TObject; aRecord : TValue; aProperty : TRttiProperty; const aPropertyName : string; aJson : TJsonObject);
|
|
|
-var
|
|
|
- ctx : TRttiContext;
|
|
|
- rRec : TRttiRecordType;
|
|
|
- rfield : TRttiField;
|
|
|
- rValue : TValue;
|
|
|
- member : TJsonValue;
|
|
|
- jArray : TJSONArray;
|
|
|
-begin
|
|
|
- rRec := ctx.GetType(aRecord.TypeInfo).AsRecord;
|
|
|
- rfield := rRec.GetField('fArray');
|
|
|
- if rfield <> nil then
|
|
|
- begin
|
|
|
- rValue := nil;
|
|
|
- //member := TJSONPair(aJson.GetValue(rField.Name));
|
|
|
- member := GetJsonPairValueByName(aJson,aPropertyName);
|
|
|
- if (member <> nil) and (rField.FieldType.TypeKind = tkDynArray) then
|
|
|
- begin
|
|
|
- jArray := TJSONObject.ParseJSONValue(member.ToJSON) as TJSONArray;
|
|
|
- try
|
|
|
- rValue := DeserializeDynArray(rField.FieldType.Handle,nil,jArray);
|
|
|
- finally
|
|
|
- jArray.Free;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- if not rValue.IsEmpty then rField.SetValue(aRecord.GetReferenceToRawData,rValue);
|
|
|
- aProperty.SetValue(Instance,aRecord);
|
|
|
-end;
|
|
|
-{$ENDIF}
|
|
|
-
|
|
|
-function StringToGUIDEx(const aGUID : string) : TGUID;
|
|
|
-begin
|
|
|
- if not aGUID.StartsWith('{') then Result := System.SysUtils.StringToGUID('{' + aGUID + '}')
|
|
|
- else Result := System.SysUtils.StringToGUID(aGUID);
|
|
|
-end;
|
|
|
-
|
|
|
-function TRTTIJson.DeserializeProperty(aObject : TObject; const aName : string; aProperty : TRttiProperty; const aJson : TJSONObject) : TObject;
|
|
|
-var
|
|
|
- rValue : TValue;
|
|
|
- {$IFNDEF FPC}
|
|
|
- member : TJsonValue;
|
|
|
- {$ELSE}
|
|
|
- member : TJsonObject;
|
|
|
- {$ENDIF}
|
|
|
- objClass: TClass;
|
|
|
- jArray : TJSONArray;
|
|
|
- json : TJSONObject;
|
|
|
-begin
|
|
|
- Result := aObject;
|
|
|
- rValue := nil;
|
|
|
- {$IFNDEF FPC}
|
|
|
- //member := TJSONPair(aJson.GetValue(aName));
|
|
|
- member := GetJsonPairValueByName(aJson,aName);
|
|
|
- {$ELSE}
|
|
|
- member := TJsonObject(aJson.Find(aName));
|
|
|
- {$ENDIF}
|
|
|
- if member <> nil then
|
|
|
- begin
|
|
|
- case aProperty.PropertyType.TypeKind of
|
|
|
- tkDynArray :
|
|
|
- begin
|
|
|
- {$IFNDEF FPC}
|
|
|
- if member is TJSONNull then Exit;
|
|
|
- jArray := TJSONObject.ParseJSONValue(member.ToJSON) as TJSONArray;
|
|
|
- {$ELSE}
|
|
|
- if member.ClassType = TJSONNull.ClassType then Exit;
|
|
|
- jArray := TJSONArray(TJSONObject.ParseJSONValue(member.ToJSON));
|
|
|
- {$ENDIF}
|
|
|
- try
|
|
|
- {$IFNDEF FPC}
|
|
|
- aProperty.SetValue(aObject,DeserializeDynArray(aProperty.PropertyType.Handle,Result,jArray));
|
|
|
- {$ELSE}
|
|
|
- DeserializeDynArray(aProperty.PropertyType.Handle,aName,Result,jArray);
|
|
|
- {$ENDIF}
|
|
|
- Exit;
|
|
|
- finally
|
|
|
- jArray.Free;
|
|
|
- end;
|
|
|
- end;
|
|
|
- tkClass :
|
|
|
- begin
|
|
|
- //if (member.JsonValue is TJSONObject) then
|
|
|
- begin
|
|
|
- json := TJsonObject(TJSONObject.ParseJSONValue(member.ToJson));
|
|
|
- try
|
|
|
- if aProperty.GetValue(aObject).AsObject = nil then
|
|
|
- begin
|
|
|
- {$IFNDEF FPC}
|
|
|
- objClass := aProperty.PropertyType.Handle^.TypeData.ClassType;
|
|
|
- rValue := DeserializeClass(objClass,json);
|
|
|
- {$ELSE}
|
|
|
- objClass := GetObjectPropClass(aObject,aName);
|
|
|
- //objClass := GetTypeData(aProperty.PropertyType.Handle)^.ClassType;
|
|
|
- rValue := DeserializeClass(objClass,json);
|
|
|
- SetObjectProp(aObject,aName,rValue.AsObject);
|
|
|
- Exit;
|
|
|
- {$ENDIF}
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- rValue := DeserializeObject(aProperty.GetValue(aObject).AsObject,json);
|
|
|
- Exit;
|
|
|
- end;
|
|
|
- finally
|
|
|
- json.Free;
|
|
|
- end;
|
|
|
- end
|
|
|
- end;
|
|
|
- {$IFNDEF FPC}
|
|
|
- tkRecord :
|
|
|
- begin
|
|
|
- if aProperty.GetValue(aObject).TypeInfo = System.TypeInfo(TGUID) then
|
|
|
- begin
|
|
|
- rValue:=TValue.From<TGUID>(StringToGUID(UnQuotedStr(member.ToJSON,'"')));
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- json := TJSONObject.ParseJSONValue(member.ToJson) as TJSONObject;
|
|
|
- try
|
|
|
- rValue := DeserializeRecord(aProperty.GetValue(aObject),aObject,json);
|
|
|
- finally
|
|
|
- json.Free;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- {$ENDIF}
|
|
|
- else
|
|
|
- begin
|
|
|
- {$IFNDEF FPC}
|
|
|
- //avoid return unicode escaped chars if string
|
|
|
- if aProperty.PropertyType.TypeKind in [tkString, tkLString, tkWString, tkUString] then
|
|
|
- {$IFDEF DELPHIRX10_UP}
|
|
|
- rValue := DeserializeType(aObject,aProperty.PropertyType.TypeKind,aProperty.GetValue(aObject).TypeInfo,TJsonValue(member).value)
|
|
|
- {$ELSE}
|
|
|
- rValue := DeserializeType(aObject,aProperty.PropertyType.TypeKind,aProperty.GetValue(aObject).TypeInfo,member.Value)
|
|
|
- {$ENDIF}
|
|
|
- else rValue := DeserializeType(aObject,aProperty.PropertyType.TypeKind,aProperty.GetValue(aObject).TypeInfo,member.ToJSON);
|
|
|
- {$ELSE}
|
|
|
- rValue := DeserializeType(aObject,aProperty.PropertyType.TypeKind,aName,member.ToJSON);
|
|
|
- if not rValue.IsEmpty then SetPropertyValue(aObject,aName,rValue);
|
|
|
- {$ENDIF}
|
|
|
- end;
|
|
|
- end;
|
|
|
- {$IFNDEF FPC}
|
|
|
- if not rValue.IsEmpty then aProperty.SetValue(Result,rValue);
|
|
|
- {$ENDIF}
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-{$IFNDEF FPC}
|
|
|
-function TRTTIJson.DeserializeType(aObject : TObject; aType : TTypeKind; aTypeInfo : PTypeInfo; const aValue: string) : TValue;
|
|
|
-var
|
|
|
- i : Integer;
|
|
|
- value : string;
|
|
|
- fsettings : TFormatSettings;
|
|
|
-begin
|
|
|
- try
|
|
|
- value := UnQuotedStr(aValue,'"');
|
|
|
- case aType of
|
|
|
- tkString, tkLString, tkWString, tkUString :
|
|
|
- begin
|
|
|
- if fUseNullStringsAsEmpty and (CompareText(value, 'null') = 0) then
|
|
|
- Result := ''
|
|
|
- else
|
|
|
- Result := value;
|
|
|
- end;
|
|
|
- tkChar, tkWChar :
|
|
|
- begin
|
|
|
- Result := value;
|
|
|
- end;
|
|
|
- tkInteger :
|
|
|
- begin
|
|
|
- if CompareText(value,'null') <> 0 then Result := StrToIntDef(value,0)
|
|
|
- else Result := 0;
|
|
|
- end;
|
|
|
- tkInt64 :
|
|
|
- begin
|
|
|
- if CompareText(value,'null') <> 0 then Result := StrToInt64Def(value,0)
|
|
|
- else Result := 0;
|
|
|
- end;
|
|
|
- tkFloat :
|
|
|
- begin
|
|
|
- if aTypeInfo = TypeInfo(TDateTime) then
|
|
|
- begin
|
|
|
- if CompareText(value,'null') <> 0 then Result := JsonDateToDateTime(value);
|
|
|
- end
|
|
|
- else if aTypeInfo = TypeInfo(TDate) then
|
|
|
- begin
|
|
|
- if CompareText(value,'null') <> 0 then Result := StrToDate(value);
|
|
|
- end
|
|
|
- else if aTypeInfo = TypeInfo(TTime) then
|
|
|
- begin
|
|
|
- Result := StrToTime(value);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- fsettings := TFormatSettings.Create;
|
|
|
- Result := StrToFloat(StringReplace(value,'.',fsettings.DecimalSeparator,[]));
|
|
|
- end;
|
|
|
- end;
|
|
|
- tkEnumeration :
|
|
|
- begin
|
|
|
- if aTypeInfo = System.TypeInfo(Boolean) then
|
|
|
- begin
|
|
|
- Result := StrToBool(value);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- //if fUseEnumNames then TValue.Make(GetEnumValue(aTypeInfo,value),aTypeInfo, Result)
|
|
|
- // else TValue.Make(StrToInt(value),aTypeInfo, Result);
|
|
|
- if not TryStrToInt(value,i) then TValue.Make(GetEnumValue(aTypeInfo,value),aTypeInfo, Result)
|
|
|
- else TValue.Make(StrToInt(value),aTypeInfo, Result);
|
|
|
- end;
|
|
|
- end;
|
|
|
- tkSet :
|
|
|
- begin
|
|
|
- i := StringToSet(aTypeInfo,value);
|
|
|
- TValue.Make(@i,aTypeInfo,Result);
|
|
|
- end;
|
|
|
- else
|
|
|
- begin
|
|
|
- //raise EclJsonSerializerError.Create('Not supported data type!');
|
|
|
- end;
|
|
|
- end;
|
|
|
- except
|
|
|
- on E : Exception do
|
|
|
- begin
|
|
|
- raise EJsonDeserializeError.CreateFmt('Deserialize error type "%s.%s" : %s',[aObject.ClassName,GetTypeName(aTypeInfo),e.Message]);
|
|
|
- end;
|
|
|
- end;
|
|
|
-end;
|
|
|
-{$ELSE}
|
|
|
-function TRTTIJson.DeserializeType(aObject : TObject; aType : TTypeKind; const aPropertyName, aValue: string) : TValue;
|
|
|
-var
|
|
|
- value : string;
|
|
|
- propinfo : PPropInfo;
|
|
|
- fsettings : TFormatSettings;
|
|
|
-begin
|
|
|
- try
|
|
|
- value := UnQuotedStr(aValue,'"');
|
|
|
-
|
|
|
- if value = '' then
|
|
|
- begin
|
|
|
- Result := nil;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
- propinfo := GetPropInfo(aObject,aPropertyName);
|
|
|
- //case propinfo.PropType.Kind of
|
|
|
- case aType of
|
|
|
- tkString, tkLString, tkWString, tkUString, tkAString :
|
|
|
- begin
|
|
|
- Result := value;
|
|
|
- //SetStrProp(aObject,propinfo,value);
|
|
|
- end;
|
|
|
- tkChar, tkWChar :
|
|
|
- begin
|
|
|
- Result := value;
|
|
|
- end;
|
|
|
- tkInteger :
|
|
|
- begin
|
|
|
- if CompareText(value,'null') <> 0 then Result := StrToInt(value)
|
|
|
- else Result := 0;
|
|
|
- end;
|
|
|
- tkInt64 :
|
|
|
- begin
|
|
|
- if CompareText(value,'null') <> 0 then Result := StrToInt64(value)
|
|
|
- else Result := 0;
|
|
|
- end;
|
|
|
- tkFloat :
|
|
|
- begin
|
|
|
- if propinfo.PropType = TypeInfo(TDateTime) then
|
|
|
- begin
|
|
|
- if CompareText(value,'null') <> 0 then Result := JsonDateToDateTime(value);
|
|
|
- end
|
|
|
- else if propinfo.PropType = TypeInfo(TDate) then
|
|
|
- begin
|
|
|
- if CompareText(value,'null') <> 0 then Result := StrToDate(value);
|
|
|
- end
|
|
|
- else if propinfo.PropType = TypeInfo(TTime) then
|
|
|
- begin
|
|
|
- Result := StrToTime(value);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- fsettings := DefaultFormatSettings;
|
|
|
- Result := StrToFloat(StringReplace(value,'.',fsettings.DecimalSeparator,[]));
|
|
|
- end;
|
|
|
- end;
|
|
|
- tkEnumeration:
|
|
|
- begin
|
|
|
- Result := value;
|
|
|
- end;
|
|
|
- tkBool :
|
|
|
- begin
|
|
|
- Result := StrToBool(value);
|
|
|
- end;
|
|
|
- tkSet :
|
|
|
- begin
|
|
|
- Result := value;
|
|
|
- end;
|
|
|
- else
|
|
|
- begin
|
|
|
- //raise EclJsonSerializerError.Create('Not supported data type!');
|
|
|
- end;
|
|
|
- end;
|
|
|
- //if not Result.IsEmpty then SetPropertyValue(aObject,propinfo,Result);
|
|
|
- except
|
|
|
- on E : Exception do
|
|
|
- begin
|
|
|
- raise EJsonDeserializeError.CreateFmt('Deserialize error type "%s" : %s',[aObject.ClassName,e.Message]);
|
|
|
- end;
|
|
|
- end;
|
|
|
-end;
|
|
|
-{$ENDIF}
|
|
|
-
|
|
|
-function TRTTIJson.IsAllowedProperty(aObject : TObject; const aPropertyName : string) : Boolean;
|
|
|
-var
|
|
|
- propname : string;
|
|
|
-begin
|
|
|
- Result := True;
|
|
|
- propname := aPropertyName.ToLower;
|
|
|
- if IsGenericList(aObject) then
|
|
|
- begin
|
|
|
- if (propname = 'capacity') or (propname = 'count') or (propname = 'ownsobjects') then Result := False;
|
|
|
- end
|
|
|
- else if (propname = 'refcount') then Result := False;
|
|
|
-end;
|
|
|
-
|
|
|
-function TRTTIJson.IsGenericList(aObject : TObject) : Boolean;
|
|
|
-var
|
|
|
- cname : string;
|
|
|
-begin
|
|
|
- if aObject = nil then Exit(False);
|
|
|
-
|
|
|
- cname := aObject.ClassName;
|
|
|
- Result := (cname.StartsWith('TObjectList')) or (cname.StartsWith('TList'));
|
|
|
-end;
|
|
|
-
|
|
|
-function TRTTIJson.IsStream(aObject : TObject) : Boolean;
|
|
|
-begin
|
|
|
- if aObject = nil then Exit(False);
|
|
|
- Result := aObject.InheritsFrom(TStream);
|
|
|
-end;
|
|
|
-
|
|
|
-function TRTTIJson.GetGenericListType(aObject : TObject) : TGenericListType;
|
|
|
-var
|
|
|
- cname : string;
|
|
|
-begin
|
|
|
- if aObject = nil then Exit(TGenericListType.gtNone);
|
|
|
-
|
|
|
- cname := aObject.ClassName;
|
|
|
- if cname.StartsWith('TObjectList') then Result := TGenericListType.gtObjectList
|
|
|
- else if cname.StartsWith('TList') then Result := TGenericListType.gtList
|
|
|
- else Result := TGenericListType.gtNone;
|
|
|
-end;
|
|
|
-
|
|
|
-function TRTTIJson.IsGenericXArray(const aClassName : string) : Boolean;
|
|
|
-begin
|
|
|
- Result := aClassName.StartsWith('TXArray');
|
|
|
-end;
|
|
|
-
|
|
|
-function TRTTIJson.GetJsonPairValueByName(aJson: TJSONObject; const aName: string): TJsonValue;
|
|
|
-var
|
|
|
- candidate : TJSONPair;
|
|
|
- i : Integer;
|
|
|
-begin
|
|
|
- if fUseJsonCaseSense then
|
|
|
- begin
|
|
|
- Result := aJson.GetValue(aName);
|
|
|
- Exit;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- for i := 0 to aJson.Count - 1 do
|
|
|
- begin
|
|
|
- candidate := aJson.Pairs[I];
|
|
|
- if candidate.JsonValue = nil then continue;
|
|
|
- if CompareText(candidate.JsonString{$IFNDEF FPC}.Value{$ENDIF},aName) = 0 then Exit(candidate.JsonValue);
|
|
|
- end;
|
|
|
- end;
|
|
|
- Result := nil;
|
|
|
-end;
|
|
|
-
|
|
|
-function TRTTIJson.GetJsonPairByName(aJson: TJSONObject; const aName: string): TJSONPair;
|
|
|
-var
|
|
|
- i : Integer;
|
|
|
-begin
|
|
|
- if fUseJsonCaseSense then
|
|
|
- begin
|
|
|
- Result := TJSONPair(aJson.GetValue(aName));
|
|
|
- Exit;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- if aJson <> nil then
|
|
|
- begin
|
|
|
- for i := 0 to aJson.Count - 1 do
|
|
|
- begin
|
|
|
- Result := aJson.Pairs[I];
|
|
|
- if Result.JsonValue = nil then continue;
|
|
|
- if CompareText(Result.JsonString{$IFNDEF FPC}.Value{$ENDIF},aName) = 0 then Exit;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- Result := nil;
|
|
|
-end;
|
|
|
-
|
|
|
-//function TRTTIJson.GetPropertyValue(Instance : TObject; const PropertyName : string) : TValue;
|
|
|
-//var
|
|
|
-// pinfo : PPropInfo;
|
|
|
-//begin
|
|
|
-// Result := nil;
|
|
|
-// pinfo := GetPropInfo(Instance,PropertyName);
|
|
|
-// if pinfo = nil then raise EJsonSerializeError.CreateFmt('Property "%s" not found!',[PropertyName]);
|
|
|
-// case pinfo.PropType^.Kind of
|
|
|
-// tkInteger : Result := GetOrdProp(Instance,pinfo);
|
|
|
-// tkInt64 : Result := GetInt64Prop(Instance,PropertyName);
|
|
|
-// tkFloat : Result := GetFloatProp(Instance,PropertyName);
|
|
|
-// tkChar : Result := Char(GetOrdProp(Instance,PropertyName));
|
|
|
-// {$IFDEF FPC}
|
|
|
-// tkWString : Result := GetWideStrProp(Instance,PropertyName);
|
|
|
-// tkSString,
|
|
|
-// tkAString,
|
|
|
-// {$ELSE}
|
|
|
-// tkWString,
|
|
|
-// {$ENDIF}
|
|
|
-// tkLString : Result := GetStrProp(Instance,pinfo);
|
|
|
-// {$IFDEF FPC}
|
|
|
-// tkEnumeration :
|
|
|
-// begin
|
|
|
-// if fUseEnumNames then Result := GetEnumName(pinfo.PropType,GetOrdProp(Instance,PropertyName))
|
|
|
-// else Result := GetOrdProp(Instance,PropertyName);
|
|
|
-// end;
|
|
|
-// {$ELSE}
|
|
|
-// tkEnumeration :
|
|
|
-// begin
|
|
|
-// if fUseEnumNames then Result := GetEnumName(@pinfo.PropType,GetOrdProp(Instance,PropertyName))
|
|
|
-// else Result := GetOrdProp(Instance,PropertyName);
|
|
|
-// end;
|
|
|
-// {$ENDIF}
|
|
|
-// tkSet : Result := GetSetProp(Instance,pinfo,True);
|
|
|
-// {$IFNDEF FPC}
|
|
|
-// tkClass :
|
|
|
-// {$ELSE}
|
|
|
-// tkBool : Result := Boolean(GetOrdProp(Instance,pinfo));
|
|
|
-// tkObject :
|
|
|
-// {$ENDIF} Result := GetObjectProp(Instance,pinfo);
|
|
|
-// tkDynArray : Result := GetDynArrayProp(Instance,pinfo);
|
|
|
-// end;
|
|
|
-//end;
|
|
|
-
|
|
|
-function TRTTIJson.GetPropertyValueFromObject(Instance : TObject; const PropertyName : string) : TValue;
|
|
|
-var
|
|
|
- ctx : TRttiContext;
|
|
|
- rprop : TRttiProperty;
|
|
|
-begin
|
|
|
- rprop := ctx.GetType(Instance.ClassInfo).GetProperty(PropertyName);
|
|
|
- Result := rprop.GetValue(Instance);
|
|
|
-end;
|
|
|
-
|
|
|
-{$IFNDEF FPC}
|
|
|
-function TRTTIJson.GetFieldValueFromRecord(const aValue : TValue; const FieldName : string) : TValue;
|
|
|
-var
|
|
|
- ctx : TRttiContext;
|
|
|
- rec : TRttiRecordType;
|
|
|
- rfield : TRttiField;
|
|
|
-begin
|
|
|
- rec := ctx.GetType(aValue.TypeInfo).AsRecord;
|
|
|
- rfield := rec.GetField(FieldName);
|
|
|
- if rfield <> nil then Result := rField.GetValue(aValue.GetReferenceToRawData)
|
|
|
- else Result := nil;
|
|
|
-end;
|
|
|
-{$ENDIF}
|
|
|
-
|
|
|
-{$IFDEF FPC}
|
|
|
-procedure TRTTIJson.SetPropertyValue(Instance : TObject; const PropertyName : string; aValue : TValue);
|
|
|
-var
|
|
|
- pinfo : PPropInfo;
|
|
|
-begin
|
|
|
- pinfo := GetPropInfo(Instance,PropertyName);
|
|
|
- SetPropertyValue(Instance,pinfo,aValue);
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TRTTIJson.SetPropertyValue(Instance : TObject; aPropInfo : PPropInfo; aValue : TValue);
|
|
|
-begin
|
|
|
- case aPropInfo.PropType^.Kind of
|
|
|
- tkInteger : SetOrdProp(Instance,aPropInfo,aValue.AsInteger);
|
|
|
- tkInt64 : SetInt64Prop(Instance,aPropInfo,aValue.AsInt64);
|
|
|
- tkFloat : SetFloatProp(Instance,aPropInfo,aValue.AsExtended);
|
|
|
- tkChar : SetOrdProp(Instance,aPropInfo,aValue.AsOrdinal);
|
|
|
- {$IFDEF FPC}
|
|
|
- tkWString : SetWideStrProp(Instance,aPropInfo,aValue.AsString);
|
|
|
- tkSString,
|
|
|
- tkAString,
|
|
|
- {$ELSE}
|
|
|
- tkWString,
|
|
|
- {$ENDIF}
|
|
|
- tkLString : SetStrProp(Instance,aPropInfo,aValue.AsString);
|
|
|
- {$IFDEF FPC}
|
|
|
- tkBool : SetOrdProp(Instance,aPropInfo,aValue.AsOrdinal);
|
|
|
- tkSet : LoadSetProperty(Instance,aPropInfo,aValue.AsString);
|
|
|
- {$ENDIF}
|
|
|
- tkEnumeration : SetEnumProp(Instance,aPropInfo,aValue.AsString);
|
|
|
- {$IFNDEF FPC}
|
|
|
- tkClass :
|
|
|
- {$ELSE}
|
|
|
- tkObject :
|
|
|
- {$ENDIF} SetObjectProp(Instance,aPropInfo,aValue.AsObject);
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TRTTIJson.LoadSetProperty(aInstance : TObject; aPropInfo: PPropInfo; const aValue: string);
|
|
|
-type
|
|
|
- TCardinalSet = set of 0..SizeOf(Cardinal) * 8 - 1;
|
|
|
-const
|
|
|
- Delims = [' ', ',', '[', ']'];
|
|
|
-var
|
|
|
- TypeInfo: PTypeInfo;
|
|
|
- W: Cardinal;
|
|
|
- I, N: Integer;
|
|
|
- Count: Integer;
|
|
|
- EnumName: string;
|
|
|
-begin
|
|
|
- W := 0;
|
|
|
- TypeInfo := GetTypeData(GetPropType(aPropInfo))^.CompType;
|
|
|
- Count := WordCount(aValue, Delims);
|
|
|
- for N := 1 to Count do
|
|
|
- begin
|
|
|
- EnumName := ExtractWord(N, aValue, Delims);
|
|
|
- try
|
|
|
- I := GetEnumValue(TypeInfo, EnumName);
|
|
|
- if I >= 0 then Include(TCardinalSet(W),I);
|
|
|
- except
|
|
|
- end;
|
|
|
- end;
|
|
|
- SetOrdProp(aInstance,aPropInfo,W);
|
|
|
-end;
|
|
|
-{$ENDIF}
|
|
|
-
|
|
|
-function TRTTIJson.SerializeObject(aObject: TObject): TJSONObject;
|
|
|
-var
|
|
|
- ctx: TRttiContext;
|
|
|
- {$IFNDEF FPC}
|
|
|
- attr : TCustomAttribute;
|
|
|
- comment : string;
|
|
|
- {$ENDIF}
|
|
|
- rType: TRttiType;
|
|
|
- rProp: TRttiProperty;
|
|
|
- jpair : TJSONPair;
|
|
|
- ExcludeSerialize : Boolean;
|
|
|
- propertyname : string;
|
|
|
- propvalue : TValue;
|
|
|
-begin
|
|
|
- if (aObject = nil) then
|
|
|
- begin
|
|
|
- Result := nil;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
-
|
|
|
- Result := nil;
|
|
|
- try
|
|
|
- //if is GenericList
|
|
|
- if IsGenericList(aObject) then
|
|
|
- begin
|
|
|
- //get list array
|
|
|
- propvalue := GetPropertyValueFromObject(aObject,'List');
|
|
|
- {$IFDEF DELPHIRX10_UP}
|
|
|
- Result := TJSONObject(SerializeDynArray(propvalue,TList<TObject>(aObject).Count));
|
|
|
- {$ELSE}
|
|
|
- Result := TJSONObject(SerializeValue(propvalue));
|
|
|
- {$ENDIF}
|
|
|
- Exit;
|
|
|
- end
|
|
|
- {$IFNDEF FPC}
|
|
|
- else if IsStream(aObject) then
|
|
|
- begin
|
|
|
- Result := TJSONObject(SerializeStream(aObject));
|
|
|
- Exit;
|
|
|
- end
|
|
|
- {$ENDIF}
|
|
|
- else Result := TJSONObject.Create;
|
|
|
- //if is standard object
|
|
|
- propertyname := '';
|
|
|
- rType := ctx.GetType(aObject.ClassInfo);
|
|
|
- for rProp in TRTTI.GetProperties(rType,roFirstBase) do
|
|
|
- begin
|
|
|
- ExcludeSerialize := False;
|
|
|
- propertyname := rProp.Name;
|
|
|
- {$IFNDEF FPC}
|
|
|
- comment := '';
|
|
|
- if not rProp.IsReadable then Continue;
|
|
|
- for attr in rProp.GetAttributes do
|
|
|
- begin
|
|
|
- if attr is TNotSerializableProperty then ExcludeSerialize := True
|
|
|
- else if attr is TCommentProperty then comment := TCommentProperty(attr).Comment
|
|
|
- else if attr is TCustomNameProperty then propertyname := TCustomNameProperty(attr).Name;
|
|
|
- end;
|
|
|
- if ((fSerializeLevel = slPublicProperty) and (rProp.PropertyType.IsPublicType))
|
|
|
- or ((fSerializeLevel = slPublishedProperty) and ((IsPublishedProp(aObject,rProp.Name)) or (rProp.Name = 'List'))) then
|
|
|
- {$ENDIF}
|
|
|
- begin
|
|
|
- if (IsAllowedProperty(aObject,propertyname)) and (not ExcludeSerialize) then
|
|
|
- begin
|
|
|
- //add comment as pair
|
|
|
- {$IFNDEF FPC}
|
|
|
- if comment <> '' then Result.AddPair(TJSONPair.Create('#Comment#->'+propertyname,Comment));
|
|
|
- {$ENDIF}
|
|
|
- begin
|
|
|
- propvalue := rProp.GetValue(aObject);
|
|
|
- jpair := TJSONPair.Create(propertyName,nil);
|
|
|
-// if (propvalue.IsObject) and (IsGenericList(propvalue.AsObject)) then
|
|
|
-// begin
|
|
|
-// jpair.JsonValue := SerializeValue(GetPropertyValueFromObject(propvalue.AsObject,'List'));
|
|
|
-// end
|
|
|
- if propvalue.IsObject then jpair.JsonValue := SerializeObject(propvalue.AsObject)
|
|
|
- {$IFNDEF FPC}
|
|
|
- else if (not propvalue.IsObject) and (IsGenericXArray(string(propvalue{$IFNDEF NEXTGEN}.TypeInfo.Name{$ELSE}.TypeInfo.NameFld.ToString{$ENDIF}))) then
|
|
|
- begin
|
|
|
- jpair.JsonValue := SerializeValue(GetFieldValueFromRecord(propvalue,'fArray'));
|
|
|
- end
|
|
|
- {$ENDIF}
|
|
|
- else
|
|
|
- begin
|
|
|
- {$IFNDEF FPC}
|
|
|
- jpair.JsonValue := SerializeValue(propvalue);
|
|
|
- {$ELSE}
|
|
|
- jpair.JsonValue := SerializeValue(propvalue);// SerializeObject(aObject,rProp.PropertyType.TypeKind,propertyname);
|
|
|
- {$ENDIF}
|
|
|
- end;
|
|
|
- //s := jpair.JsonValue.ToString;
|
|
|
- if jpair.JsonValue <> nil then
|
|
|
- begin
|
|
|
- Result.AddPair(jpair);
|
|
|
- end
|
|
|
- else jpair.Free;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- except
|
|
|
- on E : Exception do
|
|
|
- begin
|
|
|
- if Result <> nil then Result.Free;
|
|
|
- if not propertyname.IsEmpty then raise EJsonSerializeError.CreateFmt('Serialize Error -> Object property: "%s" (%s)',[propertyname,e.Message])
|
|
|
- else raise EJsonSerializeError.CreateFmt('Serialize Error -> Object (%s)',[e.Message]);
|
|
|
- end;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-function TRTTIJson.GetValue(aAddr: Pointer; aType: TRTTIType): TValue;
|
|
|
-begin
|
|
|
- TValue.Make(aAddr,aType.Handle,Result);
|
|
|
-end;
|
|
|
-
|
|
|
-{$IFDEF FPC}
|
|
|
-function TRTTIJson.GetValue(aAddr: Pointer; aTypeInfo: PTypeInfo): TValue;
|
|
|
-begin
|
|
|
- TValue.Make(aAddr,aTypeInfo,Result);
|
|
|
-end;
|
|
|
-{$ENDIF}
|
|
|
-
|
|
|
-function TRTTIJson.SerializeValue(const aValue : TValue) : TJSONValue;
|
|
|
-begin
|
|
|
- Result := nil;
|
|
|
- case avalue.Kind of
|
|
|
- tkDynArray :
|
|
|
- begin
|
|
|
- {$IFNDEF FPC}
|
|
|
- Result := SerializeDynArray(aValue);
|
|
|
- {$ENDIF}
|
|
|
- end;
|
|
|
- tkClass :
|
|
|
- begin
|
|
|
- Result := TJSONValue(SerializeObject(aValue.AsObject));
|
|
|
- end;
|
|
|
- tkString, tkLString, tkWString, tkUString :
|
|
|
- begin
|
|
|
- Result := TJSONString.Create(aValue.AsString);
|
|
|
- end;
|
|
|
- tkChar, tkWChar :
|
|
|
- begin
|
|
|
- Result := TJSONString.Create(aValue.AsString);
|
|
|
- end;
|
|
|
- tkInteger :
|
|
|
- begin
|
|
|
- Result := TJSONNumber.Create(aValue.AsInteger);
|
|
|
- end;
|
|
|
- tkInt64 :
|
|
|
- begin
|
|
|
- Result := TJSONNumber.Create(aValue.AsInt64);
|
|
|
- end;
|
|
|
- tkFloat :
|
|
|
- begin
|
|
|
- if aValue.TypeInfo = TypeInfo(TDateTime) then
|
|
|
- begin
|
|
|
- if aValue.AsExtended <> 0.0 then Result := TJSONString.Create(DateTimeToJsonDate(aValue.AsExtended));
|
|
|
- end
|
|
|
- else if aValue.TypeInfo = TypeInfo(TDate) then
|
|
|
- begin
|
|
|
- if aValue.AsExtended <> 0.0 then Result := TJSONString.Create(DateToStr(aValue.AsExtended));
|
|
|
- end
|
|
|
- else if aValue.TypeInfo = TypeInfo(TTime) then
|
|
|
- begin
|
|
|
- Result := TJSONString.Create(TimeToStr(aValue.AsExtended));
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- Result := TJSONNumber.Create(aValue.AsExtended);
|
|
|
- end;
|
|
|
- end;
|
|
|
- tkEnumeration :
|
|
|
- begin
|
|
|
- if (aValue.TypeInfo = System.TypeInfo(Boolean)) then
|
|
|
- begin
|
|
|
- {$IF Defined(DELPHIRX10_UP) OR Defined(FPC)}
|
|
|
- Result := TJSONBool.Create(aValue.AsBoolean);
|
|
|
- {$ELSE}
|
|
|
- if aValue.AsBoolean then Result := TJsonTrue.Create
|
|
|
- else Result := TJsonFalse.Create;
|
|
|
- {$ENDIF}
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- //Result.JsonValue := TJSONString.Create(GetEnumName(aValue.TypeInfo,aValue.AsOrdinal));
|
|
|
- if fUseEnumNames then Result := TJSONString.Create(aValue.ToString)
|
|
|
- else Result := TJSONNumber.Create(GetEnumValue(aValue.TypeInfo,aValue.ToString));
|
|
|
- end;
|
|
|
- end;
|
|
|
- {$IFDEF FPC}
|
|
|
- tkBool :
|
|
|
- begin
|
|
|
- Result := TJSONBool.Create(aValue.AsBoolean);
|
|
|
- end;
|
|
|
- {$ENDIF}
|
|
|
- tkSet :
|
|
|
- begin
|
|
|
- Result := TJSONString.Create(aValue.ToString);
|
|
|
- end;
|
|
|
- tkRecord :
|
|
|
- begin
|
|
|
- {$IFNDEF FPC}
|
|
|
- Result := SerializeRecord(aValue);
|
|
|
- {$ENDIF}
|
|
|
- end;
|
|
|
- tkVariant :
|
|
|
- begin
|
|
|
- {$IFNDEF FPC}
|
|
|
- case VarType(aValue.AsVariant) and VarTypeMask of
|
|
|
- varInteger, varInt64 : Result := TJSONNumber.Create(aValue.AsInteger);
|
|
|
- varString, varUString, varEmpty : Result := TJSONString.Create(aValue.AsString);
|
|
|
- varDouble : Result := TJSONNumber.Create(aValue.AsExtended);
|
|
|
- end;
|
|
|
- {$ENDIF}
|
|
|
- end;
|
|
|
- tkMethod, tkPointer, tkClassRef ,tkInterface, tkProcedure, tkUnknown :
|
|
|
- begin
|
|
|
- //skip these properties
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- {$IFNDEF FPC}
|
|
|
- raise EJsonSerializeError.CreateFmt(cNotSupportedDataType,[GetTypeName(aValue.TypeInfo)]);
|
|
|
- {$ELSE}
|
|
|
- raise EJsonSerializeError.Create('Not supported Data Type');
|
|
|
- {$ENDIF}
|
|
|
- end;
|
|
|
- end;
|
|
|
- if Result = nil then Result := TJSONNull.Create;
|
|
|
-end;
|
|
|
-
|
|
|
-function TRTTIJson.SerializeStream(aObject: TObject): TJSONValue;
|
|
|
-var
|
|
|
- stream : TStream;
|
|
|
-begin
|
|
|
- Result := nil;
|
|
|
- try
|
|
|
- stream := TStream(aObject);
|
|
|
- if fUseBase64Stream then Result := TJSONString.Create(Base64Encode(StreamToString(stream,TEncoding.Ansi)))
|
|
|
- else Result := TJSONString.Create(StreamToString(stream,TEncoding.Ansi));
|
|
|
- except
|
|
|
- on E : Exception do
|
|
|
- begin
|
|
|
- EJsonSerializeError.CreateFmt('Serialize Error -> Stream (%s)',[e.Message]);
|
|
|
- end;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-{$IFNDEF FPC}
|
|
|
-function TRTTIJson.SerializeDynArray(const aValue: TValue; aMaxElements : Integer = -1) : TJsonArray;
|
|
|
-var
|
|
|
- ctx : TRttiContext;
|
|
|
- rDynArray : TRTTIDynamicArrayType;
|
|
|
- i : Integer;
|
|
|
- jValue : TJSONValue;
|
|
|
- element : Integer;
|
|
|
- list : TList<TJSONValue>;
|
|
|
- len : Integer;
|
|
|
-begin
|
|
|
- element := -1;
|
|
|
- Result := TJSONArray.Create;
|
|
|
- try
|
|
|
- rDynArray := ctx.GetType(aValue.TypeInfo) as TRTTIDynamicArrayType;
|
|
|
- //if aValue.IsObjectInstance then TList<TObject>(aValue.AsObject).TrimExcess;
|
|
|
-
|
|
|
- list := TList<TJSONValue>.Create;
|
|
|
- if aMaxElements = -1 then len := aValue.GetArrayLength
|
|
|
- else len := aMaxElements;
|
|
|
-
|
|
|
- list.Capacity := len;
|
|
|
- for i := 0 to len - 1 do
|
|
|
- begin
|
|
|
- if not GetValue(PPByte(aValue.GetReferenceToRawData)^ + rDynArray.ElementType.TypeSize * i, rDynArray.ElementType).IsEmpty then
|
|
|
- begin
|
|
|
- element := i;
|
|
|
- jValue := SerializeValue(GetValue(PPByte(aValue.GetReferenceToRawData)^ + rDynArray.ElementType.TypeSize * i, rDynArray.ElementType));
|
|
|
- if jValue = nil then jValue := TJSONNull.Create;
|
|
|
- list.Add(jValue);
|
|
|
- end;
|
|
|
- end;
|
|
|
- Result.SetElements(list);
|
|
|
- except
|
|
|
- on E : Exception do
|
|
|
- begin
|
|
|
- if element > -1 then raise EJsonSerializeError.CreateFmt('Serialize Error -> Array[%d] (%s)',[element,e.Message])
|
|
|
- else raise EJsonSerializeError.CreateFmt('Serialize Error -> Array (%s)',[e.Message]);
|
|
|
- end;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-function TRTTIJson.SerializeRecord(const aValue : TValue) : TJSONValue;
|
|
|
-var
|
|
|
- ctx : TRttiContext;
|
|
|
- json : TJSONObject;
|
|
|
- rRec : TRttiRecordType;
|
|
|
- rField : TRttiField;
|
|
|
-begin
|
|
|
- rField := nil;
|
|
|
- try
|
|
|
- rRec := ctx.GetType(aValue.TypeInfo).AsRecord;
|
|
|
- if aValue.TypeInfo = System.TypeInfo(TGUID) then
|
|
|
- begin
|
|
|
- Result := TJSONString.Create(GUIDToString(aValue.AsType<TGUID>));
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- json := TJSONObject.Create;
|
|
|
- for rField in rRec.GetFields do
|
|
|
- begin
|
|
|
- json.AddPair(rField.Name,SerializeValue(rField.GetValue(aValue.GetReferenceToRawData)));
|
|
|
- end;
|
|
|
- Result := json;
|
|
|
- end;
|
|
|
- except
|
|
|
- on E : Exception do
|
|
|
- begin
|
|
|
- if rField <> nil then raise EJsonSerializeError.CreateFmt('Serialize Error -> Record property "%s" (%s)',[rField.Name,e.Message])
|
|
|
- else raise EJsonSerializeError.CreateFmt('Serialize Error -> Record (%s)',[e.Message]);
|
|
|
- end;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-{$ELSE}
|
|
|
-function TRTTIJson.GetPropType(aPropInfo: PPropInfo): PTypeInfo;
|
|
|
-begin
|
|
|
- Result := aPropInfo^.PropType;
|
|
|
-end;
|
|
|
-
|
|
|
-function TRTTIJson.FloatProperty(aObject : TObject; aPropInfo: PPropInfo): string;
|
|
|
-const
|
|
|
- Precisions: array[TFloatType] of Integer = (7, 15, 18, 18, 19);
|
|
|
-var
|
|
|
- fsettings : TFormatSettings;
|
|
|
-begin
|
|
|
- fsettings := FormatSettings;
|
|
|
- Result := StringReplace(FloatToStrF(GetFloatProp(aObject, aPropInfo), ffGeneral,
|
|
|
- Precisions[GetTypeData(GetPropType(aPropInfo))^.FloatType],0),
|
|
|
- '.',fsettings.DecimalSeparator,[rfReplaceAll]);
|
|
|
-end;
|
|
|
-
|
|
|
-function TRTTIJson.SerializeObject(aObject : TObject; aType : TTypeKind; const aPropertyName : string) : TJSONPair;
|
|
|
-var
|
|
|
- propinfo : PPropInfo;
|
|
|
- jArray : TJsonArray;
|
|
|
- jPair : TJsonPair;
|
|
|
- jValue : TJsonValue;
|
|
|
- i : Integer;
|
|
|
- pArr : Pointer;
|
|
|
- rValue : TValue;
|
|
|
- rItemValue : TValue;
|
|
|
- len : Integer;
|
|
|
-begin
|
|
|
- try
|
|
|
- Result := TJSONPair.Create(aPropertyName,nil);
|
|
|
-
|
|
|
- propinfo := GetPropInfo(aObject,aPropertyName);
|
|
|
- //case propinfo.PropType.Kind of
|
|
|
- case aType of
|
|
|
- tkDynArray :
|
|
|
- begin
|
|
|
- len := 0;
|
|
|
- jArray := TJSONArray.Create;
|
|
|
- try
|
|
|
- pArr := GetDynArrayProp(aObject,aPropertyName);
|
|
|
- TValue.Make(@pArr,propinfo.PropType, rValue);
|
|
|
- if rValue.IsArray then
|
|
|
- begin
|
|
|
- len := rValue.GetArrayLength;
|
|
|
- for i := 0 to len - 1 do
|
|
|
- begin
|
|
|
- rItemValue := rValue.GetArrayElement(i);
|
|
|
- jValue := SerializeValue(rItemValue);
|
|
|
- jArray.Add(jValue);
|
|
|
- end;
|
|
|
- end;
|
|
|
- Result.JsonValue := jArray;
|
|
|
- finally
|
|
|
- //DynArrayClear(pArr,propinfo.PropType);
|
|
|
- pArr := nil;
|
|
|
- end;
|
|
|
- end;
|
|
|
- tkClass :
|
|
|
- begin
|
|
|
- Result.JsonValue := TJSONValue(SerializeObject(GetObjectProp(aObject,aPropertyName)));
|
|
|
- end;
|
|
|
- tkString, tkLString, tkWString, tkUString, tkAString :
|
|
|
- begin
|
|
|
- Result.JsonValue := TJSONString.Create(GetStrProp(aObject,aPropertyName));
|
|
|
- end;
|
|
|
- tkChar, tkWChar :
|
|
|
- begin
|
|
|
- Result.JsonValue := TJSONString.Create(Char(GetOrdProp(aObject,aPropertyName)));
|
|
|
- end;
|
|
|
- tkInteger :
|
|
|
- begin
|
|
|
- Result.JsonValue := TJSONNumber.Create(GetOrdProp(aObject,aPropertyName));
|
|
|
- end;
|
|
|
- tkInt64 :
|
|
|
- begin
|
|
|
- Result.JsonValue := TJSONNumber.Create(GetOrdProp(aObject,aPropertyName));
|
|
|
- end;
|
|
|
- tkFloat :
|
|
|
- begin
|
|
|
- if propinfo.PropType = TypeInfo(TDateTime) then
|
|
|
- begin
|
|
|
- Result.JsonValue := TJSONString.Create(DateTimeToJsonDate(GetFloatProp(aObject,aPropertyName)));
|
|
|
- end
|
|
|
- else if propinfo.PropType = TypeInfo(TDate) then
|
|
|
- begin
|
|
|
- Result.JsonValue := TJSONString.Create(DateToStr(GetFloatProp(aObject,aPropertyName)));
|
|
|
- end
|
|
|
- else if propinfo.PropType = TypeInfo(TTime) then
|
|
|
- begin
|
|
|
- Result.JsonValue := TJSONString.Create(TimeToStr(GetFloatProp(aObject,aPropertyName)));
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- //Result.JsonValue := TJsonFloatNumber.Create(GetFloatProp(aObject,aPropertyName));
|
|
|
- Result.JsonValue := TJsonFloatNumber.Create(StrToFloat(FloatProperty(aObject,propinfo)));
|
|
|
- end;
|
|
|
- end;
|
|
|
- tkEnumeration,tkBool :
|
|
|
- begin
|
|
|
- if (propinfo.PropType = System.TypeInfo(Boolean)) then
|
|
|
- begin
|
|
|
- Result.JsonValue := TJSONBool.Create(Boolean(GetOrdProp(aObject,aPropertyName)));
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- if fUseEnumNames then Result.JsonValue := TJSONString.Create(GetEnumName(propinfo.PropType,GetOrdProp(aObject,aPropertyName)))
|
|
|
- else Result.JsonValue := TJSONNumber.Create(GetOrdProp(aObject,aPropertyName));
|
|
|
- //Result.JsonValue := TJSONString.Create(aValue.ToString);
|
|
|
- end;
|
|
|
- end;
|
|
|
- tkSet :
|
|
|
- begin
|
|
|
- Result.JsonValue := TJSONString.Create(GetSetProp(aObject,aPropertyName));
|
|
|
- end;
|
|
|
- {$IFNDEF FPC}
|
|
|
- tkRecord :
|
|
|
- begin
|
|
|
- Result.JsonValue := SerializeRecord(aValue);
|
|
|
- end;
|
|
|
- {$ENDIF}
|
|
|
- tkMethod, tkPointer, tkClassRef ,tkInterface, tkProcedure :
|
|
|
- begin
|
|
|
- //skip these properties
|
|
|
- //FreeAndNil(Result);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
-
|
|
|
- //raise EJsonDeserializeError.CreateFmt('Not supported type "%s":%d',[aName,Integer(aValue.Kind)]);
|
|
|
- end;
|
|
|
- end;
|
|
|
- if Result.JsonValue = nil then Result.JsonValue := TJSONNull.Create;
|
|
|
- except
|
|
|
- on E : Exception do
|
|
|
- begin
|
|
|
- Result.Free;
|
|
|
- {$IFNDEF FPC}
|
|
|
- raise EJsonSerializeError.CreateFmt('Serialize error class "%s.%s" : %s',[aName,aValue.ToString,e.Message]);
|
|
|
- {$ENDIF}
|
|
|
- end;
|
|
|
- end;
|
|
|
-end;
|
|
|
-{$ENDIF}
|
|
|
-
|
|
|
-
|
|
|
-{ TJsonSerializer}
|
|
|
-
|
|
|
-constructor TJsonSerializer.Create(aSerializeLevel: TSerializeLevel; aUseEnumNames : Boolean = True; aUseNullStringsAsEmpty : Boolean = False);
|
|
|
-begin
|
|
|
- {$IFDEF FPC}
|
|
|
- if aSerializeLevel = TSerializeLevel.slPublicProperty then raise EJsonSerializeError.Create('FreePascal RTTI only supports published properties');
|
|
|
- {$ENDIF}
|
|
|
- fSerializeLevel := aSerializeLevel;
|
|
|
- fUseEnumNames := aUseEnumNames;
|
|
|
- fUseJsonCaseSense := False;
|
|
|
- fUseBase64Stream := True;
|
|
|
- fUseNullStringsAsEmpty := aUseNullStringsAsEmpty;
|
|
|
- fRTTIJson := TRTTIJson.Create(aSerializeLevel,aUseEnumNames);
|
|
|
- fRTTIJson.UseJsonCaseSense := fUseJsonCaseSense;
|
|
|
- fRTTIJson.UseBase64Stream := fUseBase64Stream;
|
|
|
- fRTTIJson.UseNullStringsAsEmpty := fUseNullStringsAsEmpty;
|
|
|
-end;
|
|
|
-
|
|
|
-destructor TJsonSerializer.Destroy;
|
|
|
-begin
|
|
|
- fRTTIJson.Free;
|
|
|
- inherited;
|
|
|
-end;
|
|
|
-
|
|
|
-function TJsonSerializer.JsonToObject(aType: TClass; const aJson: string): TObject;
|
|
|
-var
|
|
|
- json: TJSONObject;
|
|
|
-begin
|
|
|
- {$IFDEF DEBUG_SERIALIZER}
|
|
|
- TDebugger.TimeIt(Self,'JsonToObject',aType.ClassName);
|
|
|
- {$ENDIF}
|
|
|
- try
|
|
|
- {$IFDEF DELPHIRX10_UP}
|
|
|
- json := TJSONObject.ParseJSONValue(aJson,True) as TJSONObject;
|
|
|
- {$ELSE}
|
|
|
- {$IFDEF FPC}
|
|
|
- json := TJSONObject(TJSONObject.ParseJSONValue(aJson,True));
|
|
|
- {$ELSE}
|
|
|
- json := TJsonObject.ParseJSONValue(TEncoding.UTF8.GetBytes(aJson),0,True) as TJSONObject;
|
|
|
- {$ENDIF}
|
|
|
- {$ENDIF}
|
|
|
- except
|
|
|
- raise EJsonDeserializeError.Create(cNotValidJson);
|
|
|
- end;
|
|
|
- try
|
|
|
- Result := fRTTIJson.DeserializeClass(aType,json);
|
|
|
- finally
|
|
|
- json.Free;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-function TJsonSerializer.JsonToObject(aObject: TObject; const aJson: string): TObject;
|
|
|
-var
|
|
|
- jvalue : TJSONValue;
|
|
|
- json: TJSONObject;
|
|
|
-begin;
|
|
|
- if aObject = nil then raise EJsonDeserializeError.Create('Object param cannot be null!');
|
|
|
-
|
|
|
- {$IFDEF DEBUG_SERIALIZER}
|
|
|
- TDebugger.TimeIt(Self,'JsonToObject',aObject.ClassName);
|
|
|
- {$ENDIF}
|
|
|
- try
|
|
|
- {$IFDEF DELPHIRX10_UP}
|
|
|
- jvalue := TJSONObject.ParseJSONValue(aJson,True);
|
|
|
- if jvalue.ClassType = TJSONArray then json := TJSONObject(jvalue)
|
|
|
- else json := jvalue as TJSONObject;
|
|
|
-
|
|
|
- //json := TJSONObject.ParseJSONValue(aJson,True) as TJSONObject;
|
|
|
- {$ELSE}
|
|
|
- {$IFDEF FPC}
|
|
|
- json := TJSONObject(TJSONObject.ParseJSONValue(aJson,True));
|
|
|
- {$ELSE}
|
|
|
- json := TJsonObject.ParseJSONValue(TEncoding.UTF8.GetBytes(aJson),0,True) as TJSONObject;
|
|
|
- {$ENDIF}
|
|
|
- {$ENDIF}
|
|
|
- except
|
|
|
- raise EJsonDeserializeError.Create(cNotValidJson);
|
|
|
- end;
|
|
|
- try
|
|
|
- Result := fRTTIJson.DeserializeObject(aObject,json);
|
|
|
- finally
|
|
|
- json.Free;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-function TJsonSerializer.ObjectToJson(aObject : TObject; aIndent : Boolean = False): string;
|
|
|
-var
|
|
|
- json: TJSONObject;
|
|
|
-begin
|
|
|
- {$IFDEF DEBUG_SERIALIZER}
|
|
|
- TDebugger.TimeIt(Self,'ObjectToJson',aObject.ClassName);
|
|
|
- {$ENDIF}
|
|
|
- json := fRTTIJson.SerializeObject(aObject);
|
|
|
- try
|
|
|
- if aIndent then Result := TJsonUtils.JsonFormat(json.ToJSON)
|
|
|
- else Result := json.ToJSON;
|
|
|
- finally
|
|
|
- json.Free;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TJsonSerializer.ObjectToJsonStream(aObject: TObject; aStream: TStream);
|
|
|
-var
|
|
|
- json : TJsonObject;
|
|
|
- ss : TStringStream;
|
|
|
-begin
|
|
|
- {$IFDEF DEBUG_SERIALIZER}
|
|
|
- TDebugger.TimeIt(Self,'ObjectToJsonStream',aObject.ClassName);
|
|
|
- {$ENDIF}
|
|
|
- if aStream = nil then raise EJsonSerializeError.Create('stream parameter cannot be nil!');
|
|
|
-
|
|
|
- json := fRTTIJson.SerializeObject(aObject);
|
|
|
- try
|
|
|
- ss := TStringStream.Create(json.ToString,TEncoding.UTF8);
|
|
|
- try
|
|
|
- aStream.CopyFrom(ss,ss.Size);
|
|
|
- finally
|
|
|
- ss.Free;
|
|
|
- end;
|
|
|
- finally
|
|
|
- json.Free;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-function TJsonSerializer.ObjectToJsonString(aObject : TObject; aIndent : Boolean = False): string;
|
|
|
-var
|
|
|
- json: TJSONObject;
|
|
|
-begin
|
|
|
- {$IFDEF DEBUG_SERIALIZER}
|
|
|
- TDebugger.TimeIt(Self,'ObjectToJsonString',aObject.ClassName);
|
|
|
- {$ENDIF}
|
|
|
- json := fRTTIJson.SerializeObject(aObject);
|
|
|
- try
|
|
|
- if aIndent then Result := TJsonUtils.JsonFormat(json.ToString)
|
|
|
- else Result := json.ToString;
|
|
|
- finally
|
|
|
- json.Free;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-function TJsonSerializer.ValueToJson(const aValue: TValue; aIndent: Boolean): string;
|
|
|
-var
|
|
|
- json: TJSONValue;
|
|
|
-begin
|
|
|
- {$IFDEF DEBUG_SERIALIZER}
|
|
|
- TDebugger.TimeIt(Self,'ValueToJson',aValue.ToString);
|
|
|
- {$ENDIF}
|
|
|
- json:= fRTTIJson.SerializeValue(aValue);
|
|
|
- if json = nil then raise EJsonSerializerError.Create('Error serializing TValue');
|
|
|
- try
|
|
|
- if aIndent then Result := TJsonUtils.JsonFormat(json{$IFNDEF FPC}.ToJSON{$ELSE}.AsJson{$ENDIF})
|
|
|
- else Result := json{$IFNDEF FPC}.ToJSON{$ELSE}.AsJson{$ENDIF};
|
|
|
- finally
|
|
|
- json.Free;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-function TJsonSerializer.ValueToJsonString(const aValue: TValue; aIndent: Boolean): string;
|
|
|
-var
|
|
|
- json: TJSONValue;
|
|
|
-begin
|
|
|
- {$IFDEF DEBUG_SERIALIZER}
|
|
|
- TDebugger.TimeIt(Self,'ValueToJsonString',aValue.ToString);
|
|
|
- {$ENDIF}
|
|
|
- json:= fRTTIJson.SerializeValue(aValue);
|
|
|
- if json = nil then raise EJsonSerializerError.Create('Error serializing TValue');
|
|
|
- try
|
|
|
- if aIndent then Result := TJsonUtils.JsonFormat(json.ToString)
|
|
|
- else Result := json.ToString;
|
|
|
- finally
|
|
|
- json.Free;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-function TJsonSerializer.ArrayToJson<T>(aArray: TArray<T>; aIndent: Boolean): string;
|
|
|
-var
|
|
|
- json: TJSONValue;
|
|
|
-begin
|
|
|
- {$IFDEF DEBUG_SERIALIZER}
|
|
|
- TDebugger.TimeIt(Self,'ArrayToJson','');
|
|
|
- {$ENDIF}
|
|
|
- json:= fRTTIJson.SerializeValue(TValue.From<TArray<T>>(aArray));
|
|
|
- if json = nil then raise EJsonSerializerError.Create('Error serializing Array');
|
|
|
- try
|
|
|
- if aIndent then Result := TJsonUtils.JsonFormat(json{$IFNDEF FPC}.ToJSON{$ELSE}.AsJson{$ENDIF})
|
|
|
- else Result := json{$IFNDEF FPC}.ToJSON{$ELSE}.AsJson{$ENDIF};
|
|
|
- finally
|
|
|
- json.Free;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-function TJsonSerializer.ArrayToJsonString<T>(aArray: TArray<T>; aIndent: Boolean): string;
|
|
|
-var
|
|
|
- json: TJSONValue;
|
|
|
-begin
|
|
|
- {$IFDEF DEBUG_SERIALIZER}
|
|
|
- TDebugger.TimeIt(Self,'ArrayToJsonString','');
|
|
|
- {$ENDIF}
|
|
|
- json:= fRTTIJson.SerializeValue(TValue.From<TArray<T>>(aArray));
|
|
|
- if json = nil then raise EJsonSerializerError.Create('Error serializing Array');
|
|
|
- try
|
|
|
- if aIndent then Result := TJsonUtils.JsonFormat(json.ToString)
|
|
|
- else Result := json.ToString;
|
|
|
- finally
|
|
|
- json.Free;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-function TJsonSerializer.JsonStreamToObject(aObject: TObject; aJsonStream: TStream): TObject;
|
|
|
-var
|
|
|
- json : string;
|
|
|
-begin
|
|
|
- {$IFDEF DEBUG_SERIALIZER}
|
|
|
- TDebugger.TimeIt(Self,'JsonStreamToObject','');
|
|
|
- {$ENDIF}
|
|
|
- if aJsonStream = nil then raise EJsonDeserializeError.Create('JsonStream param cannot be nil!');
|
|
|
-
|
|
|
- json := StreamToString(aJsonStream,TEncoding.UTF8);
|
|
|
- Result := JsonToObject(aObject,json);
|
|
|
-end;
|
|
|
-
|
|
|
-{$IFNDEF FPC}
|
|
|
-
|
|
|
-function TJsonSerializer.JsonToArray<T>(const aJson: string): TArray<T>;
|
|
|
-var
|
|
|
- jarray: TJSONArray;
|
|
|
- value : TValue;
|
|
|
-begin;
|
|
|
- {$IFDEF DEBUG_SERIALIZER}
|
|
|
- TDebugger.TimeIt(Self,'JsonToArray','');
|
|
|
- {$ENDIF}
|
|
|
- try
|
|
|
- {$If Defined(FPC) OR Defined(DELPHIRX10_UP)}
|
|
|
- jarray := TJSONObject.ParseJSONValue(aJson,True) as TJSONArray;
|
|
|
- {$ELSE}
|
|
|
- jarray := TJsonObject.ParseJSONValue(TEncoding.UTF8.GetBytes(aJson),0,True) as TJSONArray;
|
|
|
- {$ENDIF}
|
|
|
- except
|
|
|
- raise EJsonDeserializeError.Create(cNotValidJson);
|
|
|
- end;
|
|
|
- try
|
|
|
- value := fRTTIJson.DeserializeDynArray(PTypeInfo(TypeInfo(TArray<T>)),nil,jarray);
|
|
|
- Result := value.AsType<TArray<T>>;
|
|
|
- finally
|
|
|
- jarray.Free;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-function TJsonSerializer.JsonToValue(const aJson: string): TValue;
|
|
|
-var
|
|
|
- json: TJSONObject;
|
|
|
- value : TValue;
|
|
|
-begin;
|
|
|
- {$IFDEF DEBUG_SERIALIZER}
|
|
|
- TDebugger.TimeIt(Self,'JsonToValue','');
|
|
|
- {$ENDIF}
|
|
|
- try
|
|
|
- {$If Defined(FPC) OR Defined(DELPHIRX10_UP)}
|
|
|
- json := TJSONObject.ParseJSONValue(aJson,True) as TJSONObject;
|
|
|
- {$ELSE}
|
|
|
- json := TJsonObject.ParseJSONValue(TEncoding.UTF8.GetBytes(aJson),0,True) as TJSONObject;
|
|
|
- {$ENDIF}
|
|
|
- except
|
|
|
- raise EJsonDeserializeError.Create(cNotValidJson);
|
|
|
- end;
|
|
|
- try
|
|
|
- value := fRTTIJson.DeserializeRecord(value,nil,json);
|
|
|
- Result := value; // value.AsType<TArray<T>>;
|
|
|
- finally
|
|
|
- json.Free;
|
|
|
- end;
|
|
|
-end;
|
|
|
-{$ENDIF}
|
|
|
-
|
|
|
-procedure TJsonSerializer.SetSerializeLevel(const Value: TSerializeLevel);
|
|
|
-begin
|
|
|
- fSerializeLevel := Value;
|
|
|
- if Assigned(fRTTIJson) then fRTTIJson.fSerializeLevel := Value;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TJsonSerializer.SetUseBase64Stream(const Value: Boolean);
|
|
|
-begin
|
|
|
- fUseBase64Stream := Value;
|
|
|
- if Assigned(fRTTIJson) then fRTTIJson.UseBase64Stream := Value;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TJsonSerializer.SetUseEnumNames(const Value: Boolean);
|
|
|
-begin
|
|
|
- fUseEnumNames := Value;
|
|
|
- if Assigned(fRTTIJson) then fRTTIJson.UseEnumNames := Value;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TJsonSerializer.SetUseJsonCaseSense(const Value: Boolean);
|
|
|
-begin
|
|
|
- fUseJsonCaseSense := Value;
|
|
|
- if Assigned(fRTTIJson) then fRTTIJson.UseJsonCaseSense := Value;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TJsonSerializer.SetUseNullStringsAsEmpty(const Value: Boolean);
|
|
|
-begin
|
|
|
- fUseNullStringsAsEmpty := Value;
|
|
|
- if Assigned(fRTTIJson) then fRTTIJson.fUseNullStringsAsEmpty := Value;
|
|
|
-end;
|
|
|
-
|
|
|
-{$IFNDEF FPC}
|
|
|
-{ TCommentProperty }
|
|
|
-
|
|
|
-constructor TCommentProperty.Create(const aComment: string);
|
|
|
-begin
|
|
|
- fComment := aComment;
|
|
|
-end;
|
|
|
-
|
|
|
-{ TCustomNameProperty }
|
|
|
-
|
|
|
-constructor TCustomNameProperty.Create(const aName: string);
|
|
|
-begin
|
|
|
- fName := aName;
|
|
|
-end;
|
|
|
-{$ENDIF}
|
|
|
-
|
|
|
-{$IF NOT DEFINED(DELPHIXE7_UP) AND NOT DEFINED(FPC)}
|
|
|
-{ TJSONArrayHelper }
|
|
|
-
|
|
|
-function TJSONArrayHelper.Count: Integer;
|
|
|
-begin
|
|
|
- Result := Self.Size;
|
|
|
-end;
|
|
|
-
|
|
|
-function TJSONArrayHelper.GetItem(aValue: Integer): TJSONValue;
|
|
|
-begin
|
|
|
- Result := Self.Get(aValue);
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TJSONArrayHelper.SetElements(aElements: TList<TJSONValue>);
|
|
|
-var
|
|
|
- jvalue : TJSONValue;
|
|
|
-begin
|
|
|
- for jvalue in aElements do Self.AddElement(jvalue);
|
|
|
- aElements.Free;
|
|
|
-end;
|
|
|
-
|
|
|
-{ TJSONValueHelper }
|
|
|
-
|
|
|
-function TJSONValueHelper.ToJson: string;
|
|
|
-begin
|
|
|
- Result := Self.ToString;
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-{ TJSONObjectHelper }
|
|
|
-
|
|
|
-function TJSONObjectHelper.Count: Integer;
|
|
|
-begin
|
|
|
- Result := Self.Size;
|
|
|
-end;
|
|
|
-
|
|
|
-function TJSONObjectHelper.GetValue(const aName: string): TJSONValue;
|
|
|
-var
|
|
|
- jPair : TJSONPair;
|
|
|
-begin
|
|
|
- Result := nil;
|
|
|
- for jPair in Self do
|
|
|
- begin
|
|
|
- if jPair.JsonString.ToString = aName then Exit(jPair.JsonValue);
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-function TJSONObjectHelper.GetPair(aValue: Integer) : TJSONPair;
|
|
|
-begin
|
|
|
- Result := Self.Get(aValue);
|
|
|
-end;
|
|
|
-
|
|
|
-{$ENDIF}
|
|
|
-
|
|
|
-end.
|
|
|
-
|
|
|
-
|
|
|
+{ ***************************************************************************
|
|
|
+
|
|
|
+ Copyright (c) 2015-2022 Kike Pérez
|
|
|
+
|
|
|
+ Unit : Quick.JSON.Serializer
|
|
|
+ Description : Json Serializer
|
|
|
+ Author : Kike Pérez
|
|
|
+ Version : 1.12
|
|
|
+ Created : 21/05/2018
|
|
|
+ Modified : 26/01/2022
|
|
|
+
|
|
|
+ This file is part of QuickLib: https://github.com/exilon/QuickLib
|
|
|
+
|
|
|
+ ***************************************************************************
|
|
|
+
|
|
|
+ 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 Quick.Json.Serializer;
|
|
|
+
|
|
|
+{$i QuickLib.inc}
|
|
|
+
|
|
|
+interface
|
|
|
+
|
|
|
+uses
|
|
|
+ {$IFDEF DEBUG_SERIALIZER}
|
|
|
+ Quick.Debug.Utils,
|
|
|
+ {$ENDIF}
|
|
|
+ Classes,
|
|
|
+ SysUtils,
|
|
|
+ Rtti,
|
|
|
+ TypInfo,
|
|
|
+ Quick.Serializer.Intf,
|
|
|
+ Quick.Base64,
|
|
|
+ {$IFDEF FPC}
|
|
|
+ rttiutils,
|
|
|
+ fpjson,
|
|
|
+ jsonparser,
|
|
|
+ strUtils,
|
|
|
+ //jsonreader,
|
|
|
+ //fpjsonrtti,
|
|
|
+ Quick.Json.fpc.Compatibility,
|
|
|
+ {$ELSE}
|
|
|
+ {$IFDEF DELPHIXE7_UP}
|
|
|
+ System.Json,
|
|
|
+ {$ELSE}
|
|
|
+ Data.DBXJSON,
|
|
|
+ {$ENDIF}
|
|
|
+ {$IFDEF DELPHIRX10_UP}
|
|
|
+
|
|
|
+ {$ENDIF}
|
|
|
+ Variants,
|
|
|
+ {$ENDIF}
|
|
|
+ Generics.Collections,
|
|
|
+ Quick.RTTI.Utils,
|
|
|
+ DateUtils,
|
|
|
+ Quick.Commons,
|
|
|
+ Quick.JSON.Utils;
|
|
|
+
|
|
|
+type
|
|
|
+
|
|
|
+ IJsonSerializer = ISerializer;
|
|
|
+
|
|
|
+ EJsonSerializeError = class(Exception);
|
|
|
+ EJsonDeserializeError = class(Exception);
|
|
|
+
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ TNotSerializableProperty = class(TCustomAttribute);
|
|
|
+
|
|
|
+ TCommentProperty = class(TCustomAttribute)
|
|
|
+ private
|
|
|
+ fComment : string;
|
|
|
+ public
|
|
|
+ constructor Create(const aComment: string);
|
|
|
+ property Comment : string read fComment;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TCustomNameProperty = class(TCustomAttribute)
|
|
|
+ private
|
|
|
+ fName : string;
|
|
|
+ public
|
|
|
+ constructor Create(const aName: string);
|
|
|
+ property Name : string read fName;
|
|
|
+ end;
|
|
|
+ {$IFNDEF DELPHIXE7_UP}
|
|
|
+ TJSONArrayHelper = class helper for Data.DBXJson.TJSONArray
|
|
|
+ private
|
|
|
+ function GetItem(aValue : Integer) : TJSONValue;
|
|
|
+ public
|
|
|
+ function Count : Integer;
|
|
|
+ property Items[index : Integer] : TJSONValue read GetItem;
|
|
|
+ procedure SetElements(aElements : TList<TJSONValue>);
|
|
|
+ end;
|
|
|
+
|
|
|
+ TJSONValueHelper = class helper for Data.DBXJson.TJSONValue
|
|
|
+ public
|
|
|
+ function ToJson : string;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TJSONObjectHelper = class helper for Data.DBXJson.TJSONObject
|
|
|
+ private
|
|
|
+ function GetPair(aValue : Integer) : TJSONPair;
|
|
|
+ public
|
|
|
+ function Count : Integer;
|
|
|
+ function GetValue(const aName : string) : TJSONValue;
|
|
|
+ property Pairs[index : Integer] : TJSONPair read GetPair;
|
|
|
+ end;
|
|
|
+ {$ENDIF}
|
|
|
+ {$ENDIF}
|
|
|
+
|
|
|
+ TSerializeLevel = (slPublicProperty, slPublishedProperty);
|
|
|
+
|
|
|
+ TRTTIJson = class
|
|
|
+ type
|
|
|
+ TGenericListType = (gtNone, gtList, gtObjectList);
|
|
|
+ private
|
|
|
+ fSerializeLevel : TSerializeLevel;
|
|
|
+ fUseEnumNames : Boolean;
|
|
|
+ fUseJsonCaseSense : Boolean;
|
|
|
+ fUseBase64Stream : Boolean;
|
|
|
+ fUseNullStringsAsEmpty : Boolean;
|
|
|
+ function GetValue(aAddr: Pointer; aType: TRTTIType): TValue; overload;
|
|
|
+ {$IFDEF FPC}
|
|
|
+ function GetValue(aAddr: Pointer; aTypeInfo: PTypeInfo): TValue; overload;
|
|
|
+ {$ENDIF}
|
|
|
+ function IsAllowedProperty(aObject : TObject; const aPropertyName : string) : Boolean;
|
|
|
+ //function GetPropertyValue(Instance : TObject; const PropertyName : string) : TValue;
|
|
|
+ function GetPropertyValueFromObject(Instance : TObject; const PropertyName : string) : TValue;
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ function GetFieldValueFromRecord(const aValue : TValue; const FieldName : string) : TValue;
|
|
|
+ {$ENDIF}
|
|
|
+ {$IFDEF FPC}
|
|
|
+ procedure SetPropertyValue(Instance : TObject; aPropInfo : PPropInfo; aValue : TValue); overload;
|
|
|
+ procedure SetPropertyValue(Instance : TObject; const PropertyName : string; aValue : TValue); overload;
|
|
|
+ function FloatProperty(aObject : TObject; aPropInfo: PPropInfo): string;
|
|
|
+ function GetPropType(aPropInfo: PPropInfo): PTypeInfo;
|
|
|
+ procedure LoadSetProperty(aInstance : TObject; aPropInfo: PPropInfo; const aValue: string);
|
|
|
+ {$ENDIF}
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ function CreateInstance(aClass: TClass): TValue; overload;
|
|
|
+ function CreateInstance(aType: TRttiType): TValue; overload;
|
|
|
+ {$ENDIF}
|
|
|
+ public
|
|
|
+ constructor Create(aSerializeLevel : TSerializeLevel; aUseEnumNames : Boolean = True);
|
|
|
+ property UseEnumNames : Boolean read fUseEnumNames write fUseEnumNames;
|
|
|
+ property UseJsonCaseSense : Boolean read fUseJsonCaseSense write fUseJsonCaseSense;
|
|
|
+ property UseBase64Stream : Boolean read fUseBase64Stream write fUseBase64Stream;
|
|
|
+ property UseNullStringsAsEmpty : Boolean read fUseNullStringsAsEmpty write fUseNullStringsAsEmpty;
|
|
|
+ function GetJsonPairValueByName(aJson : TJSONObject; const aName : string) : TJsonValue;
|
|
|
+ function GetJsonPairByName(aJson : TJSONObject; const aName : string) : TJSONPair;
|
|
|
+ function IsGenericList(aObject : TObject) : Boolean;
|
|
|
+ function IsStream(aObject : TObject) : Boolean;
|
|
|
+ function IsGenericXArray(const aClassName : string) : Boolean;
|
|
|
+ function GetGenericListType(aObject : TObject) : TGenericListType;
|
|
|
+ //serialize methods
|
|
|
+ function SerializeValue(const aValue : TValue) : TJSONValue;
|
|
|
+ function SerializeObject(aObject : TObject) : TJSONObject; overload;
|
|
|
+ function SerializeStream(aObject : TObject) : TJSONValue;
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ function SerializeDynArray(const aValue: TValue; aMaxElements : Integer = -1) : TJsonArray;
|
|
|
+ function SerializeRecord(const aValue : TValue) : TJSONValue;
|
|
|
+ {$ELSE}
|
|
|
+ function SerializeObject(aObject : TObject; aType : TTypeKind; const aPropertyName : string) : TJSONPair;
|
|
|
+ {$ENDIF}
|
|
|
+ //deserialize methods
|
|
|
+ function DeserializeClass(aType : TClass; const aJson : TJSONObject) : TObject;
|
|
|
+ function DeserializeObject(aObject : TObject; const aJson : TJSONObject) : TObject; overload;
|
|
|
+ function DeserializeProperty(aObject : TObject; const aName : string; aProperty : TRttiProperty; const aJson : TJSONObject) : TObject; overload;
|
|
|
+ function DeserializeStream(aObject : TObject; const aJson : TJSONValue) : TObject;
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ function DeserializeType(aObject : TObject; aType : TTypeKind; aTypeInfo : PTypeInfo; const aValue: string) : TValue;
|
|
|
+ function DeserializeDynArray(aTypeInfo : PTypeInfo; aObject : TObject; const aJsonArray: TJSONArray) : TValue;
|
|
|
+ function DeserializeRecord(const aRecord : TValue; aObject : TObject; const aJson : TJSONObject) : TValue;
|
|
|
+ function DeserializeList(aObject: TObject; const aName : string; const aJson: TJSONObject) : TObject;
|
|
|
+ procedure DeserializeXArray(Instance : TObject; aRecord : TValue; aProperty : TRttiProperty; const aPropertyName : string; aJson : TJsonObject);
|
|
|
+ {$ELSE}
|
|
|
+ function DeserializeType(aObject : TObject; aType : TTypeKind; const aPropertyName, aValue: string) : TValue;
|
|
|
+ procedure DeserializeDynArray(aTypeInfo: PTypeInfo; const aPropertyName : string; aObject: TObject; const aJsonArray: TJSONArray);
|
|
|
+ {$ENDIF}
|
|
|
+ end;
|
|
|
+
|
|
|
+ TJsonSerializer = class(TInterfacedObject,IJsonSerializer)
|
|
|
+ strict private
|
|
|
+ fSerializeLevel : TSerializeLevel;
|
|
|
+ fUseEnumNames : Boolean;
|
|
|
+ fUseJsonCaseSense : Boolean;
|
|
|
+ fUseBase64Stream : Boolean;
|
|
|
+ fUseNullStringsAsEmpty : Boolean;
|
|
|
+ fRTTIJson : TRTTIJson;
|
|
|
+ private
|
|
|
+ procedure SetUseEnumNames(const Value: Boolean);
|
|
|
+ procedure SetUseJsonCaseSense(const Value: Boolean);
|
|
|
+ procedure SetSerializeLevel(const Value: TSerializeLevel);
|
|
|
+ procedure SetUseBase64Stream(const Value: Boolean);
|
|
|
+ //Only Delphi -> Workaround, use this when something passes : {Test : "Null"} but we expect : {Test : ""}
|
|
|
+ procedure SetUseNullStringsAsEmpty(const Value : Boolean);
|
|
|
+ public
|
|
|
+ constructor Create(aSerializeLevel: TSerializeLevel; aUseEnumNames : Boolean = True; aUseNullStringsAsEmpty : Boolean = False);
|
|
|
+ destructor Destroy; override;
|
|
|
+ property SerializeLevel : TSerializeLevel read fSerializeLevel write SetSerializeLevel;
|
|
|
+ property UseEnumNames : Boolean read fUseEnumNames write SetUseEnumNames;
|
|
|
+ property UseJsonCaseSense : Boolean read fUseJsonCaseSense write SetUseJsonCaseSense;
|
|
|
+ property UseBase64Stream : Boolean read fUseBase64Stream write SetUseBase64Stream;
|
|
|
+ property UseNullStringsAsEmpty : Boolean read fUseNullStringsAsEmpty write SetUseNullStringsAsEmpty;
|
|
|
+ function JsonToObject(aType : TClass; const aJson: string) : TObject; overload;
|
|
|
+ function JsonToObject(aObject : TObject; const aJson: string) : TObject; overload;
|
|
|
+ function JsonStreamToObject(aObject : TObject; aJsonStream : TStream) : TObject;
|
|
|
+ function ObjectToJson(aObject : TObject; aIndent : Boolean = False): string;
|
|
|
+ function ObjectToJsonString(aObject : TObject; aIndent : Boolean = False): string;
|
|
|
+ procedure ObjectToJsonStream(aObject : TObject; aStream : TStream);
|
|
|
+ function ValueToJson(const aValue : TValue; aIndent : Boolean = False) : string;
|
|
|
+ function ValueToJsonString(const aValue : TValue; aIndent : Boolean = False) : string;
|
|
|
+ function ArrayToJson<T>(aArray : TArray<T>; aIndent : Boolean = False) : string;
|
|
|
+ function ArrayToJsonString<T>(aArray : TArray<T>; aIndent : Boolean = False) : string;
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ function JsonToArray<T>(const aJson : string) : TArray<T>;
|
|
|
+ function JsonToValue(const aJson: string): TValue;
|
|
|
+ {$ENDIF}
|
|
|
+ end;
|
|
|
+
|
|
|
+ EJsonSerializerError = class(Exception);
|
|
|
+
|
|
|
+ PPByte = ^PByte;
|
|
|
+
|
|
|
+resourcestring
|
|
|
+ cNotSupportedDataType = 'Not supported data type "%s"';
|
|
|
+ cSerializeObjectError = 'Serialize object "%s" error: %s';
|
|
|
+ cSerializePropertyError = 'Property "%s" ("%s")';
|
|
|
+ cNotSerializable = 'Object is not serializable';
|
|
|
+ cNotValidJson = 'Not a valid Json';
|
|
|
+
|
|
|
+implementation
|
|
|
+
|
|
|
+{ TRTTIJson }
|
|
|
+
|
|
|
+{$IFNDEF FPC}
|
|
|
+function TRTTIJson.DeserializeDynArray(aTypeInfo: PTypeInfo; aObject: TObject; const aJsonArray: TJSONArray) : TValue;
|
|
|
+var
|
|
|
+ rType: PTypeInfo;
|
|
|
+ len: NativeInt;
|
|
|
+ pArr: Pointer;
|
|
|
+ rItemValue: TValue;
|
|
|
+ i: Integer;
|
|
|
+ objClass: TClass;
|
|
|
+ ctx : TRttiContext;
|
|
|
+ json : TJSONObject;
|
|
|
+ rDynArray : TRttiDynamicArrayType;
|
|
|
+ propObj : TObject;
|
|
|
+begin
|
|
|
+ if GetTypeData(aTypeInfo).DynArrElType = nil then Exit;
|
|
|
+ if not assigned(aJsonArray) then Exit;
|
|
|
+
|
|
|
+ len := aJsonArray.Count;
|
|
|
+ rType := GetTypeData(aTypeInfo).DynArrElType^;
|
|
|
+ pArr := nil;
|
|
|
+ DynArraySetLength(pArr,aTypeInfo, 1, @len);
|
|
|
+ try
|
|
|
+ TValue.Make(@pArr,aTypeInfo, Result);
|
|
|
+ rDynArray := ctx.GetType(Result.TypeInfo) as TRTTIDynamicArrayType;
|
|
|
+
|
|
|
+ for i := 0 to aJsonArray.Count - 1 do
|
|
|
+ begin
|
|
|
+ rItemValue := nil;
|
|
|
+ case rType.Kind of
|
|
|
+ tkClass :
|
|
|
+ begin
|
|
|
+ if aJsonArray.Items[i] is TJSONObject then
|
|
|
+ begin
|
|
|
+ propObj := GetValue(PPByte(Result.GetReferenceToRawData)^ +rDynArray.ElementType.TypeSize * i, rDynArray.ElementType).AsObject;
|
|
|
+ if propObj = nil then
|
|
|
+ begin
|
|
|
+ objClass := rType.TypeData.ClassType;
|
|
|
+ rItemValue := DeserializeClass(objClass, TJSONObject(aJsonArray.Items[i]));
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ DeserializeObject(propObj,TJSONObject(aJsonArray.Items[i]));
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ tkRecord :
|
|
|
+ begin
|
|
|
+ json := TJSONObject(aJsonArray.Items[i]);
|
|
|
+ rItemValue := DeserializeRecord(GetValue(PPByte(Result.GetReferenceToRawData)^ +rDynArray.ElementType.TypeSize * i,
|
|
|
+ rDynArray.ElementType),aObject,json);
|
|
|
+ end;
|
|
|
+ tkMethod, tkPointer, tkClassRef ,tkInterface, tkProcedure :
|
|
|
+ begin
|
|
|
+ //skip these properties
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ rItemValue := DeserializeType(aObject,rType.Kind,rType,aJsonArray.Items[i].Value);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ if not rItemValue.IsEmpty then Result.SetArrayElement(i,rItemValue);
|
|
|
+ end;
|
|
|
+ //aProperty.SetValue(aObject,rValue);
|
|
|
+ finally
|
|
|
+ DynArrayClear(pArr,aTypeInfo);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+{$ELSE}
|
|
|
+procedure TRTTIJson.DeserializeDynArray(aTypeInfo: PTypeInfo; const aPropertyName : string; aObject: TObject; const aJsonArray: TJSONArray);
|
|
|
+var
|
|
|
+ rType: PTypeInfo;
|
|
|
+ len: NativeInt;
|
|
|
+ pArr: Pointer;
|
|
|
+ rItemValue: TValue;
|
|
|
+ i: Integer;
|
|
|
+ objClass: TClass;
|
|
|
+ propObj : TObject;
|
|
|
+ rValue : TValue;
|
|
|
+begin
|
|
|
+ if GetTypeData(aTypeInfo).ElType2 = nil then Exit;
|
|
|
+ len := aJsonArray.Count;
|
|
|
+ rType := GetTypeData(aTypeInfo).ElType2;
|
|
|
+ pArr := nil;
|
|
|
+ DynArraySetLength(pArr,aTypeInfo, 1, @len);
|
|
|
+ try
|
|
|
+ TValue.Make(@pArr,aTypeInfo, rValue);
|
|
|
+ for i := 0 to aJsonArray.Count - 1 do
|
|
|
+ begin
|
|
|
+ rItemValue := nil;
|
|
|
+ case rType.Kind of
|
|
|
+ tkClass :
|
|
|
+ begin
|
|
|
+ if aJsonArray.Items[i] is TJSONObject then
|
|
|
+ begin
|
|
|
+ propObj := GetValue(PPByte(rValue.GetReferenceToRawData)^ +GetTypeData(aTypeInfo).elSize * i, GetTypeData(aTypeInfo).ElType2).AsObject;
|
|
|
+ if propObj = nil then
|
|
|
+ begin
|
|
|
+ objClass := GetTypeData(aTypeInfo).ClassType;
|
|
|
+ rItemValue := DeserializeClass(objClass, TJSONObject(aJsonArray.Items[i]));
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ DeserializeObject(propObj,TJSONObject(aJsonArray.Items[i]));
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ tkRecord :
|
|
|
+ begin
|
|
|
+ {json := TJSONObject(aJsonArray.Items[i]);
|
|
|
+ rItemValue := DeserializeRecord(GetValue(PPByte(Result.GetReferenceToRawData)^ +rDynArray.ElementType.TypeSize * i,
|
|
|
+ rDynArray.ElementType),aObject,json); }
|
|
|
+ end;
|
|
|
+ tkMethod, tkPointer, tkClassRef ,tkInterface, tkProcedure :
|
|
|
+ begin
|
|
|
+ //skip these properties
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ rItemValue := DeserializeType(aObject,GetTypeData(aTypeInfo).ElType2.Kind,aPropertyName,aJsonArray.Items[i].Value);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ if not rItemValue.IsEmpty then rValue.SetArrayElement(i,rItemValue);
|
|
|
+ end;
|
|
|
+ //aProperty.SetValue(aObject,rValue);
|
|
|
+ SetDynArrayProp(aObject,GetPropInfo(aObject,aPropertyName),pArr);
|
|
|
+ finally
|
|
|
+ DynArrayClear(pArr,aTypeInfo);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+{$ENDIF}
|
|
|
+
|
|
|
+{$IFNDEF FPC}
|
|
|
+function TRTTIJson.DeserializeRecord(const aRecord : TValue; aObject : TObject; const aJson : TJSONObject) : TValue;
|
|
|
+var
|
|
|
+ ctx : TRttiContext;
|
|
|
+ rRec : TRttiRecordType;
|
|
|
+ rField : TRttiField;
|
|
|
+ rValue : TValue;
|
|
|
+ member : TJsonValue;
|
|
|
+ jArray : TJSONArray;
|
|
|
+ json : TJSONObject;
|
|
|
+ objClass : TClass;
|
|
|
+ propobj : TObject;
|
|
|
+begin
|
|
|
+ rRec := ctx.GetType(aRecord.TypeInfo).AsRecord;
|
|
|
+ for rField in rRec.GetFields do
|
|
|
+ begin
|
|
|
+ rValue := nil;
|
|
|
+ //member := TJSONPair(aJson.GetValue(rField.Name));
|
|
|
+ member := GetJsonPairValueByName(aJson,rField.Name);
|
|
|
+ if member <> nil then
|
|
|
+ case rField.FieldType.TypeKind of
|
|
|
+ tkDynArray :
|
|
|
+ begin
|
|
|
+ jArray := TJSONObject.ParseJSONValue(member.ToJSON) as TJSONArray;
|
|
|
+ try
|
|
|
+ rValue := DeserializeDynArray(rField.FieldType.Handle,aObject,jArray);
|
|
|
+ finally
|
|
|
+ jArray.Free;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ tkClass :
|
|
|
+ begin
|
|
|
+ //if (member.JsonValue is TJSONObject) then
|
|
|
+ begin
|
|
|
+ propobj := rField.GetValue(@aRecord).AsObject;
|
|
|
+ json := TJSONObject.ParseJSONValue(member.ToJson) as TJSONObject;
|
|
|
+ try
|
|
|
+ if propobj = nil then
|
|
|
+ begin
|
|
|
+ objClass := rField.FieldType.Handle^.TypeData.ClassType;// aProperty.PropertyType.Handle^.TypeData.ClassType;
|
|
|
+ rValue := DeserializeClass(objClass,json);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ DeserializeObject(propobj,json);
|
|
|
+ end;
|
|
|
+ finally
|
|
|
+ json.Free;
|
|
|
+ end;
|
|
|
+ end
|
|
|
+ end;
|
|
|
+ tkRecord :
|
|
|
+ begin
|
|
|
+ json := TJSONObject.ParseJSONValue(member.ToJson) as TJSONObject;
|
|
|
+ try
|
|
|
+ rValue := DeserializeRecord(rField.GetValue(aRecord.GetReferenceToRawData),aObject,json);
|
|
|
+ finally
|
|
|
+ json.Free;
|
|
|
+ end;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ //rValue := DeserializeType(aObject,rField.FieldType.TypeKind,rField.FieldType.Handle,member.ToJson);
|
|
|
+ //avoid return unicode escaped chars if string
|
|
|
+ if rField.FieldType.TypeKind in [tkString, tkLString, tkWString, tkUString] then
|
|
|
+ {$IFDEF DELPHIRX10_UP}
|
|
|
+ rValue := DeserializeType(aObject,rField.FieldType.TypeKind,rField.FieldType.Handle,TJsonValue(member).value)
|
|
|
+ {$ELSE}
|
|
|
+ rValue := DeserializeType(aObject,rField.FieldType.TypeKind,rField.FieldType.Handle,member.Value)
|
|
|
+ {$ENDIF}
|
|
|
+ else rValue := DeserializeType(aObject,rField.FieldType.TypeKind,rField.FieldType.Handle,member.ToJSON);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ if not rValue.IsEmpty then rField.SetValue(aRecord.GetReferenceToRawData,rValue);
|
|
|
+ end;
|
|
|
+ Result := aRecord;
|
|
|
+end;
|
|
|
+{$ENDIF}
|
|
|
+
|
|
|
+function TRTTIJson.DeserializeStream(aObject: TObject; const aJson: TJSONValue): TObject;
|
|
|
+var
|
|
|
+ stream : TStringStream;
|
|
|
+begin
|
|
|
+ if fUseBase64Stream then stream := TStringStream.Create(Base64Decode(aJson.Value),TEncoding.Ansi)
|
|
|
+ else stream := TStringStream.Create({$IFNDEF FPC}aJson.Value{$ELSE}string(aJson.Value){$ENDIF},TEncoding.Ansi);
|
|
|
+ try
|
|
|
+ TStream(aObject).CopyFrom(stream,stream.Size);
|
|
|
+ finally
|
|
|
+ stream.Free;
|
|
|
+ end;
|
|
|
+ Result := aObject;
|
|
|
+end;
|
|
|
+
|
|
|
+constructor TRTTIJson.Create(aSerializeLevel : TSerializeLevel; aUseEnumNames : Boolean = True);
|
|
|
+begin
|
|
|
+ fSerializeLevel := aSerializeLevel;
|
|
|
+ fUseEnumNames := aUseEnumNames;
|
|
|
+ fUseJsonCaseSense := False;
|
|
|
+ fUseBase64Stream := True;
|
|
|
+end;
|
|
|
+
|
|
|
+{$IFNDEF FPC}
|
|
|
+function TRTTIJson.CreateInstance(aClass: TClass): TValue;
|
|
|
+var
|
|
|
+ ctx : TRttiContext;
|
|
|
+ rtype : TRttiType;
|
|
|
+begin
|
|
|
+ Result := nil;
|
|
|
+ rtype := ctx.GetType(aClass);
|
|
|
+ Result := CreateInstance(rtype);
|
|
|
+end;
|
|
|
+{$ENDIF}
|
|
|
+
|
|
|
+{$IFNDEF FPC}
|
|
|
+function TRTTIJson.CreateInstance(aType: TRttiType): TValue;
|
|
|
+var
|
|
|
+ rmethod : TRttiMethod;
|
|
|
+begin
|
|
|
+ Result := nil;
|
|
|
+ if atype = nil then Exit;
|
|
|
+ for rmethod in TRttiInstanceType(atype).GetMethods do
|
|
|
+ begin
|
|
|
+ if rmethod.IsConstructor then
|
|
|
+ begin
|
|
|
+ //create if don't have parameters
|
|
|
+ if Length(rmethod.GetParameters) = 0 then
|
|
|
+ begin
|
|
|
+ Result := rmethod.Invoke(TRttiInstanceType(atype).MetaclassType,[]);
|
|
|
+ Break;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+{$ENDIF}
|
|
|
+
|
|
|
+function TRTTIJson.DeserializeClass(aType: TClass; const aJson: TJSONObject): TObject;
|
|
|
+begin
|
|
|
+ Result := nil;
|
|
|
+ if (aJson = nil) or ((aJson as TJSONValue) is TJSONNull) or (aJson.Count = 0) then Exit;
|
|
|
+
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ Result := CreateInstance(aType).AsObject;
|
|
|
+ {$ELSE}
|
|
|
+ Result := aType.Create;
|
|
|
+ {$ENDIF}
|
|
|
+ try
|
|
|
+ Result := DeserializeObject(Result,aJson);
|
|
|
+ except
|
|
|
+ on E : Exception do
|
|
|
+ begin
|
|
|
+ Result.Free;
|
|
|
+ raise EJsonDeserializeError.CreateFmt('Deserialize error class "%s" : %s',[aType.ClassName,e.Message]);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function TRTTIJson.DeserializeObject(aObject: TObject; const aJson: TJSONObject): TObject;
|
|
|
+var
|
|
|
+ ctx: TRttiContext;
|
|
|
+ rType: TRttiType;
|
|
|
+ rProp: TRttiProperty;
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ attr: TCustomAttribute;
|
|
|
+ propvalue : TValue;
|
|
|
+ {$ENDIF}
|
|
|
+ propertyname : string;
|
|
|
+begin
|
|
|
+ Result := aObject;
|
|
|
+
|
|
|
+ if (aJson = nil) or ((aJson as TJSONValue) is TJSONNull) or (aJson.Count = 0) or (Result = nil) then Exit;
|
|
|
+
|
|
|
+ try
|
|
|
+ //if generic list
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ if IsGenericList(aObject) then
|
|
|
+ begin
|
|
|
+ DeserializeList(aObject,'List',aJson);
|
|
|
+ Exit;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ {$ENDIF}
|
|
|
+ if IsStream(aObject) then
|
|
|
+ begin
|
|
|
+ DeserializeStream(aObject,aJson);
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ //if standard object
|
|
|
+ rType := ctx.GetType(aObject.ClassInfo);
|
|
|
+ for rProp in rType.GetProperties do
|
|
|
+ begin
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ if ((fSerializeLevel = slPublicProperty) and (rProp.PropertyType.IsPublicType))
|
|
|
+ or ((fSerializeLevel = slPublishedProperty) and ((IsPublishedProp(aObject,rProp.Name)) or (rProp.Name = 'List'))) then
|
|
|
+ {$ENDIF}
|
|
|
+ begin
|
|
|
+ if ((rProp.IsWritable) or (rProp.Name = 'List')) and (IsAllowedProperty(aObject,rProp.Name)) then
|
|
|
+ begin
|
|
|
+ propertyname := rProp.Name;
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ for attr in rProp.GetAttributes do if attr is TCustomNameProperty then propertyname := TCustomNameProperty(attr).Name;
|
|
|
+ propvalue := rProp.GetValue(aObject);
|
|
|
+ if rProp.Name = 'List' then
|
|
|
+ begin
|
|
|
+ Result := DeserializeList(Result,propertyname,aJson);
|
|
|
+ end
|
|
|
+ else if propvalue.IsObject then
|
|
|
+ begin
|
|
|
+ if propvalue.AsObject = nil then
|
|
|
+ begin
|
|
|
+ propvalue := CreateInstance(rProp.PropertyType);
|
|
|
+ rProp.SetValue(aObject,propvalue);
|
|
|
+ end;
|
|
|
+ if IsGenericList(propvalue.AsObject) then DeserializeList(propvalue.AsObject,'List',TJSONObject(aJson.GetValue(propertyname)))
|
|
|
+ else Result := DeserializeProperty(Result,propertyname,rProp,aJson);
|
|
|
+ end
|
|
|
+ else if IsGenericXArray(string(propvalue{$IFNDEF NEXTGEN}.TypeInfo.Name{$ELSE}.TypeInfo.NameFld.ToString{$ENDIF})) then
|
|
|
+ begin
|
|
|
+ DeserializeXArray(Result,propvalue,rProp,propertyname,aJson);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ {$ENDIF}
|
|
|
+ Result := DeserializeProperty(Result,propertyname,rProp,aJson);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ except
|
|
|
+ on E : Exception do
|
|
|
+ begin
|
|
|
+ Result.Free;
|
|
|
+ raise EJsonDeserializeError.CreateFmt('Deserialize error for object "%s" : %s',[aObject.ClassName,e.Message]);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+{$IFNDEF FPC}
|
|
|
+function TRTTIJson.DeserializeList(aObject: TObject; const aName : string; const aJson: TJSONObject) : TObject;
|
|
|
+var
|
|
|
+ ctx : TRttiContext;
|
|
|
+ rType : TRttiType;
|
|
|
+ jarray : TJSONArray;
|
|
|
+ member : TJsonValue;
|
|
|
+ rvalue : TValue;
|
|
|
+ i : Integer;
|
|
|
+ n : Integer;
|
|
|
+ rProp : TRttiProperty;
|
|
|
+ {$IFDEF DELPHIRX10_UP}
|
|
|
+ rMethod: TRttiMethod;
|
|
|
+ {$ELSE}
|
|
|
+ rfield : TRttiField;
|
|
|
+ {$ENDIF}
|
|
|
+begin
|
|
|
+ Result := aObject;
|
|
|
+
|
|
|
+ rType := ctx.GetType(aObject.ClassInfo);
|
|
|
+ rProp := rType.GetProperty('List');
|
|
|
+ if (rProp = nil) or (aJson = nil) or (aJson.ClassType = TJSONNull) then Exit;
|
|
|
+
|
|
|
+ member := nil;
|
|
|
+ //check if exists List (denotes delphi json serialized) or not (normal json serialized)
|
|
|
+ if aJson.ClassType = TJSONObject then member := GetJsonPairValueByName(aJson,aName);
|
|
|
+ if member = nil then
|
|
|
+ begin
|
|
|
+ if aJson.ClassType <> TJSONArray then raise EJsonDeserializeError.CreateFmt('Not valid value for "%s" List',[aName]);
|
|
|
+ jArray := TJSONObject.ParseJSONValue(aJson.ToJSON) as TJSONArray;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ if member.ClassType <> TJSONArray then raise EJsonDeserializeError.CreateFmt('Not valid value for "%s" List',[aName]);
|
|
|
+ jArray := TJSONObject.ParseJSONValue(member.ToJSON) as TJSONArray;
|
|
|
+ end;
|
|
|
+ try
|
|
|
+ rvalue := DeserializeDynArray(rProp.PropertyType.Handle,Result,jArray);
|
|
|
+ //i := jarray.Count;
|
|
|
+ finally
|
|
|
+ jArray.Free;
|
|
|
+ end;
|
|
|
+
|
|
|
+ if not rValue.IsEmpty then
|
|
|
+ begin
|
|
|
+ {$IFDEF DELPHIRX10_UP}
|
|
|
+ if (aObject <> nil) and (rvalue.IsArray) then
|
|
|
+ begin
|
|
|
+ rMethod := ctx.GetType(aObject.ClassType).GetMethod('Clear');
|
|
|
+ if rMethod = nil then
|
|
|
+ raise EJsonDeserializeError.Create('Unable to find RTTI method');
|
|
|
+ rMethod.Invoke(aObject, []);
|
|
|
+
|
|
|
+ rMethod := ctx.GetType(aObject.ClassType).GetMethod('Add');
|
|
|
+ if rMethod = nil then
|
|
|
+ raise EJsonDeserializeError.Create('Unable to find RTTI method');
|
|
|
+
|
|
|
+ n := rvalue.GetArrayLength - 1;
|
|
|
+ for i := 0 to n do
|
|
|
+ rMethod.Invoke(aObject, [rvalue.GetArrayElement(i)]);
|
|
|
+ end;
|
|
|
+ {$ELSE}
|
|
|
+ n := 0;
|
|
|
+ for rfield in rType.GetFields do
|
|
|
+ begin
|
|
|
+ if rfield.Name = 'FOwnsObjects' then rfield.SetValue(aObject,True);
|
|
|
+ //if rfield.Name = 'FCount' then rfield.SetValue(aObject,i);
|
|
|
+ if rfield.Name = 'FItems' then
|
|
|
+ begin
|
|
|
+ //if TList(aObject) <> nil then TList(aObject).Clear;
|
|
|
+ //rfield.GetValue(aObject).AsObject.Free;// aValue.GetReferenceToRawData)
|
|
|
+ rfield.SetValue(aObject,rValue);// .SetDynArrayProp(aObject,'fItems',Result);
|
|
|
+ Break;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ rProp := rType.GetProperty('Count');
|
|
|
+ rProp.SetValue(aObject,n);
|
|
|
+ {$ENDIF}
|
|
|
+ end;
|
|
|
+end;
|
|
|
+{$ENDIF}
|
|
|
+
|
|
|
+{$IFNDEF FPC}
|
|
|
+procedure TRTTIJson.DeserializeXArray(Instance : TObject; aRecord : TValue; aProperty : TRttiProperty; const aPropertyName : string; aJson : TJsonObject);
|
|
|
+var
|
|
|
+ ctx : TRttiContext;
|
|
|
+ rRec : TRttiRecordType;
|
|
|
+ rfield : TRttiField;
|
|
|
+ rValue : TValue;
|
|
|
+ member : TJsonValue;
|
|
|
+ jArray : TJSONArray;
|
|
|
+begin
|
|
|
+ rRec := ctx.GetType(aRecord.TypeInfo).AsRecord;
|
|
|
+ rfield := rRec.GetField('fArray');
|
|
|
+ if rfield <> nil then
|
|
|
+ begin
|
|
|
+ rValue := nil;
|
|
|
+ //member := TJSONPair(aJson.GetValue(rField.Name));
|
|
|
+ member := GetJsonPairValueByName(aJson,aPropertyName);
|
|
|
+ if (member <> nil) and (rField.FieldType.TypeKind = tkDynArray) then
|
|
|
+ begin
|
|
|
+ jArray := TJSONObject.ParseJSONValue(member.ToJSON) as TJSONArray;
|
|
|
+ try
|
|
|
+ rValue := DeserializeDynArray(rField.FieldType.Handle,nil,jArray);
|
|
|
+ finally
|
|
|
+ jArray.Free;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ if not rValue.IsEmpty then rField.SetValue(aRecord.GetReferenceToRawData,rValue);
|
|
|
+ aProperty.SetValue(Instance,aRecord);
|
|
|
+end;
|
|
|
+{$ENDIF}
|
|
|
+
|
|
|
+function StringToGUIDEx(const aGUID : string) : TGUID;
|
|
|
+begin
|
|
|
+ if not aGUID.StartsWith('{') then Result := System.SysUtils.StringToGUID('{' + aGUID + '}')
|
|
|
+ else Result := System.SysUtils.StringToGUID(aGUID);
|
|
|
+end;
|
|
|
+
|
|
|
+function TRTTIJson.DeserializeProperty(aObject : TObject; const aName : string; aProperty : TRttiProperty; const aJson : TJSONObject) : TObject;
|
|
|
+var
|
|
|
+ rValue : TValue;
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ member : TJsonValue;
|
|
|
+ {$ELSE}
|
|
|
+ member : TJsonObject;
|
|
|
+ {$ENDIF}
|
|
|
+ objClass: TClass;
|
|
|
+ jArray : TJSONArray;
|
|
|
+ json : TJSONObject;
|
|
|
+begin
|
|
|
+ Result := aObject;
|
|
|
+ rValue := nil;
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ //member := TJSONPair(aJson.GetValue(aName));
|
|
|
+ member := GetJsonPairValueByName(aJson,aName);
|
|
|
+ {$ELSE}
|
|
|
+ member := TJsonObject(aJson.Find(aName));
|
|
|
+ {$ENDIF}
|
|
|
+ if member <> nil then
|
|
|
+ begin
|
|
|
+ case aProperty.PropertyType.TypeKind of
|
|
|
+ tkDynArray :
|
|
|
+ begin
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ if member is TJSONNull then Exit;
|
|
|
+ jArray := TJSONObject.ParseJSONValue(member.ToJSON) as TJSONArray;
|
|
|
+ {$ELSE}
|
|
|
+ if member.ClassType = TJSONNull.ClassType then Exit;
|
|
|
+ jArray := TJSONArray(TJSONObject.ParseJSONValue(member.ToJSON));
|
|
|
+ {$ENDIF}
|
|
|
+ try
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ aProperty.SetValue(aObject,DeserializeDynArray(aProperty.PropertyType.Handle,Result,jArray));
|
|
|
+ {$ELSE}
|
|
|
+ DeserializeDynArray(aProperty.PropertyType.Handle,aName,Result,jArray);
|
|
|
+ {$ENDIF}
|
|
|
+ Exit;
|
|
|
+ finally
|
|
|
+ jArray.Free;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ tkClass :
|
|
|
+ begin
|
|
|
+ //if (member.JsonValue is TJSONObject) then
|
|
|
+ begin
|
|
|
+ json := TJsonObject(TJSONObject.ParseJSONValue(member.ToJson));
|
|
|
+ try
|
|
|
+ if aProperty.GetValue(aObject).AsObject = nil then
|
|
|
+ begin
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ objClass := aProperty.PropertyType.Handle^.TypeData.ClassType;
|
|
|
+ rValue := DeserializeClass(objClass,json);
|
|
|
+ {$ELSE}
|
|
|
+ objClass := GetObjectPropClass(aObject,aName);
|
|
|
+ //objClass := GetTypeData(aProperty.PropertyType.Handle)^.ClassType;
|
|
|
+ rValue := DeserializeClass(objClass,json);
|
|
|
+ SetObjectProp(aObject,aName,rValue.AsObject);
|
|
|
+ Exit;
|
|
|
+ {$ENDIF}
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ rValue := DeserializeObject(aProperty.GetValue(aObject).AsObject,json);
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ finally
|
|
|
+ json.Free;
|
|
|
+ end;
|
|
|
+ end
|
|
|
+ end;
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ tkRecord :
|
|
|
+ begin
|
|
|
+ if aProperty.GetValue(aObject).TypeInfo = System.TypeInfo(TGUID) then
|
|
|
+ begin
|
|
|
+ rValue:=TValue.From<TGUID>(StringToGUID(UnQuotedStr(member.ToJSON,'"')));
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ json := TJSONObject.ParseJSONValue(member.ToJson) as TJSONObject;
|
|
|
+ try
|
|
|
+ rValue := DeserializeRecord(aProperty.GetValue(aObject),aObject,json);
|
|
|
+ finally
|
|
|
+ json.Free;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ {$ENDIF}
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ //avoid return unicode escaped chars if string
|
|
|
+ if aProperty.PropertyType.TypeKind in [tkString, tkLString, tkWString, tkUString] then
|
|
|
+ {$IFDEF DELPHIRX10_UP}
|
|
|
+ rValue := DeserializeType(aObject,aProperty.PropertyType.TypeKind,aProperty.GetValue(aObject).TypeInfo,TJsonValue(member).value)
|
|
|
+ {$ELSE}
|
|
|
+ rValue := DeserializeType(aObject,aProperty.PropertyType.TypeKind,aProperty.GetValue(aObject).TypeInfo,member.Value)
|
|
|
+ {$ENDIF}
|
|
|
+ else rValue := DeserializeType(aObject,aProperty.PropertyType.TypeKind,aProperty.GetValue(aObject).TypeInfo,member.ToJSON);
|
|
|
+ {$ELSE}
|
|
|
+ rValue := DeserializeType(aObject,aProperty.PropertyType.TypeKind,aName,member.ToJSON);
|
|
|
+ if not rValue.IsEmpty then SetPropertyValue(aObject,aName,rValue);
|
|
|
+ {$ENDIF}
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ if not rValue.IsEmpty then aProperty.SetValue(Result,rValue);
|
|
|
+ {$ENDIF}
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+{$IFNDEF FPC}
|
|
|
+function TRTTIJson.DeserializeType(aObject : TObject; aType : TTypeKind; aTypeInfo : PTypeInfo; const aValue: string) : TValue;
|
|
|
+var
|
|
|
+ i : Integer;
|
|
|
+ value : string;
|
|
|
+ fsettings : TFormatSettings;
|
|
|
+begin
|
|
|
+ try
|
|
|
+ value := UnQuotedStr(aValue,'"');
|
|
|
+ case aType of
|
|
|
+ tkString, tkLString, tkWString, tkUString :
|
|
|
+ begin
|
|
|
+ if fUseNullStringsAsEmpty and (CompareText(value, 'null') = 0) then
|
|
|
+ Result := ''
|
|
|
+ else
|
|
|
+ Result := value;
|
|
|
+ end;
|
|
|
+ tkChar, tkWChar :
|
|
|
+ begin
|
|
|
+ Result := value;
|
|
|
+ end;
|
|
|
+ tkInteger :
|
|
|
+ begin
|
|
|
+ if CompareText(value,'null') <> 0 then Result := StrToIntDef(value,0)
|
|
|
+ else Result := 0;
|
|
|
+ end;
|
|
|
+ tkInt64 :
|
|
|
+ begin
|
|
|
+ if CompareText(value,'null') <> 0 then Result := StrToInt64Def(value,0)
|
|
|
+ else Result := 0;
|
|
|
+ end;
|
|
|
+ tkFloat :
|
|
|
+ begin
|
|
|
+ if aTypeInfo = TypeInfo(TDateTime) then
|
|
|
+ begin
|
|
|
+ if CompareText(value,'null') <> 0 then Result := JsonDateToDateTime(value);
|
|
|
+ end
|
|
|
+ else if aTypeInfo = TypeInfo(TDate) then
|
|
|
+ begin
|
|
|
+ if CompareText(value,'null') <> 0 then Result := StrToDate(value);
|
|
|
+ end
|
|
|
+ else if aTypeInfo = TypeInfo(TTime) then
|
|
|
+ begin
|
|
|
+ Result := StrToTime(value);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ fsettings := TFormatSettings.Create;
|
|
|
+ Result := StrToFloat(StringReplace(value,'.',fsettings.DecimalSeparator,[]));
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ tkEnumeration :
|
|
|
+ begin
|
|
|
+ if aTypeInfo = System.TypeInfo(Boolean) then
|
|
|
+ begin
|
|
|
+ Result := StrToBool(value);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ //if fUseEnumNames then TValue.Make(GetEnumValue(aTypeInfo,value),aTypeInfo, Result)
|
|
|
+ // else TValue.Make(StrToInt(value),aTypeInfo, Result);
|
|
|
+ if not TryStrToInt(value,i) then TValue.Make(GetEnumValue(aTypeInfo,value),aTypeInfo, Result)
|
|
|
+ else TValue.Make(StrToInt(value),aTypeInfo, Result);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ tkSet :
|
|
|
+ begin
|
|
|
+ i := StringToSet(aTypeInfo,value);
|
|
|
+ TValue.Make(@i,aTypeInfo,Result);
|
|
|
+ end;
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ //raise EclJsonSerializerError.Create('Not supported data type!');
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ except
|
|
|
+ on E : Exception do
|
|
|
+ begin
|
|
|
+ raise EJsonDeserializeError.CreateFmt('Deserialize error type "%s.%s" : %s',[aObject.ClassName,GetTypeName(aTypeInfo),e.Message]);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+{$ELSE}
|
|
|
+function TRTTIJson.DeserializeType(aObject : TObject; aType : TTypeKind; const aPropertyName, aValue: string) : TValue;
|
|
|
+var
|
|
|
+ value : string;
|
|
|
+ propinfo : PPropInfo;
|
|
|
+ fsettings : TFormatSettings;
|
|
|
+begin
|
|
|
+ try
|
|
|
+ value := UnQuotedStr(aValue,'"');
|
|
|
+
|
|
|
+ if value = '' then
|
|
|
+ begin
|
|
|
+ Result := nil;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ propinfo := GetPropInfo(aObject,aPropertyName);
|
|
|
+ //case propinfo.PropType.Kind of
|
|
|
+ case aType of
|
|
|
+ tkString, tkLString, tkWString, tkUString, tkAString :
|
|
|
+ begin
|
|
|
+ Result := value;
|
|
|
+ //SetStrProp(aObject,propinfo,value);
|
|
|
+ end;
|
|
|
+ tkChar, tkWChar :
|
|
|
+ begin
|
|
|
+ Result := value;
|
|
|
+ end;
|
|
|
+ tkInteger :
|
|
|
+ begin
|
|
|
+ if CompareText(value,'null') <> 0 then Result := StrToInt(value)
|
|
|
+ else Result := 0;
|
|
|
+ end;
|
|
|
+ tkInt64 :
|
|
|
+ begin
|
|
|
+ if CompareText(value,'null') <> 0 then Result := StrToInt64(value)
|
|
|
+ else Result := 0;
|
|
|
+ end;
|
|
|
+ tkFloat :
|
|
|
+ begin
|
|
|
+ if propinfo.PropType = TypeInfo(TDateTime) then
|
|
|
+ begin
|
|
|
+ if CompareText(value,'null') <> 0 then Result := JsonDateToDateTime(value);
|
|
|
+ end
|
|
|
+ else if propinfo.PropType = TypeInfo(TDate) then
|
|
|
+ begin
|
|
|
+ if CompareText(value,'null') <> 0 then Result := StrToDate(value);
|
|
|
+ end
|
|
|
+ else if propinfo.PropType = TypeInfo(TTime) then
|
|
|
+ begin
|
|
|
+ Result := StrToTime(value);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ fsettings := DefaultFormatSettings;
|
|
|
+ Result := StrToFloat(StringReplace(value,'.',fsettings.DecimalSeparator,[]));
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ tkEnumeration:
|
|
|
+ begin
|
|
|
+ Result := value;
|
|
|
+ end;
|
|
|
+ tkBool :
|
|
|
+ begin
|
|
|
+ Result := StrToBool(value);
|
|
|
+ end;
|
|
|
+ tkSet :
|
|
|
+ begin
|
|
|
+ Result := value;
|
|
|
+ end;
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ //raise EclJsonSerializerError.Create('Not supported data type!');
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ //if not Result.IsEmpty then SetPropertyValue(aObject,propinfo,Result);
|
|
|
+ except
|
|
|
+ on E : Exception do
|
|
|
+ begin
|
|
|
+ raise EJsonDeserializeError.CreateFmt('Deserialize error type "%s" : %s',[aObject.ClassName,e.Message]);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+{$ENDIF}
|
|
|
+
|
|
|
+function TRTTIJson.IsAllowedProperty(aObject : TObject; const aPropertyName : string) : Boolean;
|
|
|
+var
|
|
|
+ propname : string;
|
|
|
+begin
|
|
|
+ Result := True;
|
|
|
+ propname := aPropertyName.ToLower;
|
|
|
+ if IsGenericList(aObject) then
|
|
|
+ begin
|
|
|
+ if (propname = 'capacity') or (propname = 'count') or (propname = 'ownsobjects') then Result := False;
|
|
|
+ end
|
|
|
+ else if (propname = 'refcount') then Result := False;
|
|
|
+end;
|
|
|
+
|
|
|
+function TRTTIJson.IsGenericList(aObject : TObject) : Boolean;
|
|
|
+var
|
|
|
+ cname : string;
|
|
|
+begin
|
|
|
+ if aObject = nil then Exit(False);
|
|
|
+
|
|
|
+ cname := aObject.ClassName;
|
|
|
+ Result := (cname.StartsWith('TObjectList')) or (cname.StartsWith('TList'));
|
|
|
+end;
|
|
|
+
|
|
|
+function TRTTIJson.IsStream(aObject : TObject) : Boolean;
|
|
|
+begin
|
|
|
+ if aObject = nil then Exit(False);
|
|
|
+ Result := aObject.InheritsFrom(TStream);
|
|
|
+end;
|
|
|
+
|
|
|
+function TRTTIJson.GetGenericListType(aObject : TObject) : TGenericListType;
|
|
|
+var
|
|
|
+ cname : string;
|
|
|
+begin
|
|
|
+ if aObject = nil then Exit(TGenericListType.gtNone);
|
|
|
+
|
|
|
+ cname := aObject.ClassName;
|
|
|
+ if cname.StartsWith('TObjectList') then Result := TGenericListType.gtObjectList
|
|
|
+ else if cname.StartsWith('TList') then Result := TGenericListType.gtList
|
|
|
+ else Result := TGenericListType.gtNone;
|
|
|
+end;
|
|
|
+
|
|
|
+function TRTTIJson.IsGenericXArray(const aClassName : string) : Boolean;
|
|
|
+begin
|
|
|
+ Result := aClassName.StartsWith('TXArray');
|
|
|
+end;
|
|
|
+
|
|
|
+function TRTTIJson.GetJsonPairValueByName(aJson: TJSONObject; const aName: string): TJsonValue;
|
|
|
+var
|
|
|
+ candidate : TJSONPair;
|
|
|
+ i : Integer;
|
|
|
+begin
|
|
|
+ if fUseJsonCaseSense then
|
|
|
+ begin
|
|
|
+ Result := aJson.GetValue(aName);
|
|
|
+ Exit;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ for i := 0 to aJson.Count - 1 do
|
|
|
+ begin
|
|
|
+ candidate := aJson.Pairs[I];
|
|
|
+ if candidate.JsonValue = nil then continue;
|
|
|
+ if CompareText(candidate.JsonString{$IFNDEF FPC}.Value{$ENDIF},aName) = 0 then Exit(candidate.JsonValue);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ Result := nil;
|
|
|
+end;
|
|
|
+
|
|
|
+function TRTTIJson.GetJsonPairByName(aJson: TJSONObject; const aName: string): TJSONPair;
|
|
|
+var
|
|
|
+ i : Integer;
|
|
|
+begin
|
|
|
+ if fUseJsonCaseSense then
|
|
|
+ begin
|
|
|
+ Result := TJSONPair(aJson.GetValue(aName));
|
|
|
+ Exit;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ if aJson <> nil then
|
|
|
+ begin
|
|
|
+ for i := 0 to aJson.Count - 1 do
|
|
|
+ begin
|
|
|
+ Result := aJson.Pairs[I];
|
|
|
+ if Result.JsonValue = nil then continue;
|
|
|
+ if CompareText(Result.JsonString{$IFNDEF FPC}.Value{$ENDIF},aName) = 0 then Exit;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ Result := nil;
|
|
|
+end;
|
|
|
+
|
|
|
+//function TRTTIJson.GetPropertyValue(Instance : TObject; const PropertyName : string) : TValue;
|
|
|
+//var
|
|
|
+// pinfo : PPropInfo;
|
|
|
+//begin
|
|
|
+// Result := nil;
|
|
|
+// pinfo := GetPropInfo(Instance,PropertyName);
|
|
|
+// if pinfo = nil then raise EJsonSerializeError.CreateFmt('Property "%s" not found!',[PropertyName]);
|
|
|
+// case pinfo.PropType^.Kind of
|
|
|
+// tkInteger : Result := GetOrdProp(Instance,pinfo);
|
|
|
+// tkInt64 : Result := GetInt64Prop(Instance,PropertyName);
|
|
|
+// tkFloat : Result := GetFloatProp(Instance,PropertyName);
|
|
|
+// tkChar : Result := Char(GetOrdProp(Instance,PropertyName));
|
|
|
+// {$IFDEF FPC}
|
|
|
+// tkWString : Result := GetWideStrProp(Instance,PropertyName);
|
|
|
+// tkSString,
|
|
|
+// tkAString,
|
|
|
+// {$ELSE}
|
|
|
+// tkWString,
|
|
|
+// {$ENDIF}
|
|
|
+// tkLString : Result := GetStrProp(Instance,pinfo);
|
|
|
+// {$IFDEF FPC}
|
|
|
+// tkEnumeration :
|
|
|
+// begin
|
|
|
+// if fUseEnumNames then Result := GetEnumName(pinfo.PropType,GetOrdProp(Instance,PropertyName))
|
|
|
+// else Result := GetOrdProp(Instance,PropertyName);
|
|
|
+// end;
|
|
|
+// {$ELSE}
|
|
|
+// tkEnumeration :
|
|
|
+// begin
|
|
|
+// if fUseEnumNames then Result := GetEnumName(@pinfo.PropType,GetOrdProp(Instance,PropertyName))
|
|
|
+// else Result := GetOrdProp(Instance,PropertyName);
|
|
|
+// end;
|
|
|
+// {$ENDIF}
|
|
|
+// tkSet : Result := GetSetProp(Instance,pinfo,True);
|
|
|
+// {$IFNDEF FPC}
|
|
|
+// tkClass :
|
|
|
+// {$ELSE}
|
|
|
+// tkBool : Result := Boolean(GetOrdProp(Instance,pinfo));
|
|
|
+// tkObject :
|
|
|
+// {$ENDIF} Result := GetObjectProp(Instance,pinfo);
|
|
|
+// tkDynArray : Result := GetDynArrayProp(Instance,pinfo);
|
|
|
+// end;
|
|
|
+//end;
|
|
|
+
|
|
|
+function TRTTIJson.GetPropertyValueFromObject(Instance : TObject; const PropertyName : string) : TValue;
|
|
|
+var
|
|
|
+ ctx : TRttiContext;
|
|
|
+ rprop : TRttiProperty;
|
|
|
+begin
|
|
|
+ rprop := ctx.GetType(Instance.ClassInfo).GetProperty(PropertyName);
|
|
|
+ Result := rprop.GetValue(Instance);
|
|
|
+end;
|
|
|
+
|
|
|
+{$IFNDEF FPC}
|
|
|
+function TRTTIJson.GetFieldValueFromRecord(const aValue : TValue; const FieldName : string) : TValue;
|
|
|
+var
|
|
|
+ ctx : TRttiContext;
|
|
|
+ rec : TRttiRecordType;
|
|
|
+ rfield : TRttiField;
|
|
|
+begin
|
|
|
+ rec := ctx.GetType(aValue.TypeInfo).AsRecord;
|
|
|
+ rfield := rec.GetField(FieldName);
|
|
|
+ if rfield <> nil then Result := rField.GetValue(aValue.GetReferenceToRawData)
|
|
|
+ else Result := nil;
|
|
|
+end;
|
|
|
+{$ENDIF}
|
|
|
+
|
|
|
+{$IFDEF FPC}
|
|
|
+procedure TRTTIJson.SetPropertyValue(Instance : TObject; const PropertyName : string; aValue : TValue);
|
|
|
+var
|
|
|
+ pinfo : PPropInfo;
|
|
|
+begin
|
|
|
+ pinfo := GetPropInfo(Instance,PropertyName);
|
|
|
+ SetPropertyValue(Instance,pinfo,aValue);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TRTTIJson.SetPropertyValue(Instance : TObject; aPropInfo : PPropInfo; aValue : TValue);
|
|
|
+begin
|
|
|
+ case aPropInfo.PropType^.Kind of
|
|
|
+ tkInteger : SetOrdProp(Instance,aPropInfo,aValue.AsInteger);
|
|
|
+ tkInt64 : SetInt64Prop(Instance,aPropInfo,aValue.AsInt64);
|
|
|
+ tkFloat : SetFloatProp(Instance,aPropInfo,aValue.AsExtended);
|
|
|
+ tkChar : SetOrdProp(Instance,aPropInfo,aValue.AsOrdinal);
|
|
|
+ {$IFDEF FPC}
|
|
|
+ tkWString : SetWideStrProp(Instance,aPropInfo,aValue.AsString);
|
|
|
+ tkSString,
|
|
|
+ tkAString,
|
|
|
+ {$ELSE}
|
|
|
+ tkWString,
|
|
|
+ {$ENDIF}
|
|
|
+ tkLString : SetStrProp(Instance,aPropInfo,aValue.AsString);
|
|
|
+ {$IFDEF FPC}
|
|
|
+ tkBool : SetOrdProp(Instance,aPropInfo,aValue.AsOrdinal);
|
|
|
+ tkSet : LoadSetProperty(Instance,aPropInfo,aValue.AsString);
|
|
|
+ {$ENDIF}
|
|
|
+ tkEnumeration : SetEnumProp(Instance,aPropInfo,aValue.AsString);
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ tkClass :
|
|
|
+ {$ELSE}
|
|
|
+ tkObject :
|
|
|
+ {$ENDIF} SetObjectProp(Instance,aPropInfo,aValue.AsObject);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TRTTIJson.LoadSetProperty(aInstance : TObject; aPropInfo: PPropInfo; const aValue: string);
|
|
|
+type
|
|
|
+ TCardinalSet = set of 0..SizeOf(Cardinal) * 8 - 1;
|
|
|
+const
|
|
|
+ Delims = [' ', ',', '[', ']'];
|
|
|
+var
|
|
|
+ TypeInfo: PTypeInfo;
|
|
|
+ W: Cardinal;
|
|
|
+ I, N: Integer;
|
|
|
+ Count: Integer;
|
|
|
+ EnumName: string;
|
|
|
+begin
|
|
|
+ W := 0;
|
|
|
+ TypeInfo := GetTypeData(GetPropType(aPropInfo))^.CompType;
|
|
|
+ Count := WordCount(aValue, Delims);
|
|
|
+ for N := 1 to Count do
|
|
|
+ begin
|
|
|
+ EnumName := ExtractWord(N, aValue, Delims);
|
|
|
+ try
|
|
|
+ I := GetEnumValue(TypeInfo, EnumName);
|
|
|
+ if I >= 0 then Include(TCardinalSet(W),I);
|
|
|
+ except
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ SetOrdProp(aInstance,aPropInfo,W);
|
|
|
+end;
|
|
|
+{$ENDIF}
|
|
|
+
|
|
|
+function TRTTIJson.SerializeObject(aObject: TObject): TJSONObject;
|
|
|
+var
|
|
|
+ ctx: TRttiContext;
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ attr : TCustomAttribute;
|
|
|
+ comment : string;
|
|
|
+ {$ENDIF}
|
|
|
+ rType: TRttiType;
|
|
|
+ rProp: TRttiProperty;
|
|
|
+ jpair : TJSONPair;
|
|
|
+ ExcludeSerialize : Boolean;
|
|
|
+ propertyname : string;
|
|
|
+ propvalue : TValue;
|
|
|
+begin
|
|
|
+ if (aObject = nil) then
|
|
|
+ begin
|
|
|
+ Result := nil;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+
|
|
|
+ Result := nil;
|
|
|
+ try
|
|
|
+ //if is GenericList
|
|
|
+ if IsGenericList(aObject) then
|
|
|
+ begin
|
|
|
+ //get list array
|
|
|
+ propvalue := GetPropertyValueFromObject(aObject,'List');
|
|
|
+ {$IFDEF DELPHIRX10_UP}
|
|
|
+ Result := TJSONObject(SerializeDynArray(propvalue));
|
|
|
+ {$ELSE}
|
|
|
+ Result := TJSONObject(SerializeValue(propvalue));
|
|
|
+ {$ENDIF}
|
|
|
+ Exit;
|
|
|
+ end
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ else if IsStream(aObject) then
|
|
|
+ begin
|
|
|
+ Result := TJSONObject(SerializeStream(aObject));
|
|
|
+ Exit;
|
|
|
+ end
|
|
|
+ {$ENDIF}
|
|
|
+ else Result := TJSONObject.Create;
|
|
|
+ //if is standard object
|
|
|
+ propertyname := '';
|
|
|
+ rType := ctx.GetType(aObject.ClassInfo);
|
|
|
+ for rProp in TRTTI.GetProperties(rType,roFirstBase) do
|
|
|
+ begin
|
|
|
+ ExcludeSerialize := False;
|
|
|
+ propertyname := rProp.Name;
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ comment := '';
|
|
|
+ if not rProp.IsReadable then Continue;
|
|
|
+ for attr in rProp.GetAttributes do
|
|
|
+ begin
|
|
|
+ if attr is TNotSerializableProperty then ExcludeSerialize := True
|
|
|
+ else if attr is TCommentProperty then comment := TCommentProperty(attr).Comment
|
|
|
+ else if attr is TCustomNameProperty then propertyname := TCustomNameProperty(attr).Name;
|
|
|
+ end;
|
|
|
+ if ((fSerializeLevel = slPublicProperty) and (rProp.PropertyType.IsPublicType))
|
|
|
+ or ((fSerializeLevel = slPublishedProperty) and ((IsPublishedProp(aObject,rProp.Name)) or (rProp.Name = 'List'))) then
|
|
|
+ {$ENDIF}
|
|
|
+ begin
|
|
|
+ if (IsAllowedProperty(aObject,propertyname)) and (not ExcludeSerialize) then
|
|
|
+ begin
|
|
|
+ //add comment as pair
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ if comment <> '' then Result.AddPair(TJSONPair.Create('#Comment#->'+propertyname,Comment));
|
|
|
+ {$ENDIF}
|
|
|
+ begin
|
|
|
+ propvalue := rProp.GetValue(aObject);
|
|
|
+ jpair := TJSONPair.Create(propertyName,nil);
|
|
|
+// if (propvalue.IsObject) and (IsGenericList(propvalue.AsObject)) then
|
|
|
+// begin
|
|
|
+// jpair.JsonValue := SerializeValue(GetPropertyValueFromObject(propvalue.AsObject,'List'));
|
|
|
+// end
|
|
|
+ if propvalue.IsObject then jpair.JsonValue := SerializeObject(propvalue.AsObject)
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ else if (not propvalue.IsObject) and (IsGenericXArray(string(propvalue{$IFNDEF NEXTGEN}.TypeInfo.Name{$ELSE}.TypeInfo.NameFld.ToString{$ENDIF}))) then
|
|
|
+ begin
|
|
|
+ jpair.JsonValue := SerializeValue(GetFieldValueFromRecord(propvalue,'fArray'));
|
|
|
+ end
|
|
|
+ {$ENDIF}
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ jpair.JsonValue := SerializeValue(propvalue);
|
|
|
+ {$ELSE}
|
|
|
+ jpair.JsonValue := SerializeValue(propvalue);// SerializeObject(aObject,rProp.PropertyType.TypeKind,propertyname);
|
|
|
+ {$ENDIF}
|
|
|
+ end;
|
|
|
+ //s := jpair.JsonValue.ToString;
|
|
|
+ if jpair.JsonValue <> nil then
|
|
|
+ begin
|
|
|
+ Result.AddPair(jpair);
|
|
|
+ end
|
|
|
+ else jpair.Free;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ except
|
|
|
+ on E : Exception do
|
|
|
+ begin
|
|
|
+ if Result <> nil then Result.Free;
|
|
|
+ if not propertyname.IsEmpty then raise EJsonSerializeError.CreateFmt('Serialize Error -> Object property: "%s" (%s)',[propertyname,e.Message])
|
|
|
+ else raise EJsonSerializeError.CreateFmt('Serialize Error -> Object (%s)',[e.Message]);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function TRTTIJson.GetValue(aAddr: Pointer; aType: TRTTIType): TValue;
|
|
|
+begin
|
|
|
+ TValue.Make(aAddr,aType.Handle,Result);
|
|
|
+end;
|
|
|
+
|
|
|
+{$IFDEF FPC}
|
|
|
+function TRTTIJson.GetValue(aAddr: Pointer; aTypeInfo: PTypeInfo): TValue;
|
|
|
+begin
|
|
|
+ TValue.Make(aAddr,aTypeInfo,Result);
|
|
|
+end;
|
|
|
+{$ENDIF}
|
|
|
+
|
|
|
+function TRTTIJson.SerializeValue(const aValue : TValue) : TJSONValue;
|
|
|
+begin
|
|
|
+ Result := nil;
|
|
|
+ case avalue.Kind of
|
|
|
+ tkDynArray :
|
|
|
+ begin
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ Result := SerializeDynArray(aValue);
|
|
|
+ {$ENDIF}
|
|
|
+ end;
|
|
|
+ tkClass :
|
|
|
+ begin
|
|
|
+ Result := TJSONValue(SerializeObject(aValue.AsObject));
|
|
|
+ end;
|
|
|
+ tkInterface :
|
|
|
+ begin
|
|
|
+ {$IFDEF DELPHIRX10_UP}
|
|
|
+ // Would not work with iOS/Android native interfaces
|
|
|
+ Result := TJSONValue(SerializeObject(aValue.AsInterface as TObject));
|
|
|
+ {$ENDIF}
|
|
|
+ end;
|
|
|
+ tkString, tkLString, tkWString, tkUString :
|
|
|
+ begin
|
|
|
+ Result := TJSONString.Create(aValue.AsString);
|
|
|
+ end;
|
|
|
+ tkChar, tkWChar :
|
|
|
+ begin
|
|
|
+ Result := TJSONString.Create(aValue.AsString);
|
|
|
+ end;
|
|
|
+ tkInteger :
|
|
|
+ begin
|
|
|
+ Result := TJSONNumber.Create(aValue.AsInteger);
|
|
|
+ end;
|
|
|
+ tkInt64 :
|
|
|
+ begin
|
|
|
+ Result := TJSONNumber.Create(aValue.AsInt64);
|
|
|
+ end;
|
|
|
+ tkFloat :
|
|
|
+ begin
|
|
|
+ if aValue.TypeInfo = TypeInfo(TDateTime) then
|
|
|
+ begin
|
|
|
+ if aValue.AsExtended <> 0.0 then Result := TJSONString.Create(DateTimeToJsonDate(aValue.AsExtended));
|
|
|
+ end
|
|
|
+ else if aValue.TypeInfo = TypeInfo(TDate) then
|
|
|
+ begin
|
|
|
+ if aValue.AsExtended <> 0.0 then Result := TJSONString.Create(DateToStr(aValue.AsExtended));
|
|
|
+ end
|
|
|
+ else if aValue.TypeInfo = TypeInfo(TTime) then
|
|
|
+ begin
|
|
|
+ Result := TJSONString.Create(TimeToStr(aValue.AsExtended));
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ Result := TJSONNumber.Create(aValue.AsExtended);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ tkEnumeration :
|
|
|
+ begin
|
|
|
+ if (aValue.TypeInfo = System.TypeInfo(Boolean)) then
|
|
|
+ begin
|
|
|
+ {$IF Defined(DELPHIRX10_UP) OR Defined(FPC)}
|
|
|
+ Result := TJSONBool.Create(aValue.AsBoolean);
|
|
|
+ {$ELSE}
|
|
|
+ if aValue.AsBoolean then Result := TJsonTrue.Create
|
|
|
+ else Result := TJsonFalse.Create;
|
|
|
+ {$ENDIF}
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ //Result.JsonValue := TJSONString.Create(GetEnumName(aValue.TypeInfo,aValue.AsOrdinal));
|
|
|
+ if fUseEnumNames then Result := TJSONString.Create(aValue.ToString)
|
|
|
+ else Result := TJSONNumber.Create(GetEnumValue(aValue.TypeInfo,aValue.ToString));
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ {$IFDEF FPC}
|
|
|
+ tkBool :
|
|
|
+ begin
|
|
|
+ Result := TJSONBool.Create(aValue.AsBoolean);
|
|
|
+ end;
|
|
|
+ {$ENDIF}
|
|
|
+ tkSet :
|
|
|
+ begin
|
|
|
+ Result := TJSONString.Create(aValue.ToString);
|
|
|
+ end;
|
|
|
+ tkRecord :
|
|
|
+ begin
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ Result := SerializeRecord(aValue);
|
|
|
+ {$ENDIF}
|
|
|
+ end;
|
|
|
+ tkVariant :
|
|
|
+ begin
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ case VarType(aValue.AsVariant) and VarTypeMask of
|
|
|
+ varInteger, varInt64 : Result := TJSONNumber.Create(aValue.AsInteger);
|
|
|
+ varString, varUString, varEmpty : Result := TJSONString.Create(aValue.AsString);
|
|
|
+ varDouble : Result := TJSONNumber.Create(aValue.AsExtended);
|
|
|
+ end;
|
|
|
+ {$ENDIF}
|
|
|
+ end;
|
|
|
+ tkMethod, tkPointer, tkClassRef, tkProcedure, tkUnknown :
|
|
|
+ begin
|
|
|
+ //skip these properties
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ raise EJsonSerializeError.CreateFmt(cNotSupportedDataType,[GetTypeName(aValue.TypeInfo)]);
|
|
|
+ {$ELSE}
|
|
|
+ raise EJsonSerializeError.Create('Not supported Data Type');
|
|
|
+ {$ENDIF}
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ if Result = nil then Result := TJSONNull.Create;
|
|
|
+end;
|
|
|
+
|
|
|
+function TRTTIJson.SerializeStream(aObject: TObject): TJSONValue;
|
|
|
+var
|
|
|
+ stream : TStream;
|
|
|
+begin
|
|
|
+ Result := nil;
|
|
|
+ try
|
|
|
+ stream := TStream(aObject);
|
|
|
+ if fUseBase64Stream then Result := TJSONString.Create(Base64Encode(StreamToString(stream,TEncoding.Ansi)))
|
|
|
+ else Result := TJSONString.Create(StreamToString(stream,TEncoding.Ansi));
|
|
|
+ except
|
|
|
+ on E : Exception do
|
|
|
+ begin
|
|
|
+ EJsonSerializeError.CreateFmt('Serialize Error -> Stream (%s)',[e.Message]);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+{$IFNDEF FPC}
|
|
|
+function TRTTIJson.SerializeDynArray(const aValue: TValue; aMaxElements : Integer = -1) : TJsonArray;
|
|
|
+var
|
|
|
+ ctx : TRttiContext;
|
|
|
+ rDynArray : TRTTIDynamicArrayType;
|
|
|
+ i : Integer;
|
|
|
+ jValue : TJSONValue;
|
|
|
+ element : Integer;
|
|
|
+ list : TList<TJSONValue>;
|
|
|
+ len : Integer;
|
|
|
+begin
|
|
|
+ element := -1;
|
|
|
+ Result := TJSONArray.Create;
|
|
|
+ try
|
|
|
+ rDynArray := ctx.GetType(aValue.TypeInfo) as TRTTIDynamicArrayType;
|
|
|
+ //if aValue.IsObjectInstance then TList<TObject>(aValue.AsObject).TrimExcess;
|
|
|
+
|
|
|
+ list := TList<TJSONValue>.Create;
|
|
|
+ if aMaxElements = -1 then len := aValue.GetArrayLength
|
|
|
+ else len := aMaxElements;
|
|
|
+
|
|
|
+ list.Capacity := len;
|
|
|
+ for i := 0 to len - 1 do
|
|
|
+ begin
|
|
|
+ if not GetValue(PPByte(aValue.GetReferenceToRawData)^ + rDynArray.ElementType.TypeSize * i, rDynArray.ElementType).IsEmpty then
|
|
|
+ begin
|
|
|
+ element := i;
|
|
|
+ jValue := SerializeValue(GetValue(PPByte(aValue.GetReferenceToRawData)^ + rDynArray.ElementType.TypeSize * i, rDynArray.ElementType));
|
|
|
+ if jValue = nil then jValue := TJSONNull.Create;
|
|
|
+ list.Add(jValue);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ Result.SetElements(list);
|
|
|
+ except
|
|
|
+ on E : Exception do
|
|
|
+ begin
|
|
|
+ if element > -1 then raise EJsonSerializeError.CreateFmt('Serialize Error -> Array[%d] (%s)',[element,e.Message])
|
|
|
+ else raise EJsonSerializeError.CreateFmt('Serialize Error -> Array (%s)',[e.Message]);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function TRTTIJson.SerializeRecord(const aValue : TValue) : TJSONValue;
|
|
|
+var
|
|
|
+ ctx : TRttiContext;
|
|
|
+ json : TJSONObject;
|
|
|
+ rRec : TRttiRecordType;
|
|
|
+ rField : TRttiField;
|
|
|
+begin
|
|
|
+ rField := nil;
|
|
|
+ try
|
|
|
+ rRec := ctx.GetType(aValue.TypeInfo).AsRecord;
|
|
|
+ if aValue.TypeInfo = System.TypeInfo(TGUID) then
|
|
|
+ begin
|
|
|
+ Result := TJSONString.Create(GUIDToString(aValue.AsType<TGUID>));
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ json := TJSONObject.Create;
|
|
|
+ for rField in rRec.GetFields do
|
|
|
+ begin
|
|
|
+ json.AddPair(rField.Name,SerializeValue(rField.GetValue(aValue.GetReferenceToRawData)));
|
|
|
+ end;
|
|
|
+ Result := json;
|
|
|
+ end;
|
|
|
+ except
|
|
|
+ on E : Exception do
|
|
|
+ begin
|
|
|
+ if rField <> nil then raise EJsonSerializeError.CreateFmt('Serialize Error -> Record property "%s" (%s)',[rField.Name,e.Message])
|
|
|
+ else raise EJsonSerializeError.CreateFmt('Serialize Error -> Record (%s)',[e.Message]);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+{$ELSE}
|
|
|
+function TRTTIJson.GetPropType(aPropInfo: PPropInfo): PTypeInfo;
|
|
|
+begin
|
|
|
+ Result := aPropInfo^.PropType;
|
|
|
+end;
|
|
|
+
|
|
|
+function TRTTIJson.FloatProperty(aObject : TObject; aPropInfo: PPropInfo): string;
|
|
|
+const
|
|
|
+ Precisions: array[TFloatType] of Integer = (7, 15, 18, 18, 19);
|
|
|
+var
|
|
|
+ fsettings : TFormatSettings;
|
|
|
+begin
|
|
|
+ fsettings := FormatSettings;
|
|
|
+ Result := StringReplace(FloatToStrF(GetFloatProp(aObject, aPropInfo), ffGeneral,
|
|
|
+ Precisions[GetTypeData(GetPropType(aPropInfo))^.FloatType],0),
|
|
|
+ '.',fsettings.DecimalSeparator,[rfReplaceAll]);
|
|
|
+end;
|
|
|
+
|
|
|
+function TRTTIJson.SerializeObject(aObject : TObject; aType : TTypeKind; const aPropertyName : string) : TJSONPair;
|
|
|
+var
|
|
|
+ propinfo : PPropInfo;
|
|
|
+ jArray : TJsonArray;
|
|
|
+ jPair : TJsonPair;
|
|
|
+ jValue : TJsonValue;
|
|
|
+ i : Integer;
|
|
|
+ pArr : Pointer;
|
|
|
+ rValue : TValue;
|
|
|
+ rItemValue : TValue;
|
|
|
+ len : Integer;
|
|
|
+begin
|
|
|
+ try
|
|
|
+ Result := TJSONPair.Create(aPropertyName,nil);
|
|
|
+
|
|
|
+ propinfo := GetPropInfo(aObject,aPropertyName);
|
|
|
+ //case propinfo.PropType.Kind of
|
|
|
+ case aType of
|
|
|
+ tkDynArray :
|
|
|
+ begin
|
|
|
+ len := 0;
|
|
|
+ jArray := TJSONArray.Create;
|
|
|
+ try
|
|
|
+ pArr := GetDynArrayProp(aObject,aPropertyName);
|
|
|
+ TValue.Make(@pArr,propinfo.PropType, rValue);
|
|
|
+ if rValue.IsArray then
|
|
|
+ begin
|
|
|
+ len := rValue.GetArrayLength;
|
|
|
+ for i := 0 to len - 1 do
|
|
|
+ begin
|
|
|
+ rItemValue := rValue.GetArrayElement(i);
|
|
|
+ jValue := SerializeValue(rItemValue);
|
|
|
+ jArray.Add(jValue);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ Result.JsonValue := jArray;
|
|
|
+ finally
|
|
|
+ //DynArrayClear(pArr,propinfo.PropType);
|
|
|
+ pArr := nil;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ tkClass :
|
|
|
+ begin
|
|
|
+ Result.JsonValue := TJSONValue(SerializeObject(GetObjectProp(aObject,aPropertyName)));
|
|
|
+ end;
|
|
|
+ tkString, tkLString, tkWString, tkUString, tkAString :
|
|
|
+ begin
|
|
|
+ Result.JsonValue := TJSONString.Create(GetStrProp(aObject,aPropertyName));
|
|
|
+ end;
|
|
|
+ tkChar, tkWChar :
|
|
|
+ begin
|
|
|
+ Result.JsonValue := TJSONString.Create(Char(GetOrdProp(aObject,aPropertyName)));
|
|
|
+ end;
|
|
|
+ tkInteger :
|
|
|
+ begin
|
|
|
+ Result.JsonValue := TJSONNumber.Create(GetOrdProp(aObject,aPropertyName));
|
|
|
+ end;
|
|
|
+ tkInt64 :
|
|
|
+ begin
|
|
|
+ Result.JsonValue := TJSONNumber.Create(GetOrdProp(aObject,aPropertyName));
|
|
|
+ end;
|
|
|
+ tkFloat :
|
|
|
+ begin
|
|
|
+ if propinfo.PropType = TypeInfo(TDateTime) then
|
|
|
+ begin
|
|
|
+ Result.JsonValue := TJSONString.Create(DateTimeToJsonDate(GetFloatProp(aObject,aPropertyName)));
|
|
|
+ end
|
|
|
+ else if propinfo.PropType = TypeInfo(TDate) then
|
|
|
+ begin
|
|
|
+ Result.JsonValue := TJSONString.Create(DateToStr(GetFloatProp(aObject,aPropertyName)));
|
|
|
+ end
|
|
|
+ else if propinfo.PropType = TypeInfo(TTime) then
|
|
|
+ begin
|
|
|
+ Result.JsonValue := TJSONString.Create(TimeToStr(GetFloatProp(aObject,aPropertyName)));
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ //Result.JsonValue := TJsonFloatNumber.Create(GetFloatProp(aObject,aPropertyName));
|
|
|
+ Result.JsonValue := TJsonFloatNumber.Create(StrToFloat(FloatProperty(aObject,propinfo)));
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ tkEnumeration,tkBool :
|
|
|
+ begin
|
|
|
+ if (propinfo.PropType = System.TypeInfo(Boolean)) then
|
|
|
+ begin
|
|
|
+ Result.JsonValue := TJSONBool.Create(Boolean(GetOrdProp(aObject,aPropertyName)));
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ if fUseEnumNames then Result.JsonValue := TJSONString.Create(GetEnumName(propinfo.PropType,GetOrdProp(aObject,aPropertyName)))
|
|
|
+ else Result.JsonValue := TJSONNumber.Create(GetOrdProp(aObject,aPropertyName));
|
|
|
+ //Result.JsonValue := TJSONString.Create(aValue.ToString);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ tkSet :
|
|
|
+ begin
|
|
|
+ Result.JsonValue := TJSONString.Create(GetSetProp(aObject,aPropertyName));
|
|
|
+ end;
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ tkRecord :
|
|
|
+ begin
|
|
|
+ Result.JsonValue := SerializeRecord(aValue);
|
|
|
+ end;
|
|
|
+ {$ENDIF}
|
|
|
+ tkMethod, tkPointer, tkClassRef ,tkInterface, tkProcedure :
|
|
|
+ begin
|
|
|
+ //skip these properties
|
|
|
+ //FreeAndNil(Result);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+
|
|
|
+ //raise EJsonDeserializeError.CreateFmt('Not supported type "%s":%d',[aName,Integer(aValue.Kind)]);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ if Result.JsonValue = nil then Result.JsonValue := TJSONNull.Create;
|
|
|
+ except
|
|
|
+ on E : Exception do
|
|
|
+ begin
|
|
|
+ Result.Free;
|
|
|
+ {$IFNDEF FPC}
|
|
|
+ raise EJsonSerializeError.CreateFmt('Serialize error class "%s.%s" : %s',[aName,aValue.ToString,e.Message]);
|
|
|
+ {$ENDIF}
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+{$ENDIF}
|
|
|
+
|
|
|
+
|
|
|
+{ TJsonSerializer}
|
|
|
+
|
|
|
+constructor TJsonSerializer.Create(aSerializeLevel: TSerializeLevel; aUseEnumNames : Boolean = True; aUseNullStringsAsEmpty : Boolean = False);
|
|
|
+begin
|
|
|
+ {$IFDEF FPC}
|
|
|
+ if aSerializeLevel = TSerializeLevel.slPublicProperty then raise EJsonSerializeError.Create('FreePascal RTTI only supports published properties');
|
|
|
+ {$ENDIF}
|
|
|
+ fSerializeLevel := aSerializeLevel;
|
|
|
+ fUseEnumNames := aUseEnumNames;
|
|
|
+ fUseJsonCaseSense := False;
|
|
|
+ fUseBase64Stream := True;
|
|
|
+ fUseNullStringsAsEmpty := aUseNullStringsAsEmpty;
|
|
|
+ fRTTIJson := TRTTIJson.Create(aSerializeLevel,aUseEnumNames);
|
|
|
+ fRTTIJson.UseJsonCaseSense := fUseJsonCaseSense;
|
|
|
+ fRTTIJson.UseBase64Stream := fUseBase64Stream;
|
|
|
+ fRTTIJson.UseNullStringsAsEmpty := fUseNullStringsAsEmpty;
|
|
|
+end;
|
|
|
+
|
|
|
+destructor TJsonSerializer.Destroy;
|
|
|
+begin
|
|
|
+ fRTTIJson.Free;
|
|
|
+ inherited;
|
|
|
+end;
|
|
|
+
|
|
|
+function TJsonSerializer.JsonToObject(aType: TClass; const aJson: string): TObject;
|
|
|
+var
|
|
|
+ json: TJSONObject;
|
|
|
+begin
|
|
|
+ {$IFDEF DEBUG_SERIALIZER}
|
|
|
+ TDebugger.TimeIt(Self,'JsonToObject',aType.ClassName);
|
|
|
+ {$ENDIF}
|
|
|
+ try
|
|
|
+ {$IFDEF DELPHIRX10_UP}
|
|
|
+ json := TJSONObject.ParseJSONValue(aJson,True) as TJSONObject;
|
|
|
+ {$ELSE}
|
|
|
+ {$IFDEF FPC}
|
|
|
+ json := TJSONObject(TJSONObject.ParseJSONValue(aJson,True));
|
|
|
+ {$ELSE}
|
|
|
+ json := TJsonObject.ParseJSONValue(TEncoding.UTF8.GetBytes(aJson),0,True) as TJSONObject;
|
|
|
+ {$ENDIF}
|
|
|
+ {$ENDIF}
|
|
|
+ except
|
|
|
+ raise EJsonDeserializeError.Create(cNotValidJson);
|
|
|
+ end;
|
|
|
+ try
|
|
|
+ Result := fRTTIJson.DeserializeClass(aType,json);
|
|
|
+ finally
|
|
|
+ json.Free;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function TJsonSerializer.JsonToObject(aObject: TObject; const aJson: string): TObject;
|
|
|
+var
|
|
|
+ jvalue : TJSONValue;
|
|
|
+ json: TJSONObject;
|
|
|
+begin;
|
|
|
+ if aObject = nil then raise EJsonDeserializeError.Create('Object param cannot be null!');
|
|
|
+
|
|
|
+ {$IFDEF DEBUG_SERIALIZER}
|
|
|
+ TDebugger.TimeIt(Self,'JsonToObject',aObject.ClassName);
|
|
|
+ {$ENDIF}
|
|
|
+ try
|
|
|
+ {$IFDEF DELPHIRX10_UP}
|
|
|
+ jvalue := TJSONObject.ParseJSONValue(aJson,True);
|
|
|
+ if jvalue.ClassType = TJSONArray then json := TJSONObject(jvalue)
|
|
|
+ else json := jvalue as TJSONObject;
|
|
|
+
|
|
|
+ //json := TJSONObject.ParseJSONValue(aJson,True) as TJSONObject;
|
|
|
+ {$ELSE}
|
|
|
+ {$IFDEF FPC}
|
|
|
+ json := TJSONObject(TJSONObject.ParseJSONValue(aJson,True));
|
|
|
+ {$ELSE}
|
|
|
+ json := TJsonObject.ParseJSONValue(TEncoding.UTF8.GetBytes(aJson),0,True) as TJSONObject;
|
|
|
+ {$ENDIF}
|
|
|
+ {$ENDIF}
|
|
|
+ except
|
|
|
+ raise EJsonDeserializeError.Create(cNotValidJson);
|
|
|
+ end;
|
|
|
+ try
|
|
|
+ Result := fRTTIJson.DeserializeObject(aObject,json);
|
|
|
+ finally
|
|
|
+ json.Free;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function TJsonSerializer.ObjectToJson(aObject : TObject; aIndent : Boolean = False): string;
|
|
|
+var
|
|
|
+ json: TJSONObject;
|
|
|
+begin
|
|
|
+ {$IFDEF DEBUG_SERIALIZER}
|
|
|
+ TDebugger.TimeIt(Self,'ObjectToJson',aObject.ClassName);
|
|
|
+ {$ENDIF}
|
|
|
+ json := fRTTIJson.SerializeObject(aObject);
|
|
|
+ try
|
|
|
+ if aIndent then Result := TJsonUtils.JsonFormat(json.ToJSON)
|
|
|
+ else Result := json.ToJSON;
|
|
|
+ finally
|
|
|
+ json.Free;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TJsonSerializer.ObjectToJsonStream(aObject: TObject; aStream: TStream);
|
|
|
+var
|
|
|
+ json : TJsonObject;
|
|
|
+ ss : TStringStream;
|
|
|
+begin
|
|
|
+ {$IFDEF DEBUG_SERIALIZER}
|
|
|
+ TDebugger.TimeIt(Self,'ObjectToJsonStream',aObject.ClassName);
|
|
|
+ {$ENDIF}
|
|
|
+ if aStream = nil then raise EJsonSerializeError.Create('stream parameter cannot be nil!');
|
|
|
+
|
|
|
+ json := fRTTIJson.SerializeObject(aObject);
|
|
|
+ try
|
|
|
+ ss := TStringStream.Create(json.ToString,TEncoding.UTF8);
|
|
|
+ try
|
|
|
+ aStream.CopyFrom(ss,ss.Size);
|
|
|
+ finally
|
|
|
+ ss.Free;
|
|
|
+ end;
|
|
|
+ finally
|
|
|
+ json.Free;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function TJsonSerializer.ObjectToJsonString(aObject : TObject; aIndent : Boolean = False): string;
|
|
|
+var
|
|
|
+ json: TJSONObject;
|
|
|
+begin
|
|
|
+ {$IFDEF DEBUG_SERIALIZER}
|
|
|
+ TDebugger.TimeIt(Self,'ObjectToJsonString',aObject.ClassName);
|
|
|
+ {$ENDIF}
|
|
|
+ json := fRTTIJson.SerializeObject(aObject);
|
|
|
+ try
|
|
|
+ if aIndent then Result := TJsonUtils.JsonFormat(json.ToString)
|
|
|
+ else Result := json.ToString;
|
|
|
+ finally
|
|
|
+ json.Free;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function TJsonSerializer.ValueToJson(const aValue: TValue; aIndent: Boolean): string;
|
|
|
+var
|
|
|
+ json: TJSONValue;
|
|
|
+begin
|
|
|
+ {$IFDEF DEBUG_SERIALIZER}
|
|
|
+ TDebugger.TimeIt(Self,'ValueToJson',aValue.ToString);
|
|
|
+ {$ENDIF}
|
|
|
+ json:= fRTTIJson.SerializeValue(aValue);
|
|
|
+ if json = nil then raise EJsonSerializerError.Create('Error serializing TValue');
|
|
|
+ try
|
|
|
+ if aIndent then Result := TJsonUtils.JsonFormat(json{$IFNDEF FPC}.ToJSON{$ELSE}.AsJson{$ENDIF})
|
|
|
+ else Result := json{$IFNDEF FPC}.ToJSON{$ELSE}.AsJson{$ENDIF};
|
|
|
+ finally
|
|
|
+ json.Free;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function TJsonSerializer.ValueToJsonString(const aValue: TValue; aIndent: Boolean): string;
|
|
|
+var
|
|
|
+ json: TJSONValue;
|
|
|
+begin
|
|
|
+ {$IFDEF DEBUG_SERIALIZER}
|
|
|
+ TDebugger.TimeIt(Self,'ValueToJsonString',aValue.ToString);
|
|
|
+ {$ENDIF}
|
|
|
+ json:= fRTTIJson.SerializeValue(aValue);
|
|
|
+ if json = nil then raise EJsonSerializerError.Create('Error serializing TValue');
|
|
|
+ try
|
|
|
+ if aIndent then Result := TJsonUtils.JsonFormat(json.ToString)
|
|
|
+ else Result := json.ToString;
|
|
|
+ finally
|
|
|
+ json.Free;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function TJsonSerializer.ArrayToJson<T>(aArray: TArray<T>; aIndent: Boolean): string;
|
|
|
+var
|
|
|
+ json: TJSONValue;
|
|
|
+begin
|
|
|
+ {$IFDEF DEBUG_SERIALIZER}
|
|
|
+ TDebugger.TimeIt(Self,'ArrayToJson','');
|
|
|
+ {$ENDIF}
|
|
|
+ json:= fRTTIJson.SerializeValue(TValue.From<TArray<T>>(aArray));
|
|
|
+ if json = nil then raise EJsonSerializerError.Create('Error serializing Array');
|
|
|
+ try
|
|
|
+ if aIndent then Result := TJsonUtils.JsonFormat(json{$IFNDEF FPC}.ToJSON{$ELSE}.AsJson{$ENDIF})
|
|
|
+ else Result := json{$IFNDEF FPC}.ToJSON{$ELSE}.AsJson{$ENDIF};
|
|
|
+ finally
|
|
|
+ json.Free;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function TJsonSerializer.ArrayToJsonString<T>(aArray: TArray<T>; aIndent: Boolean): string;
|
|
|
+var
|
|
|
+ json: TJSONValue;
|
|
|
+begin
|
|
|
+ {$IFDEF DEBUG_SERIALIZER}
|
|
|
+ TDebugger.TimeIt(Self,'ArrayToJsonString','');
|
|
|
+ {$ENDIF}
|
|
|
+ json:= fRTTIJson.SerializeValue(TValue.From<TArray<T>>(aArray));
|
|
|
+ if json = nil then raise EJsonSerializerError.Create('Error serializing Array');
|
|
|
+ try
|
|
|
+ if aIndent then Result := TJsonUtils.JsonFormat(json.ToString)
|
|
|
+ else Result := json.ToString;
|
|
|
+ finally
|
|
|
+ json.Free;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function TJsonSerializer.JsonStreamToObject(aObject: TObject; aJsonStream: TStream): TObject;
|
|
|
+var
|
|
|
+ json : string;
|
|
|
+begin
|
|
|
+ {$IFDEF DEBUG_SERIALIZER}
|
|
|
+ TDebugger.TimeIt(Self,'JsonStreamToObject','');
|
|
|
+ {$ENDIF}
|
|
|
+ if aJsonStream = nil then raise EJsonDeserializeError.Create('JsonStream param cannot be nil!');
|
|
|
+
|
|
|
+ json := StreamToString(aJsonStream,TEncoding.UTF8);
|
|
|
+ Result := JsonToObject(aObject,json);
|
|
|
+end;
|
|
|
+
|
|
|
+{$IFNDEF FPC}
|
|
|
+
|
|
|
+function TJsonSerializer.JsonToArray<T>(const aJson: string): TArray<T>;
|
|
|
+var
|
|
|
+ jarray: TJSONArray;
|
|
|
+ value : TValue;
|
|
|
+begin;
|
|
|
+ {$IFDEF DEBUG_SERIALIZER}
|
|
|
+ TDebugger.TimeIt(Self,'JsonToArray','');
|
|
|
+ {$ENDIF}
|
|
|
+ try
|
|
|
+ {$If Defined(FPC) OR Defined(DELPHIRX10_UP)}
|
|
|
+ jarray := TJSONObject.ParseJSONValue(aJson,True) as TJSONArray;
|
|
|
+ {$ELSE}
|
|
|
+ jarray := TJsonObject.ParseJSONValue(TEncoding.UTF8.GetBytes(aJson),0,True) as TJSONArray;
|
|
|
+ {$ENDIF}
|
|
|
+ except
|
|
|
+ raise EJsonDeserializeError.Create(cNotValidJson);
|
|
|
+ end;
|
|
|
+ try
|
|
|
+ value := fRTTIJson.DeserializeDynArray(PTypeInfo(TypeInfo(TArray<T>)),nil,jarray);
|
|
|
+ Result := value.AsType<TArray<T>>;
|
|
|
+ finally
|
|
|
+ jarray.Free;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function TJsonSerializer.JsonToValue(const aJson: string): TValue;
|
|
|
+var
|
|
|
+ json: TJSONObject;
|
|
|
+ value : TValue;
|
|
|
+begin;
|
|
|
+ {$IFDEF DEBUG_SERIALIZER}
|
|
|
+ TDebugger.TimeIt(Self,'JsonToValue','');
|
|
|
+ {$ENDIF}
|
|
|
+ try
|
|
|
+ {$If Defined(FPC) OR Defined(DELPHIRX10_UP)}
|
|
|
+ json := TJSONObject.ParseJSONValue(aJson,True) as TJSONObject;
|
|
|
+ {$ELSE}
|
|
|
+ json := TJsonObject.ParseJSONValue(TEncoding.UTF8.GetBytes(aJson),0,True) as TJSONObject;
|
|
|
+ {$ENDIF}
|
|
|
+ except
|
|
|
+ raise EJsonDeserializeError.Create(cNotValidJson);
|
|
|
+ end;
|
|
|
+ try
|
|
|
+ value := fRTTIJson.DeserializeRecord(value,nil,json);
|
|
|
+ Result := value; // value.AsType<TArray<T>>;
|
|
|
+ finally
|
|
|
+ json.Free;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+{$ENDIF}
|
|
|
+
|
|
|
+procedure TJsonSerializer.SetSerializeLevel(const Value: TSerializeLevel);
|
|
|
+begin
|
|
|
+ fSerializeLevel := Value;
|
|
|
+ if Assigned(fRTTIJson) then fRTTIJson.fSerializeLevel := Value;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TJsonSerializer.SetUseBase64Stream(const Value: Boolean);
|
|
|
+begin
|
|
|
+ fUseBase64Stream := Value;
|
|
|
+ if Assigned(fRTTIJson) then fRTTIJson.UseBase64Stream := Value;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TJsonSerializer.SetUseEnumNames(const Value: Boolean);
|
|
|
+begin
|
|
|
+ fUseEnumNames := Value;
|
|
|
+ if Assigned(fRTTIJson) then fRTTIJson.UseEnumNames := Value;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TJsonSerializer.SetUseJsonCaseSense(const Value: Boolean);
|
|
|
+begin
|
|
|
+ fUseJsonCaseSense := Value;
|
|
|
+ if Assigned(fRTTIJson) then fRTTIJson.UseJsonCaseSense := Value;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TJsonSerializer.SetUseNullStringsAsEmpty(const Value: Boolean);
|
|
|
+begin
|
|
|
+ fUseNullStringsAsEmpty := Value;
|
|
|
+ if Assigned(fRTTIJson) then fRTTIJson.fUseNullStringsAsEmpty := Value;
|
|
|
+end;
|
|
|
+
|
|
|
+{$IFNDEF FPC}
|
|
|
+{ TCommentProperty }
|
|
|
+
|
|
|
+constructor TCommentProperty.Create(const aComment: string);
|
|
|
+begin
|
|
|
+ fComment := aComment;
|
|
|
+end;
|
|
|
+
|
|
|
+{ TCustomNameProperty }
|
|
|
+
|
|
|
+constructor TCustomNameProperty.Create(const aName: string);
|
|
|
+begin
|
|
|
+ fName := aName;
|
|
|
+end;
|
|
|
+{$ENDIF}
|
|
|
+
|
|
|
+{$IF NOT DEFINED(DELPHIXE7_UP) AND NOT DEFINED(FPC)}
|
|
|
+{ TJSONArrayHelper }
|
|
|
+
|
|
|
+function TJSONArrayHelper.Count: Integer;
|
|
|
+begin
|
|
|
+ Result := Self.Size;
|
|
|
+end;
|
|
|
+
|
|
|
+function TJSONArrayHelper.GetItem(aValue: Integer): TJSONValue;
|
|
|
+begin
|
|
|
+ Result := Self.Get(aValue);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TJSONArrayHelper.SetElements(aElements: TList<TJSONValue>);
|
|
|
+var
|
|
|
+ jvalue : TJSONValue;
|
|
|
+begin
|
|
|
+ for jvalue in aElements do Self.AddElement(jvalue);
|
|
|
+ aElements.Free;
|
|
|
+end;
|
|
|
+
|
|
|
+{ TJSONValueHelper }
|
|
|
+
|
|
|
+function TJSONValueHelper.ToJson: string;
|
|
|
+begin
|
|
|
+ Result := Self.ToString;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+{ TJSONObjectHelper }
|
|
|
+
|
|
|
+function TJSONObjectHelper.Count: Integer;
|
|
|
+begin
|
|
|
+ Result := Self.Size;
|
|
|
+end;
|
|
|
+
|
|
|
+function TJSONObjectHelper.GetValue(const aName: string): TJSONValue;
|
|
|
+var
|
|
|
+ jPair : TJSONPair;
|
|
|
+begin
|
|
|
+ Result := nil;
|
|
|
+ for jPair in Self do
|
|
|
+ begin
|
|
|
+ if jPair.JsonString.ToString = aName then Exit(jPair.JsonValue);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function TJSONObjectHelper.GetPair(aValue: Integer) : TJSONPair;
|
|
|
+begin
|
|
|
+ Result := Self.Get(aValue);
|
|
|
+end;
|
|
|
+
|
|
|
+{$ENDIF}
|
|
|
+
|
|
|
+end.
|
|
|
+
|
|
|
+
|
Exilon