delphimvcframework/sources/MVCFramework.Serializer.Commons.pas

1616 lines
44 KiB
ObjectPascal
Raw Normal View History

// ***************************************************************************
2017-02-09 19:33:59 +01:00
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2020 Daniele Teti and the DMVCFramework Team
2017-02-09 19:33:59 +01:00
//
// https://github.com/danieleteti/delphimvcframework
//
// Collaborators on this file: Ezequiel Juliano Müller (ezequieljuliano@gmail.com)
//
2017-02-09 19:33:59 +01:00
// ***************************************************************************
//
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
// http://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.
//
// ***************************************************************************
2017-02-09 19:33:59 +01:00
2017-02-07 14:08:36 +01:00
unit MVCFramework.Serializer.Commons;
2017-02-10 14:19:55 +01:00
{$I dmvcframework.inc}
{$WARN SYMBOL_DEPRECATED OFF}
2017-02-10 14:19:55 +01:00
interface
2017-02-07 14:08:36 +01:00
uses
System.Rtti,
System.Classes,
System.SysUtils,
System.DateUtils,
System.TypInfo,
2017-02-07 14:08:36 +01:00
{$IFDEF SYSTEMNETENCODING}
System.NetEncoding,
2017-02-07 14:08:36 +01:00
{$ELSE}
Soap.EncdDecd,
2017-02-07 14:08:36 +01:00
{$ENDIF}
MVCFramework.Commons,
Data.DB,
System.Generics.Collections,
JsonDataObjects;
2017-02-07 14:08:36 +01:00
type
EMVCSerializationException = class(EMVCException)
end;
EMVCDeserializationException = class(EMVCException)
end;
TMVCSerializationType = (stUnknown, stDefault, stProperties, stFields);
TMVCNameCase = (ncAsIs, ncUpperCase, ncLowerCase, ncCamelCase, ncPascalCase);
TMVCDataType = (dtObject, dtArray);
TMVCDatasetSerializationType = (dstSingleRecord, dstAllRecords);
TMVCEnumSerializationType = (estEnumName, estEnumOrd, estEnumMappedValues);
TMVCIgnoredList = array of string;
2019-05-09 20:53:52 +02:00
TMVCSerializationAction<T: class> = reference to procedure(const AObject: T; const Links: IMVCLinks);
TMVCSerializationAction = reference to procedure(const AObject: TObject; const Links: IMVCLinks);
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
MVCValueAsTypeAttribute = class(TCustomAttribute)
2017-02-09 11:24:18 +01:00
private
FValueTypeInfo: PTypeInfo;
protected
{ protected declarations }
2017-02-09 11:24:18 +01:00
public
constructor Create(AValueTypeInfo: PTypeInfo);
function ValueTypeInfo: PTypeInfo;
2017-02-09 11:24:18 +01:00
end;
MVCDoNotSerializeAttribute = class(TCustomAttribute)
end;
MVCDoNotDeSerializeAttribute = class(TCustomAttribute)
end;
2017-02-10 14:19:55 +01:00
MVCSerializeAsStringAttribute = class(TCustomAttribute)
private
{ private declarations }
protected
{ protected declarations }
public
{ public declarations }
end;
MVCNameCaseAttribute = class(TCustomAttribute)
private
FKeyCase: TMVCNameCase;
function GetKeyCase: TMVCNameCase;
protected
{ protected declarations }
public
constructor Create(const AKeyCase: TMVCNameCase);
property KeyCase: TMVCNameCase read GetKeyCase;
2017-02-10 14:19:55 +01:00
end;
MapperJSONNaming = MVCNameCaseAttribute deprecated 'Use MVCNameCaseAttribute';
MVCNameAsAttribute = class(TCustomAttribute)
private
fName: string;
fFixed: Boolean;
protected
{ protected declarations }
public
constructor Create(const AName: string; const Fixed: Boolean = False);
property name: string read fName;
property Fixed: Boolean read fFixed;
end;
2017-02-09 19:33:59 +01:00
2017-04-26 14:39:18 +02:00
MapperJSONSer = MVCNameAsAttribute deprecated 'Use MVCNameAsAttribute';
MVCListOfAttribute = class(TCustomAttribute)
2017-02-09 19:33:59 +01:00
private
FValue: TClass;
protected
{ protected declarations }
2017-02-09 19:33:59 +01:00
public
constructor Create(const AValue: TClass);
property Value: TClass read FValue;
2017-02-09 19:33:59 +01:00
end;
MapperListOfAttribute = MVCListOfAttribute deprecated 'Use MVCListOfAttribute';
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;
MVCColumnAttribute = class(TCustomAttribute)
private
FFieldName: string;
FIsPK: Boolean;
procedure SetFieldName(const Value: string);
procedure SetIsPK(const Value: Boolean);
public
constructor Create(AFieldName: string; AIsPK: Boolean = False);
property FieldName: string read FFieldName write SetFieldName;
property IsPK: Boolean read FIsPK write SetIsPK;
end;
MVCEnumSerializationAttribute = class(TCustomAttribute)
private
FSerializationType: TMVCEnumSerializationType;
FMappedValues: TList<string>;
public
constructor Create(const ASerializationType: TMVCEnumSerializationType; const AMappedValues: string = '');
destructor Destroy;
override;
property SerializationType: TMVCEnumSerializationType read FSerializationType;
property MappedValues: TList<string> read FMappedValues;
end;
TMVCSerializerHelper = record
private
{ private declarations }
public
class function ApplyNameCase(const NameCase: TMVCNameCase; const Value: string): string; static;
class function GetKeyName(const AField: TRttiField; const AType: TRttiType): string; overload; static;
class function GetKeyName(const AProperty: TRttiProperty; const AType: TRttiType): string; overload; static;
class function HasAttribute<T: class>(const AMember: TRttiNamedObject): Boolean; overload; static;
class function HasAttribute<T: class>(const AMember: TRttiNamedObject; out AAttribute: T): Boolean;
overload; static;
class function AttributeExists<T: TCustomAttribute>(const AAttributes: TArray<TCustomAttribute>; out AAttribute: T)
: Boolean; overload; static;
class function AttributeExists<T: TCustomAttribute>(const AAttributes: TArray<TCustomAttribute>): Boolean;
overload; static;
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;
class procedure DeSerializeStringStream(AStream: TStream; const ASerializedString: string;
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;
class function IsAPropertyToSkip(const aPropName: string): Boolean;
static;
end;
TMVCLinksCallback = reference to
procedure(const Links: TMVCStringDictionary);
IMVCResponseData = interface
['{DF69BE0E-3212-4535-8B78-38EEF0F5B656}']
function GetMetadata: TMVCStringDictionary;
property MetaData: TMVCStringDictionary read GetMetadata;
function GetData: TObject;
property Data: TObject read GetData;
end;
// Well Known Response Objects
[MVCNameCase(ncLowerCase)]
TMVCResponseBase = class abstract(TInterfacedObject, IMVCResponseData)
protected
function GetMetadata: TMVCStringDictionary;
virtual;
abstract;
function GetData: TObject;
virtual;
abstract;
end;
[MVCNameCase(ncLowerCase)]
TMVCTask = class
private
fID: string;
fHREF: string;
public
property HREF: string read fHREF write fHREF;
property ID: string read fID write fID;
constructor Create(const HREF, ID: string);
end;
[MVCNameCase(ncLowerCase)]
TMVCAcceptedResponse = class(TMVCResponseBase)
private
fTask: TMVCTask;
public
property Task: TMVCTask read fTask;
// constructor Create(const aTask: TMVCTask); overload;
constructor Create(const HREF, ID: string);
destructor Destroy;
override;
end;
[MVCNameCase(ncLowerCase)]
TMVCResponseData = class(TMVCResponseBase, IMVCResponseData)
private
fData: TObject;
fMetaData: TMVCStringDictionary;
fOwns: Boolean;
fDataSetSerializationType: TMVCDatasetSerializationType;
protected
function GetMetadata: TMVCStringDictionary;
override;
function GetData: TObject;
override;
public
constructor Create(const AObject: TObject; const AOwns: Boolean = False;
const ADataSetSerializationType: TMVCDatasetSerializationType = TMVCDatasetSerializationType.
dstAllRecords);
virtual;
destructor Destroy;
override;
function SerializationType: TMVCDatasetSerializationType;
[MVCNameAs('items')]
property Items: TObject read GetData;
[MVCNameAs('meta')]
property MetaData: TMVCStringDictionary read GetMetadata;
end deprecated 'Use "ObjectDict"';
TDataObjectHolder = TMVCResponseData deprecated 'Use "ObjectDict"';
THTTPStatusCode = 100 .. 599;
TMVCObjectListResponse = class(TMVCResponseData)
public
constructor Create(const AObject: TObject; Owns: Boolean = True);
reintroduce;
end;
TMVCObjectResponse = class(TMVCResponseData)
public
constructor Create(const AObject: TObject; Owns: Boolean = True);
reintroduce;
end;
IMVCObjectDictionary = interface
['{B54F02EE-4B3B-4E55-9E6B-FB6CFE746028}']
function Add(const Name: string; const Value: TObject; const SerializationAction: TMVCSerializationAction = nil)
: IMVCObjectDictionary; overload;
function Add(const Name: string; const Value: TDataset;
const SerializationAction: TMVCDataSetSerializationAction = nil;
2020-04-21 17:04:04 +02:00
const DataSetSerializationType: TMVCDatasetSerializationType = dstAllRecords;
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)
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;
public
constructor Create(
const Owns: Boolean;
const Data: TObject;
const SerializationAction: TMVCSerializationAction); overload;
constructor Create(
const Owns: Boolean;
const Data: TDataset;
const SerializationAction: TMVCDataSetSerializationAction;
2020-04-21 17:04:04 +02:00
const DataSetSerializationType: TMVCDatasetSerializationType;
const NameCase: TMVCNameCase); overload;
destructor Destroy; override;
property Data: TObject read fData;
property SerializationAction: TMVCSerializationAction read fSerializationAction;
property DataSetSerializationAction: TMVCDataSetSerializationAction read fDataSetSerializationAction;
property DataSetFieldNameCase: TMVCNameCase read fDataSetFieldNameCase;
2020-04-21 17:04:04 +02:00
property DataSetSerializationType: TMVCDatasetSerializationType read fDataSetSerializationType;
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;
constructor Create(const aKey: string; const Value: TObject; const OwnsValues: Boolean = True); overload; virtual;
destructor Destroy; override;
procedure Clear;
function Add(const Name: string; const Value: TObject; const SerializationAction: TMVCSerializationAction = nil)
: IMVCObjectDictionary; overload;
function Add(const Name: string; const Value: TDataset;
const SerializationAction: TMVCDataSetSerializationAction = nil;
2020-04-21 17:04:04 +02:00
const DataSetSerializationType: TMVCDatasetSerializationType = dstAllRecords;
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>;
property Items[const Key: string]: TMVCObjectDictionaryValueItem read GetItem; default;
end;
function DateTimeToISOTimeStamp(const ADateTime: TDateTime): string;
function DateToISODate(const ADate: TDateTime): string;
function TimeToISOTime(const ATime: TTime): string;
2020-02-05 23:46:38 +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;
function MapDataSetFieldToNullableRTTIProperty(const AValue: TValue; const AField: TField;
const aRTTIProp: TRttiProperty;
const AObject: TObject): Boolean;
2020-02-05 23:46:38 +01:00
/// <summary>
/// Supports ISO8601 in the following formats:
/// yyyy-mm-ddThh:nn:ss
/// yyyy-mm-ddThh:nn:ss.000Z
/// </summary>
function ISOTimeStampToDateTime(const ADateTime: string): TDateTime;
function ISODateToDate(const ADate: string): TDate;
function ISOTimeToTime(const ATime: string): TTime;
const
JSONNameLowerCase = ncLowerCase deprecated 'Use MVCNameCaseAttribute(ncLowerCase)';
JSONNameUpperCase = ncUpperCase deprecated 'Use MVCNameCaseAttribute(ncUpperCase)';
function StrDict: TMVCStringDictionary; overload;
function StrDict(const aKeys: array of string; const aValues: array of string)
: TMVCStringDictionary; overload;
function ObjectDict(const OwnsValues: Boolean = True): IMVCObjectDictionary;
function GetPaginationMeta(const CurrPageNumber: UInt32; const CurrPageSize: UInt32; const DefaultPageSize: UInt32;
const URITemplate: string): TMVCStringDictionary;
2017-02-07 14:08:36 +01:00
implementation
uses
Data.FmtBcd,
MVCFramework.Nullables,
System.Generics.Defaults;
function StrDict: TMVCStringDictionary; overload;
begin
Result := TMVCStringDictionary.Create;
end;
function GetPaginationMeta(const CurrPageNumber: UInt32; const CurrPageSize: UInt32; const DefaultPageSize: UInt32;
const URITemplate: string)
: TMVCStringDictionary;
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;
function ObjectDict(const OwnsValues: Boolean): IMVCObjectDictionary;
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;
function DateTimeToISOTimeStamp(const ADateTime: TDateTime): string;
begin
// fs.TimeSeparator := ':';
Result := DateToISO8601(ADateTime, True)
// Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', ADateTime, fs);
end;
2017-02-07 14:08:36 +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;
var
lDateTime: string;
begin
lDateTime := ADateTime;
if lDateTime.Length < 19 then
raise Exception.CreateFmt
('Invalid parameter "%s". Hint: DateTime parameters must be formatted in ISO8601 (e.g. 2010-10-12T10:12:23)',
[ADateTime]);
if lDateTime.Chars[10] = ' ' then
begin
lDateTime := lDateTime.Substring(0, 10) + 'T' + lDateTime.Substring(11);
end;
Result := ISO8601ToDate(lDateTime, True);
end;
function ISODateToDate(const ADate: string): TDate;
begin
Result := EncodeDate(StrToInt(Copy(ADate, 1, 4)), StrToInt(Copy(ADate, 6, 2)), StrToInt(Copy(ADate, 9, 2)));
end;
function ISOTimeToTime(const ATime: string): TTime;
begin
Result := EncodeTime(StrToInt(Copy(ATime, 1, 2)), StrToInt(Copy(ATime, 4, 2)), StrToInt(Copy(ATime, 7, 2)), 0);
end;
{ TMVCSerializerHelper }
2017-02-07 14:08:36 +01:00
class procedure TMVCSerializerHelper.DeSerializeBase64StringStream(AStream: TStream;
const ABase64SerializedString: string);
2017-02-07 14:08:36 +01:00
var
SS: TStringStream;
begin
AStream.Size := 0;
SS := TStringStream.Create(ABase64SerializedString, TEncoding.ASCII);
2017-02-07 14:08:36 +01:00
try
SS.Position := 0;
DecodeStream(SS, AStream);
2017-02-07 14:08:36 +01:00
finally
SS.Free;
end;
end;
class procedure TMVCSerializerHelper.DeSerializeStringStream(AStream: TStream; const ASerializedString: string;
const AEncoding: string);
2017-02-07 14:08:36 +01:00
var
Encoding: TEncoding;
2017-02-07 14:08:36 +01:00
SS: TStringStream;
begin
AStream.Position := 0;
Encoding := TEncoding.GetEncoding(AEncoding);
SS := TStringStream.Create(ASerializedString, Encoding);
2017-02-07 14:08:36 +01:00
try
SS.Position := 0;
AStream.CopyFrom(SS, SS.Size);
2017-02-07 14:08:36 +01:00
finally
SS.Free;
end;
end;
class function TMVCSerializerHelper.GetKeyName(const AField: TRttiField; const AType: TRttiType): string;
2017-02-07 14:08:36 +01:00
var
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...
}
Result := AField.Name;
Attrs := AField.GetAttributes;
for Attr in Attrs do
2020-04-24 14:48:30 +02:00
begin
if Attr is MVCNameAsAttribute then
2020-04-24 14:48:30 +02:00
begin
Exit(MVCNameAsAttribute(Attr).Name);
2020-04-24 14:48:30 +02:00
end;
end;
2017-02-07 14:08:36 +01:00
Attrs := AType.GetAttributes;
for Attr in Attrs do
2020-04-24 14:48:30 +02:00
begin
if Attr is MVCNameCaseAttribute then
2017-02-07 14:08:36 +01:00
begin
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;
class function TMVCSerializerHelper.AttributeExists<T>(const AAttributes: TArray<TCustomAttribute>;
out AAttribute: T): Boolean;
var
Att: TCustomAttribute;
begin
AAttribute := nil;
for Att in AAttributes do
if Att is T then
begin
AAttribute := T(Att);
Break;
end;
Result := (AAttribute <> nil);
end;
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;
ncAsIs:
begin
Result := Value;
end
else
raise Exception.Create('Invalid NameCase');
end;
end;
class function TMVCSerializerHelper.AttributeExists<T>(const AAttributes: TArray<TCustomAttribute>): Boolean;
var
Att: TCustomAttribute;
begin
Result := False;
for Att in AAttributes do
if Att is T then
Exit(True);
end;
class function TMVCSerializerHelper.CreateObject(const AObjectType: TRttiType): TObject;
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
raise EMVCException.CreateFmt('Cannot find a propert constructor for %s', [AObjectType.ToString]);
end;
class function TMVCSerializerHelper.CreateObject(const AQualifiedClassName: string): TObject;
var
Context: TRttiContext;
ObjectType: TRttiType;
begin
{$IF not Defined(TokyoOrBetter)}
2019-08-02 12:32:23 +02:00
Result := nil;
{$ENDIF}
Context := TRttiContext.Create;
try
ObjectType := Context.FindType(AQualifiedClassName);
if Assigned(ObjectType) then
Result := CreateObject(ObjectType)
else
2019-03-10 16:29:18 +01:00
raise Exception.CreateFmt('Cannot find RTTI for %s. Hint: Is the specified classtype linked in the module?',
[AQualifiedClassName]);
finally
Context.Free;
end;
end;
class procedure TMVCSerializerHelper.DecodeStream(AInput, AOutput: TStream);
2017-02-07 14:08:36 +01:00
begin
{$IFDEF SYSTEMNETENCODING}
TNetEncoding.Base64.Decode(AInput, AOutput);
{$ELSE}
Soap.EncdDecd.DecodeStream(AInput, AOutput);
{$ENDIF}
2017-02-07 14:08:36 +01:00
end;
class function TMVCSerializerHelper.DecodeString(const AInput: string): string;
2017-02-10 14:19:55 +01:00
begin
{$IFDEF SYSTEMNETENCODING}
Result := TNetEncoding.Base64.Decode(AInput);
{$ELSE}
Result := Soap.EncdDecd.DecodeString(AInput);
{$ENDIF}
2017-02-10 14:19:55 +01:00
end;
class procedure TMVCSerializerHelper.EncodeStream(AInput, AOutput: TStream);
2017-02-07 14:08:36 +01:00
begin
{$IFDEF SYSTEMNETENCODING}
TNetEncoding.Base64.Encode(AInput, AOutput);
{$ELSE}
Soap.EncdDecd.EncodeStream(AInput, AOutput);
{$ENDIF}
2017-02-07 14:08:36 +01:00
end;
class function TMVCSerializerHelper.EncodeString(const AInput: string): string;
2017-02-10 14:19:55 +01:00
begin
{$IFDEF SYSTEMNETENCODING}
Result := TNetEncoding.Base64.Encode(AInput);
{$ELSE}
Result := Soap.EncdDecd.EncodeString(AInput);
{$ENDIF}
2017-02-10 14:19:55 +01:00
end;
class function TMVCSerializerHelper.GetKeyName(const AProperty: TRttiProperty; const AType: TRttiType): string;
2017-02-07 14:08:36 +01:00
var
Attrs: TArray<TCustomAttribute>;
Attr: TCustomAttribute;
2017-02-07 14:08:36 +01:00
begin
2020-04-24 14:48:30 +02:00
{ in un rendering di una lista, quante volte viene chiamata questa funzione? }
Result := AProperty.Name;
Attrs := AProperty.GetAttributes;
for Attr in Attrs do
2020-04-24 14:48:30 +02:00
begin
{ TODO -oDaniele -cGeneral : Time this! }
if Attr is MVCNameAsAttribute then
2020-04-24 14:48:30 +02:00
begin
// Exit(MVCNameAsAttribute(Attr).Name);
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
Attrs := AType.GetAttributes;
for Attr in Attrs do
2020-04-24 14:48:30 +02:00
begin
if Attr is MVCNameCaseAttribute then
2017-02-07 14:08:36 +01:00
begin
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;
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;
class function TMVCSerializerHelper.HasAttribute<T>(const AMember: TRttiNamedObject): Boolean;
2017-02-07 14:08:36 +01:00
var
Attrs: TArray<TCustomAttribute>;
Attr: TCustomAttribute;
2017-02-07 14:08:36 +01:00
begin
Result := False;
Attrs := AMember.GetAttributes;
if Length(Attrs) = 0 then
Exit(False);
for Attr in Attrs do
if Attr is T then
Exit(True);
2017-02-07 14:08:36 +01:00
end;
class function TMVCSerializerHelper.HasAttribute<T>(const AMember: TRttiNamedObject; out AAttribute: T): Boolean;
2017-02-07 14:08:36 +01:00
var
Attrs: TArray<TCustomAttribute>;
Attr: TCustomAttribute;
2017-02-07 14:08:36 +01:00
begin
AAttribute := nil;
Result := False;
Attrs := AMember.GetAttributes;
for Attr in Attrs do
if Attr is T then
2017-02-07 14:08:36 +01:00
begin
AAttribute := T(Attr);
Exit(True);
2017-02-07 14:08:36 +01:00
end;
end;
class function TMVCSerializerHelper.IsAPropertyToSkip(const aPropName: string): Boolean;
begin
Result := (aPropName = 'RefCount') or (aPropName = 'Disposed');
end;
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;
{ MVCValueAsTypeAttribute }
2017-02-08 11:42:05 +01:00
constructor MVCValueAsTypeAttribute.Create(AValueTypeInfo: PTypeInfo);
2017-02-08 11:42:05 +01:00
begin
inherited Create;
FValueTypeInfo := AValueTypeInfo;
2017-02-08 11:42:05 +01:00
end;
function MVCValueAsTypeAttribute.ValueTypeInfo: PTypeInfo;
2017-02-08 11:42:05 +01:00
begin
Result := FValueTypeInfo;
2017-02-09 19:33:59 +01:00
end;
{ MVCNameCaseAttribute }
2017-02-09 19:33:59 +01:00
constructor MVCNameCaseAttribute.Create(const AKeyCase: TMVCNameCase);
2017-02-09 19:33:59 +01:00
begin
inherited Create;
FKeyCase := AKeyCase;
2017-02-09 19:33:59 +01:00
end;
function MVCNameCaseAttribute.GetKeyCase: TMVCNameCase;
2017-02-09 19:33:59 +01:00
begin
Result := FKeyCase;
2017-02-08 11:42:05 +01:00
end;
{ MVCNameAsAttribute }
2017-02-09 11:24:18 +01:00
constructor MVCNameAsAttribute.Create(const AName: string; const Fixed: Boolean = False);
2017-02-09 11:24:18 +01:00
begin
inherited Create;
fName := AName;
fFixed := Fixed;
2017-02-09 11:24:18 +01:00
end;
{ MVCListOfAttribute }
2017-02-09 19:33:59 +01:00
constructor MVCListOfAttribute.Create(const AValue: TClass);
2017-02-09 19:33:59 +01:00
begin
inherited Create;
FValue := AValue;
2017-02-09 19:33:59 +01:00
end;
{ MVCDataSetFieldAttribute }
2017-03-02 12:57:40 +01:00
constructor MVCDataSetFieldAttribute.Create(const ADataType: TMVCDataType);
2017-03-02 12:57:40 +01:00
begin
inherited Create;
FDataType := ADataType;
2017-03-02 12:57:40 +01:00
end;
{ MVCSerializeAttribute }
2017-03-02 12:57:40 +01:00
constructor MVCSerializeAttribute.Create(const ASerializationType: TMVCSerializationType);
2017-03-02 12:57:40 +01:00
begin
inherited Create;
FSerializationType := ASerializationType;
2017-03-02 12:57:40 +01:00
end;
{ MVCColumnAttribute }
constructor MVCColumnAttribute.Create(AFieldName: string; AIsPK: Boolean);
begin
inherited Create;
FFieldName := AFieldName;
FIsPK := AIsPK;
end;
procedure MVCColumnAttribute.SetFieldName(const Value: string);
begin
FFieldName := Value;
end;
procedure MVCColumnAttribute.SetIsPK(const Value: Boolean);
begin
FIsPK := Value;
end;
2019-08-13 20:55:51 +02:00
{ MVCEnumSerializationTypeAttribute }
constructor MVCEnumSerializationAttribute.Create(const ASerializationType: TMVCEnumSerializationType;
const AMappedValues: string);
begin
FMappedValues := TList<string>.Create(TDelegatedComparer<string>.Create(
function(const Left, Right: string): Integer
begin
Result := CompareText(Left, Right);
end));
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;
destructor MVCEnumSerializationAttribute.Destroy;
begin
FMappedValues.Free;
inherited;
end;
{ TMVCTask }
constructor TMVCTask.Create(const HREF, ID: string);
begin
inherited Create;
fHREF := HREF;
fID := ID;
end;
{ TMVCAcceptedResponse }
// constructor TMVCAcceptedResponse.Create(const aTask: TMVCTask);
// begin
// inherited Create;
// fTask := aTask;
// end;
constructor TMVCAcceptedResponse.Create(const HREF, ID: string);
begin
inherited Create;
fTask := TMVCTask.Create(HREF, ID);
end;
destructor TMVCAcceptedResponse.Destroy;
begin
fTask.Free;
inherited;
end;
{ TObjectResponseBase }
constructor TMVCResponseData.Create(const AObject: TObject; const AOwns: Boolean;
const ADataSetSerializationType: TMVCDatasetSerializationType);
begin
inherited Create;
fData := AObject;
fMetaData := TMVCStringDictionary.Create;
fOwns := AOwns;
fDataSetSerializationType := ADataSetSerializationType;
end;
destructor TMVCResponseData.Destroy;
begin
fMetaData.Free;
if fOwns then
begin
fData.Free;
end;
inherited;
end;
function TMVCResponseData.GetData: TObject;
begin
Result := fData;
end;
function TMVCResponseData.GetMetadata: TMVCStringDictionary;
begin
Result := fMetaData;
end;
function TMVCResponseData.SerializationType: TMVCDatasetSerializationType;
begin
Result := fDataSetSerializationType;
end;
{ TMVCObjectListResponse }
constructor TMVCObjectListResponse.Create(const AObject: TObject; Owns: Boolean);
begin
inherited Create(AObject, Owns, dstAllRecords);
end;
{ TMVCObjectResponse }
constructor TMVCObjectResponse.Create(const AObject: TObject; Owns: Boolean = True);
begin
inherited Create(AObject, Owns, dstSingleRecord);
end;
2020-02-05 23:46:38 +01:00
procedure MapDataSetFieldToRTTIField(const AField: TField; const aRTTIField: TRttiField; const AObject: TObject);
var
lInternalStream: TStream;
lSStream: TStringStream;
lValue: TValue;
{$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
aRTTIField.SetValue(AObject, AField.AsString);
end;
ftLargeint, ftAutoInc:
begin
aRTTIField.SetValue(AObject, AField.AsLargeInt);
end;
ftInteger, ftSmallint, ftShortint:
begin
aRTTIField.SetValue(AObject, AField.AsInteger);
end;
ftLongWord, ftWord:
begin
aRTTIField.SetValue(AObject, AField.AsLongWord);
end;
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
aRTTIField.SetValue(AObject, Trunc(AField.AsDateTime));
end;
ftTimeStamp:
begin
aRTTIField.SetValue(AObject, AField.AsDateTime);
end;
ftBoolean:
begin
aRTTIField.SetValue(AObject, AField.AsBoolean);
end;
ftMemo, ftWideMemo:
begin
if aRTTIField.FieldType.TypeKind in [tkString, tkUString { , tkWideString } ] then
begin
// In case you want to map a "TEXT" blob into a Delphi String
lSStream := TStringStream.Create('', TEncoding.Unicode);
try
TBlobField(AField).SaveToStream(lSStream);
aRTTIField.SetValue(AObject, lSStream.DataString);
finally
lSStream.Free;
end;
end
else
begin
// 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
raise EMVCException.CreateFmt('Property target for %s field is nil', [AField.FieldName]);
2020-02-05 23:46:38 +01:00
end;
lInternalStream.Position := 0;
TBlobField(AField).SaveToStream(lInternalStream);
lInternalStream.Position := 0;
end;
end;
ftBCD:
begin
aRTTIField.SetValue(AObject, BCDtoCurrency(AField.AsBCD));
end;
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
{$IF Defined(TokyoOrBetter)}
2020-02-05 23:46:38 +01:00
aRTTIField.SetValue(AObject, TValue.From<TGUID>(AField.AsGuid));
{$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}
end;
2020-02-05 23:46:38 +01:00
else
raise EMVCException.CreateFmt('Unsupported FieldType (%d) for field %s', [Ord(AField.DataType), AField.FieldName]);
2020-02-05 23:46:38 +01:00
end;
end;
function MapDataSetFieldToNullableRTTIField(const AValue: TValue; const AField: TField; const aRTTIField: TRttiField;
const AObject: TObject): Boolean;
2020-02-05 23:46:38 +01:00
begin
Assert(AValue.Kind = tkRecord);
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
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
aRTTIField.SetValue(AObject, TValue.From<NullableTDate>(AField.AsDateTime));
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
aRTTIField.SetValue(AObject, TValue.From<NullableTDateTime>(AField.AsDateTime));
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
aRTTIField.SetValue(AObject, TValue.From<NullableTTime>(AField.AsDateTime));
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
end;
function MapDataSetFieldToNullableRTTIProperty(const AValue: TValue; const AField: TField;
const aRTTIProp: TRttiProperty;
const AObject: TObject): Boolean;
begin
Assert(AValue.Kind = tkRecord);
Result := False;
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
aRTTIProp.GetValue(AObject).AsType<NullableInt32>().Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
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
aRTTIProp.GetValue(AObject).AsType<NullableUInt32>().Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
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
aRTTIProp.GetValue(AObject).AsType<NullableInt64>().Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
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
aRTTIProp.GetValue(AObject).AsType<NullableUInt64>().Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
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
aRTTIProp.GetValue(AObject).AsType<NullableInt16>().Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
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
aRTTIProp.GetValue(AObject).AsType<NullableUInt16>().Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
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
aRTTIProp.GetValue(AObject).AsType<NullableTDate>().Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
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
aRTTIProp.GetValue(AObject).AsType<NullableTDateTime>().Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
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
aRTTIProp.GetValue(AObject).AsType<NullableTTime>().Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
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
aRTTIProp.GetValue(AObject).AsType<NullableBoolean>().Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
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
aRTTIProp.GetValue(AObject).AsType<NullableDouble>().Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
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
aRTTIProp.GetValue(AObject).AsType<NullableSingle>().Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
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
aRTTIProp.GetValue(AObject).AsType<NullableExtended>().Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
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
aRTTIProp.GetValue(AObject).AsType<NullableCurrency>().Clear;
2020-02-05 23:46:38 +01:00
end
else
begin
aRTTIProp.SetValue(AObject, TValue.From<NullableCurrency>(AField.AsCurrency));
2020-02-05 23:46:38 +01:00
end;
Result := True;
end
end;
{ TMVCObjectDictionary }
function TMVCObjectDictionary.Add(
const Name: string;
const Value: TObject;
const SerializationAction: TMVCSerializationAction): IMVCObjectDictionary;
begin
fDict.Add(name, TMVCObjectDictionaryValueItem.Create(fOwnsValueItemData, Value, SerializationAction));
Result := Self;
end;
function TMVCObjectDictionary.Add(const Name: string; const Value: TDataset;
2020-04-21 17:04:04 +02:00
const SerializationAction: TMVCDataSetSerializationAction;
const DataSetSerializationType: TMVCDatasetSerializationType;
const NameCase: TMVCNameCase): IMVCObjectDictionary;
begin
2020-04-21 17:04:04 +02:00
fDict.Add(name, TMVCObjectDictionaryValueItem.Create(fOwnsValueItemData, Value, SerializationAction,
DataSetSerializationType, NameCase));
Result := Self;
end;
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;
constructor TMVCObjectDictionary.Create(const aKey: string; const Value: TObject; const OwnsValues: Boolean);
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;
function TMVCObjectDictionary.TryGetValue(const Name: string;
out Value: TObject): Boolean;
var
lItem: TMVCObjectDictionaryValueItem;
begin
Result := fDict.TryGetValue(name, lItem);
if Result then
Value := lItem.Data;
end;
{ TMVCObjectDictionary.TMVCObjectDictionaryValueItem }
constructor TMVCObjectDictionary.TMVCObjectDictionaryValueItem.Create(
const Owns: Boolean; const Data: TObject; const SerializationAction: TMVCSerializationAction);
begin
inherited Create;
fOwns := Owns;
fData := Data;
fSerializationAction := SerializationAction;
fDataSetFieldNameCase := ncAsIs; { not used }
end;
constructor TMVCObjectDictionary.TMVCObjectDictionaryValueItem.Create(
const Owns: Boolean; const Data: TDataset;
2020-04-21 17:04:04 +02:00
const SerializationAction: TMVCDataSetSerializationAction;
const DataSetSerializationType: TMVCDatasetSerializationType;
const NameCase: TMVCNameCase);
begin
Create(Owns, Data, nil);
fDataSetFieldNameCase := NameCase;
2020-04-21 17:04:04 +02:00
fDataSetSerializationType := DataSetSerializationType;
fDataSetSerializationAction := SerializationAction;
end;
destructor TMVCObjectDictionary.TMVCObjectDictionaryValueItem.Destroy;
begin
if fOwns then
fData.Free;
inherited;
end;
2017-02-07 14:08:36 +01:00
end.