2019-12-17 14:52:11 +01:00
// ***************************************************************************
2017-02-09 19:33:59 +01:00
//
// Delphi MVC Framework
//
2022-01-04 15:44:47 +01:00
// Copyright (c) 2010-2022 Daniele Teti and the DMVCFramework Team
2017-02-09 19:33:59 +01:00
//
// https://github.com/danieleteti/delphimvcframework
//
2019-10-10 00:02:02 +02:00
// Collaborators on this file: Ezequiel Juliano Müller (ezequieljuliano@gmail.com)
2017-03-01 21:40:57 +01:00
//
2017-02-09 19:33:59 +01:00
// ***************************************************************************
//
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
// http://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.
//
2017-03-01 21:40:57 +01:00
// ***************************************************************************
2017-02-09 19:33:59 +01:00
2017-02-07 14:08:36 +01:00
unit MVCFramework. Serializer. Commons;
2017-02-10 14:19:55 +01:00
{$I dmvcframework.inc}
2020-04-24 16:36:18 +02:00
{$WARN SYMBOL_DEPRECATED OFF}
2017-02-10 14:19:55 +01:00
2017-03-23 18:51:25 +01:00
interface
2017-02-07 14:08:36 +01:00
uses
2017-03-01 21:40:57 +01:00
System. Rtti,
System. Classes,
System. SysUtils,
System. DateUtils,
System. TypInfo,
2017-02-07 14:08:36 +01:00
2018-10-31 01:07:23 +01:00
{$IFDEF SYSTEMNETENCODING}
2017-03-01 21:40:57 +01:00
System. NetEncoding,
2017-02-07 14:08:36 +01:00
2018-10-31 01:07:23 +01:00
{$ELSE}
2017-03-01 21:40:57 +01:00
Soap. EncdDecd,
2017-02-07 14:08:36 +01:00
2018-10-31 01:07:23 +01:00
{$ENDIF}
MVCFramework. Commons,
2020-03-12 18:24:20 +01:00
Data. DB,
2020-04-20 17:56:17 +02:00
System. Generics. Collections,
2021-08-19 17:58:19 +02:00
JsonDataObjects, MVCFramework. DuckTyping;
2017-02-07 14:08:36 +01:00
2017-03-01 21:40:57 +01:00
type
2020-04-20 17:56:17 +02:00
EMVCSerializationException = class( EMVCException)
end ;
EMVCDeserializationException = class( EMVCException)
end ;
2017-03-01 21:40:57 +01:00
2017-07-16 19:36:44 +02:00
TMVCSerializationType = ( stUnknown, stDefault, stProperties, stFields) ;
2017-03-28 14:52:13 +02:00
2020-10-16 02:37:55 +02:00
TMVCNameCase = ( ncAsIs, ncUpperCase, ncLowerCase, ncCamelCase, ncPascalCase, ncSnakeCase) ;
2017-03-28 14:52:13 +02:00
TMVCDataType = ( dtObject, dtArray) ;
2017-04-29 23:56:56 +02:00
TMVCDatasetSerializationType = ( dstSingleRecord, dstAllRecords) ;
2020-03-12 18:24:20 +01:00
TMVCEnumSerializationType = ( estEnumName, estEnumOrd, estEnumMappedValues) ;
2019-08-12 21:48:33 +02:00
2017-03-28 14:52:13 +02:00
TMVCIgnoredList = array of string ;
2021-03-20 00:30:20 +01:00
TMVCSerializationAction< T: class > = reference to procedure( const AObject: T;
const Links: IMVCLinks) ;
2019-05-09 20:53:52 +02:00
TMVCSerializationAction = reference to procedure( const AObject: TObject; const Links: IMVCLinks) ;
2021-03-20 00:30:20 +01:00
TMVCDataSetSerializationAction = reference to procedure( const ADataSet: TDataset;
const Links: IMVCLinks) ;
TMVCDataSetFieldSerializationAction = reference to procedure( const AField: TField;
const AJsonObject: TJsonObject; var Handled: Boolean ) ;
2017-02-08 11:42:05 +01:00
2017-03-01 21:40:57 +01:00
MVCValueAsTypeAttribute = class( TCustomAttribute)
2017-02-09 11:24:18 +01:00
private
2017-03-01 21:40:57 +01:00
FValueTypeInfo: PTypeInfo;
2017-03-28 14:52:13 +02:00
protected
{ protected declarations }
2017-02-09 11:24:18 +01:00
public
2017-03-01 21:40:57 +01:00
constructor Create( AValueTypeInfo: PTypeInfo) ;
function ValueTypeInfo: PTypeInfo;
2017-02-09 11:24:18 +01:00
end ;
2017-03-28 14:52:13 +02:00
MVCDoNotSerializeAttribute = class( TCustomAttribute)
2020-05-04 12:39:54 +02:00
end ;
MVCDoNotDeSerializeAttribute = class( TCustomAttribute)
2017-03-28 14:52:13 +02:00
end ;
2017-02-10 14:19:55 +01:00
2017-03-28 14:52:13 +02:00
MVCSerializeAsStringAttribute = class( TCustomAttribute)
private
{ private declarations }
protected
{ protected declarations }
public
{ public declarations }
end ;
2017-03-01 21:40:57 +01:00
MVCNameCaseAttribute = class( TCustomAttribute)
private
FKeyCase: TMVCNameCase;
function GetKeyCase: TMVCNameCase;
2017-03-28 14:52:13 +02:00
protected
{ protected declarations }
2017-03-01 21:40:57 +01:00
public
constructor Create( const AKeyCase: TMVCNameCase) ;
property KeyCase: TMVCNameCase read GetKeyCase;
2017-02-10 14:19:55 +01:00
end ;
2017-04-13 12:46:37 +02:00
MapperJSONNaming = MVCNameCaseAttribute deprecated 'Use MVCNameCaseAttribute' ;
2017-03-01 21:40:57 +01:00
MVCNameAsAttribute = class( TCustomAttribute)
private
2020-04-24 16:36:18 +02:00
fName: string ;
fFixed: Boolean ;
2017-03-28 14:52:13 +02:00
protected
{ protected declarations }
2017-03-01 21:40:57 +01:00
public
2020-04-24 16:36:18 +02:00
constructor Create( const AName: string ; const Fixed: Boolean = False ) ;
property name : string read fName;
property Fixed: Boolean read fFixed;
2017-03-01 21:40:57 +01:00
end ;
2017-02-09 19:33:59 +01:00
2017-04-26 14:39:18 +02:00
MapperJSONSer = MVCNameAsAttribute deprecated 'Use MVCNameAsAttribute' ;
2017-03-01 21:40:57 +01:00
MVCListOfAttribute = class( TCustomAttribute)
2017-02-09 19:33:59 +01:00
private
2017-03-01 21:40:57 +01:00
FValue: TClass;
2017-03-28 14:52:13 +02:00
protected
{ protected declarations }
2017-02-09 19:33:59 +01:00
public
2017-03-01 21:40:57 +01:00
constructor Create( const AValue: TClass) ;
property Value: TClass read FValue;
2017-02-09 19:33:59 +01:00
end ;
2017-04-13 12:46:37 +02:00
MapperListOfAttribute = MVCListOfAttribute deprecated 'Use MVCListOfAttribute' ;
2017-03-28 14:52:13 +02:00
MVCDataSetFieldAttribute = class( TCustomAttribute)
private
FDataType: TMVCDataType;
protected
{ protected declarations }
public
constructor Create( const ADataType: TMVCDataType) ;
property DataType: TMVCDataType read FDataType;
end ;
MVCSerializeAttribute = class( TCustomAttribute)
private
FSerializationType: TMVCSerializationType;
protected
{ protected declarations }
public
constructor Create( const ASerializationType: TMVCSerializationType) ;
property SerializationType: TMVCSerializationType read FSerializationType;
end ;
2017-04-24 00:19:53 +02:00
MVCColumnAttribute = class( TCustomAttribute)
private
FFieldName: string ;
2020-04-20 17:56:17 +02:00
FIsPK: Boolean ;
2017-04-24 00:19:53 +02:00
procedure SetFieldName( const Value: string ) ;
2020-04-20 17:56:17 +02:00
procedure SetIsPK( const Value: Boolean ) ;
2017-04-24 00:19:53 +02:00
public
2020-04-24 16:36:18 +02:00
constructor Create( AFieldName: string ; AIsPK: Boolean = False ) ;
2017-04-24 00:19:53 +02:00
property FieldName: string read FFieldName write SetFieldName;
2020-04-20 17:56:17 +02:00
property IsPK: Boolean read FIsPK write SetIsPK;
2017-04-24 00:19:53 +02:00
end ;
2020-03-12 20:37:48 +01:00
MVCEnumSerializationAttribute = class( TCustomAttribute)
2019-08-12 21:48:33 +02:00
private
2020-03-12 18:24:20 +01:00
FSerializationType: TMVCEnumSerializationType;
FMappedValues: TList< string > ;
2019-08-12 21:48:33 +02:00
public
2021-03-20 00:30:20 +01:00
constructor Create( const ASerializationType: TMVCEnumSerializationType;
const AMappedValues: string = '' ) ;
destructor Destroy; override ;
2020-03-12 18:24:20 +01:00
property SerializationType: TMVCEnumSerializationType read FSerializationType;
property MappedValues: TList< string > read FMappedValues;
2019-08-12 21:48:33 +02:00
end ;
2021-08-17 15:10:58 +02:00
MVCOwnedAttribute = class( TCustomAttribute)
private
fClassRef: TClass;
public
constructor Create( const ClassRef: TClass = nil ) ;
property ClassRef: TClass read fClassRef;
end ;
2022-05-13 17:19:59 +02:00
/// <summary>
/// Use this attribute in the model class to define a field of type TGuid if at the time of attribute serialization the value
/// of the guid field will be obtained without braces.
/// Sample: 61013848-8736-4D8B-AD25-91DF4C255561
/// </summary>
MVCSerializeGuidWithoutBracesAttribute = class( TCustomAttribute) ;
2021-08-17 15:10:58 +02:00
2018-10-31 01:07:23 +01:00
TMVCSerializerHelper = record
2017-03-28 14:52:13 +02:00
private
{ private declarations }
public
2020-04-20 17:56:17 +02:00
class function ApplyNameCase( const NameCase: TMVCNameCase; const Value: string ) : string ; static ;
2021-03-20 00:30:20 +01:00
class function GetKeyName( const AField: TRttiField; const AType: TRttiType) : string ;
overload ; static ;
class function GetKeyName( const AProperty: TRttiProperty; const AType: TRttiType) : string ;
overload ; static ;
2021-02-23 18:00:32 +01:00
class function HasAttribute< T: class > ( const AMember: TRttiObject) : Boolean ; overload ; static ;
class function HasAttribute< T: class > ( const AMember: TRttiObject; out AAttribute: T) : Boolean ;
2019-03-08 09:33:41 +01:00
overload ; static ;
2021-03-20 00:30:20 +01:00
class function AttributeExists< T: TCustomAttribute> ( const AAttributes: TArray< TCustomAttribute> ;
out AAttribute: T) : Boolean ; overload ; static ;
class function AttributeExists< T: TCustomAttribute> ( const AAttributes: TArray< TCustomAttribute> )
2020-04-20 17:56:17 +02:00
: Boolean ; overload ; static ;
2017-03-28 14:52:13 +02:00
2021-03-20 00:30:20 +01:00
class procedure EncodeStream( AInput, AOutput: TStream) ; static ;
class procedure DecodeStream( AInput, AOutput: TStream) ; static ;
class function EncodeString( const AInput: string ) : string ; static ;
class function DecodeString( const AInput: string ) : string ; static ;
2019-03-08 09:33:41 +01:00
class procedure DeSerializeStringStream( AStream: TStream; const ASerializedString: string ;
2021-03-20 00:30:20 +01:00
const AEncoding: string ) ; static ;
class procedure DeSerializeBase64StringStream( AStream: TStream;
const ABase64SerializedString: string ) ; static ;
class function GetTypeKindAsString( const ATypeKind: TTypeKind) : string ; static ;
class function StringToTypeKind( const AValue: string ) : TTypeKind; static ;
class function CreateObject( const AObjectType: TRttiType) : TObject; overload ; static ;
class function CreateObject( const AQualifiedClassName: string ) : TObject; overload ; static ;
2021-08-17 15:10:58 +02:00
class function IsAPropertyToSkip( const aPropName: string ) : Boolean ; static ; inline ;
2017-03-28 14:52:13 +02:00
end ;
2021-03-20 00:30:20 +01:00
TMVCLinksCallback = reference to procedure( const Links: TMVCStringDictionary) ;
2019-03-08 09:33:41 +01:00
2020-04-18 23:32:24 +02:00
IMVCResponseData = interface
[ '{DF69BE0E-3212-4535-8B78-38EEF0F5B656}' ]
function GetMetadata: TMVCStringDictionary;
property MetaData: TMVCStringDictionary read GetMetadata;
function GetData: TObject;
property Data: TObject read GetData;
end ;
2019-09-01 20:35:19 +02:00
// Well Known Response Objects
[ MVCNameCase( ncLowerCase) ]
2020-04-18 23:32:24 +02:00
TMVCResponseBase = class abstract( TInterfacedObject, IMVCResponseData)
protected
2021-03-20 00:30:20 +01:00
function GetMetadata: TMVCStringDictionary; virtual ; abstract ;
function GetData: TObject; virtual ; abstract ;
2019-09-01 20:35:19 +02:00
end ;
[ MVCNameCase( ncLowerCase) ]
TMVCTask = class
private
2020-03-08 19:35:17 +01:00
fID: string ;
fHREF: string ;
2019-09-01 20:35:19 +02:00
public
2020-03-08 19:35:17 +01:00
property HREF: string read fHREF write fHREF;
property ID: string read fID write fID;
constructor Create( const HREF, ID: string ) ;
2019-09-01 20:35:19 +02:00
end ;
[ MVCNameCase( ncLowerCase) ]
TMVCAcceptedResponse = class( TMVCResponseBase)
private
fTask: TMVCTask;
public
property Task: TMVCTask read fTask;
2019-09-25 09:14:09 +02:00
// constructor Create(const aTask: TMVCTask); overload;
2020-03-08 19:35:17 +01:00
constructor Create( const HREF, ID: string ) ;
2021-03-20 00:30:20 +01:00
destructor Destroy; override ;
2019-09-01 20:35:19 +02:00
end ;
2019-09-30 00:05:46 +02:00
[ MVCNameCase( ncLowerCase) ]
2020-04-18 23:32:24 +02:00
TMVCResponseData = class( TMVCResponseBase, IMVCResponseData)
2019-09-30 00:05:46 +02:00
private
2020-04-18 23:32:24 +02:00
fData: TObject;
fMetaData: TMVCStringDictionary;
2020-04-20 17:56:17 +02:00
fOwns: Boolean ;
2020-04-18 23:32:24 +02:00
fDataSetSerializationType: TMVCDatasetSerializationType;
protected
2021-03-20 00:30:20 +01:00
function GetMetadata: TMVCStringDictionary; override ;
function GetData: TObject; override ;
2019-09-30 00:05:46 +02:00
public
2020-04-24 16:36:18 +02:00
constructor Create( const AObject: TObject; const AOwns: Boolean = False ;
2019-09-30 00:05:46 +02:00
const ADataSetSerializationType: TMVCDatasetSerializationType = TMVCDatasetSerializationType.
2021-03-20 00:30:20 +01:00
dstAllRecords) ; virtual ;
destructor Destroy; override ;
2019-09-30 00:05:46 +02:00
function SerializationType: TMVCDatasetSerializationType;
2020-04-24 16:36:18 +02:00
[ MVCNameAs( 'items' ) ]
2020-04-18 23:32:24 +02:00
property Items: TObject read GetData;
2019-09-30 00:05:46 +02:00
[ MVCNameAs( 'meta' ) ]
2020-04-18 23:32:24 +02:00
property MetaData: TMVCStringDictionary read GetMetadata;
2020-04-24 16:36:18 +02:00
end deprecated 'Use "ObjectDict"' ;
2019-09-30 00:05:46 +02:00
2020-04-24 16:36:18 +02:00
TDataObjectHolder = TMVCResponseData deprecated 'Use "ObjectDict"' ;
2020-01-04 12:53:53 +01:00
THTTPStatusCode = 1 0 0 .. 5 9 9 ;
2020-04-18 23:32:24 +02:00
TMVCObjectListResponse = class( TMVCResponseData)
2020-01-04 12:53:53 +01:00
public
2021-03-20 00:30:20 +01:00
constructor Create( const AObject: TObject; Owns: Boolean = True ) ; reintroduce ;
2020-01-04 12:53:53 +01:00
end ;
2020-04-18 23:32:24 +02:00
TMVCObjectResponse = class( TMVCResponseData)
2020-01-04 12:53:53 +01:00
public
2021-03-20 00:30:20 +01:00
constructor Create( const AObject: TObject; Owns: Boolean = True ) ; reintroduce ;
2020-04-20 17:56:17 +02:00
end ;
2020-04-20 18:32:46 +02:00
IMVCObjectDictionary = interface
[ '{B54F02EE-4B3B-4E55-9E6B-FB6CFE746028}' ]
2021-03-20 00:30:20 +01:00
function Add( const Name : string ; const Value: TObject;
const SerializationAction: TMVCSerializationAction = nil ) : IMVCObjectDictionary; overload ;
2020-04-20 18:32:46 +02:00
function Add( const Name : string ; const Value: TDataset;
const SerializationAction: TMVCDataSetSerializationAction = nil ;
2020-04-21 17:04:04 +02:00
const DataSetSerializationType: TMVCDatasetSerializationType = dstAllRecords;
2020-04-20 18:32:46 +02:00
const NameCase: TMVCNameCase = TMVCNameCase. ncLowerCase) : IMVCObjectDictionary; overload ;
function TryGetValue( const Name : string ; out Value: TObject) : Boolean ; overload ;
function Count: Integer ;
function ContainsKey( const Key: string ) : Boolean ;
function Keys: TArray< string > ;
end ;
TMVCObjectDictionary = class( TInterfacedObject, IMVCObjectDictionary)
2020-04-20 17:56:17 +02:00
public
{
TMVCSerializationAction = reference to procedure( const AObject: TObject; const Links: IMVCLinks) ;
TMVCDataSetSerializationAction = reference to procedure( const ADataSet: TDataset; const Links: IMVCLinks) ;
}
type
TMVCObjectDictionaryValueItem = class
private
fOwns: Boolean ;
fData: TObject;
fSerializationAction: TMVCSerializationAction;
fDataSetSerializationAction: TMVCDataSetSerializationAction;
fDataSetFieldNameCase: TMVCNameCase;
2020-04-21 17:04:04 +02:00
fDataSetSerializationType: TMVCDatasetSerializationType;
2020-04-20 17:56:17 +02:00
public
2021-03-20 00:30:20 +01:00
constructor Create( const Owns: Boolean ; const Data: TObject;
2020-04-20 17:56:17 +02:00
const SerializationAction: TMVCSerializationAction) ; overload ;
2021-03-20 00:30:20 +01:00
constructor Create( const Owns: Boolean ; const Data: TDataset;
2020-04-20 17:56:17 +02:00
const SerializationAction: TMVCDataSetSerializationAction;
2020-04-21 17:04:04 +02:00
const DataSetSerializationType: TMVCDatasetSerializationType;
2020-04-20 17:56:17 +02:00
const NameCase: TMVCNameCase) ; overload ;
destructor Destroy; override ;
property Data: TObject read fData;
property SerializationAction: TMVCSerializationAction read fSerializationAction;
2021-03-20 00:30:20 +01:00
property DataSetSerializationAction: TMVCDataSetSerializationAction
read fDataSetSerializationAction;
2020-04-20 17:56:17 +02:00
property DataSetFieldNameCase: TMVCNameCase read fDataSetFieldNameCase;
2021-03-20 00:30:20 +01:00
property DataSetSerializationType: TMVCDatasetSerializationType
read fDataSetSerializationType;
2020-04-20 17:56:17 +02:00
end ;
strict private
function GetItem( const Key: string ) : TMVCObjectDictionaryValueItem;
private
fOwnsValueItemData: Boolean ;
protected
fDict: TObjectDictionary< string , TMVCObjectDictionaryValueItem> ;
public
constructor Create( const OwnsValues: Boolean = True ) ; overload ; virtual ;
2021-03-20 00:30:20 +01:00
constructor Create( const aKey: string ; const Value: TObject; const OwnsValues: Boolean = True ) ;
overload ; virtual ;
2020-04-20 17:56:17 +02:00
destructor Destroy; override ;
procedure Clear;
2021-03-20 00:30:20 +01:00
function Add( const Name : string ; const Value: TObject;
const SerializationAction: TMVCSerializationAction = nil ) : IMVCObjectDictionary; overload ;
2020-04-20 17:56:17 +02:00
function Add( const Name : string ; const Value: TDataset;
const SerializationAction: TMVCDataSetSerializationAction = nil ;
2020-04-21 17:04:04 +02:00
const DataSetSerializationType: TMVCDatasetSerializationType = dstAllRecords;
2020-04-20 18:32:46 +02:00
const NameCase: TMVCNameCase = TMVCNameCase. ncLowerCase) : IMVCObjectDictionary; overload ;
2020-04-20 17:56:17 +02:00
function TryGetValue( const Name : string ; out Value: TObject) : Boolean ; overload ;
function Count: Integer ;
function ContainsKey( const Key: string ) : Boolean ;
function Keys: TArray< string > ;
property Items[ const Key: string ] : TMVCObjectDictionaryValueItem read GetItem; default ;
2020-01-04 12:53:53 +01:00
end ;
2021-08-19 17:58:19 +02:00
IMVCJSONSerializer = interface
[ '{1FB9E04A-D1D6-4C92-B945-257D81B39A25}' ]
procedure ObjectToJsonObject( const AObject: TObject; const AJsonObject: TJDOJsonObject;
const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList) ;
procedure ListToJsonArray( const AList: IMVCList; const AJsonArray: TJDOJsonArray;
const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList;
const ASerializationAction: TMVCSerializationAction = nil ) ;
procedure JsonObjectToObject( const AJsonObject: TJDOJsonObject; const AObject: TObject;
const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList) ;
end ;
2021-01-11 18:35:44 +01:00
var
2021-01-11 19:29:31 +01:00
/// <summary>
/// Use this variable when you want to convert your local time as UTC or when you receive an UTC ISOTimeStamp and
/// do not want to apply the time zone when converting.
/// The default value of gLocalTimeStampAsUTC = False.
/// </summary>
/// <example>
/// * For gLocalTimeStampAsUTC = False and timezone: - 03:00
2021-03-20 00:30:20 +01:00
/// ISOTimeStamp: 2021-01-11T14:22:17.763Z = DateTime: 2021-01-11 11:22:17.763
/// DateTime: 2021-01-11 14:22:17.763 = ISOTimeStamp: 2021-01-11T14:22:17.763-03:00
2021-01-11 19:29:31 +01:00
///
/// * For gLocalTimeStampAsUTC = True and timezone: - 03:00
2021-03-20 00:30:20 +01:00
/// ISOTimeStamp: 2021-01-11T14:22:17.763Z = DateTime: 2021-01-11 14:22:17
/// DateTime: 2021-01-11 14:22:17.763 = ISOTimeStamp: 2021-01-11T14:22:17.763Z
2021-01-11 19:29:31 +01:00
/// </example>
2021-01-11 18:35:44 +01:00
gLocalTimeStampAsUTC: Boolean ;
2017-03-01 21:40:57 +01:00
function DateTimeToISOTimeStamp( const ADateTime: TDateTime) : string ;
function DateToISODate( const ADate: TDateTime) : string ;
function TimeToISOTime( const ATime: TTime) : string ;
2021-03-20 00:30:20 +01:00
procedure MapDataSetFieldToRTTIField( const AField: TField; const aRTTIField: TRttiField;
const AObject: TObject) ;
function MapDataSetFieldToNullableRTTIField( const AValue: TValue; const AField: TField;
const aRTTIField: TRttiField; const AObject: TObject) : Boolean ;
2020-03-08 19:35:17 +01:00
function MapDataSetFieldToNullableRTTIProperty( const AValue: TValue; const AField: TField;
2021-03-20 00:30:20 +01:00
const aRTTIProp: TRttiProperty; const AObject: TObject) : Boolean ;
2020-02-05 23:46:38 +01:00
2017-08-29 11:54:22 +02:00
/// <summary>
2017-09-23 15:03:07 +02:00
/// Supports ISO8601 in the following formats:
/// yyyy-mm-ddThh:nn:ss
/// yyyy-mm-ddThh:nn:ss.000Z
2017-08-29 11:54:22 +02:00
/// </summary>
2017-03-01 21:40:57 +01:00
function ISOTimeStampToDateTime( const ADateTime: string ) : TDateTime;
function ISODateToDate( const ADate: string ) : TDate;
function ISOTimeToTime( const ATime: string ) : TTime;
2017-04-13 12:46:37 +02:00
const
JSONNameLowerCase = ncLowerCase deprecated 'Use MVCNameCaseAttribute(ncLowerCase)' ;
JSONNameUpperCase = ncUpperCase deprecated 'Use MVCNameCaseAttribute(ncUpperCase)' ;
2020-04-20 17:56:17 +02:00
function StrDict: TMVCStringDictionary; overload ;
function StrDict( const aKeys: array of string ; const aValues: array of string )
: TMVCStringDictionary; overload ;
2020-04-20 18:32:46 +02:00
function ObjectDict( const OwnsValues: Boolean = True ) : IMVCObjectDictionary;
2021-03-20 00:30:20 +01:00
function GetPaginationMeta( const CurrPageNumber: UInt32 ; const CurrPageSize: UInt32 ;
const DefaultPageSize: UInt32 ; const URITemplate: string ) : TMVCStringDictionary;
2020-09-11 13:01:56 +02:00
procedure RaiseSerializationError( const Msg: string ) ;
2020-04-19 12:23:55 +02:00
2017-02-07 14:08:36 +01:00
implementation
2019-09-30 00:05:46 +02:00
uses
2020-03-12 18:24:20 +01:00
Data. FmtBcd,
2020-03-13 15:58:04 +01:00
MVCFramework. Nullables,
System. Generics. Defaults;
2019-09-30 00:05:46 +02:00
2020-09-11 13:01:56 +02:00
procedure RaiseSerializationError( const Msg: string ) ;
begin
raise EMVCSerializationException. Create( Msg) ;
end ;
2020-04-20 17:56:17 +02:00
function StrDict: TMVCStringDictionary; overload ;
begin
Result : = TMVCStringDictionary. Create;
end ;
2021-03-20 00:30:20 +01:00
function GetPaginationMeta( const CurrPageNumber: UInt32 ; const CurrPageSize: UInt32 ;
const DefaultPageSize: UInt32 ; const URITemplate: string ) : TMVCStringDictionary;
2020-04-20 17:56:17 +02:00
var
lMetaKeys: array of string ;
lMetaValues: array of string ;
begin
Insert( 'curr_page' , lMetaKeys, 0 ) ;
Insert( CurrPageNumber. ToString( ) , lMetaValues, 0 ) ;
if CurrPageNumber > 1 then
begin
Insert( 'prev_page_uri' , lMetaKeys, 0 ) ;
Insert( Format( URITemplate, [ ( CurrPageNumber - 1 ) ] ) , lMetaValues, 0 ) ;
end ;
if CurrPageSize = DefaultPageSize then
begin
Insert( 'next_page_uri' , lMetaKeys, 0 ) ;
Insert( Format( URITemplate, [ ( CurrPageNumber + 1 ) ] ) , lMetaValues, 0 ) ;
end ;
Result : = StrDict( lMetaKeys, lMetaValues) ;
end ;
2020-04-20 18:32:46 +02:00
function ObjectDict( const OwnsValues: Boolean ) : IMVCObjectDictionary;
2020-04-20 17:56:17 +02:00
begin
Result : = TMVCObjectDictionary. Create( OwnsValues) ;
end ;
function StrDict( const aKeys: array of string ; const aValues: array of string )
: TMVCStringDictionary; overload ;
var
I: Integer ;
begin
if Length( aKeys) < > Length( aValues) then
begin
raise EMVCException. CreateFmt( 'Dict error. Got %d keys but %d values' ,
[ Length( aKeys) , Length( aValues) ] ) ;
end ;
Result : = StrDict( ) ;
for I : = low( aKeys) to high( aKeys) do
begin
Result . Add( aKeys[ I] , aValues[ I] ) ;
end ;
end ;
2017-03-01 21:40:57 +01:00
function DateTimeToISOTimeStamp( const ADateTime: TDateTime) : string ;
begin
2021-01-11 18:35:44 +01:00
Result : = DateToISO8601( ADateTime, gLocalTimeStampAsUTC) ;
2017-03-01 21:40:57 +01:00
end ;
2017-02-07 14:08:36 +01:00
2017-03-01 21:40:57 +01:00
function DateToISODate( const ADate: TDateTime) : string ;
begin
Result : = FormatDateTime( 'YYYY-MM-DD' , ADate) ;
end ;
function TimeToISOTime( const ATime: TTime) : string ;
var
fs: TFormatSettings;
begin
fs. TimeSeparator : = ':' ;
Result : = FormatDateTime( 'hh:nn:ss' , ATime, fs) ;
end ;
function ISOTimeStampToDateTime( const ADateTime: string ) : TDateTime;
2017-08-29 11:54:22 +02:00
var
lDateTime: string ;
2020-11-04 19:06:54 +01:00
lIsUTC: Boolean ;
2017-03-01 21:40:57 +01:00
begin
2017-08-29 11:54:22 +02:00
lDateTime : = ADateTime;
if lDateTime. Length < 1 9 then
2019-03-08 09:33:41 +01:00
raise Exception. CreateFmt
( 'Invalid parameter "%s". Hint: DateTime parameters must be formatted in ISO8601 (e.g. 2010-10-12T10:12:23)' ,
2018-10-31 01:07:23 +01:00
[ ADateTime] ) ;
2017-08-29 11:54:22 +02:00
if lDateTime. Chars[ 1 0 ] = ' ' then
begin
lDateTime : = lDateTime. Substring( 0 , 1 0 ) + 'T' + lDateTime. Substring( 1 1 ) ;
end ;
2020-11-04 19:06:54 +01:00
lIsUTC : = lDateTime. Length > 1 9 ;
2020-01-04 12:53:53 +01:00
Result : = ISO8601ToDate( lDateTime, True ) ;
2021-01-11 18:35:44 +01:00
if lIsUTC and ( not gLocalTimeStampAsUTC) then
2020-11-04 19:06:54 +01:00
begin
Result : = TTimeZone. Local . ToLocalTime( Result ) ;
end ;
2017-03-01 21:40:57 +01:00
end ;
function ISODateToDate( const ADate: string ) : TDate;
begin
2021-03-20 00:30:20 +01:00
Result : = EncodeDate( StrToInt( Copy( ADate, 1 , 4 ) ) , StrToInt( Copy( ADate, 6 , 2 ) ) ,
StrToInt( Copy( ADate, 9 , 2 ) ) ) ;
2017-03-01 21:40:57 +01:00
end ;
function ISOTimeToTime( const ATime: string ) : TTime;
begin
2021-03-20 00:30:20 +01:00
Result : = EncodeTime( StrToInt( Copy( ATime, 1 , 2 ) ) , StrToInt( Copy( ATime, 4 , 2 ) ) ,
StrToInt( Copy( ATime, 7 , 2 ) ) , 0 ) ;
2017-03-01 21:40:57 +01:00
end ;
2018-10-31 01:07:23 +01:00
{ TMVCSerializerHelper }
2017-02-07 14:08:36 +01:00
2019-03-08 09:33:41 +01:00
class procedure TMVCSerializerHelper. DeSerializeBase64StringStream( AStream: TStream;
const ABase64SerializedString: string ) ;
2017-02-07 14:08:36 +01:00
var
SS: TStringStream;
begin
2017-03-01 21:40:57 +01:00
AStream. Size : = 0 ;
SS : = TStringStream. Create( ABase64SerializedString, TEncoding. ASCII) ;
2017-02-07 14:08:36 +01:00
try
SS. Position : = 0 ;
2017-03-01 21:40:57 +01:00
DecodeStream( SS, AStream) ;
2017-02-07 14:08:36 +01:00
finally
SS. Free;
end ;
end ;
2021-03-20 00:30:20 +01:00
class procedure TMVCSerializerHelper. DeSerializeStringStream( AStream: TStream;
const ASerializedString: string ; const AEncoding: string ) ;
2017-02-07 14:08:36 +01:00
var
2017-03-01 21:40:57 +01:00
Encoding: TEncoding;
2017-02-07 14:08:36 +01:00
SS: TStringStream;
begin
2017-03-01 21:40:57 +01:00
AStream. Position : = 0 ;
Encoding : = TEncoding. GetEncoding( AEncoding) ;
SS : = TStringStream. Create( ASerializedString, Encoding) ;
2017-02-07 14:08:36 +01:00
try
SS. Position : = 0 ;
2017-03-01 21:40:57 +01:00
AStream. CopyFrom( SS, SS. Size) ;
2017-02-07 14:08:36 +01:00
finally
SS. Free;
end ;
end ;
2021-03-20 00:30:20 +01:00
class function TMVCSerializerHelper. GetKeyName( const AField: TRttiField;
const AType: TRttiType) : string ;
2017-02-07 14:08:36 +01:00
var
2017-03-01 21:40:57 +01:00
Attrs: TArray< TCustomAttribute> ;
Attr: TCustomAttribute;
2017-02-07 14:08:36 +01:00
begin
2020-04-24 14:48:30 +02:00
{
Dear future me.. .
Yes, this method is called a lot of times, but after some tests
seems that the performance loss is very low , so if you don' t have any
new evidence don' t try to improve it.. .
}
2017-03-01 21:40:57 +01:00
Result : = AField. Name ;
Attrs : = AField. GetAttributes;
for Attr in Attrs do
2020-04-24 14:48:30 +02:00
begin
2017-03-01 21:40:57 +01:00
if Attr is MVCNameAsAttribute then
2020-04-24 14:48:30 +02:00
begin
2017-03-01 21:40:57 +01:00
Exit( MVCNameAsAttribute( Attr) . Name ) ;
2020-04-24 14:48:30 +02:00
end ;
end ;
2017-02-07 14:08:36 +01:00
2017-03-01 21:40:57 +01:00
Attrs : = AType. GetAttributes;
for Attr in Attrs do
2020-04-24 14:48:30 +02:00
begin
2017-03-01 21:40:57 +01:00
if Attr is MVCNameCaseAttribute then
2017-02-07 14:08:36 +01:00
begin
2020-04-20 17:56:17 +02:00
Exit( TMVCSerializerHelper. ApplyNameCase( MVCNameCaseAttribute( Attr) . KeyCase, AField. Name ) ) ;
2017-02-07 14:08:36 +01:00
end ;
2020-04-24 14:48:30 +02:00
end ;
2017-02-07 14:08:36 +01:00
end ;
2019-03-08 09:33:41 +01:00
class function TMVCSerializerHelper. AttributeExists< T> ( const AAttributes: TArray< TCustomAttribute> ;
2020-04-20 17:56:17 +02:00
out AAttribute: T) : Boolean ;
2017-02-08 18:29:52 +01:00
var
2017-03-01 21:40:57 +01:00
Att: TCustomAttribute;
2017-02-08 18:29:52 +01:00
begin
2017-03-01 21:40:57 +01:00
AAttribute : = nil ;
for Att in AAttributes do
if Att is T then
2017-02-08 18:29:52 +01:00
begin
2017-03-01 21:40:57 +01:00
AAttribute : = T( Att) ;
2017-02-08 18:29:52 +01:00
Break;
end ;
2017-03-01 21:40:57 +01:00
Result : = ( AAttribute < > nil ) ;
end ;
2020-04-20 17:56:17 +02:00
class function TMVCSerializerHelper. ApplyNameCase( const NameCase: TMVCNameCase;
const Value: string ) : string ;
begin
case NameCase of
ncUpperCase:
begin
Result : = UpperCase( Value) ;
end ;
ncLowerCase:
begin
Result : = LowerCase( Value) ;
end ;
ncCamelCase:
begin
Result : = CamelCase( Value) ;
end ;
ncPascalCase:
begin
Result : = CamelCase( Value, True ) ;
end ;
2020-10-16 02:37:55 +02:00
ncSnakeCase:
begin
Result : = SnakeCase( Value) ;
end ;
2020-04-20 17:56:17 +02:00
ncAsIs:
begin
Result : = Value;
end
else
raise Exception. Create( 'Invalid NameCase' ) ;
end ;
end ;
2021-03-20 00:30:20 +01:00
class function TMVCSerializerHelper. AttributeExists< T> ( const AAttributes
: TArray< TCustomAttribute> ) : Boolean ;
2017-03-01 21:40:57 +01:00
var
Att: TCustomAttribute;
begin
2020-04-24 16:36:18 +02:00
Result : = False ;
2017-03-01 21:40:57 +01:00
for Att in AAttributes do
if Att is T then
2020-01-04 12:53:53 +01:00
Exit( True ) ;
2017-03-01 21:40:57 +01:00
end ;
2018-10-31 01:07:23 +01:00
class function TMVCSerializerHelper. CreateObject( const AObjectType: TRttiType) : TObject;
2017-03-01 21:40:57 +01:00
var
MetaClass: TClass;
Method: TRttiMethod;
begin
MetaClass : = nil ;
Method : = nil ;
for Method in AObjectType. GetMethods do
if Method. HasExtendedInfo and Method. IsConstructor then
if Length( Method. GetParameters) = 0 then
begin
MetaClass : = AObjectType. AsInstance. MetaclassType;
Break;
end ;
if Assigned( MetaClass) then
Result : = Method. Invoke( MetaClass, [ ] ) . AsObject
else
2021-03-20 00:30:20 +01:00
raise EMVCException. CreateFmt( 'Cannot find a propert constructor for %s' ,
[ AObjectType. ToString] ) ;
2017-03-01 21:40:57 +01:00
end ;
2018-10-31 01:07:23 +01:00
class function TMVCSerializerHelper. CreateObject( const AQualifiedClassName: string ) : TObject;
2017-03-01 21:40:57 +01:00
var
Context: TRttiContext;
ObjectType: TRttiType;
begin
2020-02-21 20:14:15 +01:00
{$IF not Defined(TokyoOrBetter)}
2019-08-02 12:32:23 +02:00
Result : = nil ;
2019-08-05 12:55:44 +02:00
{$ENDIF}
2017-03-01 21:40:57 +01:00
Context : = TRttiContext. Create;
try
ObjectType : = Context. FindType( AQualifiedClassName) ;
if Assigned( ObjectType) then
Result : = CreateObject( ObjectType)
else
2021-03-20 00:30:20 +01:00
raise Exception. CreateFmt
( 'Cannot find RTTI for %s. Hint: Is the specified classtype linked in the module?' ,
2019-03-08 09:33:41 +01:00
[ AQualifiedClassName] ) ;
2017-03-01 21:40:57 +01:00
finally
Context. Free;
2017-02-08 18:29:52 +01:00
end ;
end ;
2018-10-31 01:07:23 +01:00
class procedure TMVCSerializerHelper. DecodeStream( AInput, AOutput: TStream) ;
2017-02-07 14:08:36 +01:00
begin
2017-03-01 21:40:57 +01:00
2018-10-31 01:07:23 +01:00
{$IFDEF SYSTEMNETENCODING}
2017-03-01 21:40:57 +01:00
TNetEncoding. Base64. Decode( AInput, AOutput) ;
2018-10-31 01:07:23 +01:00
{$ELSE}
2017-03-01 21:40:57 +01:00
Soap. EncdDecd. DecodeStream( AInput, AOutput) ;
2018-10-31 01:07:23 +01:00
{$ENDIF}
2017-02-07 14:08:36 +01:00
end ;
2018-10-31 01:07:23 +01:00
class function TMVCSerializerHelper. DecodeString( const AInput: string ) : string ;
2017-02-10 14:19:55 +01:00
begin
2017-03-01 21:40:57 +01:00
2018-10-31 01:07:23 +01:00
{$IFDEF SYSTEMNETENCODING}
2017-03-01 21:40:57 +01:00
Result : = TNetEncoding. Base64. Decode( AInput) ;
2018-10-31 01:07:23 +01:00
{$ELSE}
2017-03-01 21:40:57 +01:00
Result : = Soap. EncdDecd. DecodeString( AInput) ;
2018-10-31 01:07:23 +01:00
{$ENDIF}
2017-02-10 14:19:55 +01:00
end ;
2018-10-31 01:07:23 +01:00
class procedure TMVCSerializerHelper. EncodeStream( AInput, AOutput: TStream) ;
2017-02-07 14:08:36 +01:00
begin
2017-03-01 21:40:57 +01:00
2018-10-31 01:07:23 +01:00
{$IFDEF SYSTEMNETENCODING}
2017-03-01 21:40:57 +01:00
TNetEncoding. Base64. Encode( AInput, AOutput) ;
2018-10-31 01:07:23 +01:00
{$ELSE}
2017-03-01 21:40:57 +01:00
Soap. EncdDecd. EncodeStream( AInput, AOutput) ;
2018-10-31 01:07:23 +01:00
{$ENDIF}
2017-02-07 14:08:36 +01:00
end ;
2018-10-31 01:07:23 +01:00
class function TMVCSerializerHelper. EncodeString( const AInput: string ) : string ;
2017-02-10 14:19:55 +01:00
begin
2017-03-01 21:40:57 +01:00
2018-10-31 01:07:23 +01:00
{$IFDEF SYSTEMNETENCODING}
2017-03-01 21:40:57 +01:00
Result : = TNetEncoding. Base64. Encode( AInput) ;
2018-10-31 01:07:23 +01:00
{$ELSE}
2017-03-01 21:40:57 +01:00
Result : = Soap. EncdDecd. EncodeString( AInput) ;
2018-10-31 01:07:23 +01:00
{$ENDIF}
2017-02-10 14:19:55 +01:00
end ;
2021-03-20 00:30:20 +01:00
class function TMVCSerializerHelper. GetKeyName( const AProperty: TRttiProperty;
const AType: TRttiType) : string ;
2017-02-07 14:08:36 +01:00
var
2017-03-01 21:40:57 +01:00
Attrs: TArray< TCustomAttribute> ;
Attr: TCustomAttribute;
2017-02-07 14:08:36 +01:00
begin
2020-08-11 00:54:42 +02:00
{ TODO -oDanieleT -cGeneral : in un rendering di una lista, quante volte viene chiamata questa funzione? }
2020-07-18 20:14:58 +02:00
{ Tante volte, ma eliminando tutta la logica si guadagnerebbe al massiom il 6% nel caso tipico, forse non vale la pena di aggiungere una cache apposita }
2017-03-01 21:40:57 +01:00
Result : = AProperty. Name ;
Attrs : = AProperty. GetAttributes;
for Attr in Attrs do
2020-04-24 14:48:30 +02:00
begin
2017-03-01 21:40:57 +01:00
if Attr is MVCNameAsAttribute then
2020-04-24 14:48:30 +02:00
begin
2020-04-24 16:36:18 +02:00
Result : = MVCNameAsAttribute( Attr) . Name ;
if MVCNameAsAttribute( Attr) . Fixed then { if FIXED the attribute NameAs remains untouched }
begin
Exit
end
else
begin
Break;
end ;
2020-04-24 14:48:30 +02:00
end ;
end ;
2017-02-07 14:08:36 +01:00
2017-03-01 21:40:57 +01:00
Attrs : = AType. GetAttributes;
for Attr in Attrs do
2020-04-24 14:48:30 +02:00
begin
2017-03-01 21:40:57 +01:00
if Attr is MVCNameCaseAttribute then
2017-02-07 14:08:36 +01:00
begin
2020-04-24 16:36:18 +02:00
Exit( TMVCSerializerHelper. ApplyNameCase( MVCNameCaseAttribute( Attr) . KeyCase, Result ) ) ;
2017-02-07 14:08:36 +01:00
end ;
2020-04-24 14:48:30 +02:00
end ;
2017-02-07 14:08:36 +01:00
end ;
2018-10-31 01:07:23 +01:00
class function TMVCSerializerHelper. GetTypeKindAsString( const ATypeKind: TTypeKind) : string ;
2017-02-09 11:24:18 +01:00
begin
Result : = GetEnumName( TypeInfo( TTypeKind) , Ord( ATypeKind) ) ;
Result : = Result . Remove( 0 , 2 ) . ToLower;
end ;
2021-02-23 18:00:32 +01:00
class function TMVCSerializerHelper. HasAttribute< T> ( const AMember: TRttiObject) : Boolean ;
2017-02-07 14:08:36 +01:00
var
2017-03-01 21:40:57 +01:00
Attrs: TArray< TCustomAttribute> ;
Attr: TCustomAttribute;
2017-02-07 14:08:36 +01:00
begin
2020-04-24 16:36:18 +02:00
Result : = False ;
2017-03-01 21:40:57 +01:00
Attrs : = AMember. GetAttributes;
if Length( Attrs) = 0 then
2020-04-24 16:36:18 +02:00
Exit( False ) ;
2017-03-01 21:40:57 +01:00
for Attr in Attrs do
if Attr is T then
2020-01-04 12:53:53 +01:00
Exit( True ) ;
2017-02-07 14:08:36 +01:00
end ;
2021-03-20 00:30:20 +01:00
class function TMVCSerializerHelper. HasAttribute< T> ( const AMember: TRttiObject;
out AAttribute: T) : Boolean ;
2017-02-07 14:08:36 +01:00
var
2017-03-01 21:40:57 +01:00
Attrs: TArray< TCustomAttribute> ;
Attr: TCustomAttribute;
2017-02-07 14:08:36 +01:00
begin
AAttribute : = nil ;
2020-04-24 16:36:18 +02:00
Result : = False ;
2017-03-01 21:40:57 +01:00
Attrs : = AMember. GetAttributes;
for Attr in Attrs do
if Attr is T then
2017-02-07 14:08:36 +01:00
begin
2017-03-01 21:40:57 +01:00
AAttribute : = T( Attr) ;
2020-01-04 12:53:53 +01:00
Exit( True ) ;
2017-02-07 14:08:36 +01:00
end ;
end ;
2020-04-20 17:56:17 +02:00
class function TMVCSerializerHelper. IsAPropertyToSkip( const aPropName: string ) : Boolean ;
2017-05-25 12:30:08 +02:00
begin
Result : = ( aPropName = 'RefCount' ) or ( aPropName = 'Disposed' ) ;
end ;
2018-10-31 01:07:23 +01:00
class function TMVCSerializerHelper. StringToTypeKind( const AValue: string ) : TTypeKind;
2017-02-09 11:24:18 +01:00
begin
Result : = TTypeKind( GetEnumValue( TypeInfo( TTypeKind) , 'tk' + AValue) ) ;
end ;
2017-03-01 21:40:57 +01:00
{ MVCValueAsTypeAttribute }
2017-02-08 11:42:05 +01:00
2017-03-01 21:40:57 +01:00
constructor MVCValueAsTypeAttribute. Create( AValueTypeInfo: PTypeInfo) ;
2017-02-08 11:42:05 +01:00
begin
2017-03-01 21:40:57 +01:00
inherited Create;
FValueTypeInfo : = AValueTypeInfo;
2017-02-08 11:42:05 +01:00
end ;
2017-03-01 21:40:57 +01:00
function MVCValueAsTypeAttribute. ValueTypeInfo: PTypeInfo;
2017-02-08 11:42:05 +01:00
begin
2017-03-01 21:40:57 +01:00
Result : = FValueTypeInfo;
2017-02-09 19:33:59 +01:00
end ;
2017-03-01 21:40:57 +01:00
{ MVCNameCaseAttribute }
2017-02-09 19:33:59 +01:00
2017-03-01 21:40:57 +01:00
constructor MVCNameCaseAttribute. Create( const AKeyCase: TMVCNameCase) ;
2017-02-09 19:33:59 +01:00
begin
2017-03-01 21:40:57 +01:00
inherited Create;
FKeyCase : = AKeyCase;
2017-02-09 19:33:59 +01:00
end ;
2017-03-01 21:40:57 +01:00
function MVCNameCaseAttribute. GetKeyCase: TMVCNameCase;
2017-02-09 19:33:59 +01:00
begin
2017-03-01 21:40:57 +01:00
Result : = FKeyCase;
2017-02-08 11:42:05 +01:00
end ;
2017-03-01 21:40:57 +01:00
{ MVCNameAsAttribute }
2017-02-09 11:24:18 +01:00
2020-04-24 16:36:18 +02:00
constructor MVCNameAsAttribute. Create( const AName: string ; const Fixed: Boolean = False ) ;
2017-02-09 11:24:18 +01:00
begin
inherited Create;
2020-04-24 16:36:18 +02:00
fName : = AName;
fFixed : = Fixed;
2017-02-09 11:24:18 +01:00
end ;
2017-03-01 21:40:57 +01:00
{ MVCListOfAttribute }
2017-02-09 19:33:59 +01:00
2017-03-01 21:40:57 +01:00
constructor MVCListOfAttribute. Create( const AValue: TClass) ;
2017-02-09 19:33:59 +01:00
begin
inherited Create;
2017-03-01 21:40:57 +01:00
FValue : = AValue;
2017-02-09 19:33:59 +01:00
end ;
2017-03-28 14:52:13 +02:00
{ MVCDataSetFieldAttribute }
2017-03-02 12:57:40 +01:00
2017-03-28 14:52:13 +02:00
constructor MVCDataSetFieldAttribute. Create( const ADataType: TMVCDataType) ;
2017-03-02 12:57:40 +01:00
begin
inherited Create;
2017-03-28 14:52:13 +02:00
FDataType : = ADataType;
2017-03-02 12:57:40 +01:00
end ;
2017-03-28 14:52:13 +02:00
{ MVCSerializeAttribute }
2017-03-02 12:57:40 +01:00
2017-03-28 14:52:13 +02:00
constructor MVCSerializeAttribute. Create( const ASerializationType: TMVCSerializationType) ;
2017-03-02 12:57:40 +01:00
begin
2017-03-28 14:52:13 +02:00
inherited Create;
FSerializationType : = ASerializationType;
2017-03-02 12:57:40 +01:00
end ;
2017-04-24 00:19:53 +02:00
{ MVCColumnAttribute }
2020-04-20 17:56:17 +02:00
constructor MVCColumnAttribute. Create( AFieldName: string ; AIsPK: Boolean ) ;
2017-04-24 00:19:53 +02:00
begin
inherited Create;
FFieldName : = AFieldName;
FIsPK : = AIsPK;
end ;
procedure MVCColumnAttribute. SetFieldName( const Value: string ) ;
begin
FFieldName : = Value;
end ;
2020-04-20 17:56:17 +02:00
procedure MVCColumnAttribute. SetIsPK( const Value: Boolean ) ;
2017-04-24 00:19:53 +02:00
begin
FIsPK : = Value;
end ;
2019-08-13 20:55:51 +02:00
{ MVCEnumSerializationTypeAttribute }
2017-09-28 00:14:34 +02:00
2021-03-20 00:30:20 +01:00
constructor MVCEnumSerializationAttribute. Create( const ASerializationType
: TMVCEnumSerializationType; const AMappedValues: string ) ;
2020-03-12 18:24:20 +01:00
begin
2020-03-13 15:58:04 +01:00
FMappedValues : = TList< string > . Create( TDelegatedComparer< string > . Create(
function( const Left, Right: string ) : Integer
begin
Result : = CompareText( Left, Right) ;
end ) ) ;
2020-03-12 18:24:20 +01:00
FSerializationType : = ASerializationType;
if ( FSerializationType = estEnumMappedValues) then
begin
if AMappedValues. Trim. IsEmpty then
raise EMVCException. Create( 'Mapped values are required for estEnumMappedValues type.' ) ;
FMappedValues. AddRange( AMappedValues. Split( [ ',' , ';' , ' ' ] ) ) ;
end ;
end ;
2020-03-12 20:37:48 +01:00
destructor MVCEnumSerializationAttribute. Destroy;
2019-08-12 21:48:33 +02:00
begin
2020-03-12 18:24:20 +01:00
FMappedValues. Free;
inherited ;
2019-08-12 21:48:33 +02:00
end ;
2017-09-28 00:14:34 +02:00
2019-09-01 20:35:19 +02:00
{ TMVCTask }
2020-03-08 19:35:17 +01:00
constructor TMVCTask. Create( const HREF, ID: string ) ;
2019-09-01 20:35:19 +02:00
begin
inherited Create;
fHREF : = HREF;
fID : = ID;
end ;
{ TMVCAcceptedResponse }
2019-09-25 09:14:09 +02:00
// constructor TMVCAcceptedResponse.Create(const aTask: TMVCTask);
// begin
// inherited Create;
// fTask := aTask;
// end;
2019-09-01 20:35:19 +02:00
2020-03-08 19:35:17 +01:00
constructor TMVCAcceptedResponse. Create( const HREF, ID: string ) ;
2019-09-01 20:35:19 +02:00
begin
inherited Create;
fTask : = TMVCTask. Create( HREF, ID) ;
end ;
destructor TMVCAcceptedResponse. Destroy;
begin
fTask. Free;
inherited ;
end ;
2020-03-12 18:24:20 +01:00
{ TObjectResponseBase }
2019-09-30 00:05:46 +02:00
2020-04-20 17:56:17 +02:00
constructor TMVCResponseData. Create( const AObject: TObject; const AOwns: Boolean ;
2020-04-18 23:32:24 +02:00
const ADataSetSerializationType: TMVCDatasetSerializationType) ;
2019-09-30 00:05:46 +02:00
begin
inherited Create;
2020-04-18 23:32:24 +02:00
fData : = AObject;
fMetaData : = TMVCStringDictionary. Create;
fOwns : = AOwns;
fDataSetSerializationType : = ADataSetSerializationType;
2019-09-30 00:05:46 +02:00
end ;
2020-04-18 23:32:24 +02:00
destructor TMVCResponseData. Destroy;
2019-09-30 00:05:46 +02:00
begin
2020-04-18 23:32:24 +02:00
fMetaData. Free;
if fOwns then
2019-09-30 00:05:46 +02:00
begin
2020-04-18 23:32:24 +02:00
fData. Free;
2019-09-30 00:05:46 +02:00
end ;
inherited ;
end ;
2020-04-18 23:32:24 +02:00
function TMVCResponseData. GetData: TObject;
2019-09-30 00:05:46 +02:00
begin
2020-04-18 23:32:24 +02:00
Result : = fData;
end ;
function TMVCResponseData. GetMetadata: TMVCStringDictionary;
begin
Result : = fMetaData;
end ;
function TMVCResponseData. SerializationType: TMVCDatasetSerializationType;
begin
Result : = fDataSetSerializationType;
2019-09-30 00:05:46 +02:00
end ;
2020-01-04 12:53:53 +01:00
{ TMVCObjectListResponse }
2020-04-20 17:56:17 +02:00
constructor TMVCObjectListResponse. Create( const AObject: TObject; Owns: Boolean ) ;
2020-01-04 12:53:53 +01:00
begin
inherited Create( AObject, Owns, dstAllRecords) ;
end ;
{ TMVCObjectResponse }
2020-04-20 17:56:17 +02:00
constructor TMVCObjectResponse. Create( const AObject: TObject; Owns: Boolean = True ) ;
2020-01-04 12:53:53 +01:00
begin
inherited Create( AObject, Owns, dstSingleRecord) ;
end ;
2021-03-20 00:30:20 +01:00
procedure MapDataSetFieldToRTTIField( const AField: TField; const aRTTIField: TRttiField;
const AObject: TObject) ;
2020-02-05 23:46:38 +01:00
var
lInternalStream: TStream;
lSStream: TStringStream;
lValue: TValue;
2020-08-11 00:54:42 +02:00
lStrValue: string ;
2020-02-21 20:14:15 +01:00
{$IF not Defined(TokyoOrBetter)}
lFieldValue: string ;
{$ENDIF}
2020-02-05 23:46:38 +01:00
begin
lValue : = aRTTIField. GetValue( AObject) ;
if lValue. Kind = tkRecord then
begin
if MapDataSetFieldToNullableRTTIField( lValue, AField, aRTTIField, AObject) then
begin
Exit;
end ;
end ;
// if we reached this point, the field is not a nullable type...
case AField. DataType of
ftString, ftWideString:
begin
2020-08-11 00:54:42 +02:00
// mysql tinytext is identified as string, but raises an Invalid Class Cast
// so we need to do some more checks...
case aRTTIField. FieldType. TypeKind of
tkString, tkUString:
begin
aRTTIField. SetValue( AObject, AField. AsString) ;
end ;
2022-06-16 14:05:01 +02:00
tkWideString:
begin
aRTTIField. SetValue( AObject, AField. AsWideString) ;
end ;
2022-06-23 14:34:01 +02:00
tkRecord:
begin
if TypeInfo( TGUID) = aRTTIField. FieldType. Handle then
begin
aRTTIField. SetValue( AObject, TValue. From< TGUID> ( StringToGUID( AField. AsString) ) ) ;
end
else
begin
raise EMVCException. CreateFmt( 'Unsupported record type: %s.%s' , [ aRTTIField. Parent. Name , aRTTIField. Name ] ) ;
end ;
end ;
2020-08-11 00:54:42 +02:00
tkClass: { mysql - maps a tiny field, identified as string, into a TStream }
begin
lInternalStream : = aRTTIField. GetValue( AObject) . AsObject as TStream;
if lInternalStream = nil then
begin
2020-09-11 13:01:56 +02:00
raise EMVCException. CreateFmt
( 'Property target for %s field is nil. [HINT] Initialize the stream before load data' ,
[ AField. FieldName] ) ;
2020-08-11 00:54:42 +02:00
end ;
lInternalStream. Size : = 0 ;
lStrValue : = AField. AsString;
if not lStrValue. IsEmpty then
begin
lInternalStream. Write( lStrValue, Length( lStrValue) ) ;
lInternalStream. Position : = 0 ;
end ;
end
else
begin
raise EMVCException. CreateFmt( 'Unsupported FieldType (%d) for field %s' ,
[ Ord( AField. DataType) , AField. FieldName] ) ;
end ;
end ;
// aRTTIField.SetValue(AObject, AField.AsString);
2020-02-05 23:46:38 +01:00
end ;
ftLargeint, ftAutoInc:
begin
aRTTIField. SetValue( AObject, AField. AsLargeInt) ;
end ;
2021-05-14 18:26:46 +02:00
ftInteger, ftSmallint, ftShortint, ftByte:
2020-02-05 23:46:38 +01:00
begin
2022-04-12 12:12:08 +02:00
// sqlite doesn't support boolean, so are identified as integers
// so we need to do some more checks...
if ( aRTTIField. FieldType. TypeKind = tkEnumeration) and ( aRTTIField. Name . ToLower. Contains( 'bool' ) ) then
begin
aRTTIField. SetValue( AObject, AField. AsInteger = 1 ) ;
end
else
begin
aRTTIField. SetValue( AObject, AField. AsInteger) ;
end ;
2020-02-05 23:46:38 +01:00
end ;
ftLongWord, ftWord:
begin
aRTTIField. SetValue( AObject, AField. AsLongWord) ;
end ;
2020-05-13 14:26:58 +02:00
ftCurrency:
begin
aRTTIField. SetValue( AObject, AField. AsCurrency) ;
end ;
2020-02-05 23:46:38 +01:00
ftFMTBcd:
begin
aRTTIField. SetValue( AObject, BCDtoCurrency( AField. AsBCD) ) ;
end ;
ftDate:
begin
aRTTIField. SetValue( AObject, Trunc( AField. AsDateTime) ) ;
end ;
ftDateTime:
begin
2020-06-25 22:54:57 +02:00
aRTTIField. SetValue( AObject, AField. AsDateTime) ;
end ;
ftTime:
begin
aRTTIField. SetValue( AObject, Frac( AField. AsDateTime) ) ;
2020-02-05 23:46:38 +01:00
end ;
ftTimeStamp:
begin
aRTTIField. SetValue( AObject, AField. AsDateTime) ;
end ;
ftBoolean:
begin
aRTTIField. SetValue( AObject, AField. AsBoolean) ;
end ;
ftMemo, ftWideMemo:
begin
2020-06-25 22:54:57 +02:00
case aRTTIField. FieldType. TypeKind of
tkString, tkUString:
begin
2021-04-05 19:35:46 +02:00
{TODO -oDanieleT -cGeneral : Optimize this code... too complex}
if AField. DataType = ftMemo then
aRTTIField. SetValue( AObject, TMemoField( AField) . AsWideString)
else if AField. DataType = ftWideMemo then
aRTTIField. SetValue( AObject, TWideMemoField( AField) . AsWideString)
else
begin
lSStream : = TStringStream. Create( '' , TEncoding. Unicode) ;
try
TBlobField( AField) . SaveToStream( lSStream) ;
aRTTIField. SetValue( AObject, lSStream. DataString) ;
finally
lSStream. Free;
end ;
2020-06-25 22:54:57 +02:00
end ;
end ;
tkFloat: { sqlite - date types stored as text }
begin
if TypeInfo( TDate) = aRTTIField. FieldType. Handle then
begin
aRTTIField. SetValue( AObject, ISODateToDate( AField. AsString) ) ;
end
else if TypeInfo( TDateTime) = aRTTIField. FieldType. Handle then
begin
aRTTIField. SetValue( AObject, ISOTimeStampToDateTime( AField. AsString) ) ;
end
else if TypeInfo( TTime) = aRTTIField. FieldType. Handle then
begin
aRTTIField. SetValue( AObject, ISOTimeToTime( AField. AsString) ) ;
end
else
begin
2021-03-20 00:30:20 +01:00
raise EMVCDeserializationException. Create( 'Cannot deserialize field ' +
AField. FieldName) ;
2020-06-25 22:54:57 +02:00
end ;
2022-06-23 14:34:01 +02:00
end ;
tkRecord:
begin
if TypeInfo( TGUID) = aRTTIField. FieldType. Handle then
begin
aRTTIField. SetValue( AObject, TValue. From< TGUID> ( StringToGUID( AField. AsString) ) ) ;
end
else
begin
raise EMVCException. CreateFmt( 'Unsupported record type: %s.%s' , [ aRTTIField. Parent. Name , aRTTIField. Name ] ) ;
end ;
2020-06-25 22:54:57 +02:00
end
2020-02-05 23:46:38 +01:00
else
begin
2020-06-25 22:54:57 +02:00
// In case you want to map a binary blob into a Delphi Stream
lInternalStream : = aRTTIField. GetValue( AObject) . AsObject as TStream;
if lInternalStream = nil then
begin
2021-03-20 00:30:20 +01:00
raise EMVCException. CreateFmt( 'Property target for %s field is nil' ,
[ AField. FieldName] ) ;
2020-06-25 22:54:57 +02:00
end ;
lInternalStream. Position : = 0 ;
TBlobField( AField) . SaveToStream( lInternalStream) ;
lInternalStream. Position : = 0 ;
2020-02-05 23:46:38 +01:00
end ;
end ;
end ;
ftBCD:
begin
aRTTIField. SetValue( AObject, BCDtoCurrency( AField. AsBCD) ) ;
end ;
2020-03-31 00:47:35 +02:00
ftFloat, ftSingle:
2020-02-05 23:46:38 +01:00
begin
aRTTIField. SetValue( AObject, AField. AsFloat) ;
end ;
ftBlob:
begin
lInternalStream : = aRTTIField. GetValue( AObject) . AsObject as TStream;
if AField. IsNull then
begin
lInternalStream. Free;
aRTTIField. SetValue( AObject, nil ) ;
Exit;
end ;
if lInternalStream = nil then
begin
lInternalStream : = TMemoryStream. Create;
aRTTIField. SetValue( AObject, lInternalStream) ;
// raise EMVCActiveRecord.CreateFmt('Property target for %s field is nil', [aFieldName]);
end ;
lInternalStream. Position : = 0 ;
TBlobField( AField) . SaveToStream( lInternalStream) ;
lInternalStream. Position : = 0 ;
end ;
ftGuid:
begin
2020-02-21 20:14:15 +01:00
{$IF Defined(TokyoOrBetter)}
2022-06-16 14:05:01 +02:00
if AField. IsNull then
begin
aRTTIField. SetValue( AObject, TValue. Empty)
end
else if TypeInfo( NullableTGUID) = aRTTIField. FieldType. Handle then
begin
aRTTIField. SetValue( AObject, TValue. From< NullableTGUID> ( AField. AsGuid) ) ;
end
else
begin
aRTTIField. SetValue( AObject, TValue. From< TGUID> ( AField. AsGuid) ) ;
end ;
2020-02-21 20:14:15 +01:00
{$ELSE}
lFieldValue : = AField. AsString;
if lFieldValue. IsEmpty then
begin
lFieldValue : = '{00000000-0000-0000-0000-000000000000}' ;
end ;
aRTTIField. SetValue( AObject, TValue. From< TGUID> ( StringToGUID( lFieldValue) ) ) ;
2020-02-05 23:46:38 +01:00
{$ENDIF}
2020-02-21 20:14:15 +01:00
end ;
2021-03-20 00:30:20 +01:00
ftDBaseOle: // xml
begin
lSStream : = TStringStream. Create( '' , TEncoding. Unicode) ;
try
TBlobField( AField) . SaveToStream( lSStream) ;
aRTTIField. SetValue( AObject, lSStream. DataString) ;
finally
lSStream. Free;
end ;
end
2020-02-05 23:46:38 +01:00
else
2021-03-20 00:30:20 +01:00
raise EMVCException. CreateFmt( 'Unsupported FieldType (%d) for field %s' ,
[ Ord( AField. DataType) , AField. FieldName] ) ;
2020-02-05 23:46:38 +01:00
end ;
end ;
2021-03-20 00:30:20 +01:00
function MapDataSetFieldToNullableRTTIField( const AValue: TValue; const AField: TField;
const aRTTIField: TRttiField; const AObject: TObject) : Boolean ;
2021-04-05 19:35:46 +02:00
var
lStr: string ;
2020-02-05 23:46:38 +01:00
begin
Assert( AValue. Kind = tkRecord) ;
2020-04-24 16:36:18 +02:00
Result : = False ;
2020-02-05 23:46:38 +01:00
if AValue. IsType( TypeInfo( NullableString) ) then
begin
if AField. IsNull then
begin
aRTTIField. GetValue( AObject) . AsType< NullableString> ( ) . Clear;
end
else
begin
2020-03-08 19:35:17 +01:00
aRTTIField. SetValue( AObject, TValue. From< NullableString> ( AField. AsString) ) ;
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableInt32) ) then
begin
if AField. IsNull then
begin
aRTTIField. GetValue( AObject) . AsType< NullableInt32> ( ) . Clear;
end
else
begin
aRTTIField. SetValue( AObject, TValue. From< NullableInt32> ( AField. AsLargeInt) ) ;
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableUInt32) ) then
begin
if AField. IsNull then
begin
aRTTIField. GetValue( AObject) . AsType< NullableUInt32> ( ) . Clear;
end
else
begin
aRTTIField. SetValue( AObject, TValue. From< NullableUInt32> ( AField. AsLargeInt) ) ;
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableInt64) ) then
begin
if AField. IsNull then
begin
aRTTIField. GetValue( AObject) . AsType< NullableInt64> ( ) . Clear;
end
else
begin
aRTTIField. SetValue( AObject, TValue. From< NullableInt64> ( AField. AsLargeInt) ) ;
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableUInt64) ) then
begin
if AField. IsNull then
begin
aRTTIField. GetValue( AObject) . AsType< NullableUInt64> ( ) . Clear;
end
else
begin
aRTTIField. SetValue( AObject, TValue. From< NullableUInt64> ( AField. AsLargeInt) ) ;
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableInt16) ) then
begin
if AField. IsNull then
begin
aRTTIField. GetValue( AObject) . AsType< NullableInt16> ( ) . Clear;
end
else
begin
aRTTIField. SetValue( AObject, TValue. From< NullableInt16> ( AField. AsLargeInt) ) ;
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableUInt16) ) then
begin
if AField. IsNull then
begin
aRTTIField. GetValue( AObject) . AsType< NullableUInt16> ( ) . Clear;
end
else
begin
aRTTIField. SetValue( AObject, TValue. From< NullableUInt16> ( AField. AsInteger) ) ;
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableTDate) ) then
begin
if AField. IsNull then
begin
aRTTIField. GetValue( AObject) . AsType< NullableTDate> ( ) . Clear;
end
else
begin
2021-04-05 19:35:46 +02:00
if not ( AField. DataType in [ ftWideMemo] ) then
begin
aRTTIField. SetValue( AObject, TValue. From< NullableTDate> ( AField. AsDateTime) ) ;
end
else
begin
{SQLite case...}
lStr : = AField. AsWideString;
aRTTIField. SetValue( AObject, TValue. From< NullableTDate> ( ISODateToDate( lStr) ) ) ;
end ;
2020-03-08 19:35:17 +01:00
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableTDateTime) ) then
begin
if AField. IsNull then
begin
aRTTIField. GetValue( AObject) . AsType< NullableTDateTime> ( ) . Clear;
end
else
begin
2021-04-05 19:35:46 +02:00
if not ( AField. DataType in [ ftWideMemo] ) then
begin
aRTTIField. SetValue( AObject, TValue. From< NullableTDateTime> ( AField. AsDateTime) ) ;
end
else
begin
{SQLite case...}
lStr : = AField. AsWideString;
aRTTIField. SetValue( AObject, TValue. From< NullableTDateTime> ( ISOTimeStampToDateTime( lStr) ) ) ;
end ;
2020-03-08 19:35:17 +01:00
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableTTime) ) then
begin
if AField. IsNull then
begin
aRTTIField. GetValue( AObject) . AsType< NullableTTime> ( ) . Clear;
end
else
begin
2021-04-05 19:35:46 +02:00
if not ( AField. DataType in [ ftWideMemo] ) then
begin
aRTTIField. SetValue( AObject, TValue. From< NullableTTime> ( AField. AsDateTime) ) ;
end
else
begin
{SQLite case...}
lStr : = AField. AsWideString;
aRTTIField. SetValue( AObject, TValue. From< NullableTTime> ( ISOTimeToTime( lStr) ) ) ;
end ;
2020-03-08 19:35:17 +01:00
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableBoolean) ) then
begin
if AField. IsNull then
begin
aRTTIField. GetValue( AObject) . AsType< NullableBoolean> ( ) . Clear;
end
else
begin
aRTTIField. SetValue( AObject, TValue. From< NullableBoolean> ( AField. AsBoolean) ) ;
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableDouble) ) then
begin
if AField. IsNull then
begin
aRTTIField. GetValue( AObject) . AsType< NullableDouble> ( ) . Clear;
end
else
begin
aRTTIField. SetValue( AObject, TValue. From< NullableDouble> ( AField. AsFloat) ) ;
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableSingle) ) then
begin
if AField. IsNull then
begin
aRTTIField. GetValue( AObject) . AsType< NullableSingle> ( ) . Clear;
end
else
begin
aRTTIField. SetValue( AObject, TValue. From< NullableSingle> ( AField. AsSingle) ) ;
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableExtended) ) then
begin
if AField. IsNull then
begin
aRTTIField. GetValue( AObject) . AsType< NullableExtended> ( ) . Clear;
end
else
begin
aRTTIField. SetValue( AObject, TValue. From< NullableExtended> ( AField. AsExtended) ) ;
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableCurrency) ) then
begin
if AField. IsNull then
begin
aRTTIField. GetValue( AObject) . AsType< NullableCurrency> ( ) . Clear;
end
else
begin
aRTTIField. SetValue( AObject, TValue. From< NullableCurrency> ( AField. AsCurrency) ) ;
end ;
Result : = True ;
end
2022-06-16 14:05:01 +02:00
else if AValue. IsType( TypeInfo( NullableTGUID) ) then
begin
if AField. IsNull then
begin
aRTTIField. GetValue( AObject) . AsType< NullableTGUID> ( ) . Clear;
end
else
begin
2022-06-23 14:34:01 +02:00
if AField. DataType = ftGuid then
aRTTIField. SetValue( AObject, TValue. From< NullableTGUID> ( AField. AsGuid) )
else
aRTTIField. SetValue( AObject, TValue. From< NullableTGUID> ( StringToGUID( AField. AsString) ) )
2022-06-16 14:05:01 +02:00
end ;
Result : = True ;
end
2020-03-08 19:35:17 +01:00
end ;
function MapDataSetFieldToNullableRTTIProperty( const AValue: TValue; const AField: TField;
2021-03-20 00:30:20 +01:00
const aRTTIProp: TRttiProperty; const AObject: TObject) : Boolean ;
2020-03-08 19:35:17 +01:00
begin
Assert( AValue. Kind = tkRecord) ;
2020-04-24 16:36:18 +02:00
Result : = False ;
2020-03-08 19:35:17 +01:00
if AValue. IsType( TypeInfo( NullableString) ) then
begin
if AField. IsNull then
begin
aRTTIProp. GetValue( AObject) . AsType< NullableString> ( ) . Clear;
end
else
begin
aRTTIProp. SetValue( AObject, TValue. From< NullableString> ( AField. AsString) ) ;
2020-02-05 23:46:38 +01:00
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableInt32) ) then
begin
if AField. IsNull then
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. GetValue( AObject) . AsType< NullableInt32> ( ) . Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. SetValue( AObject, TValue. From< NullableInt32> ( AField. AsLargeInt) ) ;
2020-02-05 23:46:38 +01:00
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableUInt32) ) then
begin
if AField. IsNull then
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. GetValue( AObject) . AsType< NullableUInt32> ( ) . Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. SetValue( AObject, TValue. From< NullableUInt32> ( AField. AsLargeInt) ) ;
2020-02-05 23:46:38 +01:00
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableInt64) ) then
begin
if AField. IsNull then
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. GetValue( AObject) . AsType< NullableInt64> ( ) . Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. SetValue( AObject, TValue. From< NullableInt64> ( AField. AsLargeInt) ) ;
2020-02-05 23:46:38 +01:00
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableUInt64) ) then
begin
if AField. IsNull then
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. GetValue( AObject) . AsType< NullableUInt64> ( ) . Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. SetValue( AObject, TValue. From< NullableUInt64> ( AField. AsLargeInt) ) ;
2020-02-05 23:46:38 +01:00
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableInt16) ) then
begin
if AField. IsNull then
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. GetValue( AObject) . AsType< NullableInt16> ( ) . Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. SetValue( AObject, TValue. From< NullableInt16> ( AField. AsLargeInt) ) ;
2020-02-05 23:46:38 +01:00
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableUInt16) ) then
begin
if AField. IsNull then
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. GetValue( AObject) . AsType< NullableUInt16> ( ) . Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. SetValue( AObject, TValue. From< NullableUInt16> ( AField. AsInteger) ) ;
2020-02-05 23:46:38 +01:00
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableTDate) ) then
begin
if AField. IsNull then
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. GetValue( AObject) . AsType< NullableTDate> ( ) . Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. SetValue( AObject, TValue. From< NullableTDate> ( AField. AsDateTime) ) ;
2020-02-05 23:46:38 +01:00
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableTDateTime) ) then
begin
if AField. IsNull then
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. GetValue( AObject) . AsType< NullableTDateTime> ( ) . Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. SetValue( AObject, TValue. From< NullableTDateTime> ( AField. AsDateTime) ) ;
2020-02-05 23:46:38 +01:00
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableTTime) ) then
begin
if AField. IsNull then
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. GetValue( AObject) . AsType< NullableTTime> ( ) . Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. SetValue( AObject, TValue. From< NullableTTime> ( AField. AsDateTime) ) ;
2020-02-05 23:46:38 +01:00
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableBoolean) ) then
begin
if AField. IsNull then
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. GetValue( AObject) . AsType< NullableBoolean> ( ) . Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. SetValue( AObject, TValue. From< NullableBoolean> ( AField. AsBoolean) ) ;
2020-02-05 23:46:38 +01:00
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableDouble) ) then
begin
if AField. IsNull then
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. GetValue( AObject) . AsType< NullableDouble> ( ) . Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. SetValue( AObject, TValue. From< NullableDouble> ( AField. AsFloat) ) ;
2020-02-05 23:46:38 +01:00
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableSingle) ) then
begin
if AField. IsNull then
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. GetValue( AObject) . AsType< NullableSingle> ( ) . Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. SetValue( AObject, TValue. From< NullableSingle> ( AField. AsSingle) ) ;
2020-02-05 23:46:38 +01:00
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableExtended) ) then
begin
if AField. IsNull then
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. GetValue( AObject) . AsType< NullableExtended> ( ) . Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. SetValue( AObject, TValue. From< NullableExtended> ( AField. AsExtended) ) ;
2020-02-05 23:46:38 +01:00
end ;
Result : = True ;
end
else if AValue. IsType( TypeInfo( NullableCurrency) ) then
begin
if AField. IsNull then
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. GetValue( AObject) . AsType< NullableCurrency> ( ) . Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
2020-03-08 19:35:17 +01:00
aRTTIProp. SetValue( AObject, TValue. From< NullableCurrency> ( AField. AsCurrency) ) ;
2020-02-05 23:46:38 +01:00
end ;
Result : = True ;
end
end ;
2020-04-20 17:56:17 +02:00
{ TMVCObjectDictionary }
2021-03-20 00:30:20 +01:00
function TMVCObjectDictionary. Add( const Name : string ; const Value: TObject;
2020-04-20 18:32:46 +02:00
const SerializationAction: TMVCSerializationAction) : IMVCObjectDictionary;
2020-04-20 17:56:17 +02:00
begin
2021-03-20 00:30:20 +01:00
fDict. Add( name , TMVCObjectDictionaryValueItem. Create( fOwnsValueItemData, Value,
SerializationAction) ) ;
2020-04-20 17:56:17 +02:00
Result : = Self;
end ;
function TMVCObjectDictionary. Add( const Name : string ; const Value: TDataset;
2020-04-21 17:04:04 +02:00
const SerializationAction: TMVCDataSetSerializationAction;
2021-03-20 00:30:20 +01:00
const DataSetSerializationType: TMVCDatasetSerializationType; const NameCase: TMVCNameCase)
: IMVCObjectDictionary;
2020-04-20 17:56:17 +02:00
begin
2021-03-20 00:30:20 +01:00
fDict. Add( name , TMVCObjectDictionaryValueItem. Create( fOwnsValueItemData, Value,
SerializationAction, DataSetSerializationType, NameCase) ) ;
2020-04-20 18:32:46 +02:00
Result : = Self;
end ;
2020-04-20 17:56:17 +02:00
procedure TMVCObjectDictionary. Clear;
begin
fDict. Clear;
end ;
function TMVCObjectDictionary. ContainsKey( const Key: string ) : Boolean ;
begin
Result : = fDict. ContainsKey( Key) ;
end ;
function TMVCObjectDictionary. Count: Integer ;
begin
Result : = fDict. Count;
end ;
2021-03-20 00:30:20 +01:00
constructor TMVCObjectDictionary. Create( const aKey: string ; const Value: TObject;
const OwnsValues: Boolean ) ;
2020-04-20 17:56:17 +02:00
begin
Create( OwnsValues) ;
Add( aKey, Value) ;
end ;
constructor TMVCObjectDictionary. Create( const OwnsValues: Boolean ) ;
begin
inherited Create;
fOwnsValueItemData : = OwnsValues;
fDict : = TObjectDictionary< string , TMVCObjectDictionaryValueItem> . Create( [ doOwnsValues] ) ;
end ;
destructor TMVCObjectDictionary. Destroy;
begin
fDict. Free;
inherited ;
end ;
function TMVCObjectDictionary. GetItem( const Key: string ) : TMVCObjectDictionaryValueItem;
begin
Result : = fDict. Items[ Key] ;
end ;
function TMVCObjectDictionary. Keys: TArray< string > ;
begin
Result : = fDict. Keys. ToArray;
end ;
2021-03-20 00:30:20 +01:00
function TMVCObjectDictionary. TryGetValue( const Name : string ; out Value: TObject) : Boolean ;
2020-04-20 17:56:17 +02:00
var
lItem: TMVCObjectDictionaryValueItem;
begin
Result : = fDict. TryGetValue( name , lItem) ;
if Result then
Value : = lItem. Data;
end ;
{ TMVCObjectDictionary.TMVCObjectDictionaryValueItem }
2021-03-20 00:30:20 +01:00
constructor TMVCObjectDictionary. TMVCObjectDictionaryValueItem. Create( const Owns: Boolean ;
const Data: TObject; const SerializationAction: TMVCSerializationAction) ;
2020-04-20 17:56:17 +02:00
begin
inherited Create;
fOwns : = Owns;
fData : = Data;
fSerializationAction : = SerializationAction;
fDataSetFieldNameCase : = ncAsIs; { not used }
end ;
2021-03-20 00:30:20 +01:00
constructor TMVCObjectDictionary. TMVCObjectDictionaryValueItem. Create( const Owns: Boolean ;
const Data: TDataset; const SerializationAction: TMVCDataSetSerializationAction;
const DataSetSerializationType: TMVCDatasetSerializationType; const NameCase: TMVCNameCase) ;
2020-04-20 17:56:17 +02:00
begin
Create( Owns, Data, nil ) ;
fDataSetFieldNameCase : = NameCase;
2020-04-21 17:04:04 +02:00
fDataSetSerializationType : = DataSetSerializationType;
2020-04-20 17:56:17 +02:00
fDataSetSerializationAction : = SerializationAction;
end ;
destructor TMVCObjectDictionary. TMVCObjectDictionaryValueItem. Destroy;
begin
if fOwns then
fData. Free;
inherited ;
end ;
2021-08-17 15:10:58 +02:00
{ MVCOwnedAttribute }
constructor MVCOwnedAttribute. Create( const ClassRef: TClass) ;
begin
inherited Create;
fClassRef : = ClassRef;
end ;
2021-01-11 18:35:44 +01:00
initialization
2021-03-20 00:30:20 +01:00
gLocalTimeStampAsUTC : = False ;
2021-01-11 18:35:44 +01:00
2017-02-07 14:08:36 +01:00
end .