delphimvcframework/sources/ObjectsMappers.pas
daniele.teti 8fc2614a1d Now the JSONObjectToObject can deserialize the following tkClass:
- TStream
 - TObjectList<T> (only if the list itself is already created on the object)
 - TObject (only if the list itself is already created on the object)

MapperItemClassType has been aliased with MapperListOf to be more compliant to DORM and can be on the property itself or in the declaration of the type of the property (Check TEST TestComplexObjectToJSONObjectAndBack test)
2014-05-22 21:37:13 +00:00

2340 lines
72 KiB
ObjectPascal

{ *******************************************************************************
Copyright 2010-2013 Daniele Teti
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,
{$IF Defined(VER270)}
System.JSON,
{$ELSE}
Data.DBXJSON,
Data.SqlExpr,
DBXCommon,
{$IFEND}
{$IF Defined(VER260) or Defined(VER270)}
FireDAC.Comp.Client, FireDAC.Stan.Param,
{$IFEND}
DuckListU;
type
TJSONObjectActionProc = reference to procedure(const AJSONObject: TJSONObject);
Mapper = class
strict private
class var ctx: TRTTIContext;
private
{$IF not Defined(VER270)}
class function InternalExecuteSQLQuery(AQuery: TSQLQuery; AObject: TObject; WithResult: boolean): Int64;
{$IFEND}
{$IF Defined(VER260) or Defined(VER270)}
class function InternalExecuteFDQuery(AQuery: TFDQuery; AObject: TObject; WithResult: boolean): Int64;
{$IFEND}
class function GetKeyName(const ARttiField: TRttiField; AType: TRttiType): string; overload;
class function GetKeyName(const ARttiProp: TRttiProperty; AType: TRttiType): string; overload;
class procedure InternalJSONObjectToObject(ctx: TRTTIContext; AJSONObject: TJSONObject;
AObject: TObject); static;
public
class function HasAttribute<T: class>(ARTTIMember: TRttiNamedObject): boolean; overload;
class function HasAttribute<T: class>(ARTTIMember: TRttiNamedObject; out AAttribute: T): boolean; overload;
///
/// Do not restore nested classes
///
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;
class procedure ObjectToDataSet(Obj: TObject; Field: TField; var Value: Variant); static;
class procedure DataSetToObject(ADataSet: TDataSet; AObject: TObject);
class function ObjectToJSONObject(AObject: TObject; AIgnoredProperties: array of string)
: TJSONObject; overload;
class function ObjectToJSONObjectFields(AObject: TObject; AIgnoredProperties: array of string)
: TJSONObject; overload;
class function ObjectToJSONObject(AObject: TObject): TJSONObject; overload;
class function ObjectToJSONObjectString(AObject: TObject): string;
class function ObjectToJSONArray(AObject: TObject): TJSONArray;
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; AOwnsChildObjects: boolean = True); overload;
{$IF not Defined(VER270)}
class procedure ReaderToObject(AReader: TDBXReader; AObject: TObject);
class procedure ReaderToObjectList<T: class, constructor>(AReader: TDBXReader;
AObjectList: TObjectList<T>);
class procedure ReaderToJSONObject(AReader: TDBXReader; AJSONObject: TJSONObject;
AReaderInstanceOwner: boolean = True);
{$ENDIF}
class procedure DataSetToJSONObject(ADataSet: TDataSet; AJSONObject: TJSONObject;
ADataSetInstanceOwner: boolean = True);
class procedure JSONObjectToDataSet(AJSONObject: TJSONObject; ADataSet: TDataSet;
AJSONObjectInstanceOwner: boolean = True); overload;
class procedure JSONObjectToDataSet(AJSONObject: TJSONObject; ADataSet: TDataSet;
AIgnoredFields: TArray<string>;
AJSONObjectInstanceOwner: boolean = True); overload;
class procedure DataSetToObjectList<T: class, constructor>(ADataSet: TDataSet; AObjectList: TObjectList<T>;
ACloseDataSetAfterScroll: boolean = True);
class function DataSetToJSONArrayOf<T: class, constructor>(ADataSet: TDataSet): TJSONArray;
{$IF not Defined(VER270)}
class procedure ReaderToList<T: class, constructor>(AReader: TDBXReader; AList: IWrappedList);
class procedure ReaderToJSONArray(AReader: TDBXReader; AJSONArray: TJSONArray;
AReaderInstanceOwner: boolean = True);
{$ENDIF}
class procedure DataSetToJSONArray(ADataSet: TDataSet; AJSONArray: TJSONArray;
ADataSetInstanceOwner: boolean = True);
class procedure JSONArrayToDataSet(AJSONArray: TJSONArray; ADataSet: TDataSet;
AJSONArrayInstanceOwner: boolean = True); overload;
class procedure JSONArrayToDataSet(AJSONArray: TJSONArray; ADataSet: TDataSet;
AIgnoredFields: TArray<string>;
AJSONArrayInstanceOwner: boolean = True); overload;
// class procedure DataSetRowToXML(ADataSet: TDataSet; Row: IXMLNode;
// ADataSetInstanceOwner: boolean = True);
// class procedure DataSetToXML(ADataSet: TDataSet; XMLDocument: String;
// ADataSetInstanceOwner: boolean = True);
class function ObjectListToJSONArray<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;
class function GetProperty(Obj: TObject; const PropertyName: string): TValue; static;
{$IF not Defined(VER270)}
class function ExecuteSQLQueryNoResult(AQuery: TSQLQuery; AObject: TObject): Int64;
class procedure ExecuteSQLQuery(AQuery: TSQLQuery; AObject: TObject = nil);
class function ExecuteSQLQueryAsObjectList<T: class, constructor>(AQuery: TSQLQuery;
AObject: TObject = nil)
: TObjectList<T>;
{$ENDIF}
{ FIREDAC RELATED METHODS }
{$IF Defined(VER260) or Defined(VER270)}
class function ExecuteFDQueryNoResult(AQuery: TFDQuery; AObject: TObject): Int64;
class procedure ExecuteFDQuery(AQuery: TFDQuery; AObject: TObject);
class procedure ObjectToFDParameters(AFDParams: TFDParams; AObject: TObject; AParamPrefix: string = '');
{$IFEND}
{$IF not Defined(VER270)}
class function CreateQuery(AConnection: TSQLConnection; ASQL: string): TSQLQuery;
{$IFEND}
// SAFE TJSONObject getter
class function GetPair(JSONObject: TJSONObject; PropertyName: string): TJSONPair;
class function GetStringDef(JSONObject: TJSONObject; PropertyName: string;
DefaultValue: string = ''): string;
class function GetNumberDef(JSONObject: TJSONObject; PropertyName: string; DefaultValue: Extended = 0)
: Extended;
class function GetJSONObj(JSONObject: TJSONObject; PropertyName: string): TJSONObject;
class function GetJSONArray(JSONObject: TJSONObject; PropertyName: string): TJSONArray;
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;
class function PropertyExists(JSONObject: TJSONObject; PropertyName: string): boolean;
end;
TDataSetHelper = class helper for TDataSet
public
function AsJSONArray: TJSONArray;
function AsJSONArrayString: string;
function AsJSONObject(AReturnNilIfEOF: boolean = false): TJSONObject;
function AsJSONObjectString(AReturnEmptyStringIfEOF: boolean = false): string;
procedure LoadFromJSONObject(AJSONObject: TJSONObject); overload;
procedure LoadFromJSONObject(AJSONObject: TJSONObject; AIgnoredFields: TArray<string>); overload;
procedure LoadFromJSONArray(AJSONArray: TJSONArray); overload;
procedure LoadFromJSONArray(AJSONArray: TJSONArray; AIgnoredFields: TArray<string>); overload;
procedure LoadFromJSONObjectString(AJSONObjectString: string); overload;
procedure LoadFromJSONObjectString(AJSONObjectString: string; AIgnoredFields: TArray<string>); overload;
procedure AppendFromJSONArrayString(AJSONArrayString: string); overload;
procedure AppendFromJSONArrayString(AJSONArrayString: string; AIgnoredFields: TArray<string>); overload;
function AsObjectList<T: class, constructor>(CloseAfterScroll: boolean = false): TObjectList<T>;
function AsObject<T: class, constructor>(CloseAfterScroll: boolean = false): T;
end;
MapperTransientAttribute = class(TCustomAttribute)
end;
DoNotSerializeAttribute = class(TCustomAttribute)
end;
MapperItemsClassType = class(TCustomAttribute)
private
FValue: TClass;
procedure SetValue(const Value: TClass);
public
constructor Create(Value: TClass);
property Value: TClass read FValue write SetValue;
end;
MapperListOf = MapperItemsClassType; // just to be more similar to DORM
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;
MapperSerializeAsString = class(TCustomAttribute)
end;
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;
FIsPK: boolean;
procedure SetFieldName(const Value: string);
procedure SetIsPK(const Value: boolean);
public
constructor Create(AFieldName: string; AIsPK: boolean = false);
property FieldName: string read FFieldName write SetFieldName;
property IsPK: boolean read FIsPK write SetIsPK;
end;
TGridColumnAlign = (caLeft, caCenter, caRight);
GridColumnProps = class(TCustomAttribute)
private
FCaption: string;
FAlign: TGridColumnAlign;
FWidth: Integer;
function GetAlignAsString: string;
public
constructor Create(ACaption: string; AAlign: TGridColumnAlign = caCenter; AWidth: Integer = -1);
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
uses
TypInfo,
SysUtils,
FmtBcd,
Math,
SqlTimSt,
DateUtils,
Classes,
RTTIUtilsU,
Soap.EncdDecd,
Xml.adomxmldom;
{ Mapper }
function ContainsFieldName(const FieldName: string; var FieldsArray: TArray<string>): boolean;
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;
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
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)), StrToInt(Copy(DateTimeAsString, 18, 2)), 0);
end;
function ISOStrToTime(TimeAsString: string): TTime;
begin
Result := EncodeTime(StrToInt(Copy(TimeAsString, 1, 2)), StrToInt(Copy(TimeAsString, 4, 2)),
StrToInt(Copy(TimeAsString, 7, 2)), 0);
end;
function ISOStrToDate(DateAsString: string): TDate;
begin
Result := EncodeDate(StrToInt(Copy(DateAsString, 1, 4)), StrToInt(Copy(DateAsString, 6, 2)),
StrToInt(Copy(DateAsString, 9, 2)));
// , 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;
{$IF not Defined(VER270)}
class function Mapper.InternalExecuteSQLQuery(AQuery: TSQLQuery; AObject: TObject;
WithResult: boolean): Int64;
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;
class procedure Mapper.ReaderToJSONArray(AReader: TDBXReader; AJSONArray: TJSONArray;
AReaderInstanceOwner: boolean);
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;
class procedure Mapper.ReaderToJSONObject(AReader: TDBXReader; AJSONObject: TJSONObject;
AReaderInstanceOwner: boolean);
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:
AJSONObject.AddPair(key, TJSONNumber.Create(BcdToDouble(AReader.Value[I].AsBcd)));
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
raise Exception.Create('Cannot find type');
end;
end;
if AReaderInstanceOwner then
FreeAndNil(AReader);
end;
class procedure Mapper.ReaderToList<T>(AReader: TDBXReader; AList: IWrappedList);
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
if (not _dict.TryGetValue(_field.Name, field_name)) or (not _field.IsWritable) or
(HasAttribute<MapperTransientAttribute>(_field)) then
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
if AReader.Value[field_name].ValueType.DataType = TDBXDataTypes.DateType then
begin
ts.Time := 0;
ts.date := AReader.Value[field_name].AsDate;
Value := TimeStampToDateTime(ts);
end
else if AReader.Value[field_name].ValueType.DataType = TDBXDataTypes.DoubleType then
Value := AReader.Value[field_name].AsDouble
else if AReader.Value[field_name].ValueType.DataType = TDBXDataTypes.BcdType then
Value := BcdToDouble(AReader.Value[field_name].AsBcd)
else if AReader.Value[field_name].ValueType.DataType = TDBXDataTypes.TimeType then
begin
sqlts := AReader.Value[field_name].AsTimeStamp;
Value := SQLTimeStampToDateTime(sqlts);
end
else
raise Exception.Create('Unknown tkFloat Type');
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
raise Exception.Create('Unknown field type for ' + field_name);
end;
_field.SetValue(AObject, Value);
end;
_dict.Free;
_keys.Free;
end;
class procedure Mapper.ReaderToObjectList<T>(AReader: TDBXReader; AObjectList: TObjectList<T>);
var
Obj: T;
begin
while AReader.Next do
begin
Obj := T.Create;
ReaderToObject(AReader, Obj);
AObjectList.Add(Obj);
end;
AReader.Close;
end;
class function Mapper.CreateQuery(AConnection: TSQLConnection; ASQL: string): TSQLQuery;
begin
Result := TSQLQuery.Create(nil);
Result.SQLConnection := AConnection;
Result.CommandText := ASQL;
end;
{$IFEND}
class procedure Mapper.DataSetToJSONArray(ADataSet: TDataSet; AJSONArray: TJSONArray;
ADataSetInstanceOwner: boolean);
var
Obj: TJSONObject;
begin
repeat
Obj := TJSONObject.Create;
AJSONArray.AddElement(Obj);
DataSetToJSONObject(ADataSet, Obj, false);
ADataSet.Next;
until ADataSet.Eof;
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;
class procedure Mapper.DataSetToJSONObject(ADataSet: TDataSet; AJSONObject: TJSONObject;
ADataSetInstanceOwner: boolean);
var
I: Integer;
key: string;
ts: TSQLTimeStamp;
MS: TMemoryStream;
SS: TStringStream;
begin
for I := 0 to ADataSet.FieldCount - 1 do
begin
key := LowerCase(ADataSet.Fields[I].FieldName);
if ADataSet.Fields[I].IsNull then
begin
AJSONObject.AddPair(key, TJSONNull.Create);
Continue;
end;
case ADataSet.Fields[I].DataType of
TFieldType.ftInteger, TFieldType.ftAutoInc, TFieldType.ftSmallint, TFieldType.ftShortint:
AJSONObject.AddPair(key, TJSONNumber.Create(ADataSet.Fields[I].AsInteger));
TFieldType.ftLargeint:
begin
AJSONObject.AddPair(key, TJSONNumber.Create(ADataSet.Fields[I].AsLargeInt));
end;
TFieldType.ftSingle, TFieldType.ftFloat:
AJSONObject.AddPair(key, TJSONNumber.Create(ADataSet.Fields[I].AsFloat));
ftString, ftWideString, ftMemo:
AJSONObject.AddPair(key, ADataSet.Fields[I].AsWideString);
TFieldType.ftDate:
begin
if not ADataSet.Fields[I].IsNull then
begin
AJSONObject.AddPair(key, ISODateToString(ADataSet.Fields[I].AsDateTime));
end
else
AJSONObject.AddPair(key, TJSONNull.Create);
end;
TFieldType.ftDateTime:
begin
if not ADataSet.Fields[I].IsNull then
begin
AJSONObject.AddPair(key, ISODateTimeToString(ADataSet.Fields[I].AsDateTime));
end
else
AJSONObject.AddPair(key, TJSONNull.Create);
end;
TFieldType.ftTimeStamp:
begin
if not ADataSet.Fields[I].IsNull then
begin
ts := ADataSet.Fields[I].AsSQLTimeStamp;
AJSONObject.AddPair(key, SQLTimeStampToStr('hh:nn:ss', ts));
end
else
AJSONObject.AddPair(key, TJSONNull.Create);
end;
TFieldType.ftCurrency:
begin
if not ADataSet.Fields[I].IsNull then
begin
AJSONObject.AddPair(key, FormatCurr('0.00##', ADataSet.Fields[I].AsCurrency));
end
else
AJSONObject.AddPair(key, TJSONNull.Create);
end;
TFieldType.ftFMTBcd:
begin
if not ADataSet.Fields[I].IsNull then
begin
AJSONObject.AddPair(key, TJSONNumber.Create(BcdToDouble(ADataSet.Fields[I].AsBcd)));
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;
try
TBlobField(ADataSet.Fields[I]).SaveToStream(MS);
MS.Position := 0;
SS := TStringStream.Create('', TEncoding.ASCII);
try
EncodeStream(MS, SS);
SS.Position := 0;
AJSONObject.AddPair(key, SS.DataString);
finally
SS.Free;
end;
finally
MS.Free;
end;
end
else
AJSONObject.AddPair(key, TJSONNull.Create);
end;
// else
// raise Exception.Create('Cannot find type for field ' + key);
end;
end;
if ADataSetInstanceOwner then
FreeAndNil(ADataSet);
end;
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;
end;
_field.SetValue(AObject, Value);
end;
_dict.Free;
_keys.Free;
end;
class function Mapper.ObjectListToJSONArray<T>(AList: TObjectList<T>; AOwnsInstance: boolean;
AForEach: TJSONObjectActionProc): TJSONArray;
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;
class function Mapper.ObjectListToJSONArrayOfJSONArray<T>(AList: TObjectList<T>): TJSONArray;
var
I: Integer;
begin
Result := TJSONArray.Create;
for I := 0 to AList.Count - 1 do
Result.AddElement(ObjectToJSONArray(AList[I]));
end;
class function Mapper.ObjectListToJSONArrayString<T>(AList: TObjectList<T>; AOwnsInstance: boolean): string;
var
Arr: TJSONArray;
begin
Arr := Mapper.ObjectListToJSONArray<T>(AList, AOwnsInstance);
try
Result := Arr.ToString;
finally
Arr.Free;
end;
end;
class procedure Mapper.ObjectToDataSet(Obj: TObject; Field: TField; var Value: Variant);
begin
Value := GetProperty(Obj, Field.FieldName).AsVariant;
end;
class function Mapper.ObjectToJSONArray(AObject: TObject): TJSONArray;
var
_type: TRttiType;
_fields: TArray<TRttiProperty>;
_field: TRttiProperty;
f: string;
JSONArray: TJSONArray;
o: TObject;
list: IWrappedList;
Arr: TJSONArray;
Obj: TObject;
begin
JSONArray := TJSONArray.Create;
_type := ctx.GetType(AObject.ClassInfo);
_fields := _type.GetProperties;
for _field in _fields do
begin
if HasAttribute<DoNotSerializeAttribute>(_field) then
Continue;
f := GetKeyName(_field, _type);
case _field.PropertyType.TypeKind of
tkEnumeration:
begin
if _field.PropertyType.QualifiedName = 'System.Boolean' then
begin
if _field.GetValue(AObject).AsBoolean then
JSONArray.AddElement(TJSONTrue.Create)
else
JSONArray.AddElement(TJSONFalse.Create)
end;
end;
tkInteger, tkInt64:
JSONArray.AddElement(TJSONNumber.Create(_field.GetValue(AObject).AsInteger));
tkFloat:
begin
if _field.PropertyType.QualifiedName = 'System.TDate' then
JSONArray.AddElement(TJSONString.Create(ISODateToString(_field.GetValue(AObject).AsExtended)))
else if _field.PropertyType.QualifiedName = 'System.TDateTime' then
JSONArray.AddElement(TJSONString.Create(ISODateTimeToString(_field.GetValue(AObject).AsExtended)))
else if _field.PropertyType.QualifiedName = 'System.TTime' then
JSONArray.AddElement(TJSONString.Create(ISOTimeToString(_field.GetValue(AObject).AsExtended)))
else
JSONArray.AddElement(TJSONNumber.Create(_field.GetValue(AObject).AsExtended));
end;
tkString, tkLString, tkWString, tkUString:
JSONArray.AddElement(TJSONString.Create(_field.GetValue(AObject).AsString));
tkClass:
begin
o := _field.GetValue(AObject).AsObject;
if Assigned(o) then
begin
list := nil;
if TDuckTypedList.CanBeWrappedAsList(o) then
list := WrapAsList(o);
if Assigned(list) then
begin
Arr := TJSONArray.Create;
JSONArray.AddElement(Arr);
for Obj in list do
begin
Arr.AddElement(ObjectToJSONObject(Obj));
end;
end
else
begin
JSONArray.AddElement(ObjectToJSONObject(_field.GetValue(AObject).AsObject));
end;
end
else
JSONArray.AddElement(TJSONNull.Create);
end;
end;
end;
Result := JSONArray;
end;
class function Mapper.ObjectToJSONObject(AObject: TObject; AIgnoredProperties: array of string): TJSONObject;
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;
sr: TStreamReader;
SS: TStringStream;
EncBytes: TBytes;
enc: TEncoding;
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;
if HasAttribute<DoNotSerializeAttribute>(_property) then
Continue;
case _property.PropertyType.TypeKind of
tkInteger, tkInt64:
JSONObject.AddPair(f, TJSONNumber.Create(_property.GetValue(AObject).AsInteger));
tkFloat:
begin
if _property.PropertyType.QualifiedName = 'System.TDate' then
begin
if _property.GetValue(AObject).AsExtended = 0 then
JSONObject.AddPair(f, TJSONNull.Create)
else
JSONObject.AddPair(f, ISODateToString(_property.GetValue(AObject).AsExtended))
end
else if _property.PropertyType.QualifiedName = 'System.TDateTime' then
begin
if _property.GetValue(AObject).AsExtended = 0 then
JSONObject.AddPair(f, TJSONNull.Create)
else
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));
end;
tkString, tkLString, tkWString, tkUString:
JSONObject.AddPair(f, _property.GetValue(AObject).AsString);
tkEnumeration:
begin
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;
end;
tkRecord:
begin
if _property.PropertyType.QualifiedName = 'System.SysUtils.TTimeStamp' then
begin
ts := _property.GetValue(AObject).AsType<System.SysUtils.TTimeStamp>;
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
begin
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;
end
end
else if o is TStream then
begin
if HasAttribute<MapperSerializeAsString>(_property) then
begin
// serialize the stream as a normal string...
TStream(o).Position := 0;
SetLength(EncBytes, Min(TStream(o).Size, 10));
TStream(o).Read(EncBytes, Length(EncBytes));
TStream(o).Position := 0;
TEncoding.GetBufferEncoding(EncBytes, enc);
sr := TStreamReader.Create(TStream(o), enc);
try
JSONObject.AddPair(f, sr.ReadToEnd);
finally
sr.Free;
end;
end
else
begin
// 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;
end;
end
else
begin
JSONObject.AddPair(f, ObjectToJSONObject(_property.GetValue(AObject).AsObject));
end;
end
else
JSONObject.AddPair(f, TJSONNull.Create);
end;
end;
end;
Result := JSONObject;
end;
class function Mapper.ObjectToJSONObject(AObject: TObject): TJSONObject;
begin
Result := ObjectToJSONObject(AObject, []);
end;
class function Mapper.ObjectToJSONObjectFields(AObject: TObject; AIgnoredProperties: array of string)
: TJSONObject;
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;
begin
ThereAreIgnoredProperties := Length(AIgnoredProperties) > 0;
JSONObject := TJSONObject.Create;
_type := ctx.GetType(AObject.ClassInfo);
_fields := _type.GetFields;
for _field in _fields do
begin
// f := LowerCase(_field.Name);
f := GetKeyName(_field, _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;
case _field.FieldType.TypeKind of
tkInteger, tkInt64:
JSONObject.AddPair(f, TJSONNumber.Create(_field.GetValue(AObject).AsInteger));
tkFloat:
begin
if _field.FieldType.QualifiedName = 'System.TDate' then
JSONObject.AddPair(f, ISODateToString(_field.GetValue(AObject).AsExtended))
else if _field.FieldType.QualifiedName = 'System.TDateTime' then
JSONObject.AddPair(f, ISODateTimeToString(_field.GetValue(AObject).AsExtended))
else if _field.FieldType.QualifiedName = 'System.TTime' then
JSONObject.AddPair(f, ISOTimeToString(_field.GetValue(AObject).AsExtended))
else
JSONObject.AddPair(f, TJSONNumber.Create(_field.GetValue(AObject).AsExtended));
end;
tkString, tkLString, tkWString, tkUString:
JSONObject.AddPair(f, _field.GetValue(AObject).AsString);
tkEnumeration:
begin
if _field.FieldType.QualifiedName = 'System.Boolean' then
begin
if _field.GetValue(AObject).AsBoolean then
JSONObject.AddPair(f, TJSONTrue.Create)
else
JSONObject.AddPair(f, TJSONFalse.Create);
end
else
begin
JSONObject.AddPair(f, TJSONNumber.Create(_field.GetValue(AObject).AsOrdinal));
end;
end;
tkClass:
begin
o := _field.GetValue(AObject).AsObject;
if Assigned(o) then
begin
list := WrapAsList(o);
if Assigned(list) then
begin
Arr := TJSONArray.Create;
JSONObject.AddPair(f, Arr);
for Obj in list do
begin
Arr.AddElement(ObjectToJSONObject(Obj));
end;
end
else
begin
JSONObject.AddPair(f, ObjectToJSONObject(_field.GetValue(AObject).AsObject));
end;
end
else
JSONObject.AddPair(f, TJSONNull.Create);
end;
end;
end;
Result := JSONObject;
end;
class function Mapper.ObjectToJSONObjectString(AObject: TObject): string;
var
JObj: TJSONObject;
begin
JObj := ObjectToJSONObject(AObject);
try
Result := JObj.ToString;
finally
JObj.Free;
end;
end;
class function Mapper.PropertyExists(JSONObject: TJSONObject; PropertyName: string): boolean;
begin
Result := Assigned(GetPair(JSONObject, PropertyName));
end;
class function Mapper.GetKeyName(const ARttiField: TRttiField; AType: TRttiType): string;
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;
// 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;
// Default
Result := ARttiField.Name;
end;
class function Mapper.GetBooleanDef(JSONObject: TJSONObject; PropertyName: string;
DefaultValue: boolean): boolean;
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
raise Exception.CreateFmt('Property %s is not a Boolean Property', [PropertyName]);
end;
class function Mapper.GetInt64Def(JSONObject: TJSONObject; PropertyName: string; DefaultValue: Int64): Int64;
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
raise Exception.CreateFmt('Property %s is not a Int64 Property', [PropertyName]);
end;
class function Mapper.GetIntegerDef(JSONObject: TJSONObject; PropertyName: string;
DefaultValue: Integer): Integer;
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
raise Exception.CreateFmt('Property %s is not an Integer Property', [PropertyName]);
end;
class function Mapper.GetJSONArray(JSONObject: TJSONObject; PropertyName: string): TJSONArray;
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
raise Exception.Create('Property is not a JSONArray');
end;
class function Mapper.GetJSONObj(JSONObject: TJSONObject; PropertyName: string): TJSONObject;
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
raise Exception.Create('Property is not a JSONObject');
end;
class function Mapper.GetKeyName(const ARttiProp: TRttiProperty; AType: TRttiType): string;
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;
// 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;
// Default
Result := ARttiProp.Name;
end;
class function Mapper.GetNumberDef(JSONObject: TJSONObject; PropertyName: string; DefaultValue: Extended)
: Extended;
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
raise Exception.Create('Property is not a Number Property');
end;
class function Mapper.GetPair(JSONObject: TJSONObject; PropertyName: string): TJSONPair;
var
pair: TJSONPair;
begin
if not Assigned(JSONObject) then
raise Exception.Create('JSONObject is nil');
pair := JSONObject.Get(PropertyName);
Result := pair;
end;
class function Mapper.GetProperty(Obj: TObject; const PropertyName: string): TValue;
var
Prop: TRttiProperty;
ARTTIType: TRttiType;
begin
ARTTIType := ctx.GetType(Obj.ClassType);
if not Assigned(ARTTIType) then
raise Exception.CreateFmt('Cannot get RTTI for type [%s]', [ARTTIType.ToString]);
Prop := ARTTIType.GetProperty(PropertyName);
if not Assigned(Prop) then
raise Exception.CreateFmt('Cannot get RTTI for property [%s.%s]', [ARTTIType.ToString, PropertyName]);
if Prop.IsReadable then
Result := Prop.GetValue(Obj)
else
raise Exception.CreateFmt('Property is not readable [%s.%s]', [ARTTIType.ToString, PropertyName]);
end;
class function Mapper.GetStringDef(JSONObject: TJSONObject; PropertyName, DefaultValue: string): string;
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
raise Exception.Create('Property is not a String Property');
end;
class function Mapper.HasAttribute<T>(ARTTIMember: TRttiNamedObject; out AAttribute: T): boolean;
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;
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;
class procedure Mapper.JSONArrayToDataSet(AJSONArray: TJSONArray; ADataSet: TDataSet;
AJSONArrayInstanceOwner: boolean);
begin
JSONArrayToDataSet(AJSONArray, ADataSet, TArray<string>.Create(), AJSONArrayInstanceOwner);
end;
class procedure Mapper.JSONArrayToDataSet(AJSONArray: TJSONArray; ADataSet: TDataSet;
AIgnoredFields: TArray<string>;
AJSONArrayInstanceOwner: boolean);
var
I: Integer;
begin
for I := 0 to AJSONArray.Size - 1 do
begin
ADataSet.Append;
Mapper.JSONObjectToDataSet(AJSONArray.Get(I) as TJSONObject, ADataSet, AIgnoredFields, false);
ADataSet.Post;
end;
if AJSONArrayInstanceOwner then
AJSONArray.Free;
end;
class procedure Mapper.JSONArrayToObjectList<T>(AList: TObjectList<T>; AJSONArray: TJSONArray;
AInstanceOwner, AOwnsChildObjects: boolean);
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;
class function Mapper.JSONArrayToObjectList<T>(AJSONArray: TJSONArray; AInstanceOwner: boolean;
AOwnsChildObjects: boolean): TObjectList<T>;
begin
Result := TObjectList<T>.Create(AOwnsChildObjects);
JSONArrayToObjectList<T>(Result, AJSONArray, AInstanceOwner, AOwnsChildObjects);
end;
class procedure Mapper.InternalJSONObjectToObject(ctx: TRTTIContext; AJSONObject: TJSONObject;
AObject: TObject);
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;
EncBytes: TBytes;
enc: TEncoding;
sw: TStreamWriter;
begin
jvalue := nil;
_type := ctx.GetType(AObject.ClassInfo);
_fields := _type.GetProperties;
for _field in _fields do
begin
if ((not _field.IsWritable) and (_field.PropertyType.TypeKind <> tkClass)) or
(HasAttribute<MapperTransientAttribute>(_field)) then
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
_field.SetValue(TObject(AObject), True)
else if jvalue is TJSONFalse then
_field.SetValue(TObject(AObject), false)
else
raise Exception.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.PropertyType.Handle, v);
_field.SetValue(TObject(AObject), v);
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
_field.SetValue(TObject(AObject), 0)
else
_field.SetValue(TObject(AObject), ISOStrToDateTime(jvalue.Value + ' 00:00:00'))
end
else if _field.PropertyType.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.PropertyType.QualifiedName = 'System.TTime' then
_field.SetValue(TObject(AObject), ISOStrToTime(jvalue.Value))
else
_field.SetValue(TObject(AObject), (jvalue as TJSONNumber).AsDouble)
end;
tkString, tkLString, tkWString, tkUString:
begin
_field.SetValue(TObject(AObject), jvalue.Value);
end;
tkRecord:
begin
if _field.PropertyType.QualifiedName = 'System.SysUtils.TTimeStamp' then
begin
n := jvalue as TJSONNumber;
_field.SetValue(TObject(AObject), TValue.From<TTimeStamp>(MSecsToTimeStamp(n.AsInt64)));
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
begin
if jvalue is TJSONString then
begin
SerStreamASString := TJSONString(jvalue).Value;
end
else
raise Exception.Create('Expected JSONString in ' + AJSONObject.Get(f).JsonString.Value);
if HasAttribute<MapperSerializeAsString>(_field) then
begin
// serialize the stream as a normal string...
TStream(o).Position := 0;
sw := TStreamWriter.Create(TStream(o));
try
sw.Write(SerStreamASString);
finally
sw.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
if jvalue is TJSONArray then
begin
Arr := TJSONArray(jvalue);
// look for the MapperItemsClassType on the property itself or on the property type
if Mapper.HasAttribute<MapperItemsClassType>(_field, attr) or
Mapper.HasAttribute<MapperItemsClassType>(_field.PropertyType, attr) then
begin
cref := attr.Value;
list := WrapAsList(o);
for I := 0 to Arr.Size - 1 do
begin
list.Add(Mapper.JSONObjectToObject(cref, Arr.Get(I) as TJSONObject));
end;
end;
end
else
raise Exception.Create('Cannot restore ' + f +
' because the related json property is not an array');
end
else // try to deserialize into the property... but the json MUST be an object
begin
if jvalue is TJSONObject then
begin
InternalJSONObjectToObject(ctx, TJSONObject(jvalue), o);
end
else
raise Exception.Create('Cannot deserialize property ' + _field.Name);
end;
end;
end;
end;
end;
end;
class function Mapper.JSONObjectToObject(Clazz: TClass; AJSONObject: TJSONObject): TObject;
var
AObject: TObject;
begin
AObject := TRTTIUtils.CreateObject(Clazz.QualifiedClassName);
try
InternalJSONObjectToObject(ctx, AJSONObject, AObject);
Result := AObject;
except
AObject.Free;
Result := nil;
end;
end;
class procedure Mapper.JSONObjectToDataSet(AJSONObject: TJSONObject; ADataSet: TDataSet;
AJSONObjectInstanceOwner: boolean);
begin
JSONObjectToDataSet(AJSONObject, ADataSet, TArray<string>.Create(), AJSONObjectInstanceOwner);
end;
class function Mapper.JSONObjectStringToObject<T>(const AJSONObjectString: string): T;
var
JObj: TJSONObject;
begin
JObj := TJSONObject.ParseJSONValue(AJSONObjectString) as TJSONObject;
try
Result := JSONObjectToObject<T>(JObj);
finally
JObj.Free;
end;
end;
class procedure Mapper.JSONObjectToDataSet(AJSONObject: TJSONObject; ADataSet: TDataSet;
AIgnoredFields: TArray<string>;
AJSONObjectInstanceOwner: boolean);
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;
key := LowerCase(ADataSet.Fields[I].FieldName);
v := nil;
jp := AJSONObject.Get(key);
if Assigned(jp) then
if not(jp.JsonValue is TJSONNull) then
v := AJSONObject.Get(key).JsonValue;
if not Assigned(v) then
begin
ADataSet.Fields[I].Clear;
Continue;
end;
case ADataSet.Fields[I].DataType of
TFieldType.ftInteger, TFieldType.ftAutoInc, TFieldType.ftSmallint, TFieldType.ftShortint:
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
ADataSet.Fields[I].AsDateTime := ISOStrToDate((v as TJSONString).Value);
end;
TFieldType.ftDateTime:
begin
ADataSet.Fields[I].AsDateTime := ISOStrToDateTime((v as TJSONString).Value);
end;
TFieldType.ftTimeStamp:
begin
ADataSet.Fields[I].AsSQLTimeStamp := StrToSQLTimeStamp((v as TJSONString).Value);
end;
TFieldType.ftCurrency:
begin
fs.DecimalSeparator := '.';
ADataSet.Fields[I].AsCurrency := StrToCurr((v as TJSONString).Value, fs);
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
SS := TStringStream.Create((v as TJSONString).Value, TEncoding.ASCII);
try
DecodeStream(SS, MS);
MS.Position := 0;
TBlobField(ADataSet.Fields[I]).LoadFromStream(MS);
finally
SS.Free;
end;
finally
MS.Free;
end;
end;
// else
// raise Exception.Create('Cannot find type for field ' + key);
end;
end;
if AJSONObjectInstanceOwner then
FreeAndNil(AJSONObject);
end;
class function Mapper.JSONObjectToObject(ClazzName: string; AJSONObject: TJSONObject): TObject;
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;
Result := nil;
end;
end
else
raise Exception.CreateFmt('Class not found [%s]', [ClazzName]);
end;
class function Mapper.JSONObjectToObject<T>(AJSONObject: TJSONObject): T;
begin
if not Assigned(AJSONObject) then
raise Exception.Create('JSONObject not assigned');
Result := Mapper.JSONObjectToObject(T.QualifiedClassName, AJSONObject) as T;
// Result := JSONObjectToObject(TObject.ClassInfo, AJSONObject);
end;
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
_field.SetValue(TObject(AObject), StrToDate(jvalue.Value))
else if _field.FieldType.QualifiedName = 'System.TDateTime' then
_field.SetValue(TObject(AObject), StrToDateTime(jvalue.Value))
else
_field.SetValue(TObject(AObject), (jvalue as TJSONNumber).AsDouble)
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;
class procedure Mapper.DataSetToObjectList<T>(ADataSet: TDataSet; AObjectList: TObjectList<T>;
ACloseDataSetAfterScroll: boolean);
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
// raise Exception.Create('Cannot find type for field ' + key);
// end;
// end;
// if ADataSetInstanceOwner then
// FreeAndNil(ADataSet);
// end;
{$IF Defined(VER260) or Defined(VER270)}
class procedure Mapper.ObjectToFDParameters(AFDParams: TFDParams; AObject: TObject; AParamPrefix: string);
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;
function KindToFieldType(AKind: TTypeKind): TFieldType;
begin
case AKind of
tkInteger:
Result := ftInteger;
tkFloat:
Result := ftFloat;
tkChar,
tkWChar,
tkString,
tkUString,
tkLString,
tkWString:
Result := ftWideString;
tkVariant:
Result := ftVariant;
tkArray:
Result := ftArray;
tkInterface:
Result := ftInterface;
tkInt64:
Result := ftLongWord;
else
Result := ftUnknown;
end;
end;
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
Map.Add(MapperColumnAttribute(obj_field_attr).FieldName.ToLower, obj_field);
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); // DmitryG - 2014-03-28
AFDParams[I].Value := fv.AsVariant;
end
else
begin
AFDParams[I].Clear;
end;
end;
finally
Map.Free;
end
end;
class function Mapper.InternalExecuteFDQuery(AQuery: TFDQuery; AObject: TObject;
WithResult: boolean): Int64;
begin
ObjectToFDParameters(AQuery.Params, AObject);
Result := 0;
if WithResult then
AQuery.Open
else
begin
AQuery.ExecSQL;
Result := AQuery.RowsAffected;
end;
end;
class function Mapper.ExecuteFDQueryNoResult(AQuery: TFDQuery; AObject: TObject): Int64;
begin
Result := InternalExecuteFDQuery(AQuery, AObject, false);
end;
class procedure Mapper.ExecuteFDQuery(AQuery: TFDQuery; AObject: TObject);
begin
InternalExecuteFDQuery(AQuery, AObject, True);
end;
{$ENDIF}
{$IF not Defined(VER270)}
class function Mapper.ExecuteSQLQueryNoResult(AQuery: TSQLQuery; AObject: TObject): Int64;
begin
Result := InternalExecuteSQLQuery(AQuery, AObject, false);
end;
class procedure Mapper.ExecuteSQLQuery(AQuery: TSQLQuery; AObject: TObject);
begin
InternalExecuteSQLQuery(AQuery, AObject, True);
end;
class function Mapper.ExecuteSQLQueryAsObjectList<T>(AQuery: TSQLQuery; AObject: TObject): TObjectList<T>;
begin
ExecuteSQLQuery(AQuery, AObject);
Result := TObjectList<T>.Create(True);
DataSetToObjectList<T>(AQuery, Result);
end;
{$IFEND}
{ MappedField }
constructor MapperColumnAttribute.Create(AFieldName: string; AIsPK: boolean);
begin
inherited Create;
FFieldName := AFieldName;
FIsPK := AIsPK;
end;
procedure MapperColumnAttribute.SetFieldName(const Value: string);
begin
FFieldName := Value;
end;
procedure MapperColumnAttribute.SetIsPK(const Value: boolean);
begin
FIsPK := Value;
end;
{ GridColumnProps }
constructor GridColumnProps.Create(ACaption: string; AAlign: TGridColumnAlign; AWidth: Integer);
begin
inherited Create;
FCaption := ACaption;
FAlign := AAlign;
{$IF CompilerVersion >= 23.0}
FWidth := System.Math.Max(AWidth, 50);
{$ELSE}
FWidth := Math.Max(AWidth, 50);
{$IFEND}
end;
function GridColumnProps.GetAlignAsString: string;
begin
case FAlign of
caLeft:
Result := 'left';
caCenter:
Result := 'center';
caRight:
Result := 'right';
end;
end;
{ JSONSer }
constructor MapperJSONSer.Create(AName: string);
begin
inherited Create;
FName := AName;
end;
function MapperJSONSer.GetName: string;
begin
Result := FName;
end;
{ JSONNaming }
constructor MapperJSONNaming.Create(JSONKeyCase: TJSONNameCase);
begin
inherited Create;
FJSONKeyCase := JSONKeyCase;
end;
function MapperJSONNaming.GetKeyCase: TJSONNameCase;
begin
Result := FJSONKeyCase;
end;
{ StringValueAttribute }
constructor StringValueAttribute.Create(Value: string);
begin
inherited Create;
FValue := Value;
end;
procedure StringValueAttribute.SetValue(const Value: string);
begin
FValue := Value;
end;
{ ItemsClassType }
constructor MapperItemsClassType.Create(Value: TClass);
begin
inherited Create;
FValue := Value;
end;
procedure MapperItemsClassType.SetValue(const Value: TClass);
begin
FValue := Value;
end;
{ TDataSetHelper }
function TDataSetHelper.AsJSONArray: TJSONArray;
var
JArr: TJSONArray;
begin
JArr := TJSONArray.Create;
try
if not Eof then
Mapper.DataSetToJSONArray(Self, JArr, false);
Result := JArr;
except
FreeAndNil(JArr);
raise;
end;
end;
function TDataSetHelper.AsJSONArrayString: string;
var
Arr: TJSONArray;
begin
Arr := AsJSONArray;
try
Result := Arr.ToString;
finally
Arr.Free;
end;
end;
function TDataSetHelper.AsJSONObject(AReturnNilIfEOF: boolean): TJSONObject;
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;
function TDataSetHelper.AsJSONObjectString(AReturnEmptyStringIfEOF: boolean): string;
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;
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;
function TDataSetHelper.AsObjectList<T>(CloseAfterScroll: boolean): TObjectList<T>;
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;
procedure TDataSetHelper.LoadFromJSONArray(AJSONArray: TJSONArray);
begin
Self.DisableControls;
try
Mapper.JSONArrayToDataSet(AJSONArray, Self, false);
finally
Self.EnableControls;
end;
end;
procedure TDataSetHelper.LoadFromJSONArray(AJSONArray: TJSONArray; AIgnoredFields: TArray<string>);
begin
Self.DisableControls;
try
Mapper.JSONArrayToDataSet(AJSONArray, Self, AIgnoredFields, false);
finally
Self.EnableControls;
end;
end;
procedure TDataSetHelper.AppendFromJSONArrayString(AJSONArrayString: string;
AIgnoredFields: TArray<string>);
var
JV: TJSONValue;
begin
JV := TJSONObject.ParseJSONValue(AJSONArrayString);
try
if JV is TJSONArray then
LoadFromJSONArray(TJSONArray(JV), AIgnoredFields)
else
raise Exception.Create('Extected JSONArray in LoadFromJSONArrayString');
finally
JV.Free;
end;
end;
procedure TDataSetHelper.AppendFromJSONArrayString(AJSONArrayString: string);
begin
AppendFromJSONArrayString(AJSONArrayString, TArray<string>.Create());
end;
procedure TDataSetHelper.LoadFromJSONObject(AJSONObject: TJSONObject; AIgnoredFields: TArray<string>);
begin
Mapper.JSONObjectToDataSet(AJSONObject, Self, AIgnoredFields, false);
end;
procedure TDataSetHelper.LoadFromJSONObjectString(AJSONObjectString: string;
AIgnoredFields: TArray<string>);
var
JV: TJSONValue;
begin
JV := TJSONObject.ParseJSONValue(AJSONObjectString);
try
if JV is TJSONObject then
LoadFromJSONObject(TJSONObject(JV), AIgnoredFields)
else
raise Exception.Create('Extected JSONObject in LoadFromJSONObjectString');
finally
JV.Free;
end;
end;
procedure TDataSetHelper.LoadFromJSONObject(AJSONObject: TJSONObject);
begin
LoadFromJSONObject(AJSONObject, TArray<string>.Create());
end;
procedure TDataSetHelper.LoadFromJSONObjectString(AJSONObjectString: string);
begin
LoadFromJSONObjectString(AJSONObjectString, TArray<string>.Create());
end;
end.