2013-10-30 00:48:23 +01:00
|
|
|
{ *******************************************************************************
|
2015-01-14 14:13:48 +01:00
|
|
|
Copyright 2010-2015 Daniele Teti
|
2013-10-30 00:48:23 +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.
|
|
|
|
|
|
|
|
******************************************************************************** }
|
|
|
|
unit ObjectsMappers;
|
|
|
|
|
|
|
|
interface
|
|
|
|
|
|
|
|
uses
|
|
|
|
System.RTTI,
|
|
|
|
System.IOUtils,
|
|
|
|
DBXPLatform,
|
|
|
|
DB,
|
|
|
|
Generics.Collections,
|
2014-09-05 12:47:40 +02:00
|
|
|
{$IF CompilerVersion < 27}
|
2014-04-16 22:52:25 +02:00
|
|
|
Data.DBXJSON,
|
|
|
|
Data.SqlExpr,
|
2014-04-22 00:20:00 +02:00
|
|
|
DBXCommon,
|
2014-09-05 12:47:40 +02:00
|
|
|
{$ELSE}
|
|
|
|
System.JSON,
|
|
|
|
{$ENDIF}
|
|
|
|
{$IF CompilerVersion > 25}
|
2014-04-22 00:20:00 +02:00
|
|
|
FireDAC.Comp.Client, FireDAC.Stan.Param,
|
|
|
|
{$IFEND}
|
2014-11-24 16:26:02 +01:00
|
|
|
DuckListU, System.SysUtils;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
|
|
|
type
|
2015-01-14 11:39:44 +01:00
|
|
|
{ ***** Daniele Spinetti ***** }
|
|
|
|
TFieldNamePolicy = (fpLowerCase, fpUpperCase, fpAsIs);
|
2015-02-16 14:25:09 +01:00
|
|
|
{ ***** END - Daniele Spinetti ***** }
|
|
|
|
|
|
|
|
EMapperException = class(Exception)
|
|
|
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
TSerializationType = (Properties, Fields);
|
2015-01-14 11:39:44 +01:00
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
TJSONObjectActionProc = reference to procedure(const AJSONObject: TJSONObject);
|
2014-03-31 11:25:16 +02:00
|
|
|
|
2013-10-30 00:48:23 +01:00
|
|
|
Mapper = class
|
|
|
|
strict private
|
|
|
|
class var ctx: TRTTIContext;
|
|
|
|
|
|
|
|
private
|
2014-09-05 12:47:40 +02:00
|
|
|
{$IF CompilerVersion > 25}
|
2015-04-01 17:01:23 +02:00
|
|
|
class function InternalExecuteFDQuery(AQuery: TFDQuery; AObject: TObject;
|
|
|
|
WithResult: boolean): Int64;
|
2014-09-05 12:47:40 +02:00
|
|
|
{$ELSE}
|
2015-04-01 17:01:23 +02:00
|
|
|
class function InternalExecuteSQLQuery(AQuery: TSQLQuery; AObject: TObject;
|
|
|
|
WithResult: boolean): Int64;
|
2014-02-24 10:20:34 +01:00
|
|
|
{$IFEND}
|
2015-02-16 14:25:09 +01:00
|
|
|
class function GetKeyName(const ARttiField: TRttiField; AType: TRttiType): string; overload;
|
|
|
|
class function GetKeyName(const ARttiProp: TRttiProperty; AType: TRttiType): string; overload;
|
2015-04-01 17:01:23 +02:00
|
|
|
class procedure InternalJSONObjectToObject(ctx: TRTTIContext; AJSONObject: TJSONObject;
|
|
|
|
AObject: TObject); static;
|
|
|
|
class procedure InternalJSONObjectFieldsToObject(ctx: TRTTIContext; AJSONObject: TJSONObject;
|
|
|
|
AObject: TObject); static;
|
2015-02-16 14:25:09 +01:00
|
|
|
|
|
|
|
{ following methods are used by the serializer/unserializer to handle with the ser/unser logic }
|
2015-04-01 17:01:23 +02:00
|
|
|
class function SerializeFloatProperty(AObject: TObject; ARTTIProperty: TRttiProperty)
|
|
|
|
: TJSONValue;
|
2015-02-16 14:25:09 +01:00
|
|
|
class function SerializeFloatField(AObject: TObject; ARttiField: TRttiField): TJSONValue;
|
2015-04-01 17:01:23 +02:00
|
|
|
class function SerializeEnumerationProperty(AObject: TObject; ARTTIProperty: TRttiProperty)
|
|
|
|
: TJSONValue;
|
2015-02-16 14:25:09 +01:00
|
|
|
class function SerializeEnumerationField(AObject: TObject; ARttiField: TRttiField): TJSONValue;
|
2013-10-30 00:48:23 +01:00
|
|
|
public
|
2015-02-16 14:25:09 +01:00
|
|
|
class function HasAttribute<T: class>(ARTTIMember: TRttiNamedObject): boolean; overload;
|
2015-04-01 17:01:23 +02:00
|
|
|
class function HasAttribute<T: class>(ARTTIMember: TRttiNamedObject; out AAttribute: T)
|
|
|
|
: boolean; overload;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
|
|
|
///
|
|
|
|
/// Do not restore nested classes
|
|
|
|
///
|
2015-04-01 17:01:23 +02:00
|
|
|
class function JSONObjectToObject<T: constructor, class>(AJSONObject: TJSONObject): T;
|
|
|
|
overload; static;
|
|
|
|
class function JSONObjectStringToObject<T: constructor, class>(const AJSONObjectString
|
|
|
|
: string): T;
|
|
|
|
|
|
|
|
class function JSONObjectToObject(Clazz: TClass; AJSONObject: TJSONObject): TObject;
|
|
|
|
overload; static;
|
|
|
|
class function JSONObjectToObject(ClazzName: string; AJSONObject: TJSONObject): TObject;
|
|
|
|
overload; static;
|
|
|
|
class function JSONObjectToObjectFields<T: constructor, class>(AJSONObject: TJSONObject)
|
|
|
|
: T; static;
|
2015-02-16 14:25:09 +01:00
|
|
|
class procedure ObjectToDataSet(Obj: TObject; Field: TField; var Value: Variant); static;
|
2013-10-30 00:48:23 +01:00
|
|
|
class procedure DataSetToObject(ADataSet: TDataSet; AObject: TObject);
|
2015-04-01 17:01:23 +02:00
|
|
|
class function ObjectToJSONObject(AObject: TObject; AIgnoredProperties: array of string)
|
|
|
|
: TJSONObject; overload;
|
2015-02-16 14:25:09 +01:00
|
|
|
/// <summary>
|
|
|
|
/// Serializes an object to a jsonobject using fields value, not property values. WARNING! This
|
|
|
|
/// method do not generate the $dmvc_classname property in the jsonobject. To have the $dmvc_classname
|
|
|
|
/// into the json you should use ObjectToJSONObjectFields.
|
|
|
|
/// </summary>
|
2015-04-01 17:01:23 +02:00
|
|
|
class function ObjectToJSONObjectFields(AObject: TObject; AIgnoredProperties: array of string)
|
|
|
|
: TJSONObject; overload;
|
|
|
|
class function ObjectToJSONObjectFieldsString(AObject: TObject;
|
|
|
|
AIgnoredProperties: array of string): string; overload;
|
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
/// <summary>
|
|
|
|
/// Restore the object stored in the JSON object using the $dmvc_classname property
|
|
|
|
/// to know the qualified full class name. Values readed from the json are restored directly to the object fields.
|
2015-04-01 17:01:23 +02:00
|
|
|
/// Fields MUST be exists into the json. This kind of deserialization is way more strit than the properties based.
|
|
|
|
/// It should not be used to serialize object for a thin client, but to serialize objects that must be deserialized using
|
|
|
|
/// the same delphi class. So this method is useful when you are developing a delphi-delphi solution. Exceptions apply.
|
2015-02-16 14:25:09 +01:00
|
|
|
/// </summary>
|
|
|
|
class function JSONObjectFieldsToObject(AJSONObject: TJSONObject): TObject;
|
|
|
|
/// <summary>
|
|
|
|
/// Serialize an object to a JSONObject using properties values. It is useful when you
|
|
|
|
/// have to send derived or calculated properties. It is not a simple serialization, it bring
|
|
|
|
/// also all the logic applyed to the oebjsct properties (es. Price,Q.ty, Discount, Total. Total is
|
|
|
|
/// a derived property)
|
|
|
|
/// </summary>
|
2013-10-30 00:48:23 +01:00
|
|
|
class function ObjectToJSONObject(AObject: TObject): TJSONObject; overload;
|
2015-02-16 14:25:09 +01:00
|
|
|
/// <summary>
|
|
|
|
/// Identical to ObjectToJSONObject but it return a string representation instead of a json object
|
|
|
|
/// </summary>
|
2014-05-22 23:37:13 +02:00
|
|
|
class function ObjectToJSONObjectString(AObject: TObject): string;
|
2013-10-30 00:48:23 +01:00
|
|
|
class function ObjectToJSONArray(AObject: TObject): TJSONArray;
|
2015-01-15 10:32:29 +01:00
|
|
|
{ ***** Daniele Spinetti ***** }
|
2015-04-01 17:01:23 +02:00
|
|
|
class function JSONArrayToObjectList(AListOf: TClass; AJSONArray: TJSONArray;
|
|
|
|
AInstanceOwner: boolean = True; AOwnsChildObjects: boolean = True)
|
|
|
|
: TObjectList<TObject>; overload;
|
2015-01-15 10:32:29 +01:00
|
|
|
{ ***** Daniele Spinetti ***** }
|
2015-04-01 17:01:23 +02:00
|
|
|
class procedure JSONArrayToObjectList(AList: IWrappedList; AListOf: TClass;
|
|
|
|
AJSONArray: TJSONArray; AInstanceOwner: boolean = True;
|
|
|
|
AOwnsChildObjects: boolean = True); overload;
|
|
|
|
class function JSONArrayToObjectList<T: class, constructor>(AJSONArray: TJSONArray;
|
|
|
|
AInstanceOwner: boolean = True; AOwnsChildObjects: boolean = True): TObjectList<T>; overload;
|
|
|
|
class procedure JSONArrayToObjectList<T: class, constructor>(AList: TObjectList<T>;
|
|
|
|
AJSONArray: TJSONArray; AInstanceOwner: boolean = True;
|
2015-01-14 11:39:44 +01:00
|
|
|
AOwnsChildObjects: boolean = True); overload;
|
2014-09-17 23:10:52 +02:00
|
|
|
{$IF CompilerVersion <= 25}
|
2013-10-30 00:48:23 +01:00
|
|
|
class procedure ReaderToObject(AReader: TDBXReader; AObject: TObject);
|
2015-04-01 17:01:23 +02:00
|
|
|
class procedure ReaderToObjectList<T: class, constructor>(AReader: TDBXReader;
|
|
|
|
AObjectList: TObjectList<T>);
|
|
|
|
class procedure ReaderToJSONObject(AReader: TDBXReader; AJSONObject: TJSONObject;
|
|
|
|
AReaderInstanceOwner: boolean = True);
|
2014-04-16 22:52:25 +02:00
|
|
|
{$ENDIF}
|
2015-04-01 17:01:23 +02:00
|
|
|
class procedure DataSetToJSONObject(ADataSet: TDataSet; AJSONObject: TJSONObject;
|
|
|
|
ADataSetInstanceOwner: boolean = True; AJSONObjectActionProc: TJSONObjectActionProc = nil;
|
|
|
|
AFieldNamePolicy: TFieldNamePolicy = fpLowerCase);
|
|
|
|
class procedure JSONObjectToDataSet(AJSONObject: TJSONObject; ADataSet: TDataSet;
|
|
|
|
AJSONObjectInstanceOwner: boolean = True); overload;
|
|
|
|
class procedure JSONObjectToDataSet(AJSONObject: TJSONObject; ADataSet: TDataSet;
|
|
|
|
AIgnoredFields: TArray<string>; AJSONObjectInstanceOwner: boolean = True;
|
|
|
|
AFieldNamePolicy: TFieldNamePolicy = fpLowerCase); overload;
|
|
|
|
class procedure DataSetToObjectList<T: class, constructor>(ADataSet: TDataSet;
|
|
|
|
AObjectList: TObjectList<T>; ACloseDataSetAfterScroll: boolean = True);
|
2015-02-16 14:25:09 +01:00
|
|
|
class function DataSetToJSONArrayOf<T: class, constructor>(ADataSet: TDataSet): TJSONArray;
|
2014-09-17 23:10:52 +02:00
|
|
|
{$IF CompilerVersion <= 25}
|
2015-02-16 14:25:09 +01:00
|
|
|
class procedure ReaderToList<T: class, constructor>(AReader: TDBXReader; AList: IWrappedList);
|
2015-04-01 17:01:23 +02:00
|
|
|
class procedure ReaderToJSONArray(AReader: TDBXReader; AJSONArray: TJSONArray;
|
|
|
|
AReaderInstanceOwner: boolean = True);
|
2014-04-16 22:52:25 +02:00
|
|
|
{$ENDIF}
|
2015-04-01 17:01:23 +02:00
|
|
|
class procedure DataSetToJSONArray(ADataSet: TDataSet; AJSONArray: TJSONArray;
|
|
|
|
ADataSetInstanceOwner: boolean = True; AJSONObjectActionProc: TJSONObjectActionProc = nil);
|
|
|
|
class procedure JSONArrayToDataSet(AJSONArray: TJSONArray; ADataSet: TDataSet;
|
2014-03-24 13:17:30 +01:00
|
|
|
AJSONArrayInstanceOwner: boolean = True); overload;
|
2015-04-01 17:01:23 +02:00
|
|
|
class procedure JSONArrayToDataSet(AJSONArray: TJSONArray; ADataSet: TDataSet;
|
2015-04-09 19:57:13 +02:00
|
|
|
AIgnoredFields: TArray<string>; AJSONArrayInstanceOwner: boolean = True;
|
|
|
|
AFieldNamePolicy: TFieldNamePolicy = fpLowerCase); overload;
|
2013-11-11 01:11:09 +01:00
|
|
|
// class procedure DataSetRowToXML(ADataSet: TDataSet; Row: IXMLNode;
|
|
|
|
// ADataSetInstanceOwner: boolean = True);
|
|
|
|
// class procedure DataSetToXML(ADataSet: TDataSet; XMLDocument: String;
|
|
|
|
// ADataSetInstanceOwner: boolean = True);
|
2015-04-01 17:01:23 +02:00
|
|
|
class function ObjectListToJSONArray<T: class>(AList: TObjectList<T>;
|
|
|
|
AOwnsInstance: boolean = false; AForEach: TJSONObjectActionProc = nil): TJSONArray;
|
|
|
|
class function ObjectListToJSONArrayFields<T: class>(AList: TObjectList<T>;
|
|
|
|
AOwnsInstance: boolean = false; AForEach: TJSONObjectActionProc = nil): TJSONArray;
|
|
|
|
class function ObjectListToJSONArrayString<T: class>(AList: TObjectList<T>;
|
|
|
|
AOwnsInstance: boolean = false): string;
|
|
|
|
class function ObjectListToJSONArrayOfJSONArray<T: class, constructor>(AList: TObjectList<T>)
|
|
|
|
: TJSONArray;
|
2015-02-16 14:25:09 +01:00
|
|
|
class function GetProperty(Obj: TObject; const PropertyName: string): TValue; static;
|
2014-09-17 23:10:52 +02:00
|
|
|
{$IF CompilerVersion <= 25}
|
2015-02-16 14:25:09 +01:00
|
|
|
class function ExecuteSQLQueryNoResult(AQuery: TSQLQuery; AObject: TObject): Int64;
|
2013-10-30 00:48:23 +01:00
|
|
|
class procedure ExecuteSQLQuery(AQuery: TSQLQuery; AObject: TObject = nil);
|
2015-04-01 17:01:23 +02:00
|
|
|
class function ExecuteSQLQueryAsObjectList<T: class, constructor>(AQuery: TSQLQuery;
|
|
|
|
AObject: TObject = nil): TObjectList<T>;
|
2015-02-16 14:25:09 +01:00
|
|
|
class function CreateQuery(AConnection: TSQLConnection; ASQL: string): TSQLQuery;
|
2014-04-16 22:52:25 +02:00
|
|
|
{$ENDIF}
|
2014-02-24 10:20:34 +01:00
|
|
|
{ FIREDAC RELATED METHODS }
|
2014-09-05 12:47:40 +02:00
|
|
|
{$IF CompilerVersion > 25}
|
2015-02-16 14:25:09 +01:00
|
|
|
class function ExecuteFDQueryNoResult(AQuery: TFDQuery; AObject: TObject): Int64;
|
2014-02-24 10:20:34 +01:00
|
|
|
class procedure ExecuteFDQuery(AQuery: TFDQuery; AObject: TObject);
|
2015-04-01 17:01:23 +02:00
|
|
|
class procedure ObjectToFDParameters(AFDParams: TFDParams; AObject: TObject;
|
|
|
|
AParamPrefix: string = '');
|
2014-02-24 10:20:34 +01:00
|
|
|
{$IFEND}
|
2013-10-30 00:48:23 +01:00
|
|
|
// SAFE TJSONObject getter
|
2015-02-16 14:25:09 +01:00
|
|
|
class function GetPair(JSONObject: TJSONObject; PropertyName: string): TJSONPair;
|
2015-04-01 17:01:23 +02:00
|
|
|
class function GetStringDef(JSONObject: TJSONObject; PropertyName: string;
|
|
|
|
DefaultValue: string = ''): string;
|
|
|
|
class function GetNumberDef(JSONObject: TJSONObject; PropertyName: string;
|
|
|
|
DefaultValue: Extended = 0): Extended;
|
2015-02-16 14:25:09 +01:00
|
|
|
class function GetJSONObj(JSONObject: TJSONObject; PropertyName: string): TJSONObject;
|
|
|
|
class function GetJSONArray(JSONObject: TJSONObject; PropertyName: string): TJSONArray;
|
2015-04-01 17:01:23 +02:00
|
|
|
class function GetIntegerDef(JSONObject: TJSONObject; PropertyName: string;
|
|
|
|
DefaultValue: Integer = 0): Integer;
|
|
|
|
class function GetInt64Def(JSONObject: TJSONObject; PropertyName: string;
|
|
|
|
DefaultValue: Int64 = 0): Int64;
|
|
|
|
class function GetBooleanDef(JSONObject: TJSONObject; PropertyName: string;
|
|
|
|
DefaultValue: boolean = false): boolean;
|
2015-02-16 14:25:09 +01:00
|
|
|
class function PropertyExists(JSONObject: TJSONObject; PropertyName: string): boolean;
|
2013-10-30 00:48:23 +01:00
|
|
|
end;
|
|
|
|
|
2014-03-08 00:26:31 +01:00
|
|
|
TDataSetHelper = class helper for TDataSet
|
|
|
|
public
|
|
|
|
function AsJSONArray: TJSONArray;
|
2014-05-22 23:37:13 +02:00
|
|
|
function AsJSONArrayString: string;
|
2015-04-01 17:01:23 +02:00
|
|
|
function AsJSONObject(AReturnNilIfEOF: boolean = false;
|
|
|
|
AFieldNamePolicy: TFieldNamePolicy = fpLowerCase): TJSONObject;
|
2015-02-16 14:25:09 +01:00
|
|
|
function AsJSONObjectString(AReturnEmptyStringIfEOF: boolean = false): string;
|
2015-04-01 17:01:23 +02:00
|
|
|
procedure LoadFromJSONObject(AJSONObject: TJSONObject;
|
|
|
|
AFieldNamePolicy: TFieldNamePolicy = fpLowerCase); overload;
|
2015-02-16 14:25:09 +01:00
|
|
|
procedure LoadFromJSONObject(AJSONObject: TJSONObject; AIgnoredFields: TArray<string>;
|
2015-01-14 11:39:44 +01:00
|
|
|
AFieldNamePolicy: TFieldNamePolicy = fpLowerCase); overload;
|
2015-04-09 19:57:13 +02:00
|
|
|
procedure LoadFromJSONArray(AJSONArray: TJSONArray;
|
|
|
|
AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy.fpLowerCase); overload;
|
2015-02-16 14:25:09 +01:00
|
|
|
procedure LoadFromJSONArrayString(AJSONArrayString: string);
|
|
|
|
procedure LoadFromJSONArray(AJSONArray: TJSONArray; AIgnoredFields: TArray<string>); overload;
|
2014-05-22 23:37:13 +02:00
|
|
|
procedure LoadFromJSONObjectString(AJSONObjectString: string); overload;
|
2015-04-01 17:01:23 +02:00
|
|
|
procedure LoadFromJSONObjectString(AJSONObjectString: string;
|
|
|
|
AIgnoredFields: TArray<string>); overload;
|
2014-05-22 23:37:13 +02:00
|
|
|
procedure AppendFromJSONArrayString(AJSONArrayString: string); overload;
|
2015-04-01 17:01:23 +02:00
|
|
|
procedure AppendFromJSONArrayString(AJSONArrayString: string;
|
|
|
|
AIgnoredFields: TArray<string>); overload;
|
2015-02-16 14:25:09 +01:00
|
|
|
function AsObjectList<T: class, constructor>(CloseAfterScroll: boolean = false): TObjectList<T>;
|
|
|
|
function AsObject<T: class, constructor>(CloseAfterScroll: boolean = false): T;
|
2014-03-08 00:26:31 +01:00
|
|
|
end;
|
|
|
|
|
2013-10-30 00:48:23 +01:00
|
|
|
MapperTransientAttribute = class(TCustomAttribute)
|
|
|
|
|
|
|
|
end;
|
|
|
|
|
2013-11-11 15:24:51 +01:00
|
|
|
DoNotSerializeAttribute = class(TCustomAttribute)
|
|
|
|
|
|
|
|
end;
|
|
|
|
|
2013-10-30 00:48:23 +01:00
|
|
|
MapperItemsClassType = class(TCustomAttribute)
|
|
|
|
private
|
|
|
|
FValue: TClass;
|
|
|
|
procedure SetValue(const Value: TClass);
|
|
|
|
|
2014-03-07 23:16:33 +01:00
|
|
|
public
|
2013-10-30 00:48:23 +01:00
|
|
|
constructor Create(Value: TClass);
|
|
|
|
property Value: TClass read FValue write SetValue;
|
|
|
|
end;
|
|
|
|
|
2014-05-22 23:37:13 +02:00
|
|
|
MapperListOf = MapperItemsClassType; // just to be more similar to DORM
|
|
|
|
|
2013-10-30 00:48:23 +01:00
|
|
|
TJSONNameCase = (JSONNameUpperCase, JSONNameLowerCase);
|
|
|
|
|
|
|
|
HideInGrids = class(TCustomAttribute)
|
|
|
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
StringValueAttribute = class abstract(TCustomAttribute)
|
|
|
|
private
|
|
|
|
FValue: string;
|
|
|
|
procedure SetValue(const Value: string);
|
|
|
|
|
|
|
|
public
|
|
|
|
constructor Create(Value: string);
|
|
|
|
property Value: string read FValue write SetValue;
|
|
|
|
end;
|
|
|
|
|
|
|
|
FormatFloatValue = class(StringValueAttribute)
|
|
|
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
FormatDateTimeValue = class(StringValueAttribute)
|
|
|
|
|
|
|
|
end;
|
|
|
|
|
2014-04-10 13:56:23 +02:00
|
|
|
MapperSerializeAsString = class(TCustomAttribute)
|
2014-11-24 16:26:02 +01:00
|
|
|
strict private
|
|
|
|
FEncoding: string;
|
|
|
|
procedure SetEncoding(const Value: string);
|
2014-04-10 13:56:23 +02:00
|
|
|
|
2014-11-24 16:26:02 +01:00
|
|
|
const
|
|
|
|
DefaultEncoding = 'utf-8';
|
|
|
|
public
|
|
|
|
constructor Create(AEncoding: string = DefaultEncoding);
|
|
|
|
property Encoding: string read FEncoding write SetEncoding;
|
2014-04-10 13:56:23 +02:00
|
|
|
end;
|
|
|
|
|
2013-10-30 00:48:23 +01:00
|
|
|
MapperJSONNaming = class(TCustomAttribute)
|
|
|
|
private
|
|
|
|
FJSONKeyCase: TJSONNameCase;
|
|
|
|
function GetKeyCase: TJSONNameCase;
|
|
|
|
|
|
|
|
public
|
|
|
|
constructor Create(JSONKeyCase: TJSONNameCase);
|
|
|
|
property KeyCase: TJSONNameCase read GetKeyCase;
|
|
|
|
end;
|
|
|
|
|
|
|
|
MapperJSONSer = class(TCustomAttribute)
|
|
|
|
private
|
|
|
|
FName: string;
|
|
|
|
function GetName: string;
|
|
|
|
|
|
|
|
public
|
|
|
|
constructor Create(AName: string);
|
|
|
|
property name: string read GetName;
|
|
|
|
end;
|
|
|
|
|
|
|
|
MapperColumnAttribute = class(TCustomAttribute)
|
|
|
|
private
|
|
|
|
FFieldName: string;
|
2013-11-10 01:04:17 +01:00
|
|
|
FIsPK: boolean;
|
2013-10-30 00:48:23 +01:00
|
|
|
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;
|
|
|
|
|
|
|
|
TGridColumnAlign = (caLeft, caCenter, caRight);
|
|
|
|
|
|
|
|
GridColumnProps = class(TCustomAttribute)
|
|
|
|
private
|
|
|
|
FCaption: string;
|
2013-11-10 01:04:17 +01:00
|
|
|
FAlign: TGridColumnAlign;
|
|
|
|
FWidth: Integer;
|
2013-10-30 00:48:23 +01:00
|
|
|
function GetAlignAsString: string;
|
|
|
|
|
|
|
|
public
|
2015-04-01 17:01:23 +02:00
|
|
|
constructor Create(ACaption: string; AAlign: TGridColumnAlign = caCenter;
|
|
|
|
AWidth: Integer = - 1);
|
2013-10-30 00:48:23 +01:00
|
|
|
property Caption: string read FCaption;
|
|
|
|
property Align: TGridColumnAlign read FAlign;
|
|
|
|
property AlignAsString: string read GetAlignAsString;
|
|
|
|
property Width: Integer read FWidth;
|
|
|
|
end;
|
|
|
|
|
|
|
|
function ISODateTimeToString(ADateTime: TDateTime): string;
|
|
|
|
function ISODateToString(ADate: TDateTime): string;
|
|
|
|
function ISOTimeToString(ATime: TTime): string;
|
|
|
|
|
|
|
|
function ISOStrToDateTime(DateTimeAsString: string): TDateTime;
|
|
|
|
function ISOStrToDate(DateAsString: string): TDate;
|
|
|
|
function ISOStrToTime(TimeAsString: string): TTime;
|
|
|
|
|
|
|
|
|
|
|
|
// function ISODateToStr(const ADate: TDate): String;
|
|
|
|
//
|
|
|
|
// function ISOTimeToStr(const ATime: TTime): String;
|
|
|
|
|
|
|
|
implementation
|
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
{$WARN SYMBOL_DEPRECATED OFF}
|
|
|
|
|
2013-10-30 00:48:23 +01:00
|
|
|
uses
|
|
|
|
TypInfo,
|
|
|
|
FmtBcd,
|
|
|
|
Math,
|
|
|
|
SqlTimSt,
|
|
|
|
DateUtils,
|
|
|
|
Classes,
|
2013-11-10 01:04:17 +01:00
|
|
|
RTTIUtilsU,
|
2015-02-16 14:25:09 +01:00
|
|
|
Xml.adomxmldom,
|
|
|
|
{$IF CompilerVersion >= 28}
|
|
|
|
System.NetEncoding, // so that the old functions in Soap.EncdDecd can be inlined
|
|
|
|
{$ENDIF}
|
|
|
|
Soap.EncdDecd;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
const
|
|
|
|
DMVC_CLASSNAME = '$dmvc_classname';
|
|
|
|
{ Mapper }
|
|
|
|
|
|
|
|
function ContainsFieldName(const FieldName: string; var FieldsArray: TArray<string>): boolean;
|
2014-03-24 13:17:30 +01:00
|
|
|
var
|
|
|
|
I: Integer;
|
|
|
|
begin
|
|
|
|
for I := 0 to Length(FieldsArray) - 1 do
|
|
|
|
begin
|
|
|
|
if SameText(FieldsArray[I], FieldName) then
|
|
|
|
Exit(True);
|
|
|
|
end;
|
|
|
|
Result := false;
|
|
|
|
end;
|
|
|
|
|
2013-10-30 00:48:23 +01:00
|
|
|
function ISOTimeToString(ATime: TTime): string;
|
|
|
|
var
|
|
|
|
fs: TFormatSettings;
|
|
|
|
begin
|
|
|
|
fs.TimeSeparator := ':';
|
|
|
|
Result := FormatDateTime('hh:nn:ss', ATime, fs);
|
|
|
|
end;
|
|
|
|
|
|
|
|
function ISODateToString(ADate: TDateTime): string;
|
|
|
|
begin
|
|
|
|
Result := FormatDateTime('YYYY-MM-DD', ADate);
|
|
|
|
end;
|
|
|
|
|
|
|
|
function ISODateTimeToString(ADateTime: TDateTime): string;
|
|
|
|
var
|
|
|
|
fs: TFormatSettings;
|
|
|
|
begin
|
|
|
|
fs.TimeSeparator := ':';
|
|
|
|
Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', ADateTime, fs);
|
|
|
|
end;
|
|
|
|
|
|
|
|
function ISOStrToDateTime(DateTimeAsString: string): TDateTime;
|
|
|
|
begin
|
2015-04-01 17:01:23 +02:00
|
|
|
Result := EncodeDateTime(StrToInt(Copy(DateTimeAsString, 1, 4)),
|
|
|
|
StrToInt(Copy(DateTimeAsString, 6, 2)), StrToInt(Copy(DateTimeAsString, 9, 2)),
|
|
|
|
StrToInt(Copy(DateTimeAsString, 12, 2)), StrToInt(Copy(DateTimeAsString, 15, 2)),
|
2014-09-05 12:47:40 +02:00
|
|
|
StrToInt(Copy(DateTimeAsString, 18, 2)), 0);
|
2013-10-30 00:48:23 +01:00
|
|
|
end;
|
|
|
|
|
|
|
|
function ISOStrToTime(TimeAsString: string): TTime;
|
|
|
|
begin
|
2015-04-01 17:01:23 +02:00
|
|
|
Result := EncodeTime(StrToInt(Copy(TimeAsString, 1, 2)), StrToInt(Copy(TimeAsString, 4, 2)),
|
|
|
|
StrToInt(Copy(TimeAsString, 7, 2)), 0);
|
2013-10-30 00:48:23 +01:00
|
|
|
end;
|
|
|
|
|
|
|
|
function ISOStrToDate(DateAsString: string): TDate;
|
|
|
|
begin
|
2015-04-01 17:01:23 +02:00
|
|
|
Result := EncodeDate(StrToInt(Copy(DateAsString, 1, 4)), StrToInt(Copy(DateAsString, 6, 2)),
|
|
|
|
StrToInt(Copy(DateAsString, 9, 2)));
|
2013-10-30 00:48:23 +01:00
|
|
|
// , StrToInt
|
|
|
|
// (Copy(DateAsString, 12, 2)), StrToInt(Copy(DateAsString, 15, 2)),
|
|
|
|
// StrToInt(Copy(DateAsString, 18, 2)), 0);
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
// function ISODateToStr(const ADate: TDate): String;
|
|
|
|
// begin
|
|
|
|
// Result := FormatDateTime('YYYY-MM-DD', ADate);
|
|
|
|
// end;
|
|
|
|
//
|
|
|
|
// function ISOTimeToStr(const ATime: TTime): String;
|
|
|
|
// begin
|
|
|
|
// Result := FormatDateTime('HH:nn:ss', ATime);
|
|
|
|
// end;
|
|
|
|
|
2014-09-17 23:10:52 +02:00
|
|
|
{$IF CompilerVersion <= 25}
|
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class function Mapper.InternalExecuteSQLQuery(AQuery: TSQLQuery; AObject: TObject;
|
|
|
|
WithResult: boolean): Int64;
|
2014-04-16 22:52:25 +02:00
|
|
|
var
|
|
|
|
I: Integer;
|
|
|
|
pname: string;
|
|
|
|
_rttiType: TRttiType;
|
|
|
|
obj_fields: TArray<TRttiProperty>;
|
|
|
|
obj_field: TRttiProperty;
|
|
|
|
obj_field_attr: MapperColumnAttribute;
|
|
|
|
Map: TObjectDictionary<string, TRttiProperty>;
|
|
|
|
f: TRttiProperty;
|
|
|
|
fv: TValue;
|
|
|
|
begin
|
|
|
|
Map := TObjectDictionary<string, TRttiProperty>.Create;
|
|
|
|
try
|
|
|
|
if Assigned(AObject) then
|
|
|
|
begin
|
|
|
|
_rttiType := ctx.GetType(AObject.ClassType);
|
|
|
|
obj_fields := _rttiType.GetProperties;
|
|
|
|
for obj_field in obj_fields do
|
|
|
|
begin
|
|
|
|
if HasAttribute<MapperColumnAttribute>(obj_field, obj_field_attr) then
|
|
|
|
begin
|
|
|
|
Map.Add(MapperColumnAttribute(obj_field_attr).FieldName, obj_field);
|
|
|
|
end
|
|
|
|
else
|
|
|
|
begin
|
|
|
|
Map.Add(LowerCase(obj_field.Name), obj_field);
|
|
|
|
end
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
for I := 0 to AQuery.Params.Count - 1 do
|
|
|
|
begin
|
|
|
|
pname := AQuery.Params[I].Name;
|
|
|
|
if Map.TryGetValue(pname, f) then
|
|
|
|
begin
|
|
|
|
fv := f.GetValue(AObject);
|
|
|
|
AQuery.Params[I].Value := fv.AsVariant;
|
|
|
|
end
|
|
|
|
else
|
|
|
|
begin
|
|
|
|
AQuery.Params[I].Clear;
|
|
|
|
AQuery.Params[I].DataType := ftString; // just to make dbx happy
|
|
|
|
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
Result := 0;
|
|
|
|
if WithResult then
|
|
|
|
AQuery.Open
|
|
|
|
else
|
|
|
|
Result := AQuery.ExecSQL;
|
|
|
|
finally
|
|
|
|
Map.Free;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class procedure Mapper.ReaderToJSONArray(AReader: TDBXReader; AJSONArray: TJSONArray;
|
|
|
|
AReaderInstanceOwner: boolean);
|
2014-04-16 22:52:25 +02:00
|
|
|
var
|
|
|
|
Obj: TJSONObject;
|
|
|
|
begin
|
|
|
|
while AReader.Next do
|
|
|
|
begin
|
|
|
|
Obj := TJSONObject.Create;
|
|
|
|
AJSONArray.AddElement(Obj);
|
|
|
|
ReaderToJSONObject(AReader, Obj, false);
|
|
|
|
end;
|
|
|
|
if AReaderInstanceOwner then
|
|
|
|
FreeAndNil(AReader);
|
|
|
|
end;
|
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class procedure Mapper.ReaderToJSONObject(AReader: TDBXReader; AJSONObject: TJSONObject;
|
|
|
|
AReaderInstanceOwner: boolean);
|
2014-04-16 22:52:25 +02:00
|
|
|
var
|
|
|
|
I: Integer;
|
|
|
|
key: string;
|
|
|
|
dt: TDateTime;
|
|
|
|
Time: TTimeStamp;
|
|
|
|
ts: TSQLTimeStamp;
|
|
|
|
begin
|
|
|
|
for I := 0 to AReader.ColumnCount - 1 do
|
|
|
|
begin
|
|
|
|
key := LowerCase(AReader.Value[I].ValueType.Name);
|
|
|
|
case AReader.Value[I].ValueType.DataType of
|
|
|
|
TDBXDataTypes.Int16Type:
|
|
|
|
AJSONObject.AddPair(key, TJSONNumber.Create(AReader.Value[I].AsInt16));
|
|
|
|
TDBXDataTypes.Int32Type:
|
|
|
|
AJSONObject.AddPair(key, TJSONNumber.Create(AReader.Value[I].AsInt32));
|
|
|
|
TDBXDataTypes.Int64Type:
|
|
|
|
AJSONObject.AddPair(key, TJSONNumber.Create(AReader.Value[I].AsInt64));
|
|
|
|
TDBXDataTypes.DoubleType:
|
|
|
|
AJSONObject.AddPair(key, TJSONNumber.Create(AReader.Value[I].AsDouble));
|
|
|
|
TDBXDataTypes.AnsiStringType, TDBXDataTypes.WideStringType:
|
|
|
|
AJSONObject.AddPair(key, AReader.Value[I].AsString);
|
|
|
|
TDBXDataTypes.BcdType:
|
2015-02-16 14:25:09 +01:00
|
|
|
AJSONObject.AddPair(key, TJSONNumber.Create(BcdToDouble(AReader.Value[I].AsBcd)));
|
2014-04-16 22:52:25 +02:00
|
|
|
TDBXDataTypes.DateType:
|
|
|
|
begin
|
|
|
|
if not AReader.Value[I].IsNull then
|
|
|
|
begin
|
|
|
|
Time.Time := 0;
|
|
|
|
Time.date := AReader.Value[I].AsDate;
|
|
|
|
dt := TimeStampToDateTime(Time);
|
|
|
|
AJSONObject.AddPair(key, ISODateToString(dt));
|
|
|
|
end
|
|
|
|
else
|
|
|
|
AJSONObject.AddPair(key, TJSONNull.Create);
|
|
|
|
end;
|
|
|
|
TDBXDataTypes.TimeType:
|
|
|
|
begin
|
|
|
|
if not AReader.Value[I].IsNull then
|
|
|
|
begin
|
|
|
|
ts := AReader.Value[I].AsTimeStamp;
|
|
|
|
AJSONObject.AddPair(key, SQLTimeStampToStr('hh:nn:ss', ts));
|
|
|
|
end
|
|
|
|
else
|
|
|
|
AJSONObject.AddPair(key, TJSONNull.Create);
|
|
|
|
end
|
|
|
|
else
|
2015-02-16 14:25:09 +01:00
|
|
|
raise EMapperException.Create('Cannot find type');
|
2014-04-16 22:52:25 +02:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
if AReaderInstanceOwner then
|
|
|
|
FreeAndNil(AReader);
|
|
|
|
end;
|
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
class procedure Mapper.ReaderToList<T>(AReader: TDBXReader; AList: IWrappedList);
|
2014-04-16 22:52:25 +02:00
|
|
|
var
|
|
|
|
Obj: T;
|
|
|
|
begin
|
|
|
|
while AReader.Next do
|
|
|
|
begin
|
|
|
|
Obj := T.Create;
|
|
|
|
ReaderToObject(AReader, Obj);
|
|
|
|
AList.Add(Obj);
|
|
|
|
end;
|
|
|
|
AReader.Close;
|
|
|
|
end;
|
|
|
|
|
|
|
|
class procedure Mapper.ReaderToObject(AReader: TDBXReader; AObject: TObject);
|
|
|
|
var
|
|
|
|
_type: TRttiType;
|
|
|
|
_fields: TArray<TRttiProperty>;
|
|
|
|
_field: TRttiProperty;
|
|
|
|
_attribute: MapperColumnAttribute;
|
|
|
|
_dict: TDictionary<string, string>;
|
|
|
|
_keys: TDictionary<string, boolean>;
|
|
|
|
mf: MapperColumnAttribute;
|
|
|
|
field_name: string;
|
|
|
|
Value: TValue;
|
|
|
|
ts: TTimeStamp;
|
|
|
|
sqlts: TSQLTimeStamp;
|
|
|
|
begin
|
|
|
|
_dict := TDictionary<string, string>.Create();
|
|
|
|
_keys := TDictionary<string, boolean>.Create();
|
|
|
|
_type := ctx.GetType(AObject.ClassInfo);
|
|
|
|
_fields := _type.GetProperties;
|
|
|
|
for _field in _fields do
|
|
|
|
if HasAttribute<MapperColumnAttribute>(_field, _attribute) then
|
|
|
|
begin
|
|
|
|
mf := _attribute;
|
|
|
|
_dict.Add(_field.Name, mf.FieldName);
|
|
|
|
_keys.Add(_field.Name, mf.IsPK);
|
|
|
|
end
|
|
|
|
else
|
|
|
|
begin
|
|
|
|
_dict.Add(_field.Name, _field.Name);
|
|
|
|
_keys.Add(_field.Name, false);
|
|
|
|
end;
|
|
|
|
|
|
|
|
for _field in _fields do
|
|
|
|
begin
|
2015-04-01 17:01:23 +02:00
|
|
|
if (not _dict.TryGetValue(_field.Name, field_name)) or (not _field.IsWritable) or
|
|
|
|
(HasAttribute<MapperTransientAttribute>(_field)) then
|
2014-04-16 22:52:25 +02:00
|
|
|
Continue;
|
|
|
|
case _field.PropertyType.TypeKind of
|
|
|
|
tkInteger:
|
|
|
|
Value := AReader.Value[field_name].AsInt32;
|
|
|
|
tkFloat:
|
|
|
|
begin
|
|
|
|
if AReader.Value[field_name].IsNull then
|
|
|
|
Value := 0
|
|
|
|
else
|
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
if AReader.Value[field_name].ValueType.DataType = TDBXDataTypes.DateType then
|
2014-04-16 22:52:25 +02:00
|
|
|
begin
|
|
|
|
ts.Time := 0;
|
|
|
|
ts.date := AReader.Value[field_name].AsDate;
|
|
|
|
Value := TimeStampToDateTime(ts);
|
|
|
|
end
|
2015-02-16 14:25:09 +01:00
|
|
|
else if AReader.Value[field_name].ValueType.DataType = TDBXDataTypes.DoubleType then
|
2014-04-16 22:52:25 +02:00
|
|
|
Value := AReader.Value[field_name].AsDouble
|
2015-02-16 14:25:09 +01:00
|
|
|
else if AReader.Value[field_name].ValueType.DataType = TDBXDataTypes.BcdType then
|
2014-04-16 22:52:25 +02:00
|
|
|
Value := BcdToDouble(AReader.Value[field_name].AsBcd)
|
2015-02-16 14:25:09 +01:00
|
|
|
else if AReader.Value[field_name].ValueType.DataType = TDBXDataTypes.TimeType then
|
2014-04-16 22:52:25 +02:00
|
|
|
begin
|
|
|
|
sqlts := AReader.Value[field_name].AsTimeStamp;
|
|
|
|
Value := SQLTimeStampToDateTime(sqlts);
|
|
|
|
end
|
|
|
|
else
|
2015-02-16 14:25:09 +01:00
|
|
|
raise EMapperException.Create('Unknown tkFloat Type');
|
2014-04-16 22:52:25 +02:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
tkString, tkUString, tkWChar, tkLString, tkWString:
|
|
|
|
begin
|
|
|
|
if AReader.Value[field_name].IsNull then
|
|
|
|
Value := ''
|
|
|
|
else
|
|
|
|
Value := AReader.Value[field_name].AsString;
|
|
|
|
end;
|
|
|
|
else
|
2015-02-16 14:25:09 +01:00
|
|
|
raise EMapperException.Create('Unknown field type for ' + field_name);
|
2014-04-16 22:52:25 +02:00
|
|
|
end;
|
|
|
|
_field.SetValue(AObject, Value);
|
|
|
|
end;
|
|
|
|
_dict.Free;
|
|
|
|
_keys.Free;
|
|
|
|
end;
|
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
class procedure Mapper.ReaderToObjectList<T>(AReader: TDBXReader; AObjectList: TObjectList<T>);
|
2014-04-16 22:52:25 +02:00
|
|
|
var
|
|
|
|
Obj: T;
|
|
|
|
begin
|
|
|
|
while AReader.Next do
|
|
|
|
begin
|
|
|
|
Obj := T.Create;
|
|
|
|
ReaderToObject(AReader, Obj);
|
|
|
|
AObjectList.Add(Obj);
|
|
|
|
end;
|
|
|
|
AReader.Close;
|
|
|
|
end;
|
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
class function Mapper.CreateQuery(AConnection: TSQLConnection; ASQL: string): TSQLQuery;
|
2013-10-30 00:48:23 +01:00
|
|
|
begin
|
|
|
|
Result := TSQLQuery.Create(nil);
|
|
|
|
Result.SQLConnection := AConnection;
|
|
|
|
Result.CommandText := ASQL;
|
|
|
|
end;
|
2014-04-16 22:52:25 +02:00
|
|
|
{$IFEND}
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class procedure Mapper.DataSetToJSONArray(ADataSet: TDataSet; AJSONArray: TJSONArray;
|
|
|
|
ADataSetInstanceOwner: boolean; AJSONObjectActionProc: TJSONObjectActionProc);
|
2013-10-30 00:48:23 +01:00
|
|
|
var
|
|
|
|
Obj: TJSONObject;
|
|
|
|
begin
|
2014-10-26 20:48:52 +01:00
|
|
|
while not ADataSet.Eof do
|
|
|
|
begin
|
2013-10-30 00:48:23 +01:00
|
|
|
Obj := TJSONObject.Create;
|
|
|
|
AJSONArray.AddElement(Obj);
|
2014-10-26 20:48:52 +01:00
|
|
|
DataSetToJSONObject(ADataSet, Obj, false, AJSONObjectActionProc);
|
2013-10-30 00:48:23 +01:00
|
|
|
ADataSet.Next;
|
2014-10-26 20:48:52 +01:00
|
|
|
end;
|
|
|
|
// repeat
|
|
|
|
// Obj := TJSONObject.Create;
|
|
|
|
// AJSONArray.AddElement(Obj);
|
|
|
|
// DataSetToJSONObject(ADataSet, Obj, false);
|
|
|
|
// ADataSet.Next;
|
|
|
|
// until ADataSet.Eof;
|
2014-03-24 13:17:30 +01:00
|
|
|
|
2013-10-30 00:48:23 +01:00
|
|
|
if ADataSetInstanceOwner then
|
|
|
|
FreeAndNil(ADataSet);
|
|
|
|
end;
|
|
|
|
|
|
|
|
class function Mapper.DataSetToJSONArrayOf<T>(ADataSet: TDataSet): TJSONArray;
|
|
|
|
var
|
|
|
|
list: TObjectList<T>;
|
|
|
|
begin
|
|
|
|
list := TObjectList<T>.Create;
|
|
|
|
try
|
|
|
|
Mapper.DataSetToObjectList<T>(ADataSet, list);
|
|
|
|
Result := Mapper.ObjectListToJSONArray<T>(list);
|
|
|
|
finally
|
|
|
|
list.Free;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class procedure Mapper.DataSetToJSONObject(ADataSet: TDataSet; AJSONObject: TJSONObject;
|
|
|
|
ADataSetInstanceOwner: boolean; AJSONObjectActionProc: TJSONObjectActionProc;
|
|
|
|
AFieldNamePolicy: TFieldNamePolicy);
|
2013-10-30 00:48:23 +01:00
|
|
|
var
|
2013-11-10 01:04:17 +01:00
|
|
|
I: Integer;
|
|
|
|
key: string;
|
|
|
|
ts: TSQLTimeStamp;
|
2014-03-13 00:29:23 +01:00
|
|
|
MS: TMemoryStream;
|
|
|
|
SS: TStringStream;
|
2013-10-30 00:48:23 +01:00
|
|
|
begin
|
|
|
|
for I := 0 to ADataSet.FieldCount - 1 do
|
|
|
|
begin
|
2015-01-14 11:39:44 +01:00
|
|
|
// Name policy { ***** Daniele Spinetti ***** }
|
|
|
|
case AFieldNamePolicy of
|
|
|
|
fpLowerCase:
|
|
|
|
key := LowerCase(ADataSet.Fields[I].FieldName);
|
|
|
|
fpUpperCase:
|
|
|
|
key := UpperCase(ADataSet.Fields[I].FieldName);
|
|
|
|
fpAsIs:
|
|
|
|
key := ADataSet.Fields[I].FieldName;
|
|
|
|
end;
|
|
|
|
|
2014-03-07 23:16:33 +01:00
|
|
|
if ADataSet.Fields[I].IsNull then
|
|
|
|
begin
|
|
|
|
AJSONObject.AddPair(key, TJSONNull.Create);
|
|
|
|
Continue;
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
case ADataSet.Fields[I].DataType of
|
2015-02-16 14:25:09 +01:00
|
|
|
TFieldType.ftInteger, TFieldType.ftAutoInc, TFieldType.ftSmallint, TFieldType.ftShortint:
|
|
|
|
AJSONObject.AddPair(key, TJSONNumber.Create(ADataSet.Fields[I].AsInteger));
|
2013-10-30 00:48:23 +01:00
|
|
|
TFieldType.ftLargeint:
|
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
AJSONObject.AddPair(key, TJSONNumber.Create(ADataSet.Fields[I].AsLargeInt));
|
2013-10-30 00:48:23 +01:00
|
|
|
end;
|
|
|
|
TFieldType.ftSingle, TFieldType.ftFloat:
|
2015-02-16 14:25:09 +01:00
|
|
|
AJSONObject.AddPair(key, TJSONNumber.Create(ADataSet.Fields[I].AsFloat));
|
2013-10-30 00:48:23 +01:00
|
|
|
ftString, ftWideString, ftMemo:
|
|
|
|
AJSONObject.AddPair(key, ADataSet.Fields[I].AsWideString);
|
|
|
|
TFieldType.ftDate:
|
|
|
|
begin
|
|
|
|
if not ADataSet.Fields[I].IsNull then
|
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
AJSONObject.AddPair(key, ISODateToString(ADataSet.Fields[I].AsDateTime));
|
2013-10-30 00:48:23 +01:00
|
|
|
end
|
|
|
|
else
|
|
|
|
AJSONObject.AddPair(key, TJSONNull.Create);
|
|
|
|
end;
|
|
|
|
TFieldType.ftDateTime:
|
|
|
|
begin
|
|
|
|
if not ADataSet.Fields[I].IsNull then
|
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
AJSONObject.AddPair(key, ISODateTimeToString(ADataSet.Fields[I].AsDateTime));
|
2013-10-30 00:48:23 +01:00
|
|
|
end
|
|
|
|
else
|
|
|
|
AJSONObject.AddPair(key, TJSONNull.Create);
|
|
|
|
end;
|
|
|
|
TFieldType.ftTimeStamp:
|
|
|
|
begin
|
|
|
|
if not ADataSet.Fields[I].IsNull then
|
|
|
|
begin
|
|
|
|
ts := ADataSet.Fields[I].AsSQLTimeStamp;
|
2015-02-16 14:25:09 +01:00
|
|
|
AJSONObject.AddPair(key, SQLTimeStampToStr('yyyy-mm-dd hh:nn:ss', ts));
|
2013-10-30 00:48:23 +01:00
|
|
|
end
|
|
|
|
else
|
|
|
|
AJSONObject.AddPair(key, TJSONNull.Create);
|
|
|
|
end;
|
|
|
|
TFieldType.ftCurrency:
|
|
|
|
begin
|
|
|
|
if not ADataSet.Fields[I].IsNull then
|
|
|
|
begin
|
2014-06-30 12:33:17 +02:00
|
|
|
// AJSONObject.AddPair(key, FormatCurr('0.00##', ADataSet.Fields[I].AsCurrency));
|
2015-02-16 14:25:09 +01:00
|
|
|
AJSONObject.AddPair(key, TJSONNumber.Create(ADataSet.Fields[I].AsCurrency));
|
2014-09-05 12:47:40 +02:00
|
|
|
end
|
|
|
|
else
|
|
|
|
AJSONObject.AddPair(key, TJSONNull.Create);
|
|
|
|
end;
|
2014-11-19 12:11:31 +01:00
|
|
|
TFieldType.ftBCD, TFieldType.ftFMTBcd:
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
|
|
|
if not ADataSet.Fields[I].IsNull then
|
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
AJSONObject.AddPair(key, TJSONNumber.Create(BcdToDouble(ADataSet.Fields[I].AsBcd)));
|
2014-09-05 12:47:40 +02:00
|
|
|
end
|
|
|
|
else
|
|
|
|
AJSONObject.AddPair(key, TJSONNull.Create);
|
|
|
|
end;
|
|
|
|
TFieldType.ftGraphic, TFieldType.ftBlob, TFieldType.ftStream:
|
|
|
|
begin
|
|
|
|
if not ADataSet.Fields[I].IsNull then
|
|
|
|
begin
|
|
|
|
MS := TMemoryStream.Create;
|
2014-03-13 00:29:23 +01:00
|
|
|
try
|
|
|
|
TBlobField(ADataSet.Fields[I]).SaveToStream(MS);
|
2014-09-05 12:47:40 +02:00
|
|
|
MS.Position := 0;
|
|
|
|
SS := TStringStream.Create('', TEncoding.ASCII);
|
|
|
|
try
|
|
|
|
EncodeStream(MS, SS);
|
|
|
|
SS.Position := 0;
|
|
|
|
AJSONObject.AddPair(key, SS.DataString);
|
|
|
|
finally
|
|
|
|
SS.Free;
|
|
|
|
end;
|
2014-03-13 00:29:23 +01:00
|
|
|
finally
|
|
|
|
MS.Free;
|
|
|
|
end;
|
2014-09-05 12:47:40 +02:00
|
|
|
end
|
|
|
|
else
|
|
|
|
AJSONObject.AddPair(key, TJSONNull.Create);
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
// else
|
2015-02-16 14:25:09 +01:00
|
|
|
// raise EMapperException.Create('Cannot find type for field ' + key);
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
if ADataSetInstanceOwner then
|
|
|
|
FreeAndNil(ADataSet);
|
2014-10-26 20:48:52 +01:00
|
|
|
if Assigned(AJSONObjectActionProc) then
|
|
|
|
AJSONObjectActionProc(AJSONObject);
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
class procedure Mapper.DataSetToObject(ADataSet: TDataSet; AObject: TObject);
|
|
|
|
var
|
|
|
|
_type: TRttiType;
|
|
|
|
_fields: TArray<TRttiProperty>;
|
|
|
|
_field: TRttiProperty;
|
|
|
|
_attribute: TCustomAttribute;
|
|
|
|
_dict: TDictionary<string, string>;
|
|
|
|
_keys: TDictionary<string, boolean>;
|
|
|
|
mf: MapperColumnAttribute;
|
|
|
|
field_name: string;
|
|
|
|
Value: TValue;
|
|
|
|
FoundAttribute: boolean;
|
|
|
|
FoundTransientAttribute: boolean;
|
|
|
|
begin
|
|
|
|
_dict := TDictionary<string, string>.Create();
|
|
|
|
_keys := TDictionary<string, boolean>.Create();
|
|
|
|
_type := ctx.GetType(AObject.ClassInfo);
|
|
|
|
_fields := _type.GetProperties;
|
|
|
|
for _field in _fields do
|
|
|
|
begin
|
|
|
|
FoundAttribute := false;
|
|
|
|
FoundTransientAttribute := false;
|
|
|
|
for _attribute in _field.GetAttributes do
|
|
|
|
begin
|
|
|
|
if _attribute is MapperColumnAttribute then
|
|
|
|
begin
|
|
|
|
FoundAttribute := True;
|
|
|
|
mf := MapperColumnAttribute(_attribute);
|
|
|
|
_dict.Add(_field.Name, mf.FieldName);
|
|
|
|
_keys.Add(_field.Name, mf.IsPK);
|
|
|
|
end
|
|
|
|
else if _attribute is MapperTransientAttribute then
|
|
|
|
FoundTransientAttribute := True;
|
|
|
|
end;
|
|
|
|
if ((not FoundAttribute) and (not FoundTransientAttribute)) then
|
|
|
|
begin
|
|
|
|
_dict.Add(_field.Name, _field.Name);
|
|
|
|
_keys.Add(_field.Name, false);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
for _field in _fields do
|
|
|
|
begin
|
|
|
|
if not _dict.TryGetValue(_field.Name, field_name) then
|
|
|
|
Continue;
|
|
|
|
case _field.PropertyType.TypeKind of
|
|
|
|
tkInteger:
|
|
|
|
Value := ADataSet.FieldByName(field_name).AsInteger;
|
|
|
|
tkInt64:
|
|
|
|
Value := ADataSet.FieldByName(field_name).AsLargeInt;
|
|
|
|
tkFloat:
|
|
|
|
Value := ADataSet.FieldByName(field_name).AsFloat;
|
|
|
|
tkString, tkUString, tkWChar, tkLString, tkWString:
|
|
|
|
Value := ADataSet.FieldByName(field_name).AsString;
|
|
|
|
else
|
|
|
|
Continue;
|
|
|
|
end;
|
|
|
|
_field.SetValue(AObject, Value);
|
|
|
|
end;
|
|
|
|
_dict.Free;
|
|
|
|
_keys.Free;
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class function Mapper.ObjectListToJSONArrayFields<T>(AList: TObjectList<T>;
|
|
|
|
AOwnsInstance: boolean = false; AForEach: TJSONObjectActionProc = nil): TJSONArray;
|
2015-02-16 14:25:09 +01:00
|
|
|
var
|
|
|
|
I: Integer;
|
|
|
|
JV: TJSONObject;
|
|
|
|
begin
|
|
|
|
Result := TJSONArray.Create;
|
|
|
|
if Assigned(AList) then
|
|
|
|
for I := 0 to AList.Count - 1 do
|
|
|
|
begin
|
|
|
|
JV := ObjectToJSONObjectFields(AList[I], []);
|
|
|
|
if Assigned(AForEach) then
|
|
|
|
AForEach(JV);
|
|
|
|
Result.AddElement(JV);
|
|
|
|
end;
|
|
|
|
if AOwnsInstance then
|
|
|
|
AList.Free;
|
|
|
|
end;
|
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class function Mapper.ObjectListToJSONArray<T>(AList: TObjectList<T>; AOwnsInstance: boolean;
|
|
|
|
AForEach: TJSONObjectActionProc): TJSONArray;
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
I: Integer;
|
|
|
|
JV: TJSONObject;
|
|
|
|
begin
|
|
|
|
Result := TJSONArray.Create;
|
|
|
|
if Assigned(AList) then
|
|
|
|
for I := 0 to AList.Count - 1 do
|
|
|
|
begin
|
|
|
|
JV := ObjectToJSONObject(AList[I]);
|
|
|
|
if Assigned(AForEach) then
|
|
|
|
AForEach(JV);
|
|
|
|
Result.AddElement(JV);
|
|
|
|
end;
|
|
|
|
if AOwnsInstance then
|
|
|
|
AList.Free;
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
class function Mapper.ObjectListToJSONArrayOfJSONArray<T>(AList: TObjectList<T>): TJSONArray;
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
I: Integer;
|
|
|
|
begin
|
|
|
|
Result := TJSONArray.Create;
|
|
|
|
for I := 0 to AList.Count - 1 do
|
|
|
|
Result.AddElement(ObjectToJSONArray(AList[I]));
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class function Mapper.ObjectListToJSONArrayString<T>(AList: TObjectList<T>;
|
|
|
|
AOwnsInstance: boolean): string;
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
Arr: TJSONArray;
|
|
|
|
begin
|
|
|
|
Arr := Mapper.ObjectListToJSONArray<T>(AList, AOwnsInstance);
|
|
|
|
try
|
|
|
|
Result := Arr.ToString;
|
|
|
|
finally
|
|
|
|
Arr.Free;
|
|
|
|
end;
|
|
|
|
end;
|
2014-03-24 13:17:30 +01:00
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
class procedure Mapper.ObjectToDataSet(Obj: TObject; Field: TField; var Value: Variant);
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
|
|
|
Value := GetProperty(Obj, Field.FieldName).AsVariant;
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
class function Mapper.ObjectToJSONArray(AObject: TObject): TJSONArray;
|
|
|
|
var
|
2015-02-16 14:25:09 +01:00
|
|
|
LRTTIType: TRttiType;
|
|
|
|
LProperties: TArray<TRttiProperty>;
|
|
|
|
LProperty: TRttiProperty;
|
|
|
|
LKeyName: string;
|
|
|
|
LJArray: TJSONArray;
|
|
|
|
LObj: TObject;
|
|
|
|
LList: IWrappedList;
|
|
|
|
LJArr: TJSONArray;
|
|
|
|
LObjItem: TObject;
|
|
|
|
begin
|
|
|
|
LJArray := TJSONArray.Create;
|
|
|
|
LRTTIType := ctx.GetType(AObject.ClassInfo);
|
|
|
|
LProperties := LRTTIType.GetProperties;
|
|
|
|
for LProperty in LProperties do
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
if HasAttribute<DoNotSerializeAttribute>(LProperty) then
|
2014-09-05 12:47:40 +02:00
|
|
|
Continue;
|
2015-02-16 14:25:09 +01:00
|
|
|
LKeyName := GetKeyName(LProperty, LRTTIType);
|
|
|
|
case LProperty.PropertyType.TypeKind of
|
2014-09-05 12:47:40 +02:00
|
|
|
tkEnumeration:
|
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
LJArray.AddElement(SerializeEnumerationProperty(AObject, LProperty));
|
|
|
|
// if LProperty.PropertyType.QualifiedName = 'System.Boolean' then
|
|
|
|
// begin
|
|
|
|
// if LProperty.GetValue(AObject).AsBoolean then
|
|
|
|
// LJArray.AddElement(TJSONTrue.Create)
|
|
|
|
// else
|
|
|
|
// LJArray.AddElement(TJSONFalse.Create)
|
|
|
|
// end;
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
|
|
|
tkInteger, tkInt64:
|
2015-02-16 14:25:09 +01:00
|
|
|
LJArray.AddElement(TJSONNumber.Create(LProperty.GetValue(AObject).AsInteger));
|
2014-09-05 12:47:40 +02:00
|
|
|
tkFloat:
|
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
LJArray.AddElement(SerializeFloatProperty(AObject, LProperty));
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
|
|
|
tkString, tkLString, tkWString, tkUString:
|
2015-02-16 14:25:09 +01:00
|
|
|
LJArray.AddElement(TJSONString.Create(LProperty.GetValue(AObject).AsString));
|
2014-09-05 12:47:40 +02:00
|
|
|
tkClass:
|
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
LObj := LProperty.GetValue(AObject).AsObject;
|
|
|
|
if Assigned(LObj) then
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
LList := nil;
|
|
|
|
if TDuckTypedList.CanBeWrappedAsList(LObj) then
|
|
|
|
LList := WrapAsList(LObj);
|
|
|
|
if Assigned(LList) then
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
LJArr := TJSONArray.Create;
|
|
|
|
LJArray.AddElement(LJArr);
|
|
|
|
for LObjItem in LList do
|
2013-10-30 00:48:23 +01:00
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
LJArr.AddElement(ObjectToJSONObject(LObjItem));
|
2013-10-30 00:48:23 +01:00
|
|
|
end;
|
2014-09-05 12:47:40 +02:00
|
|
|
end
|
|
|
|
else
|
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
LJArray.AddElement(ObjectToJSONObject(LProperty.GetValue(AObject).AsObject));
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
|
|
|
end
|
|
|
|
else
|
2015-02-16 14:25:09 +01:00
|
|
|
LJArray.AddElement(TJSONNull.Create);
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
2015-02-16 14:25:09 +01:00
|
|
|
Result := LJArray;
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class function Mapper.ObjectToJSONObject(AObject: TObject; AIgnoredProperties: array of string)
|
|
|
|
: TJSONObject;
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
_type: TRttiType;
|
|
|
|
_properties: TArray<TRttiProperty>;
|
|
|
|
_property: TRttiProperty;
|
|
|
|
f: string;
|
|
|
|
JSONObject: TJSONObject;
|
|
|
|
Arr: TJSONArray;
|
|
|
|
list: IWrappedList;
|
|
|
|
Obj, o: TObject;
|
|
|
|
DoNotSerializeThis: boolean;
|
|
|
|
I: Integer;
|
|
|
|
ThereAreIgnoredProperties: boolean;
|
|
|
|
ts: TTimeStamp;
|
2014-11-24 16:26:02 +01:00
|
|
|
sr: TStringStream;
|
2014-09-05 12:47:40 +02:00
|
|
|
SS: TStringStream;
|
2014-11-24 16:26:02 +01:00
|
|
|
_attrser: MapperSerializeAsString;
|
|
|
|
SerEnc: TEncoding;
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
|
|
|
ThereAreIgnoredProperties := Length(AIgnoredProperties) > 0;
|
|
|
|
JSONObject := TJSONObject.Create;
|
|
|
|
_type := ctx.GetType(AObject.ClassInfo);
|
|
|
|
_properties := _type.GetProperties;
|
|
|
|
for _property in _properties do
|
|
|
|
begin
|
|
|
|
// f := LowerCase(_property.Name);
|
|
|
|
f := GetKeyName(_property, _type);
|
|
|
|
// Delete(f, 1, 1);
|
|
|
|
if ThereAreIgnoredProperties then
|
|
|
|
begin
|
|
|
|
DoNotSerializeThis := false;
|
|
|
|
for I := low(AIgnoredProperties) to high(AIgnoredProperties) do
|
|
|
|
if SameText(f, AIgnoredProperties[I]) then
|
|
|
|
begin
|
|
|
|
DoNotSerializeThis := True;
|
|
|
|
Break;
|
|
|
|
end;
|
|
|
|
if DoNotSerializeThis then
|
|
|
|
Continue;
|
|
|
|
end;
|
2013-11-11 01:11:09 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
if HasAttribute<DoNotSerializeAttribute>(_property) then
|
|
|
|
Continue;
|
2013-11-11 01:11:09 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
case _property.PropertyType.TypeKind of
|
|
|
|
tkInteger, tkInt64:
|
2015-02-16 14:25:09 +01:00
|
|
|
JSONObject.AddPair(f, TJSONNumber.Create(_property.GetValue(AObject).AsInteger));
|
2014-09-05 12:47:40 +02:00
|
|
|
tkFloat:
|
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
JSONObject.AddPair(f, SerializeFloatProperty(AObject, _property));
|
|
|
|
{
|
|
|
|
if _property.PropertyType.QualifiedName = 'System.TDate' then
|
|
|
|
begin
|
2014-09-05 12:47:40 +02:00
|
|
|
if _property.GetValue(AObject).AsExtended = 0 then
|
2015-02-16 14:25:09 +01:00
|
|
|
JSONObject.AddPair(f, TJSONNull.Create)
|
2014-09-05 12:47:40 +02:00
|
|
|
else
|
2015-02-16 14:25:09 +01:00
|
|
|
JSONObject.AddPair(f, ISODateToString(_property.GetValue(AObject).AsExtended))
|
|
|
|
end
|
|
|
|
else if _property.PropertyType.QualifiedName = 'System.TDateTime' then
|
|
|
|
begin
|
2014-09-05 12:47:40 +02:00
|
|
|
if _property.GetValue(AObject).AsExtended = 0 then
|
2015-02-16 14:25:09 +01:00
|
|
|
JSONObject.AddPair(f, TJSONNull.Create)
|
2014-09-05 12:47:40 +02:00
|
|
|
else
|
2015-02-16 14:25:09 +01:00
|
|
|
JSONObject.AddPair(f, ISODateTimeToString(_property.GetValue(AObject).AsExtended))
|
|
|
|
end
|
|
|
|
else if _property.PropertyType.QualifiedName = 'System.TTime' then
|
|
|
|
JSONObject.AddPair(f, ISOTimeToString(_property.GetValue(AObject).AsExtended))
|
|
|
|
else
|
|
|
|
JSONObject.AddPair(f, TJSONNumber.Create(_property.GetValue(AObject).AsExtended));
|
|
|
|
}
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
|
|
|
tkString, tkLString, tkWString, tkUString:
|
|
|
|
JSONObject.AddPair(f, _property.GetValue(AObject).AsString);
|
|
|
|
tkEnumeration:
|
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
JSONObject.AddPair(f, SerializeEnumerationProperty(AObject, _property));
|
|
|
|
// if _property.PropertyType.QualifiedName = 'System.Boolean' then
|
|
|
|
// begin
|
|
|
|
// if _property.GetValue(AObject).AsBoolean then
|
|
|
|
// JSONObject.AddPair(f, TJSONTrue.Create)
|
|
|
|
// else
|
|
|
|
// JSONObject.AddPair(f, TJSONFalse.Create);
|
|
|
|
// end
|
|
|
|
// else
|
|
|
|
// begin
|
|
|
|
// JSONObject.AddPair(f, TJSONNumber.Create(_property.GetValue(AObject).AsOrdinal));
|
|
|
|
// end;
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
|
|
|
tkRecord:
|
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
if _property.PropertyType.QualifiedName = 'System.SysUtils.TTimeStamp' then
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
ts := _property.GetValue(AObject).AsType<System.SysUtils.TTimeStamp>;
|
2014-09-05 12:47:40 +02:00
|
|
|
JSONObject.AddPair(f, TJSONNumber.Create(TimeStampToMsecs(ts)));
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
tkClass:
|
|
|
|
begin
|
|
|
|
o := _property.GetValue(AObject).AsObject;
|
|
|
|
if Assigned(o) then
|
|
|
|
begin
|
|
|
|
if TDuckTypedList.CanBeWrappedAsList(o) then
|
|
|
|
begin
|
|
|
|
list := WrapAsList(o);
|
|
|
|
if Assigned(list) then
|
2014-06-30 12:33:17 +02:00
|
|
|
begin
|
2014-09-05 12:47:40 +02:00
|
|
|
Arr := TJSONArray.Create;
|
|
|
|
JSONObject.AddPair(f, Arr);
|
|
|
|
for Obj in list do
|
|
|
|
begin
|
|
|
|
if Assigned(Obj) then
|
|
|
|
// nil element into the list are not serialized
|
|
|
|
Arr.AddElement(ObjectToJSONObject(Obj));
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
end
|
2014-09-05 12:47:40 +02:00
|
|
|
end
|
|
|
|
else if o is TStream then
|
|
|
|
begin
|
2014-11-24 16:26:02 +01:00
|
|
|
if HasAttribute<MapperSerializeAsString>(_property, _attrser) then
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
|
|
|
// serialize the stream as a normal string...
|
|
|
|
TStream(o).Position := 0;
|
2014-11-24 16:26:02 +01:00
|
|
|
SerEnc := TEncoding.GetEncoding(_attrser.Encoding);
|
|
|
|
sr := TStringStream.Create('', SerEnc);
|
2014-09-05 12:47:40 +02:00
|
|
|
try
|
2014-11-24 16:26:02 +01:00
|
|
|
sr.LoadFromStream(TStream(o));
|
|
|
|
JSONObject.AddPair(f, sr.DataString);
|
2014-09-05 12:47:40 +02:00
|
|
|
finally
|
|
|
|
sr.Free;
|
|
|
|
end;
|
2014-06-30 12:33:17 +02:00
|
|
|
end
|
|
|
|
else
|
|
|
|
begin
|
2014-09-05 12:47:40 +02:00
|
|
|
// serialize the stream as Base64 encoded string...
|
|
|
|
TStream(o).Position := 0;
|
|
|
|
SS := TStringStream.Create;
|
|
|
|
try
|
|
|
|
EncodeStream(TStream(o), SS);
|
|
|
|
JSONObject.AddPair(f, SS.DataString);
|
|
|
|
finally
|
|
|
|
SS.Free;
|
|
|
|
end;
|
2014-06-30 12:33:17 +02:00
|
|
|
end;
|
2014-09-05 12:47:40 +02:00
|
|
|
end
|
|
|
|
else
|
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
JSONObject.AddPair(f, ObjectToJSONObject(_property.GetValue(AObject).AsObject));
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
|
|
|
end
|
|
|
|
else
|
2014-11-26 12:27:56 +01:00
|
|
|
begin
|
|
|
|
if HasAttribute<MapperSerializeAsString>(_property) then
|
|
|
|
JSONObject.AddPair(f, '')
|
|
|
|
else
|
|
|
|
JSONObject.AddPair(f, TJSONNull.Create);
|
|
|
|
end;
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
Result := JSONObject;
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
class function Mapper.ObjectToJSONObject(AObject: TObject): TJSONObject;
|
|
|
|
begin
|
|
|
|
Result := ObjectToJSONObject(AObject, []);
|
|
|
|
end;
|
2014-03-24 13:17:30 +01:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class function Mapper.ObjectToJSONObjectFields(AObject: TObject;
|
|
|
|
AIgnoredProperties: array of string): TJSONObject;
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
_type: TRttiType;
|
|
|
|
_fields: TArray<TRttiField>;
|
|
|
|
_field: TRttiField;
|
|
|
|
f: string;
|
|
|
|
JSONObject: TJSONObject;
|
|
|
|
Arr: TJSONArray;
|
|
|
|
list: IWrappedList;
|
|
|
|
Obj, o: TObject;
|
|
|
|
DoNotSerializeThis: boolean;
|
|
|
|
I: Integer;
|
|
|
|
ThereAreIgnoredProperties: boolean;
|
2015-04-09 19:57:13 +02:00
|
|
|
JObj: TJSONObject;
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
|
|
|
ThereAreIgnoredProperties := Length(AIgnoredProperties) > 0;
|
|
|
|
JSONObject := TJSONObject.Create;
|
2015-02-16 14:25:09 +01:00
|
|
|
try
|
|
|
|
// add the $dmvc.classname property to allows a strict deserialization
|
|
|
|
JSONObject.AddPair(DMVC_CLASSNAME, AObject.QualifiedClassName);
|
|
|
|
_type := ctx.GetType(AObject.ClassInfo);
|
|
|
|
_fields := _type.GetFields;
|
|
|
|
for _field in _fields do
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
f := GetKeyName(_field, _type);
|
|
|
|
if ThereAreIgnoredProperties then
|
|
|
|
begin
|
|
|
|
DoNotSerializeThis := false;
|
|
|
|
for I := low(AIgnoredProperties) to high(AIgnoredProperties) do
|
|
|
|
if SameText(f, AIgnoredProperties[I]) then
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
DoNotSerializeThis := True;
|
|
|
|
Break;
|
|
|
|
end;
|
|
|
|
if DoNotSerializeThis then
|
|
|
|
Continue;
|
|
|
|
end;
|
|
|
|
case _field.FieldType.TypeKind of
|
|
|
|
tkInteger, tkInt64:
|
|
|
|
JSONObject.AddPair(f, TJSONNumber.Create(_field.GetValue(AObject).AsInteger));
|
|
|
|
tkFloat:
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
JSONObject.AddPair(f, SerializeFloatField(AObject, _field));
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
2015-02-16 14:25:09 +01:00
|
|
|
tkString, tkLString, tkWString, tkUString:
|
|
|
|
JSONObject.AddPair(f, _field.GetValue(AObject).AsString);
|
|
|
|
tkEnumeration:
|
|
|
|
begin
|
|
|
|
JSONObject.AddPair(f, SerializeEnumerationField(AObject, _field));
|
|
|
|
end;
|
|
|
|
tkClass:
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
o := _field.GetValue(AObject).AsObject;
|
|
|
|
if Assigned(o) then
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
2015-04-09 19:57:13 +02:00
|
|
|
if TDuckTypedList.CanBeWrappedAsList(o) then
|
2014-06-30 12:33:17 +02:00
|
|
|
begin
|
2015-04-09 19:57:13 +02:00
|
|
|
list := WrapAsList(o);
|
|
|
|
JObj := TJSONObject.Create;
|
|
|
|
JSONObject.AddPair(f, JObj);
|
|
|
|
JObj.AddPair(DMVC_CLASSNAME, o.QualifiedClassName);
|
2015-02-16 14:25:09 +01:00
|
|
|
Arr := TJSONArray.Create;
|
2015-04-09 19:57:13 +02:00
|
|
|
JObj.AddPair('items', Arr);
|
2015-02-16 14:25:09 +01:00
|
|
|
for Obj in list do
|
|
|
|
begin
|
2015-04-09 19:57:13 +02:00
|
|
|
Arr.AddElement(ObjectToJSONObjectFields(Obj, []));
|
2015-02-16 14:25:09 +01:00
|
|
|
end;
|
|
|
|
end
|
|
|
|
else
|
|
|
|
begin
|
2015-04-09 19:57:13 +02:00
|
|
|
JSONObject.AddPair(f, ObjectToJSONObjectFields(_field.GetValue(AObject)
|
|
|
|
.AsObject, []));
|
2014-06-30 12:33:17 +02:00
|
|
|
end;
|
2014-09-05 12:47:40 +02:00
|
|
|
end
|
|
|
|
else
|
2015-02-16 14:25:09 +01:00
|
|
|
JSONObject.AddPair(f, TJSONNull.Create);
|
|
|
|
end;
|
|
|
|
end;
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
2015-02-16 14:25:09 +01:00
|
|
|
Result := JSONObject;
|
|
|
|
except
|
|
|
|
FreeAndNil(JSONObject);
|
|
|
|
raise;
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
|
|
|
end;
|
2014-04-10 13:56:23 +02:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class function Mapper.ObjectToJSONObjectFieldsString(AObject: TObject;
|
|
|
|
AIgnoredProperties: array of string): string;
|
|
|
|
var
|
|
|
|
LJObj: TJSONObject;
|
|
|
|
begin
|
|
|
|
LJObj := ObjectToJSONObjectFields(AObject, AIgnoredProperties);
|
|
|
|
try
|
2015-04-10 10:37:09 +02:00
|
|
|
{$IF CompilerVersion >= 28}
|
2015-04-01 17:01:23 +02:00
|
|
|
Result := LJObj.ToJSON;
|
|
|
|
{$ELSE}
|
|
|
|
Result := LJObj.ToString
|
|
|
|
{$ENDIF}
|
|
|
|
finally
|
|
|
|
LJObj.Free;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
class function Mapper.ObjectToJSONObjectString(AObject: TObject): string;
|
|
|
|
var
|
|
|
|
JObj: TJSONObject;
|
|
|
|
begin
|
|
|
|
JObj := ObjectToJSONObject(AObject);
|
|
|
|
try
|
|
|
|
Result := JObj.ToString;
|
|
|
|
finally
|
|
|
|
JObj.Free;
|
|
|
|
end;
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
class function Mapper.PropertyExists(JSONObject: TJSONObject; PropertyName: string): boolean;
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
|
|
|
Result := Assigned(GetPair(JSONObject, PropertyName));
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class function Mapper.SerializeEnumerationField(AObject: TObject; ARttiField: TRttiField)
|
|
|
|
: TJSONValue;
|
2015-02-16 14:25:09 +01:00
|
|
|
begin
|
|
|
|
if ARttiField.FieldType.QualifiedName = 'System.Boolean' then
|
|
|
|
begin
|
|
|
|
if ARttiField.GetValue(AObject).AsBoolean then
|
|
|
|
Result := TJSONTrue.Create
|
|
|
|
else
|
|
|
|
Result := TJSONFalse.Create;
|
|
|
|
end
|
|
|
|
else
|
|
|
|
begin
|
|
|
|
Result := TJSONNumber.Create(ARttiField.GetValue(AObject).AsOrdinal);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class function Mapper.SerializeEnumerationProperty(AObject: TObject; ARTTIProperty: TRttiProperty)
|
|
|
|
: TJSONValue;
|
2015-02-16 14:25:09 +01:00
|
|
|
begin
|
|
|
|
if ARTTIProperty.PropertyType.QualifiedName = 'System.Boolean' then
|
|
|
|
begin
|
|
|
|
if ARTTIProperty.GetValue(AObject).AsBoolean then
|
|
|
|
Result := TJSONTrue.Create
|
|
|
|
else
|
|
|
|
Result := TJSONFalse.Create;
|
|
|
|
end
|
|
|
|
else
|
|
|
|
begin
|
|
|
|
Result := TJSONNumber.Create(ARTTIProperty.GetValue(AObject).AsOrdinal);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
class function Mapper.SerializeFloatField(AObject: TObject; ARttiField: TRttiField): TJSONValue;
|
|
|
|
begin
|
|
|
|
if ARttiField.FieldType.QualifiedName = 'System.TDate' then
|
|
|
|
begin
|
|
|
|
if ARttiField.GetValue(AObject).AsExtended = 0 then
|
|
|
|
Result := TJSONNull.Create
|
|
|
|
else
|
|
|
|
Result := TJSONString.Create(ISODateToString(ARttiField.GetValue(AObject).AsExtended))
|
|
|
|
end
|
|
|
|
else if ARttiField.FieldType.QualifiedName = 'System.TDateTime' then
|
|
|
|
begin
|
|
|
|
if ARttiField.GetValue(AObject).AsExtended = 0 then
|
|
|
|
Result := TJSONNull.Create
|
|
|
|
else
|
|
|
|
Result := TJSONString.Create(ISODateTimeToString(ARttiField.GetValue(AObject).AsExtended))
|
|
|
|
end
|
|
|
|
else if ARttiField.FieldType.QualifiedName = 'System.TTime' then
|
|
|
|
Result := TJSONString.Create(ISOTimeToString(ARttiField.GetValue(AObject).AsExtended))
|
|
|
|
else
|
|
|
|
Result := TJSONNumber.Create(ARttiField.GetValue(AObject).AsExtended);
|
|
|
|
end;
|
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class function Mapper.SerializeFloatProperty(AObject: TObject; ARTTIProperty: TRttiProperty)
|
|
|
|
: TJSONValue;
|
2015-02-16 14:25:09 +01:00
|
|
|
begin
|
|
|
|
if ARTTIProperty.PropertyType.QualifiedName = 'System.TDate' then
|
|
|
|
begin
|
|
|
|
if ARTTIProperty.GetValue(AObject).AsExtended = 0 then
|
|
|
|
Result := TJSONNull.Create
|
|
|
|
else
|
|
|
|
Result := TJSONString.Create(ISODateToString(ARTTIProperty.GetValue(AObject).AsExtended))
|
|
|
|
end
|
|
|
|
else if ARTTIProperty.PropertyType.QualifiedName = 'System.TDateTime' then
|
|
|
|
begin
|
|
|
|
if ARTTIProperty.GetValue(AObject).AsExtended = 0 then
|
|
|
|
Result := TJSONNull.Create
|
|
|
|
else
|
|
|
|
Result := TJSONString.Create(ISODateTimeToString(ARTTIProperty.GetValue(AObject).AsExtended))
|
|
|
|
end
|
|
|
|
else if ARTTIProperty.PropertyType.QualifiedName = 'System.TTime' then
|
|
|
|
Result := TJSONString.Create(ISOTimeToString(ARTTIProperty.GetValue(AObject).AsExtended))
|
|
|
|
else
|
|
|
|
Result := TJSONNumber.Create(ARTTIProperty.GetValue(AObject).AsExtended);
|
|
|
|
|
|
|
|
// if ARTTIProperty.PropertyType.QualifiedName = 'System.TDate' then
|
|
|
|
// Result := TJSONString.Create(ISODateToString(ARTTIProperty.GetValue(AObject).AsExtended))
|
|
|
|
// else if ARTTIProperty.PropertyType.QualifiedName = 'System.TDateTime' then
|
|
|
|
// Result := TJSONString.Create(ISODateTimeToString(ARTTIProperty.GetValue(AObject).AsExtended))
|
|
|
|
// else if ARTTIProperty.PropertyType.QualifiedName = 'System.TTime' then
|
|
|
|
// Result := TJSONString.Create(ISOTimeToString(ARTTIProperty.GetValue(AObject).AsExtended))
|
|
|
|
// else
|
|
|
|
// Result := TJSONNumber.Create(ARTTIProperty.GetValue(AObject).AsExtended);
|
|
|
|
end;
|
|
|
|
|
|
|
|
class function Mapper.GetKeyName(const ARttiField: TRttiField; AType: TRttiType): string;
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
attrs: TArray<TCustomAttribute>;
|
|
|
|
attr: TCustomAttribute;
|
|
|
|
begin
|
|
|
|
// JSONSer property attribute handling
|
|
|
|
attrs := ARttiField.GetAttributes;
|
|
|
|
for attr in attrs do
|
|
|
|
begin
|
|
|
|
if attr is MapperJSONSer then
|
|
|
|
Exit(MapperJSONSer(attr).Name);
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
// JSONNaming class attribute handling
|
|
|
|
attrs := AType.GetAttributes;
|
|
|
|
for attr in attrs do
|
|
|
|
begin
|
|
|
|
if attr is MapperJSONNaming then
|
|
|
|
begin
|
|
|
|
case MapperJSONNaming(attr).GetKeyCase of
|
|
|
|
JSONNameUpperCase:
|
|
|
|
begin
|
|
|
|
Exit(UpperCase(ARttiField.Name));
|
|
|
|
end;
|
|
|
|
JSONNameLowerCase:
|
|
|
|
begin
|
|
|
|
Exit(LowerCase(ARttiField.Name));
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
// Default
|
|
|
|
Result := ARttiField.Name;
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class function Mapper.GetBooleanDef(JSONObject: TJSONObject; PropertyName: string;
|
|
|
|
DefaultValue: boolean): boolean;
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
pair: TJSONPair;
|
|
|
|
begin
|
|
|
|
pair := GetPair(JSONObject, PropertyName);
|
|
|
|
if pair = nil then
|
|
|
|
Exit(DefaultValue);
|
|
|
|
if pair.JsonValue is TJSONFalse then
|
|
|
|
Exit(false)
|
|
|
|
else if pair.JsonValue is TJSONTrue then
|
|
|
|
Exit(True)
|
|
|
|
else
|
2015-02-16 14:25:09 +01:00
|
|
|
raise EMapperException.CreateFmt('Property %s is not a Boolean Property', [PropertyName]);
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
2014-04-22 00:20:00 +02:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class function Mapper.GetInt64Def(JSONObject: TJSONObject; PropertyName: string;
|
|
|
|
DefaultValue: Int64): Int64;
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
pair: TJSONPair;
|
|
|
|
begin
|
|
|
|
pair := GetPair(JSONObject, PropertyName);
|
|
|
|
if pair = nil then
|
|
|
|
Exit(DefaultValue);
|
|
|
|
if pair.JsonValue is TJSONNumber then
|
|
|
|
Exit(TJSONNumber(pair.JsonValue).AsInt64)
|
|
|
|
else
|
2015-02-16 14:25:09 +01:00
|
|
|
raise EMapperException.CreateFmt('Property %s is not a Int64 Property', [PropertyName]);
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class function Mapper.GetIntegerDef(JSONObject: TJSONObject; PropertyName: string;
|
|
|
|
DefaultValue: Integer): Integer;
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
pair: TJSONPair;
|
|
|
|
begin
|
|
|
|
pair := GetPair(JSONObject, PropertyName);
|
|
|
|
if pair = nil then
|
|
|
|
Exit(DefaultValue);
|
|
|
|
if pair.JsonValue is TJSONNumber then
|
|
|
|
Exit(TJSONNumber(pair.JsonValue).AsInt)
|
|
|
|
else
|
2015-02-16 14:25:09 +01:00
|
|
|
raise EMapperException.CreateFmt('Property %s is not an Integer Property', [PropertyName]);
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
class function Mapper.GetJSONArray(JSONObject: TJSONObject; PropertyName: string): TJSONArray;
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
pair: TJSONPair;
|
|
|
|
begin
|
|
|
|
pair := GetPair(JSONObject, PropertyName);
|
|
|
|
if pair = nil then
|
|
|
|
Exit(nil);
|
|
|
|
if pair.JsonValue is TJSONArray then
|
|
|
|
Exit(TJSONArray(pair.JsonValue))
|
|
|
|
else
|
2015-02-16 14:25:09 +01:00
|
|
|
raise EMapperException.Create('Property is not a JSONArray');
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
class function Mapper.GetJSONObj(JSONObject: TJSONObject; PropertyName: string): TJSONObject;
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
pair: TJSONPair;
|
|
|
|
begin
|
|
|
|
pair := GetPair(JSONObject, PropertyName);
|
|
|
|
if pair = nil then
|
|
|
|
Exit(nil);
|
|
|
|
if pair.JsonValue is TJSONObject then
|
|
|
|
Exit(TJSONObject(pair.JsonValue))
|
|
|
|
else
|
2015-02-16 14:25:09 +01:00
|
|
|
raise EMapperException.Create('Property is not a JSONObject');
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
class function Mapper.GetKeyName(const ARttiProp: TRttiProperty; AType: TRttiType): string;
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
attrs: TArray<TCustomAttribute>;
|
|
|
|
attr: TCustomAttribute;
|
|
|
|
begin
|
|
|
|
// JSONSer property attribute handling
|
|
|
|
attrs := ARttiProp.GetAttributes;
|
|
|
|
for attr in attrs do
|
|
|
|
begin
|
|
|
|
if attr is MapperJSONSer then
|
|
|
|
Exit(MapperJSONSer(attr).Name);
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
// JSONNaming class attribute handling
|
|
|
|
attrs := AType.GetAttributes;
|
|
|
|
for attr in attrs do
|
|
|
|
begin
|
|
|
|
if attr is MapperJSONNaming then
|
|
|
|
begin
|
|
|
|
case MapperJSONNaming(attr).GetKeyCase of
|
|
|
|
JSONNameUpperCase:
|
|
|
|
begin
|
|
|
|
Exit(UpperCase(ARttiProp.Name));
|
|
|
|
end;
|
|
|
|
JSONNameLowerCase:
|
|
|
|
begin
|
|
|
|
Exit(LowerCase(ARttiProp.Name));
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
// Default
|
|
|
|
Result := ARttiProp.Name;
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class function Mapper.GetNumberDef(JSONObject: TJSONObject; PropertyName: string;
|
|
|
|
DefaultValue: Extended): Extended;
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
pair: TJSONPair;
|
|
|
|
begin
|
|
|
|
pair := GetPair(JSONObject, PropertyName);
|
|
|
|
if pair = nil then
|
|
|
|
Exit(DefaultValue);
|
|
|
|
if pair.JsonValue is TJSONNumber then
|
|
|
|
Exit(TJSONNumber(pair.JsonValue).AsDouble)
|
|
|
|
else
|
2015-02-16 14:25:09 +01:00
|
|
|
raise EMapperException.Create('Property is not a Number Property');
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
class function Mapper.GetPair(JSONObject: TJSONObject; PropertyName: string): TJSONPair;
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
pair: TJSONPair;
|
|
|
|
begin
|
|
|
|
if not Assigned(JSONObject) then
|
2015-02-16 14:25:09 +01:00
|
|
|
raise EMapperException.Create('JSONObject is nil');
|
2014-09-05 12:47:40 +02:00
|
|
|
pair := JSONObject.Get(PropertyName);
|
|
|
|
Result := pair;
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
class function Mapper.GetProperty(Obj: TObject; const PropertyName: string): TValue;
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
Prop: TRttiProperty;
|
|
|
|
ARTTIType: TRttiType;
|
|
|
|
begin
|
|
|
|
ARTTIType := ctx.GetType(Obj.ClassType);
|
|
|
|
if not Assigned(ARTTIType) then
|
2015-02-16 14:25:09 +01:00
|
|
|
raise EMapperException.CreateFmt('Cannot get RTTI for type [%s]', [ARTTIType.ToString]);
|
2014-09-05 12:47:40 +02:00
|
|
|
Prop := ARTTIType.GetProperty(PropertyName);
|
|
|
|
if not Assigned(Prop) then
|
2015-04-01 17:01:23 +02:00
|
|
|
raise EMapperException.CreateFmt('Cannot get RTTI for property [%s.%s]',
|
|
|
|
[ARTTIType.ToString, PropertyName]);
|
2014-09-05 12:47:40 +02:00
|
|
|
if Prop.IsReadable then
|
|
|
|
Result := Prop.GetValue(Obj)
|
|
|
|
else
|
2015-04-01 17:01:23 +02:00
|
|
|
raise EMapperException.CreateFmt('Property is not readable [%s.%s]',
|
|
|
|
[ARTTIType.ToString, PropertyName]);
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class function Mapper.GetStringDef(JSONObject: TJSONObject;
|
|
|
|
PropertyName, DefaultValue: string): string;
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
pair: TJSONPair;
|
|
|
|
begin
|
|
|
|
pair := GetPair(JSONObject, PropertyName);
|
|
|
|
if pair = nil then
|
|
|
|
Exit(DefaultValue);
|
|
|
|
if pair.JsonValue is TJSONString then
|
|
|
|
Exit(TJSONString(pair.JsonValue).Value)
|
|
|
|
else
|
2015-02-16 14:25:09 +01:00
|
|
|
raise EMapperException.Create('Property is not a String Property');
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
class function Mapper.HasAttribute<T>(ARTTIMember: TRttiNamedObject; out AAttribute: T): boolean;
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
attrs: TArray<TCustomAttribute>;
|
|
|
|
attr: TCustomAttribute;
|
|
|
|
begin
|
|
|
|
AAttribute := nil;
|
|
|
|
Result := false;
|
|
|
|
attrs := ARTTIMember.GetAttributes;
|
|
|
|
for attr in attrs do
|
|
|
|
if attr is T then
|
|
|
|
begin
|
|
|
|
AAttribute := T(attr);
|
|
|
|
Exit(True);
|
|
|
|
end;
|
|
|
|
end;
|
2014-03-24 13:17:30 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
class function Mapper.HasAttribute<T>(ARTTIMember: TRttiNamedObject): boolean;
|
|
|
|
var
|
|
|
|
attrs: TArray<TCustomAttribute>;
|
|
|
|
attr: TCustomAttribute;
|
|
|
|
begin
|
|
|
|
Result := false;
|
|
|
|
attrs := ARTTIMember.GetAttributes;
|
|
|
|
for attr in attrs do
|
|
|
|
if attr is T then
|
|
|
|
Exit(True);
|
|
|
|
end;
|
2014-03-13 00:46:29 +01:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class procedure Mapper.JSONArrayToDataSet(AJSONArray: TJSONArray; ADataSet: TDataSet;
|
|
|
|
AJSONArrayInstanceOwner: boolean);
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
JSONArrayToDataSet(AJSONArray, ADataSet, TArray<string>.Create(), AJSONArrayInstanceOwner);
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class procedure Mapper.JSONArrayToDataSet(AJSONArray: TJSONArray; ADataSet: TDataSet;
|
2015-04-09 19:57:13 +02:00
|
|
|
AIgnoredFields: TArray<string>; AJSONArrayInstanceOwner: boolean;
|
|
|
|
AFieldNamePolicy: TFieldNamePolicy);
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
I: Integer;
|
|
|
|
begin
|
|
|
|
for I := 0 to AJSONArray.Size - 1 do
|
|
|
|
begin
|
|
|
|
ADataSet.Append;
|
2015-04-09 19:57:13 +02:00
|
|
|
Mapper.JSONObjectToDataSet(AJSONArray.Get(I) as TJSONObject, ADataSet, AIgnoredFields, false,
|
|
|
|
AFieldNamePolicy);
|
2014-09-05 12:47:40 +02:00
|
|
|
ADataSet.Post;
|
|
|
|
end;
|
|
|
|
if AJSONArrayInstanceOwner then
|
|
|
|
AJSONArray.Free;
|
|
|
|
end;
|
2014-04-01 02:12:34 +02:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class function Mapper.JSONArrayToObjectList(AListOf: TClass; AJSONArray: TJSONArray;
|
|
|
|
AInstanceOwner: boolean = True; AOwnsChildObjects: boolean = True): TObjectList<TObject>;
|
2015-01-14 11:39:44 +01:00
|
|
|
var
|
|
|
|
I: Integer;
|
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
Result := nil;
|
2015-01-14 11:39:44 +01:00
|
|
|
if Assigned(AJSONArray) then
|
|
|
|
begin
|
|
|
|
Result := TObjectList<TObject>.Create(AOwnsChildObjects);
|
|
|
|
for I := 0 to AJSONArray.Size - 1 do
|
2015-02-16 14:25:09 +01:00
|
|
|
Result.Add(Mapper.JSONObjectToObject(AListOf, AJSONArray.Get(I) as TJSONObject));
|
2015-01-14 11:39:44 +01:00
|
|
|
if AInstanceOwner then
|
|
|
|
AJSONArray.Free;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class procedure Mapper.JSONArrayToObjectList(AList: IWrappedList; AListOf: TClass;
|
|
|
|
AJSONArray: TJSONArray; AInstanceOwner: boolean = True; AOwnsChildObjects: boolean = True);
|
2015-01-14 11:39:44 +01:00
|
|
|
var
|
|
|
|
I: Integer;
|
|
|
|
begin
|
|
|
|
if Assigned(AJSONArray) then
|
|
|
|
begin
|
2015-01-16 14:41:21 +01:00
|
|
|
AList.OwnsObjects := AOwnsChildObjects;
|
2015-01-14 11:39:44 +01:00
|
|
|
for I := 0 to AJSONArray.Size - 1 do
|
2015-02-16 14:25:09 +01:00
|
|
|
AList.Add(Mapper.JSONObjectToObject(AListOf, AJSONArray.Get(I) as TJSONObject));
|
2015-01-14 11:39:44 +01:00
|
|
|
if AInstanceOwner then
|
|
|
|
AJSONArray.Free;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class procedure Mapper.JSONArrayToObjectList<T>(AList: TObjectList<T>; AJSONArray: TJSONArray;
|
|
|
|
AInstanceOwner, AOwnsChildObjects: boolean);
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
I: Integer;
|
|
|
|
begin
|
|
|
|
if Assigned(AJSONArray) then
|
|
|
|
begin
|
|
|
|
for I := 0 to AJSONArray.Size - 1 do
|
|
|
|
AList.Add(Mapper.JSONObjectToObject<T>(AJSONArray.Get(I) as TJSONObject));
|
|
|
|
if AInstanceOwner then
|
|
|
|
AJSONArray.Free;
|
|
|
|
end;
|
|
|
|
end;
|
2014-06-30 12:33:17 +02:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class function Mapper.JSONArrayToObjectList<T>(AJSONArray: TJSONArray; AInstanceOwner: boolean;
|
|
|
|
AOwnsChildObjects: boolean): TObjectList<T>;
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
|
|
|
Result := TObjectList<T>.Create(AOwnsChildObjects);
|
2015-02-16 14:25:09 +01:00
|
|
|
JSONArrayToObjectList<T>(Result, AJSONArray, AInstanceOwner, AOwnsChildObjects);
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
2014-06-30 12:33:17 +02:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class procedure Mapper.InternalJSONObjectFieldsToObject(ctx: TRTTIContext; AJSONObject: TJSONObject;
|
|
|
|
AObject: TObject);
|
2015-04-10 09:13:02 +02:00
|
|
|
procedure RaiseExceptForField(FieldName: string);
|
|
|
|
begin
|
|
|
|
raise EMapperException.Create(FieldName + ' key field is not present in the JSONObject');
|
|
|
|
end;
|
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
var
|
|
|
|
_type: TRttiType;
|
|
|
|
_fields: TArray<TRttiField>;
|
|
|
|
_field: TRttiField;
|
|
|
|
f: string;
|
|
|
|
jvalue: TJSONValue;
|
|
|
|
v: TValue;
|
|
|
|
o: TObject;
|
|
|
|
list: IWrappedList;
|
|
|
|
I: Integer;
|
|
|
|
Arr: TJSONArray;
|
|
|
|
n: TJSONNumber;
|
|
|
|
SerStreamASString: string;
|
|
|
|
sw: TStreamWriter;
|
|
|
|
SS: TStringStream;
|
|
|
|
_attrser: MapperSerializeAsString;
|
|
|
|
SerEnc: TEncoding;
|
2015-04-09 19:57:13 +02:00
|
|
|
LClassName: string;
|
2015-04-10 09:13:02 +02:00
|
|
|
LJSONKeyIsNotPresent: boolean;
|
2015-02-16 14:25:09 +01:00
|
|
|
begin
|
2015-04-10 11:48:49 +02:00
|
|
|
jvalue := nil;
|
2015-02-16 14:25:09 +01:00
|
|
|
_type := ctx.GetType(AObject.ClassInfo);
|
|
|
|
_fields := _type.GetFields;
|
|
|
|
for _field in _fields do
|
|
|
|
begin
|
2015-04-10 11:48:49 +02:00
|
|
|
if HasAttribute<MapperTransientAttribute>(_field) then
|
2015-02-16 14:25:09 +01:00
|
|
|
Continue;
|
|
|
|
f := GetKeyName(_field, _type);
|
|
|
|
if Assigned(AJSONObject.Get(f)) then
|
2015-04-10 09:13:02 +02:00
|
|
|
begin
|
|
|
|
LJSONKeyIsNotPresent := false;
|
|
|
|
jvalue := AJSONObject.Get(f).JsonValue;
|
|
|
|
end
|
2015-02-16 14:25:09 +01:00
|
|
|
else
|
2015-04-09 19:57:13 +02:00
|
|
|
begin
|
2015-04-10 09:13:02 +02:00
|
|
|
LJSONKeyIsNotPresent := True;
|
2015-04-09 19:57:13 +02:00
|
|
|
end;
|
2015-04-10 09:13:02 +02:00
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
case _field.FieldType.TypeKind of
|
|
|
|
tkEnumeration:
|
|
|
|
begin
|
2015-04-10 09:13:02 +02:00
|
|
|
if LJSONKeyIsNotPresent then
|
|
|
|
RaiseExceptForField(_field.Name);
|
2015-02-16 14:25:09 +01:00
|
|
|
if _field.FieldType.QualifiedName = 'System.Boolean' then
|
|
|
|
begin
|
|
|
|
if jvalue is TJSONTrue then
|
|
|
|
_field.SetValue(TObject(AObject), True)
|
|
|
|
else if jvalue is TJSONFalse then
|
|
|
|
_field.SetValue(TObject(AObject), false)
|
|
|
|
else
|
|
|
|
raise EMapperException.Create('Invalid value for property ' + _field.Name);
|
|
|
|
end
|
|
|
|
else // it is an enumerated value but it's not a boolean.
|
|
|
|
begin
|
|
|
|
TValue.Make((jvalue as TJSONNumber).AsInt, _field.FieldType.Handle, v);
|
|
|
|
_field.SetValue(TObject(AObject), v);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
tkInteger, tkInt64:
|
2015-04-10 09:13:02 +02:00
|
|
|
begin
|
|
|
|
if LJSONKeyIsNotPresent then
|
2015-04-10 09:36:35 +02:00
|
|
|
_field.SetValue(TObject(AObject), 0)
|
|
|
|
else
|
|
|
|
_field.SetValue(TObject(AObject), StrToIntDef(jvalue.Value, 0));
|
2015-04-10 09:13:02 +02:00
|
|
|
end;
|
2015-02-16 14:25:09 +01:00
|
|
|
tkFloat:
|
|
|
|
begin
|
2015-04-10 09:13:02 +02:00
|
|
|
if LJSONKeyIsNotPresent then
|
2015-02-16 14:25:09 +01:00
|
|
|
begin
|
2015-04-10 09:36:35 +02:00
|
|
|
_field.SetValue(TObject(AObject), 0);
|
2015-02-16 14:25:09 +01:00
|
|
|
end
|
2015-04-10 09:36:35 +02:00
|
|
|
else
|
2015-02-16 14:25:09 +01:00
|
|
|
begin
|
2015-04-10 09:36:35 +02:00
|
|
|
if _field.FieldType.QualifiedName = 'System.TDate' then
|
|
|
|
begin
|
|
|
|
if jvalue is TJSONNull then
|
|
|
|
_field.SetValue(TObject(AObject), 0)
|
|
|
|
else
|
|
|
|
_field.SetValue(TObject(AObject), ISOStrToDateTime(jvalue.Value + ' 00:00:00'))
|
|
|
|
end
|
|
|
|
else if _field.FieldType.QualifiedName = 'System.TDateTime' then
|
|
|
|
begin
|
|
|
|
if jvalue is TJSONNull then
|
|
|
|
_field.SetValue(TObject(AObject), 0)
|
|
|
|
else
|
|
|
|
_field.SetValue(TObject(AObject), ISOStrToDateTime(jvalue.Value))
|
|
|
|
end
|
|
|
|
else if _field.FieldType.QualifiedName = 'System.TTime' then
|
|
|
|
begin
|
|
|
|
if jvalue is TJSONString then
|
|
|
|
_field.SetValue(TObject(AObject), ISOStrToTime(jvalue.Value))
|
|
|
|
else
|
|
|
|
raise EMapperException.CreateFmt('Cannot deserialize [%s], expected [%s] got [%s]',
|
|
|
|
[_field.Name, 'TJSONString', jvalue.ClassName]);
|
|
|
|
end
|
|
|
|
else { if _field.PropertyType.QualifiedName = 'System.Currency' then }
|
|
|
|
begin
|
|
|
|
if jvalue is TJSONNumber then
|
|
|
|
_field.SetValue(TObject(AObject), TJSONNumber(jvalue).AsDouble)
|
|
|
|
else
|
|
|
|
raise EMapperException.CreateFmt('Cannot deserialize [%s], expected [%s] got [%s]',
|
|
|
|
[_field.Name, 'TJSONNumber', jvalue.ClassName]);
|
|
|
|
end;
|
2015-02-16 14:25:09 +01:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
tkString, tkLString, tkWString, tkUString:
|
|
|
|
begin
|
2015-04-10 09:13:02 +02:00
|
|
|
if LJSONKeyIsNotPresent then
|
2015-04-10 09:36:35 +02:00
|
|
|
_field.SetValue(TObject(AObject), '')
|
|
|
|
else
|
|
|
|
_field.SetValue(TObject(AObject), jvalue.Value);
|
2015-02-16 14:25:09 +01:00
|
|
|
end;
|
|
|
|
tkRecord:
|
|
|
|
begin
|
|
|
|
if _field.FieldType.QualifiedName = 'System.SysUtils.TTimeStamp' then
|
|
|
|
begin
|
2015-04-10 09:36:35 +02:00
|
|
|
if LJSONKeyIsNotPresent then
|
|
|
|
begin
|
|
|
|
_field.SetValue(TObject(AObject), TValue.From<TTimeStamp>(MSecsToTimeStamp(0)));
|
|
|
|
end
|
|
|
|
else
|
|
|
|
begin
|
|
|
|
n := jvalue as TJSONNumber;
|
|
|
|
_field.SetValue(TObject(AObject),
|
|
|
|
TValue.From<TTimeStamp>(MSecsToTimeStamp(n.AsInt64)));
|
|
|
|
end;
|
2015-02-16 14:25:09 +01:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
tkClass: // try to restore child properties... but only if the collection is not nil!!!
|
|
|
|
begin
|
|
|
|
o := _field.GetValue(TObject(AObject)).AsObject;
|
2015-04-10 09:13:02 +02:00
|
|
|
if LJSONKeyIsNotPresent then
|
|
|
|
begin
|
|
|
|
o.Free;
|
|
|
|
o := nil;
|
|
|
|
_field.SetValue(AObject, nil);
|
|
|
|
end;
|
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
if Assigned(o) then
|
|
|
|
begin
|
|
|
|
if o is TStream then
|
|
|
|
begin
|
|
|
|
if jvalue is TJSONString then
|
|
|
|
begin
|
|
|
|
SerStreamASString := TJSONString(jvalue).Value;
|
|
|
|
end
|
|
|
|
else
|
2015-04-01 17:01:23 +02:00
|
|
|
raise EMapperException.Create('Expected JSONString in ' + AJSONObject.Get(f)
|
|
|
|
.JsonString.Value);
|
2015-02-16 14:25:09 +01:00
|
|
|
|
|
|
|
if HasAttribute<MapperSerializeAsString>(_field, _attrser) then
|
|
|
|
begin
|
|
|
|
// serialize the stream as a normal string...
|
|
|
|
TStream(o).Position := 0;
|
|
|
|
SerEnc := TEncoding.GetEncoding(_attrser.Encoding);
|
|
|
|
SS := TStringStream.Create(SerStreamASString, SerEnc);
|
|
|
|
try
|
|
|
|
SS.Position := 0;
|
|
|
|
TStream(o).CopyFrom(SS, SS.Size);
|
|
|
|
finally
|
|
|
|
SS.Free;
|
|
|
|
end;
|
|
|
|
end
|
|
|
|
else
|
|
|
|
begin
|
|
|
|
// deserialize the stream as Base64 encoded string...
|
|
|
|
TStream(o).Position := 0;
|
|
|
|
sw := TStreamWriter.Create(TStream(o));
|
|
|
|
try
|
|
|
|
sw.Write(DecodeString(SerStreamASString));
|
|
|
|
finally
|
|
|
|
sw.Free;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end
|
|
|
|
else if TDuckTypedList.CanBeWrappedAsList(o) then
|
|
|
|
begin // restore collection
|
2015-04-09 19:57:13 +02:00
|
|
|
if not (jvalue is TJSONObject) then
|
|
|
|
raise EMapperException.Create('Wrong serialization for ' + o.QualifiedClassName);
|
|
|
|
LClassName := TJSONObject(jvalue).Get(DMVC_CLASSNAME).JsonValue.Value;
|
|
|
|
if o = nil then // recreate the object as it should be
|
|
|
|
begin
|
|
|
|
o := TRTTIUtils.CreateObject(LClassName);
|
|
|
|
end;
|
|
|
|
jvalue := TJSONObject(jvalue).Get('items').JsonValue;
|
2015-02-16 14:25:09 +01:00
|
|
|
if jvalue is TJSONArray then
|
|
|
|
begin
|
|
|
|
Arr := TJSONArray(jvalue);
|
|
|
|
begin
|
|
|
|
list := WrapAsList(o);
|
|
|
|
for I := 0 to Arr.Size - 1 do
|
|
|
|
begin
|
2015-04-09 19:57:13 +02:00
|
|
|
list.Add(Mapper.JSONObjectFieldsToObject(Arr.Get(I) as TJSONObject));
|
2015-02-16 14:25:09 +01:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end
|
|
|
|
else
|
2015-04-01 17:01:23 +02:00
|
|
|
raise EMapperException.Create('Cannot restore ' + f +
|
|
|
|
' because the related json property is not an array');
|
2015-02-16 14:25:09 +01:00
|
|
|
end
|
|
|
|
else // try to deserialize into the property... but the json MUST be an object
|
|
|
|
begin
|
|
|
|
if jvalue is TJSONObject then
|
|
|
|
begin
|
|
|
|
InternalJSONObjectFieldsToObject(ctx, TJSONObject(jvalue), o);
|
|
|
|
end
|
|
|
|
else if jvalue is TJSONNull then
|
|
|
|
begin
|
|
|
|
FreeAndNil(o);
|
|
|
|
_field.SetValue(AObject, nil)
|
|
|
|
end
|
|
|
|
else
|
|
|
|
raise EMapperException.Create('Cannot deserialize property ' + _field.Name);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class procedure Mapper.InternalJSONObjectToObject(ctx: TRTTIContext; AJSONObject: TJSONObject;
|
|
|
|
AObject: TObject);
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
_type: TRttiType;
|
|
|
|
_fields: TArray<TRttiProperty>;
|
|
|
|
_field: TRttiProperty;
|
|
|
|
f: string;
|
|
|
|
jvalue: TJSONValue;
|
|
|
|
v: TValue;
|
|
|
|
o: TObject;
|
|
|
|
list: IWrappedList;
|
|
|
|
I: Integer;
|
|
|
|
cref: TClass;
|
|
|
|
attr: MapperItemsClassType;
|
|
|
|
Arr: TJSONArray;
|
|
|
|
n: TJSONNumber;
|
|
|
|
SerStreamASString: string;
|
2015-04-09 19:57:13 +02:00
|
|
|
// EncBytes: TBytes;
|
2014-09-05 12:47:40 +02:00
|
|
|
sw: TStreamWriter;
|
2014-11-24 16:26:02 +01:00
|
|
|
SS: TStringStream;
|
|
|
|
_attrser: MapperSerializeAsString;
|
|
|
|
SerEnc: TEncoding;
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
|
|
|
jvalue := nil;
|
|
|
|
_type := ctx.GetType(AObject.ClassInfo);
|
|
|
|
_fields := _type.GetProperties;
|
|
|
|
for _field in _fields do
|
|
|
|
begin
|
2015-04-01 17:01:23 +02:00
|
|
|
if ((not _field.IsWritable) and (_field.PropertyType.TypeKind <> tkClass)) or
|
|
|
|
(HasAttribute<MapperTransientAttribute>(_field)) then
|
2014-09-05 12:47:40 +02:00
|
|
|
Continue;
|
|
|
|
f := GetKeyName(_field, _type);
|
|
|
|
if Assigned(AJSONObject.Get(f)) then
|
|
|
|
jvalue := AJSONObject.Get(f).JsonValue
|
|
|
|
else
|
|
|
|
Continue;
|
|
|
|
case _field.PropertyType.TypeKind of
|
|
|
|
tkEnumeration:
|
|
|
|
begin
|
|
|
|
if _field.PropertyType.QualifiedName = 'System.Boolean' then
|
|
|
|
begin
|
|
|
|
if jvalue is TJSONTrue then
|
2013-10-30 00:48:23 +01:00
|
|
|
_field.SetValue(TObject(AObject), True)
|
|
|
|
else if jvalue is TJSONFalse then
|
|
|
|
_field.SetValue(TObject(AObject), false)
|
|
|
|
else
|
2015-02-16 14:25:09 +01:00
|
|
|
raise EMapperException.Create('Invalid value for property ' + _field.Name);
|
2014-09-05 12:47:40 +02:00
|
|
|
end
|
|
|
|
else // it is an enumerated value but it's not a boolean.
|
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
TValue.Make((jvalue as TJSONNumber).AsInt, _field.PropertyType.Handle, v);
|
2013-10-30 00:48:23 +01:00
|
|
|
_field.SetValue(TObject(AObject), v);
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
tkInteger, tkInt64:
|
|
|
|
_field.SetValue(TObject(AObject), StrToIntDef(jvalue.Value, 0));
|
|
|
|
tkFloat:
|
|
|
|
begin
|
|
|
|
if _field.PropertyType.QualifiedName = 'System.TDate' then
|
|
|
|
begin
|
|
|
|
if jvalue is TJSONNull then
|
2013-10-30 00:48:23 +01:00
|
|
|
_field.SetValue(TObject(AObject), 0)
|
|
|
|
else
|
2015-02-16 14:25:09 +01:00
|
|
|
_field.SetValue(TObject(AObject), ISOStrToDateTime(jvalue.Value + ' 00:00:00'))
|
2014-09-05 12:47:40 +02:00
|
|
|
end
|
|
|
|
else if _field.PropertyType.QualifiedName = 'System.TDateTime' then
|
|
|
|
begin
|
|
|
|
if jvalue is TJSONNull then
|
2013-10-30 00:48:23 +01:00
|
|
|
_field.SetValue(TObject(AObject), 0)
|
|
|
|
else
|
|
|
|
_field.SetValue(TObject(AObject), ISOStrToDateTime(jvalue.Value))
|
2014-09-05 12:47:40 +02:00
|
|
|
end
|
|
|
|
else if _field.PropertyType.QualifiedName = 'System.TTime' then
|
|
|
|
begin
|
|
|
|
if jvalue is TJSONString then
|
2014-06-30 12:33:17 +02:00
|
|
|
_field.SetValue(TObject(AObject), ISOStrToTime(jvalue.Value))
|
|
|
|
else
|
2015-02-16 14:25:09 +01:00
|
|
|
raise EMapperException.CreateFmt('Cannot deserialize [%s], expected [%s] got [%s]',
|
2014-09-05 12:47:40 +02:00
|
|
|
[_field.Name, 'TJSONString', jvalue.ClassName]);
|
|
|
|
end
|
|
|
|
else { if _field.PropertyType.QualifiedName = 'System.Currency' then }
|
|
|
|
begin
|
|
|
|
if jvalue is TJSONNumber then
|
2014-06-30 12:33:17 +02:00
|
|
|
_field.SetValue(TObject(AObject), TJSONNumber(jvalue).AsDouble)
|
|
|
|
else
|
2015-02-16 14:25:09 +01:00
|
|
|
raise EMapperException.CreateFmt('Cannot deserialize [%s], expected [%s] got [%s]',
|
2014-09-05 12:47:40 +02:00
|
|
|
[_field.Name, 'TJSONNumber', jvalue.ClassName]);
|
|
|
|
end {
|
2014-06-30 12:33:17 +02:00
|
|
|
else
|
|
|
|
begin
|
2014-09-05 12:47:40 +02:00
|
|
|
_field.SetValue(TObject(AObject), (jvalue as TJSONNumber).AsDouble)
|
|
|
|
end; }
|
|
|
|
end;
|
|
|
|
tkString, tkLString, tkWString, tkUString:
|
|
|
|
begin
|
|
|
|
_field.SetValue(TObject(AObject), jvalue.Value);
|
|
|
|
end;
|
|
|
|
tkRecord:
|
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
if _field.PropertyType.QualifiedName = 'System.SysUtils.TTimeStamp' then
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
|
|
|
n := jvalue as TJSONNumber;
|
2015-02-16 14:25:09 +01:00
|
|
|
_field.SetValue(TObject(AObject), TValue.From<TTimeStamp>(MSecsToTimeStamp(n.AsInt64)));
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
tkClass: // try to restore child properties... but only if the collection is not nil!!!
|
|
|
|
begin
|
|
|
|
o := _field.GetValue(TObject(AObject)).AsObject;
|
|
|
|
if Assigned(o) then
|
|
|
|
begin
|
|
|
|
if o is TStream then
|
2014-06-30 12:33:17 +02:00
|
|
|
begin
|
2014-09-05 12:47:40 +02:00
|
|
|
if jvalue is TJSONString then
|
|
|
|
begin
|
|
|
|
SerStreamASString := TJSONString(jvalue).Value;
|
|
|
|
end
|
|
|
|
else
|
2015-04-01 17:01:23 +02:00
|
|
|
raise EMapperException.Create('Expected JSONString in ' + AJSONObject.Get(f)
|
|
|
|
.JsonString.Value);
|
2014-09-05 12:47:40 +02:00
|
|
|
|
2014-11-24 16:26:02 +01:00
|
|
|
if HasAttribute<MapperSerializeAsString>(_field, _attrser) then
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
|
|
|
// serialize the stream as a normal string...
|
|
|
|
TStream(o).Position := 0;
|
2014-11-24 16:26:02 +01:00
|
|
|
SerEnc := TEncoding.GetEncoding(_attrser.Encoding);
|
|
|
|
SS := TStringStream.Create(SerStreamASString, SerEnc);
|
2014-09-05 12:47:40 +02:00
|
|
|
try
|
2014-11-24 16:26:02 +01:00
|
|
|
SS.Position := 0;
|
|
|
|
TStream(o).CopyFrom(SS, SS.Size);
|
2014-09-05 12:47:40 +02:00
|
|
|
finally
|
2014-11-24 16:26:02 +01:00
|
|
|
SS.Free;
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
|
|
|
end
|
|
|
|
else
|
|
|
|
begin
|
|
|
|
// deserialize the stream as Base64 encoded string...
|
|
|
|
TStream(o).Position := 0;
|
|
|
|
sw := TStreamWriter.Create(TStream(o));
|
|
|
|
try
|
|
|
|
sw.Write(DecodeString(SerStreamASString));
|
|
|
|
finally
|
|
|
|
sw.Free;
|
|
|
|
end;
|
|
|
|
end;
|
2014-05-05 18:52:49 +02:00
|
|
|
end
|
2014-09-05 12:47:40 +02:00
|
|
|
else if TDuckTypedList.CanBeWrappedAsList(o) then
|
2013-10-30 00:48:23 +01:00
|
|
|
begin // restore collection
|
2014-09-05 12:47:40 +02:00
|
|
|
if jvalue is TJSONArray then
|
|
|
|
begin
|
|
|
|
Arr := TJSONArray(jvalue);
|
|
|
|
// look for the MapperItemsClassType on the property itself or on the property type
|
2015-04-01 17:01:23 +02:00
|
|
|
if Mapper.HasAttribute<MapperItemsClassType>(_field, attr) or
|
|
|
|
Mapper.HasAttribute<MapperItemsClassType>(_field.PropertyType, attr) then
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
|
|
|
cref := attr.Value;
|
|
|
|
list := WrapAsList(o);
|
|
|
|
for I := 0 to Arr.Size - 1 do
|
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
list.Add(Mapper.JSONObjectToObject(cref, Arr.Get(I) as TJSONObject));
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end
|
|
|
|
else
|
2015-04-01 17:01:23 +02:00
|
|
|
raise EMapperException.Create('Cannot restore ' + f +
|
|
|
|
' because the related json property is not an array');
|
2013-10-30 00:48:23 +01:00
|
|
|
end
|
2014-05-22 23:37:13 +02:00
|
|
|
else // try to deserialize into the property... but the json MUST be an object
|
|
|
|
begin
|
|
|
|
if jvalue is TJSONObject then
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
|
|
|
InternalJSONObjectToObject(ctx, TJSONObject(jvalue), o);
|
|
|
|
end
|
2015-01-17 17:19:09 +01:00
|
|
|
else if jvalue is TJSONNull then
|
2015-02-16 14:25:09 +01:00
|
|
|
begin
|
|
|
|
FreeAndNil(o);
|
|
|
|
_field.SetValue(AObject, nil);
|
|
|
|
end
|
2014-09-05 12:47:40 +02:00
|
|
|
else
|
2015-02-16 14:25:09 +01:00
|
|
|
raise EMapperException.Create('Cannot deserialize property ' + _field.Name);
|
2014-05-22 23:37:13 +02:00
|
|
|
end;
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
class function Mapper.JSONObjectToObject(Clazz: TClass; AJSONObject: TJSONObject): TObject;
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
AObject: TObject;
|
|
|
|
begin
|
|
|
|
AObject := TRTTIUtils.CreateObject(Clazz.QualifiedClassName);
|
|
|
|
try
|
|
|
|
InternalJSONObjectToObject(ctx, AJSONObject, AObject);
|
|
|
|
Result := AObject;
|
|
|
|
except
|
|
|
|
AObject.Free;
|
|
|
|
Result := nil;
|
|
|
|
end;
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class procedure Mapper.JSONObjectToDataSet(AJSONObject: TJSONObject; ADataSet: TDataSet;
|
|
|
|
AJSONObjectInstanceOwner: boolean);
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
JSONObjectToDataSet(AJSONObject, ADataSet, TArray<string>.Create(), AJSONObjectInstanceOwner);
|
|
|
|
end;
|
|
|
|
|
|
|
|
class function Mapper.JSONObjectFieldsToObject(AJSONObject: TJSONObject): TObject;
|
|
|
|
var
|
|
|
|
lJClassName: TJSONString;
|
|
|
|
LObj: TObject;
|
|
|
|
begin
|
2015-04-01 17:01:23 +02:00
|
|
|
{$IF CompilerVersion <= 26}
|
|
|
|
if Assigned(AJSONObject.Get(DMVC_CLASSNAME)) then
|
2015-02-16 14:25:09 +01:00
|
|
|
begin
|
2015-04-01 17:01:23 +02:00
|
|
|
lJClassName := AJSONObject.Get(DMVC_CLASSNAME).JsonValue as TJSONString;
|
2015-02-16 14:25:09 +01:00
|
|
|
end
|
|
|
|
else
|
|
|
|
raise EMapperException.Create('No $classname property in the JSON object');
|
2015-04-01 17:01:23 +02:00
|
|
|
{$ELSE}
|
|
|
|
if not AJSONObject.TryGetValue<TJSONString>(DMVC_CLASSNAME, lJClassName) then
|
|
|
|
raise EMapperException.Create('No $classname property in the JSON object');
|
|
|
|
{$ENDIF}
|
|
|
|
LObj := TRTTIUtils.CreateObject(lJClassName.Value);
|
|
|
|
try
|
|
|
|
InternalJSONObjectFieldsToObject(ctx, AJSONObject, LObj);
|
|
|
|
Result := LObj;
|
|
|
|
except
|
|
|
|
FreeAndNil(LObj);
|
|
|
|
raise;
|
|
|
|
end;
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
2014-03-24 13:17:30 +01:00
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
class function Mapper.JSONObjectStringToObject<T>(const AJSONObjectString: string): T;
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
JObj: TJSONObject;
|
|
|
|
begin
|
|
|
|
JObj := TJSONObject.ParseJSONValue(AJSONObjectString) as TJSONObject;
|
|
|
|
try
|
|
|
|
Result := JSONObjectToObject<T>(JObj);
|
|
|
|
finally
|
|
|
|
JObj.Free;
|
|
|
|
end;
|
|
|
|
end;
|
2014-04-10 13:56:23 +02:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class procedure Mapper.JSONObjectToDataSet(AJSONObject: TJSONObject; ADataSet: TDataSet;
|
|
|
|
AIgnoredFields: TArray<string>; AJSONObjectInstanceOwner: boolean;
|
|
|
|
AFieldNamePolicy: TFieldNamePolicy);
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
I: Integer;
|
|
|
|
key: string;
|
|
|
|
v: TJSONValue;
|
|
|
|
jp: TJSONPair;
|
|
|
|
fs: TFormatSettings;
|
|
|
|
MS: TMemoryStream;
|
|
|
|
SS: TStringStream;
|
|
|
|
begin
|
|
|
|
for I := 0 to ADataSet.FieldCount - 1 do
|
|
|
|
begin
|
|
|
|
if ContainsFieldName(ADataSet.Fields[I].FieldName, AIgnoredFields) then
|
|
|
|
Continue;
|
2015-01-14 11:39:44 +01:00
|
|
|
|
|
|
|
// Name policy { ***** Daniele Spinetti ***** }
|
|
|
|
case AFieldNamePolicy of
|
|
|
|
fpLowerCase:
|
|
|
|
key := LowerCase(ADataSet.Fields[I].FieldName);
|
|
|
|
fpUpperCase:
|
|
|
|
key := UpperCase(ADataSet.Fields[I].FieldName);
|
|
|
|
fpAsIs:
|
|
|
|
key := ADataSet.Fields[I].FieldName;
|
|
|
|
end;
|
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
v := nil;
|
|
|
|
jp := AJSONObject.Get(key);
|
|
|
|
if Assigned(jp) then
|
2015-02-16 14:25:09 +01:00
|
|
|
if not (jp.JsonValue is TJSONNull) then
|
2014-09-05 12:47:40 +02:00
|
|
|
v := AJSONObject.Get(key).JsonValue;
|
|
|
|
if not Assigned(v) then
|
|
|
|
begin
|
|
|
|
ADataSet.Fields[I].Clear;
|
|
|
|
Continue;
|
|
|
|
end;
|
2014-03-13 00:29:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
case ADataSet.Fields[I].DataType of
|
2015-02-16 14:25:09 +01:00
|
|
|
TFieldType.ftInteger, TFieldType.ftAutoInc, TFieldType.ftSmallint, TFieldType.ftShortint:
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
|
|
|
ADataSet.Fields[I].AsInteger := (v as TJSONNumber).AsInt;
|
|
|
|
end;
|
|
|
|
TFieldType.ftLargeint:
|
|
|
|
begin
|
|
|
|
ADataSet.Fields[I].AsLargeInt := (v as TJSONNumber).AsInt64;
|
|
|
|
end;
|
|
|
|
TFieldType.ftSingle, TFieldType.ftFloat:
|
|
|
|
begin
|
|
|
|
ADataSet.Fields[I].AsFloat := (v as TJSONNumber).AsDouble;
|
|
|
|
end;
|
|
|
|
ftString, ftWideString, ftMemo:
|
|
|
|
begin
|
|
|
|
ADataSet.Fields[I].AsString := (v as TJSONString).Value;
|
|
|
|
end;
|
|
|
|
TFieldType.ftDate:
|
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
ADataSet.Fields[I].AsDateTime := ISOStrToDate((v as TJSONString).Value);
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
|
|
|
TFieldType.ftDateTime:
|
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
ADataSet.Fields[I].AsDateTime := ISOStrToDateTime((v as TJSONString).Value);
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
|
|
|
TFieldType.ftTimeStamp:
|
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
ADataSet.Fields[I].AsSQLTimeStamp := StrToSQLTimeStamp((v as TJSONString).Value);
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
|
|
|
TFieldType.ftCurrency:
|
|
|
|
begin
|
|
|
|
fs.DecimalSeparator := '.';
|
2015-01-14 14:13:48 +01:00
|
|
|
{$IF CompilerVersion <= 27}
|
2015-02-16 14:25:09 +01:00
|
|
|
ADataSet.Fields[I].AsCurrency := StrToCurr((v as TJSONString).Value, fs);
|
2015-01-14 14:13:48 +01:00
|
|
|
{$ELSE} // Delphi XE7 introduces method "ToJSON" to fix some old bugs...
|
2015-02-16 14:25:09 +01:00
|
|
|
ADataSet.Fields[I].AsCurrency := StrToCurr((v as TJSONNumber).ToJSON, fs);
|
2015-01-14 14:13:48 +01:00
|
|
|
{$ENDIF}
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
|
|
|
TFieldType.ftFMTBcd:
|
|
|
|
begin
|
|
|
|
ADataSet.Fields[I].AsBcd := DoubleToBcd((v as TJSONNumber).AsDouble);
|
|
|
|
end;
|
|
|
|
TFieldType.ftGraphic, TFieldType.ftBlob, TFieldType.ftStream:
|
|
|
|
begin
|
|
|
|
MS := TMemoryStream.Create;
|
|
|
|
try
|
2015-02-16 14:25:09 +01:00
|
|
|
SS := TStringStream.Create((v as TJSONString).Value, TEncoding.ASCII);
|
2014-03-13 00:29:23 +01:00
|
|
|
try
|
|
|
|
DecodeStream(SS, MS);
|
2014-09-05 12:47:40 +02:00
|
|
|
MS.Position := 0;
|
|
|
|
TBlobField(ADataSet.Fields[I]).LoadFromStream(MS);
|
2014-03-13 00:29:23 +01:00
|
|
|
finally
|
|
|
|
SS.Free;
|
|
|
|
end;
|
2014-09-05 12:47:40 +02:00
|
|
|
finally
|
|
|
|
MS.Free;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
// else
|
2015-02-16 14:25:09 +01:00
|
|
|
// raise EMapperException.Create('Cannot find type for field ' + key);
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
if AJSONObjectInstanceOwner then
|
|
|
|
FreeAndNil(AJSONObject);
|
|
|
|
end;
|
2014-03-13 00:29:23 +01:00
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
class function Mapper.JSONObjectToObject(ClazzName: string; AJSONObject: TJSONObject): TObject;
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
AObject: TObject;
|
|
|
|
_rttiType: TRttiType;
|
|
|
|
begin
|
|
|
|
_rttiType := Mapper.ctx.FindType(ClazzName);
|
|
|
|
if Assigned(_rttiType) then
|
|
|
|
begin
|
|
|
|
AObject := TRTTIUtils.CreateObject(_rttiType);
|
|
|
|
try
|
|
|
|
InternalJSONObjectToObject(ctx, AJSONObject, AObject);
|
|
|
|
Result := AObject;
|
|
|
|
except
|
|
|
|
AObject.Free;
|
2015-04-09 19:57:13 +02:00
|
|
|
// Result := nil;
|
2014-09-05 12:47:40 +02:00
|
|
|
raise; // added 20140630
|
|
|
|
end;
|
|
|
|
end
|
|
|
|
else
|
2015-02-16 14:25:09 +01:00
|
|
|
raise EMapperException.CreateFmt('Class not found [%s]', [ClazzName]);
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
class function Mapper.JSONObjectToObject<T>(AJSONObject: TJSONObject): T;
|
|
|
|
begin
|
|
|
|
if not Assigned(AJSONObject) then
|
2015-02-16 14:25:09 +01:00
|
|
|
raise EMapperException.Create('JSONObject not assigned');
|
2014-09-05 12:47:40 +02:00
|
|
|
Result := Mapper.JSONObjectToObject(T.QualifiedClassName, AJSONObject) as T;
|
|
|
|
// Result := JSONObjectToObject(TObject.ClassInfo, AJSONObject);
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
class function Mapper.JSONObjectToObjectFields<T>(AJSONObject: TJSONObject): T;
|
|
|
|
var
|
|
|
|
_type: TRttiType;
|
|
|
|
_fields: TArray<TRttiField>;
|
|
|
|
_field: TRttiField;
|
|
|
|
f: string;
|
|
|
|
AObject: T;
|
|
|
|
jvalue: TJSONValue;
|
|
|
|
begin
|
|
|
|
AObject := T.Create;
|
|
|
|
try
|
|
|
|
_type := ctx.GetType(AObject.ClassInfo);
|
|
|
|
_fields := _type.GetFields;
|
|
|
|
for _field in _fields do
|
|
|
|
begin
|
|
|
|
f := LowerCase(_field.Name);
|
|
|
|
Delete(f, 1, 1);
|
|
|
|
if Assigned(AJSONObject.Get(f)) then
|
|
|
|
jvalue := AJSONObject.Get(f).JsonValue
|
|
|
|
else
|
|
|
|
Continue;
|
|
|
|
case _field.FieldType.TypeKind of
|
|
|
|
tkInteger, tkInt64:
|
|
|
|
_field.SetValue(TObject(AObject), StrToIntDef(jvalue.Value, 0));
|
|
|
|
tkFloat:
|
|
|
|
begin
|
|
|
|
if _field.FieldType.QualifiedName = 'System.TDate' then
|
2013-10-30 00:48:23 +01:00
|
|
|
_field.SetValue(TObject(AObject), StrToDate(jvalue.Value))
|
|
|
|
else if _field.FieldType.QualifiedName = 'System.TDateTime' then
|
|
|
|
_field.SetValue(TObject(AObject), StrToDateTime(jvalue.Value))
|
|
|
|
else
|
2015-02-16 14:25:09 +01:00
|
|
|
_field.SetValue(TObject(AObject), (jvalue as TJSONNumber).AsDouble)
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
|
|
|
tkString, tkLString, tkWString, tkUString:
|
|
|
|
begin
|
|
|
|
_field.SetValue(TObject(AObject), jvalue.Value);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
Result := AObject;
|
|
|
|
except
|
|
|
|
AObject.Free;
|
|
|
|
AObject := nil;
|
|
|
|
Result := nil;
|
|
|
|
end;
|
|
|
|
end;
|
2014-02-24 10:20:34 +01:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class procedure Mapper.DataSetToObjectList<T>(ADataSet: TDataSet; AObjectList: TObjectList<T>;
|
|
|
|
ACloseDataSetAfterScroll: boolean);
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
Obj: T;
|
|
|
|
SavedPosition: TArray<Byte>;
|
|
|
|
begin
|
|
|
|
ADataSet.DisableControls;
|
|
|
|
try
|
|
|
|
SavedPosition := ADataSet.Bookmark;
|
|
|
|
while not ADataSet.Eof do
|
|
|
|
begin
|
|
|
|
Obj := T.Create;
|
|
|
|
DataSetToObject(ADataSet, Obj);
|
|
|
|
AObjectList.Add(Obj);
|
|
|
|
ADataSet.Next;
|
|
|
|
end;
|
|
|
|
if ADataSet.BookmarkValid(SavedPosition) then
|
|
|
|
ADataSet.Bookmark := SavedPosition;
|
|
|
|
finally
|
|
|
|
ADataSet.EnableControls;
|
|
|
|
end;
|
|
|
|
if ACloseDataSetAfterScroll then
|
|
|
|
ADataSet.Close;
|
|
|
|
end;
|
|
|
|
//
|
|
|
|
// class procedure Mapper.DataSetToXML(ADataSet: TDataSet;
|
|
|
|
// XMLDocument: String; ADataSetInstanceOwner: boolean);
|
|
|
|
// var
|
|
|
|
// Xml: IXMLDocument;
|
|
|
|
// Row: IXMLNode;
|
|
|
|
// begin
|
|
|
|
// DefaultDOMVendor := 'ADOM XML v4';
|
|
|
|
// Xml := NewXMLDocument();
|
|
|
|
// while not ADataSet.Eof do
|
|
|
|
// begin
|
|
|
|
// Row := Xml.CreateNode('row');
|
|
|
|
// // Row := Xml.DocumentElement.AddChild('row');
|
|
|
|
// // DataSetRowToXML(ADataSet, Row, false);
|
|
|
|
// Xml.ChildNodes.Add(Row);
|
|
|
|
// break;
|
|
|
|
// ADataSet.Next;
|
|
|
|
// end;
|
|
|
|
// if ADataSetInstanceOwner then
|
|
|
|
// FreeAndNil(ADataSet);
|
|
|
|
// Xml.SaveToXML(XMLDocument);
|
|
|
|
// end;
|
|
|
|
//
|
|
|
|
// class procedure Mapper.DataSetRowToXML(ADataSet: TDataSet;
|
|
|
|
// Row: IXMLNode; ADataSetInstanceOwner: boolean);
|
|
|
|
// var
|
|
|
|
// I: Integer;
|
|
|
|
// key: string;
|
|
|
|
// dt: TDateTime;
|
|
|
|
// tt: TTime;
|
|
|
|
// Time: TTimeStamp;
|
|
|
|
// ts: TSQLTimeStamp;
|
|
|
|
// begin
|
|
|
|
// for I := 0 to ADataSet.FieldCount - 1 do
|
|
|
|
// begin
|
|
|
|
// key := LowerCase(ADataSet.Fields[I].FieldName);
|
|
|
|
// case ADataSet.Fields[I].DataType of
|
|
|
|
// TFieldType.ftInteger, TFieldType.ftSmallint, TFieldType.ftShortint:
|
|
|
|
// Row.Attributes[key] := ADataSet.Fields[I].AsInteger;
|
|
|
|
// // AJSONObject.AddPair(key, TJSONNumber.Create(ADataSet.Fields[I].AsInteger));
|
|
|
|
// TFieldType.ftLargeint:
|
|
|
|
// begin
|
|
|
|
// Row.Attributes[key] := ADataSet.Fields[I].AsLargeInt;
|
|
|
|
// end;
|
|
|
|
// TFieldType.ftSingle, TFieldType.ftFloat:
|
|
|
|
// Row.Attributes[key] := ADataSet.Fields[I].AsFloat;
|
|
|
|
// ftString, ftWideString, ftMemo:
|
|
|
|
// Row.Attributes[key] := ADataSet.Fields[I].AsWideString;
|
|
|
|
// TFieldType.ftDate:
|
|
|
|
// begin
|
|
|
|
// if not ADataSet.Fields[I].IsNull then
|
|
|
|
// begin
|
|
|
|
// Row.Attributes[key] := ISODateToString(ADataSet.Fields[I].AsDateTime);
|
|
|
|
// end
|
|
|
|
// end;
|
|
|
|
// TFieldType.ftDateTime:
|
|
|
|
// begin
|
|
|
|
// if not ADataSet.Fields[I].IsNull then
|
|
|
|
// begin
|
|
|
|
// Row.Attributes[key] := ISODateTimeToString(ADataSet.Fields[I].AsDateTime);
|
|
|
|
// end
|
|
|
|
// end;
|
|
|
|
// TFieldType.ftTimeStamp:
|
|
|
|
// begin
|
|
|
|
// if not ADataSet.Fields[I].IsNull then
|
|
|
|
// begin
|
|
|
|
// ts := ADataSet.Fields[I].AsSQLTimeStamp;
|
|
|
|
// Row.Attributes[key] := SQLTimeStampToStr('hh:nn:ss', ts);
|
|
|
|
// end
|
|
|
|
// end;
|
|
|
|
// TFieldType.ftCurrency:
|
|
|
|
// begin
|
|
|
|
// if not ADataSet.Fields[I].IsNull then
|
|
|
|
// begin
|
|
|
|
// Row.Attributes[key] := FormatCurr('0.00##', ADataSet.Fields[I].AsCurrency);
|
|
|
|
// end
|
|
|
|
// end;
|
|
|
|
// TFieldType.ftFMTBcd:
|
|
|
|
// begin
|
|
|
|
// if not ADataSet.Fields[I].IsNull then
|
|
|
|
// begin
|
|
|
|
// Row.Attributes[key] := BcdToDouble(ADataSet.Fields[I].AsBcd);
|
|
|
|
// end
|
|
|
|
// end
|
|
|
|
// else
|
2015-02-16 14:25:09 +01:00
|
|
|
// raise EMapperException.Create('Cannot find type for field ' + key);
|
2014-09-05 12:47:40 +02:00
|
|
|
// end;
|
|
|
|
// end;
|
|
|
|
// if ADataSetInstanceOwner then
|
|
|
|
// FreeAndNil(ADataSet);
|
|
|
|
// end;
|
2014-06-30 12:33:17 +02:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
{$IF CompilerVersion > 25}
|
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class procedure Mapper.ObjectToFDParameters(AFDParams: TFDParams; AObject: TObject;
|
|
|
|
AParamPrefix: string);
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
I: Integer;
|
|
|
|
pname: string;
|
|
|
|
_rttiType: TRttiType;
|
|
|
|
obj_fields: TArray<TRttiProperty>;
|
|
|
|
obj_field: TRttiProperty;
|
|
|
|
obj_field_attr: MapperColumnAttribute;
|
|
|
|
Map: TObjectDictionary<string, TRttiProperty>;
|
|
|
|
f: TRttiProperty;
|
|
|
|
fv: TValue;
|
|
|
|
PrefixLength: Integer;
|
2014-06-30 12:33:17 +02:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
function KindToFieldType(AKind: TTypeKind; AProp: TRttiProperty): TFieldType;
|
|
|
|
begin
|
|
|
|
case AKind of
|
|
|
|
tkInteger:
|
|
|
|
Result := ftInteger;
|
|
|
|
tkFloat:
|
|
|
|
begin // daniele teti 2014-05-23
|
|
|
|
if AProp.PropertyType.QualifiedName = 'System.TDate' then
|
|
|
|
Result := ftDate
|
|
|
|
else if AProp.PropertyType.QualifiedName = 'System.TDateTime' then
|
|
|
|
Result := ftDateTime
|
|
|
|
else if AProp.PropertyType.QualifiedName = 'System.TTime' then
|
|
|
|
Result := ftTime
|
|
|
|
else
|
|
|
|
Result := ftFloat;
|
|
|
|
end;
|
2015-04-01 17:01:23 +02:00
|
|
|
tkChar, tkString:
|
|
|
|
Result := ftString;
|
|
|
|
tkWChar, tkUString, tkLString, tkWString:
|
2014-09-05 12:47:40 +02:00
|
|
|
Result := ftWideString;
|
|
|
|
tkVariant:
|
|
|
|
Result := ftVariant;
|
|
|
|
tkArray:
|
|
|
|
Result := ftArray;
|
|
|
|
tkInterface:
|
|
|
|
Result := ftInterface;
|
|
|
|
tkInt64:
|
|
|
|
Result := ftLongWord;
|
|
|
|
else
|
|
|
|
Result := ftUnknown;
|
|
|
|
end;
|
|
|
|
end;
|
2014-06-30 12:33:17 +02:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
|
|
|
PrefixLength := Length(AParamPrefix);
|
|
|
|
Map := TObjectDictionary<string, TRttiProperty>.Create;
|
|
|
|
try
|
|
|
|
if Assigned(AObject) then
|
|
|
|
begin
|
|
|
|
_rttiType := ctx.GetType(AObject.ClassType);
|
|
|
|
obj_fields := _rttiType.GetProperties;
|
|
|
|
for obj_field in obj_fields do
|
|
|
|
begin
|
|
|
|
if HasAttribute<MapperColumnAttribute>(obj_field, obj_field_attr) then
|
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
Map.Add(MapperColumnAttribute(obj_field_attr).FieldName.ToLower, obj_field);
|
2014-09-05 12:47:40 +02:00
|
|
|
end
|
|
|
|
else
|
|
|
|
begin
|
|
|
|
Map.Add(obj_field.Name.ToLower, obj_field);
|
|
|
|
end
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
for I := 0 to AFDParams.Count - 1 do
|
|
|
|
begin
|
|
|
|
pname := AFDParams[I].Name.ToLower;
|
|
|
|
if pname.StartsWith(AParamPrefix, True) then
|
|
|
|
Delete(pname, 1, PrefixLength);
|
|
|
|
if Map.TryGetValue(pname, f) then
|
|
|
|
begin
|
|
|
|
fv := f.GetValue(AObject);
|
|
|
|
AFDParams[I].DataType := KindToFieldType(fv.Kind, f);
|
|
|
|
// DmitryG - 2014-03-28
|
|
|
|
AFDParams[I].Value := fv.AsVariant;
|
|
|
|
end
|
|
|
|
else
|
|
|
|
begin
|
|
|
|
AFDParams[I].Clear;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
finally
|
|
|
|
Map.Free;
|
|
|
|
end
|
|
|
|
end;
|
2014-06-30 12:33:17 +02:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class function Mapper.InternalExecuteFDQuery(AQuery: TFDQuery; AObject: TObject;
|
|
|
|
WithResult: boolean): Int64;
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
|
|
|
ObjectToFDParameters(AQuery.Params, AObject);
|
|
|
|
Result := 0;
|
|
|
|
if WithResult then
|
|
|
|
AQuery.Open
|
|
|
|
else
|
|
|
|
begin
|
|
|
|
AQuery.ExecSQL;
|
|
|
|
Result := AQuery.RowsAffected;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
class function Mapper.ExecuteFDQueryNoResult(AQuery: TFDQuery; AObject: TObject): Int64;
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
|
|
|
Result := InternalExecuteFDQuery(AQuery, AObject, false);
|
|
|
|
end;
|
|
|
|
|
|
|
|
class procedure Mapper.ExecuteFDQuery(AQuery: TFDQuery; AObject: TObject);
|
|
|
|
begin
|
|
|
|
InternalExecuteFDQuery(AQuery, AObject, True);
|
|
|
|
end;
|
2014-04-22 00:20:00 +02:00
|
|
|
{$ENDIF}
|
2014-09-17 23:10:52 +02:00
|
|
|
{$IF CompilerVersion <= 25}
|
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
class function Mapper.ExecuteSQLQueryNoResult(AQuery: TSQLQuery; AObject: TObject): Int64;
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
|
|
|
Result := InternalExecuteSQLQuery(AQuery, AObject, false);
|
|
|
|
end;
|
2014-05-05 18:52:49 +02:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
class procedure Mapper.ExecuteSQLQuery(AQuery: TSQLQuery; AObject: TObject);
|
|
|
|
begin
|
|
|
|
InternalExecuteSQLQuery(AQuery, AObject, True);
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
class function Mapper.ExecuteSQLQueryAsObjectList<T>(AQuery: TSQLQuery; AObject: TObject)
|
|
|
|
: TObjectList<T>;
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
|
|
|
ExecuteSQLQuery(AQuery, AObject);
|
|
|
|
Result := TObjectList<T>.Create(True);
|
|
|
|
DataSetToObjectList<T>(AQuery, Result);
|
|
|
|
end;
|
2014-04-16 22:52:25 +02:00
|
|
|
{$IFEND}
|
2014-09-05 12:47:40 +02:00
|
|
|
{ MappedField }
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
constructor MapperColumnAttribute.Create(AFieldName: string; AIsPK: boolean);
|
|
|
|
begin
|
|
|
|
inherited Create;
|
|
|
|
FFieldName := AFieldName;
|
|
|
|
FIsPK := AIsPK;
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
procedure MapperColumnAttribute.SetFieldName(const Value: string);
|
|
|
|
begin
|
|
|
|
FFieldName := Value;
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
procedure MapperColumnAttribute.SetIsPK(const Value: boolean);
|
|
|
|
begin
|
|
|
|
FIsPK := Value;
|
|
|
|
end;
|
|
|
|
{ GridColumnProps }
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
constructor GridColumnProps.Create(ACaption: string; AAlign: TGridColumnAlign; AWidth: Integer);
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
|
|
|
inherited Create;
|
|
|
|
FCaption := ACaption;
|
|
|
|
FAlign := AAlign;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2013-11-10 01:04:17 +01:00
|
|
|
{$IF CompilerVersion >= 23.0}
|
2014-09-05 12:47:40 +02:00
|
|
|
FWidth := System.Math.Max(AWidth, 50);
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2013-11-10 01:04:17 +01:00
|
|
|
{$ELSE}
|
2014-09-05 12:47:40 +02:00
|
|
|
FWidth := Math.Max(AWidth, 50);
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2013-11-10 01:04:17 +01:00
|
|
|
{$IFEND}
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
function GridColumnProps.GetAlignAsString: string;
|
|
|
|
begin
|
|
|
|
case FAlign of
|
|
|
|
caLeft:
|
|
|
|
Result := 'left';
|
|
|
|
caCenter:
|
|
|
|
Result := 'center';
|
|
|
|
caRight:
|
|
|
|
Result := 'right';
|
|
|
|
end;
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
{ JSONSer }
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
constructor MapperJSONSer.Create(AName: string);
|
|
|
|
begin
|
|
|
|
inherited Create;
|
|
|
|
FName := AName;
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
function MapperJSONSer.GetName: string;
|
|
|
|
begin
|
|
|
|
Result := FName;
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
{ JSONNaming }
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
constructor MapperJSONNaming.Create(JSONKeyCase: TJSONNameCase);
|
|
|
|
begin
|
|
|
|
inherited Create;
|
|
|
|
FJSONKeyCase := JSONKeyCase;
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
function MapperJSONNaming.GetKeyCase: TJSONNameCase;
|
|
|
|
begin
|
|
|
|
Result := FJSONKeyCase;
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
{ StringValueAttribute }
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
constructor StringValueAttribute.Create(Value: string);
|
|
|
|
begin
|
|
|
|
inherited Create;
|
|
|
|
FValue := Value;
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
procedure StringValueAttribute.SetValue(const Value: string);
|
|
|
|
begin
|
|
|
|
FValue := Value;
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
{ ItemsClassType }
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
constructor MapperItemsClassType.Create(Value: TClass);
|
|
|
|
begin
|
|
|
|
inherited Create;
|
|
|
|
FValue := Value;
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
procedure MapperItemsClassType.SetValue(const Value: TClass);
|
|
|
|
begin
|
|
|
|
FValue := Value;
|
|
|
|
end;
|
2013-10-30 00:48:23 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
{ TDataSetHelper }
|
2014-03-08 00:26:31 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
function TDataSetHelper.AsJSONArray: TJSONArray;
|
|
|
|
var
|
|
|
|
JArr: TJSONArray;
|
|
|
|
begin
|
2014-05-22 23:37:13 +02:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
JArr := TJSONArray.Create;
|
|
|
|
try
|
|
|
|
if not Eof then
|
|
|
|
Mapper.DataSetToJSONArray(Self, JArr, false);
|
|
|
|
Result := JArr;
|
|
|
|
except
|
|
|
|
FreeAndNil(JArr);
|
|
|
|
raise;
|
|
|
|
end;
|
|
|
|
end;
|
2014-03-08 00:26:31 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
function TDataSetHelper.AsJSONArrayString: string;
|
|
|
|
var
|
|
|
|
Arr: TJSONArray;
|
|
|
|
begin
|
|
|
|
Arr := AsJSONArray;
|
|
|
|
try
|
|
|
|
Result := Arr.ToString;
|
|
|
|
finally
|
|
|
|
Arr.Free;
|
|
|
|
end;
|
|
|
|
end;
|
2014-03-24 13:17:30 +01:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
function TDataSetHelper.AsJSONObject(AReturnNilIfEOF: boolean; AFieldNamePolicy: TFieldNamePolicy)
|
|
|
|
: TJSONObject;
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
JObj: TJSONObject;
|
|
|
|
begin
|
|
|
|
JObj := TJSONObject.Create;
|
|
|
|
try
|
|
|
|
Mapper.DataSetToJSONObject(Self, JObj, false);
|
|
|
|
if AReturnNilIfEOF and (JObj.Size = 0) then
|
|
|
|
FreeAndNil(JObj);
|
|
|
|
Result := JObj;
|
|
|
|
except
|
|
|
|
FreeAndNil(JObj);
|
|
|
|
raise;
|
|
|
|
end;
|
|
|
|
end;
|
2014-03-08 00:26:31 +01:00
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
function TDataSetHelper.AsJSONObjectString(AReturnEmptyStringIfEOF: boolean): string;
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
JObj: TJSONObject;
|
|
|
|
begin
|
|
|
|
JObj := AsJSONObject(True);
|
|
|
|
if not Assigned(JObj) then
|
|
|
|
begin
|
|
|
|
if AReturnEmptyStringIfEOF then
|
|
|
|
Result := ''
|
|
|
|
else
|
|
|
|
Result := '{}';
|
|
|
|
end
|
|
|
|
else
|
|
|
|
try
|
|
|
|
Result := JObj.ToString;
|
|
|
|
finally
|
|
|
|
JObj.Free;
|
|
|
|
end;
|
|
|
|
end;
|
2014-03-24 13:17:30 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
function TDataSetHelper.AsObject<T>(CloseAfterScroll: boolean): T;
|
|
|
|
var
|
|
|
|
Obj: T;
|
|
|
|
begin
|
|
|
|
if not Self.Eof then
|
|
|
|
begin
|
|
|
|
Obj := T.Create;
|
|
|
|
try
|
|
|
|
Mapper.DataSetToObject(Self, Obj);
|
|
|
|
Result := Obj;
|
|
|
|
except
|
|
|
|
FreeAndNil(Obj);
|
|
|
|
raise;
|
|
|
|
end;
|
|
|
|
end
|
|
|
|
else
|
|
|
|
Result := nil;
|
|
|
|
end;
|
2014-03-08 00:26:31 +01:00
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
function TDataSetHelper.AsObjectList<T>(CloseAfterScroll: boolean): TObjectList<T>;
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
Objs: TObjectList<T>;
|
|
|
|
begin
|
|
|
|
Objs := TObjectList<T>.Create(True);
|
|
|
|
try
|
|
|
|
Mapper.DataSetToObjectList<T>(Self, Objs, CloseAfterScroll);
|
|
|
|
Result := Objs;
|
|
|
|
except
|
|
|
|
FreeAndNil(Objs);
|
|
|
|
raise;
|
|
|
|
end;
|
|
|
|
end;
|
2014-03-08 00:26:31 +01:00
|
|
|
|
2015-04-09 19:57:13 +02:00
|
|
|
procedure TDataSetHelper.LoadFromJSONArray(AJSONArray: TJSONArray;
|
|
|
|
AFieldNamePolicy: TFieldNamePolicy);
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
|
|
|
Self.DisableControls;
|
|
|
|
try
|
2015-04-10 10:41:39 +02:00
|
|
|
Mapper.JSONArrayToDataSet(AJSONArray, Self, TArray<string>.Create(), false, AFieldNamePolicy);
|
2014-09-05 12:47:40 +02:00
|
|
|
finally
|
|
|
|
Self.EnableControls;
|
|
|
|
end;
|
|
|
|
end;
|
2014-03-13 00:46:29 +01:00
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
procedure TDataSetHelper.LoadFromJSONArray(AJSONArray: TJSONArray; AIgnoredFields: TArray<string>);
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
|
|
|
Self.DisableControls;
|
|
|
|
try
|
|
|
|
Mapper.JSONArrayToDataSet(AJSONArray, Self, AIgnoredFields, false);
|
|
|
|
finally
|
|
|
|
Self.EnableControls;
|
|
|
|
end;
|
|
|
|
end;
|
2014-03-24 13:17:30 +01:00
|
|
|
|
2015-02-16 14:25:09 +01:00
|
|
|
procedure TDataSetHelper.LoadFromJSONArrayString(AJSONArrayString: string);
|
2015-01-14 14:13:48 +01:00
|
|
|
begin
|
|
|
|
AppendFromJSONArrayString(AJSONArrayString);
|
|
|
|
end;
|
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
procedure TDataSetHelper.AppendFromJSONArrayString(AJSONArrayString: string;
|
|
|
|
AIgnoredFields: TArray<string>);
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
JV: TJSONValue;
|
|
|
|
begin
|
|
|
|
JV := TJSONObject.ParseJSONValue(AJSONArrayString);
|
|
|
|
try
|
|
|
|
if JV is TJSONArray then
|
|
|
|
LoadFromJSONArray(TJSONArray(JV), AIgnoredFields)
|
|
|
|
else
|
2015-02-16 14:25:09 +01:00
|
|
|
raise EMapperException.Create('Extected JSONArray in LoadFromJSONArrayString');
|
2014-09-05 12:47:40 +02:00
|
|
|
finally
|
|
|
|
JV.Free;
|
|
|
|
end;
|
|
|
|
end;
|
2014-03-24 13:17:30 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
procedure TDataSetHelper.AppendFromJSONArrayString(AJSONArrayString: string);
|
|
|
|
begin
|
|
|
|
AppendFromJSONArrayString(AJSONArrayString, TArray<string>.Create());
|
|
|
|
end;
|
2014-03-24 13:17:30 +01:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
procedure TDataSetHelper.LoadFromJSONObject(AJSONObject: TJSONObject;
|
|
|
|
AIgnoredFields: TArray<string>; AFieldNamePolicy: TFieldNamePolicy);
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
2015-02-16 14:25:09 +01:00
|
|
|
Mapper.JSONObjectToDataSet(AJSONObject, Self, AIgnoredFields, false, AFieldNamePolicy);
|
2014-09-05 12:47:40 +02:00
|
|
|
end;
|
2014-03-24 13:17:30 +01:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
procedure TDataSetHelper.LoadFromJSONObjectString(AJSONObjectString: string;
|
|
|
|
AIgnoredFields: TArray<string>);
|
2014-09-05 12:47:40 +02:00
|
|
|
var
|
|
|
|
JV: TJSONValue;
|
|
|
|
begin
|
|
|
|
JV := TJSONObject.ParseJSONValue(AJSONObjectString);
|
|
|
|
try
|
|
|
|
if JV is TJSONObject then
|
|
|
|
LoadFromJSONObject(TJSONObject(JV), AIgnoredFields)
|
|
|
|
else
|
2015-02-16 14:25:09 +01:00
|
|
|
raise EMapperException.Create('Extected JSONObject in LoadFromJSONObjectString');
|
2014-09-05 12:47:40 +02:00
|
|
|
finally
|
|
|
|
JV.Free;
|
|
|
|
end;
|
|
|
|
end;
|
2014-03-24 13:17:30 +01:00
|
|
|
|
2015-04-01 17:01:23 +02:00
|
|
|
procedure TDataSetHelper.LoadFromJSONObject(AJSONObject: TJSONObject;
|
|
|
|
AFieldNamePolicy: TFieldNamePolicy);
|
2014-09-05 12:47:40 +02:00
|
|
|
begin
|
|
|
|
LoadFromJSONObject(AJSONObject, TArray<string>.Create());
|
|
|
|
end;
|
2014-03-24 13:17:30 +01:00
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
procedure TDataSetHelper.LoadFromJSONObjectString(AJSONObjectString: string);
|
|
|
|
begin
|
|
|
|
LoadFromJSONObjectString(AJSONObjectString, TArray<string>.Create());
|
|
|
|
end;
|
2014-03-13 00:46:29 +01:00
|
|
|
|
2014-11-24 16:26:02 +01:00
|
|
|
{ MapperSerializeAsString }
|
|
|
|
|
|
|
|
constructor MapperSerializeAsString.Create(AEncoding: string);
|
|
|
|
begin
|
|
|
|
inherited Create;
|
|
|
|
if AEncoding.IsEmpty then
|
|
|
|
FEncoding := DefaultEncoding
|
|
|
|
else
|
|
|
|
FEncoding := AEncoding;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure MapperSerializeAsString.SetEncoding(const Value: string);
|
|
|
|
begin
|
|
|
|
FEncoding := Value;
|
|
|
|
end;
|
|
|
|
|
2014-09-05 12:47:40 +02:00
|
|
|
end.
|