Repository: ezequieljuliano/DataSetConverter4Delphi Branch: master Commit: ecf36d8878db Files: 12 Total size: 89.6 KB Directory structure: gitextract_k5l2wodl/ ├── .gitignore ├── Clean.bat ├── LICENSE ├── README.md ├── src/ │ ├── DataSetConverter4D.Helper.pas │ ├── DataSetConverter4D.Impl.pas │ ├── DataSetConverter4D.Util.pas │ └── DataSetConverter4D.pas └── unittest/ ├── DataSetConverter4D.UnitTest.pas ├── DataSetConverter4DTests.dpr ├── DataSetConverter4DTests.dproj └── DataSetConverter4DTests.res ================================================ FILE CONTENTS ================================================ ================================================ FILE: .gitignore ================================================ /src/__history /unittest/Win32/Debug /unittest/__history ================================================ FILE: Clean.bat ================================================ @echo off echo Cleaning... del /f /q /s *.bak del /f /q /s *.dcu del /f /q /s *.ddp del /f /q /s *.~* del /f /q /s *.local del /f /q /s *.identcache del /f /q /s *.tvsconfig del /f /q /s *.stat del /f /q /s *.bpl del /f /q /s *.cbk del /f /q /s *.dcp del /f /q /s *.dsk del /f /q /s *.o del /f /q /s *.rsm del /f /q /s *.skincfg del /f /q /s *.log del /f /q /s *.xml del /f /q /s *.dof del /f /q /s *.mpb for /f "tokens=* delims=" %%i in ('dir /s /b /a:d __history') do ( rd /s /q "%%i" ) for /f "tokens=* delims=" %%i in ('dir /s /b /a:d __recovery') do ( rd /s /q "%%i" ) for /f "tokens=* delims=" %%i in ('dir /s /b /a:d Win32') do ( rd /s /q "%%i" ) for /f "tokens=* delims=" %%i in ('dir /s /b /a:d Win64') do ( rd /s /q "%%i" ) if "%1"=="" goto :eof pause ================================================ FILE: LICENSE ================================================ Apache License Version 2.0, January 2004 http://www.apache.org/licenses/ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 1. Definitions. "License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document. "Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License. "Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. "You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License. "Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files. "Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types. "Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below). "Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof. "Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution." "Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work. 2. Grant of Copyright License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form. 3. Grant of Patent License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed. 4. Redistribution. You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions: (a) You must give any other recipients of the Work or Derivative Works a copy of this License; and (b) You must cause any modified files to carry prominent notices stating that You changed the files; and (c) You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and (d) If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License. You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License. 5. Submission of Contributions. Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions. 6. Trademarks. This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file. 7. Disclaimer of Warranty. Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License. 8. Limitation of Liability. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages. 9. Accepting Warranty or Additional Liability. While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability. END OF TERMS AND CONDITIONS APPENDIX: How to apply the Apache License to your work. To apply the Apache License to your work, attach the following boilerplate notice, with the fields enclosed by brackets "{}" replaced with your own identifying information. (Don't include the brackets!) The text should be enclosed in the appropriate comment syntax for the file format. We also recommend that a file or class name and description of purpose be included on the same "printed page" as the copyright notice for easier identification within third-party archives. Copyright {yyyy} {name of copyright owner} 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. ================================================ FILE: README.md ================================================ DataSet Converter For Delphi ================================= The DataSetConverter4D it is an API to convert JSON objects for DataSet's and also doing reverse process, ie, converting DataSet's in JSON. Works with the TDataSet, and TJSONObject TJSONArray classes. To use this API you must add the "DataSetConverter4D\src" Path in your Delphi or on your project. Convert DataSet to JSON ======================== First you must have your DataSet and its Fields created. uses DataSetConverter4D, DataSetConverter4D.Impl; var ja: TJSONArray; jo: TJSONObject; begin fCdsCustomers.DataSetField := nil; fCdsCustomers.CreateDataSet; fCdsCustomers.Append; fCdsCustomers.FieldByName('Id').AsInteger := 1; fCdsCustomers.FieldByName('Name').AsString := 'Customers 1'; fCdsCustomers.FieldByName('Birth').AsDateTime := StrToDateTime('22/01/2014 14:05:03'); fCdsCustomers.Post; fCdsCustomers.Append; fCdsCustomers.FieldByName('Id').AsInteger := 2; fCdsCustomers.FieldByName('Name').AsString := 'Customers 2'; fCdsCustomers.FieldByName('Birth').AsDateTime := StrToDateTime('22/01/2014 14:05:03'); fCdsCustomers.Post; //Convert all records ja := TConverter.New.DataSet(fCdsCustomers).AsJSONArray; //Convert current record jo := TConverter.New.DataSet.Source(fCdsCustomers).AsJSONObject; ja.Free; jo.Free; end; Convert JSON to DataSet ======================= First you must have your DataSet and its Fields created. uses DataSetConverter4D, DataSetConverter4D.Impl; JSON_ARRAY = [{ "Id": 1, "Name": "Customers 1", "Birth": "2014-01-22 14:05:03" }, { "Id": 2, "Name": "Customers 2", "Birth": "2014-01-22 14:05:03" }] JSON_OBJECT = { "Id": 2, "Name": "Customers 2", "Birth": "2014-01-22 14:05:03" } var ja: TJSONArray; jo: TJSONObject; begin fCdsCustomers.CreateDataSet; ja := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(JSON_ARRAY), 0) as TJSONArray; jo := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(JSON_OBJECT), 0) as TJSONObject; //Convert one record TConverter.New.JSON(jo).ToDataSet(fCdsCustomers); fCdsCustomers.EmptyDataSet; //Convert all records TConverter.New.JSON.Source(ja).ToDataSet(fCdsCustomers); ja.Free; jo.Free; end; Using DataSetConverter4D ============================ Using this library will is very simple, you simply add the Search Path of your IDE or your project the following directories: - DataSetConverter4Delphi\src\ Analyze the unit tests they will assist you. ================================================ FILE: src/DataSetConverter4D.Helper.pas ================================================ unit DataSetConverter4D.Helper; interface uses System.JSON, Data.DB, DataSetConverter4D, DataSetConverter4D.Impl; type TDataSetConverterHelper = class helper for TDataSet public function AsJSONObject: TJSONObject; function AsJSONArray: TJSONArray; function AsJSONObjectString: string; function AsJSONArrayString: string; procedure FromJSONObject(json: TJSONObject); procedure FromJSONArray(json: TJSONArray); procedure RecordFromJSONObject(json: TJSONObject); end; implementation { TDataSetConverterHelper } function TDataSetConverterHelper.AsJSONArray: TJSONArray; begin Result := TConverter.New.DataSet(Self).AsJSONArray; end; function TDataSetConverterHelper.AsJSONArrayString: string; var ja: TJSONArray; begin ja := Self.AsJSONArray; try Result := ja.ToString; finally ja.Free; end; end; function TDataSetConverterHelper.AsJSONObject: TJSONObject; begin Result := TConverter.New.DataSet(Self).AsJSONObject; end; function TDataSetConverterHelper.AsJSONObjectString: string; var jo: TJSONObject; begin jo := Self.AsJSONObject; try Result := jo.ToString; finally jo.Free; end; end; procedure TDataSetConverterHelper.FromJSONArray(json: TJSONArray); begin TConverter.New.JSON(json).ToDataSet(Self); end; procedure TDataSetConverterHelper.FromJSONObject(json: TJSONObject); begin TConverter.New.JSON(json).ToDataSet(Self); end; procedure TDataSetConverterHelper.RecordFromJSONObject(json: TJSONObject); begin TConverter.New.JSON(json).ToRecord(Self); end; end. ================================================ FILE: src/DataSetConverter4D.Impl.pas ================================================ unit DataSetConverter4D.Impl; interface uses System.SysUtils, System.Classes, System.JSON, System.DateUtils, System.NetEncoding, System.TypInfo, Data.SqlTimSt, Data.FmtBcd, Data.DB, DataSetConverter4D, DataSetConverter4D.Util; type TDataSetConverter = class(TInterfacedObject, IDataSetConverter) private fDataSet: TDataSet; fOwns: Boolean; procedure ClearDataSet; protected function GetDataSet: TDataSet; function DataSetToJSONObject(dataSet: TDataSet): TJSONObject; function DataSetToJSONArray(dataSet: TDataSet): TJSONArray; function StructureToJSON(dataSet: TDataSet): TJSONArray; function Source(dataSet: TDataSet): IDataSetConverter; overload; function Source(dataSet: TDataSet; const owns: Boolean): IDataSetConverter; overload; function AsJSONObject: TJSONObject; function AsJSONArray: TJSONArray; function AsJSONStructure: TJSONArray; public constructor Create; destructor Destroy; override; class function New: IDataSetConverter; static; end; TJSONConverter = class(TInterfacedObject, IJSONConverter) private fJSONObject: TJSONObject; fJSONArray: TJSONArray; fOwns: Boolean; fIsRecord: Boolean; procedure ClearJSONs; protected procedure JSONObjectToDataSet(json: TJSONObject; dataSet: TDataSet; const recNo: Integer; const isRecord: Boolean); procedure JSONArrayToDataSet(json: TJSONArray; dataSet: TDataSet; const isRecord: Boolean); procedure JSONToStructure(json: TJSONArray; dataSet: TDataSet); function Source(json: TJSONObject): IJSONConverter; overload; function Source(json: TJSONObject; const owns: Boolean): IJSONConverter; overload; function Source(json: TJSONArray): IJSONConverter; overload; function Source(json: TJSONArray; const owns: Boolean): IJSONConverter; overload; procedure ToDataSet(dataSet: TDataSet); procedure ToRecord(dataSet: TDataSet); procedure ToStructure(dataSet: TDataSet); public constructor Create; destructor Destroy; override; class function New: IJSONConverter; static; end; TConverter = class(TInterfacedObject, IConverter) private { private declarations } protected function DataSet: IDataSetConverter; overload; function DataSet(dataSet: TDataSet): IDataSetConverter; overload; function DataSet(dataSet: TDataSet; const owns: Boolean): IDataSetConverter; overload; function JSON: IJSONConverter; overload; function JSON(json: TJSONObject): IJSONConverter; overload; function JSON(json: TJSONObject; const owns: Boolean): IJSONConverter; overload; function JSON(json: TJSONArray): IJSONConverter; overload; function JSON(json: TJSONArray; const owns: Boolean): IJSONConverter; overload; public class function New: IConverter; static; end; implementation { TDataSetConverter } function TDataSetConverter.AsJSONArray: TJSONArray; begin Result := DataSetToJSONArray(GetDataSet); end; function TDataSetConverter.AsJSONObject: TJSONObject; begin Result := DataSetToJSONObject(GetDataSet); end; constructor TDataSetConverter.Create; begin inherited Create; fDataSet := nil; fOwns := False; end; function TDataSetConverter.DataSetToJSONArray(dataSet: TDataSet): TJSONArray; var bookMark: TBookmark; begin Result := TJSONArray.Create; if Assigned(dataSet) and (not dataSet.IsEmpty) then try bookMark := dataSet.Bookmark; dataSet.First; while not dataSet.Eof do begin Result.AddElement(DataSetToJSONObject(dataSet)); dataSet.Next; end; finally if dataSet.BookmarkValid(bookMark) then dataSet.GotoBookmark(bookMark); dataSet.FreeBookmark(bookMark); end; end; function TDataSetConverter.DataSetToJSONObject(dataSet: TDataSet): TJSONObject; var i: Integer; key: string; timeStamp: TSQLTimeStamp; nestedDataSet: TDataSet; dft: TDataSetFieldType; bft: TBooleanFieldType; ms: TMemoryStream; ss: TStringStream; fs: TFormatSettings; begin Result := TJSONObject.Create; if Assigned(dataSet) and (not dataSet.IsEmpty) then begin fs.DecimalSeparator := '.'; for i := 0 to Pred(dataSet.FieldCount) do begin if dataSet.Fields[i].Visible then begin key := dataSet.Fields[i].FieldName; case dataSet.Fields[i].DataType of TFieldType.ftBoolean: begin bft := BooleanFieldToType(TBooleanField(dataSet.Fields[i])); case bft of bfUnknown, bfBoolean: Result.AddPair(key, BooleanToJSON(dataSet.Fields[i].AsBoolean)); bfInteger: Result.AddPair(key, TJSONNumber.Create(dataSet.Fields[i].AsInteger)); end; end; TFieldType.ftInteger, TFieldType.ftSmallint, TFieldType.ftShortint: Result.AddPair(key, TJSONNumber.Create(dataSet.Fields[i].AsInteger)); TFieldType.ftLongWord, TFieldType.ftAutoInc: begin if not dataSet.Fields[i].IsNull then Result.AddPair(key, TJSONNumber.Create(dataSet.Fields[i].AsWideString)) else Result.AddPair(key, TJSONNull.Create); end; TFieldType.ftLargeint: Result.AddPair(key, TJSONNumber.Create(dataSet.Fields[i].AsLargeInt)); TFieldType.ftSingle, TFieldType.ftFloat: Result.AddPair(key, TJSONNumber.Create(FloatToStr(dataSet.Fields[i].AsFloat, fs))); ftString, ftWideString, ftMemo, ftWideMemo: begin if not dataSet.Fields[i].IsNull then Result.AddPair(key, TJSONString.Create(dataSet.Fields[i].AsWideString)) else Result.AddPair(key, TJSONNull.Create); end; TFieldType.ftDate: begin if not dataSet.Fields[i].IsNull then Result.AddPair(key, TJSONString.Create(DateToISODate(dataSet.Fields[i].AsDateTime))) else Result.AddPair(key, TJSONNull.Create); end; TFieldType.ftTimeStamp, TFieldType.ftDateTime: begin if not dataSet.Fields[i].IsNull then Result.AddPair(key, TJSONString.Create(DateTimeToISOTimeStamp(dataSet.Fields[i].AsDateTime))) else Result.AddPair(key, TJSONNull.Create); end; TFieldType.ftTime: begin if not dataSet.Fields[i].IsNull then begin timeStamp := dataSet.Fields[i].AsSQLTimeStamp; Result.AddPair(key, TJSONString.Create(SQLTimeStampToStr('hh:nn:ss', timeStamp))); end else Result.AddPair(key, TJSONNull.Create); end; TFieldType.ftCurrency: begin if not dataSet.Fields[i].IsNull then Result.AddPair(key, TJSONString.Create(FormatCurr('0.00##', dataSet.Fields[i].AsCurrency))) else Result.AddPair(key, TJSONNull.Create); end; TFieldType.ftFMTBcd, TFieldType.ftBCD: begin if not dataSet.Fields[i].IsNull then Result.AddPair(key, TJSONNumber.Create(BcdToStr(dataSet.Fields[i].AsBcd, fs))) else Result.AddPair(key, TJSONNull.Create); end; TFieldType.ftDataSet: begin dft := DataSetFieldToType(TDataSetField(dataSet.Fields[i])); nestedDataSet := TDataSetField(dataSet.Fields[i]).NestedDataSet; case dft of dfJSONObject: Result.AddPair(key, DataSetToJSONObject(nestedDataSet)); dfJSONArray: Result.AddPair(key, DataSetToJSONArray(nestedDataSet)); end; end; TFieldType.ftGraphic, TFieldType.ftBlob, TFieldType.ftStream: begin ms := TMemoryStream.Create; try TBlobField(dataSet.Fields[I]).SaveToStream(ms); ms.Position := 0; ss := TStringStream.Create; try TNetEncoding.Base64.Encode(ms, ss); Result.AddPair(key, TJSONString.Create(ss.DataString)); finally ss.Free; end; finally ms.Free; end; end; TFieldType.ftGuid: begin Result.AddPair(key, DataSet.Fields[I].AsString); end; else raise EDataSetConverterException.CreateFmt('Cannot find type for field "%s"', [key]); end; end; end; end; end; destructor TDataSetConverter.Destroy; begin ClearDataSet; inherited Destroy; end; procedure TDataSetConverter.ClearDataSet; begin if fOwns then if Assigned(fDataSet) then fDataSet.Free; fDataSet := nil; end; function TDataSetConverter.GetDataSet: TDataSet; begin if (fDataSet = nil) then raise EDataSetConverterException.Create('DataSet Uninformed.'); Result := fDataSet; end; class function TDataSetConverter.New: IDataSetConverter; begin Result := TDataSetConverter.Create; end; function TDataSetConverter.Source(dataSet: TDataSet; const owns: Boolean): IDataSetConverter; begin ClearDataSet; fDataSet := dataSet; fOwns := owns; Result := Self; end; function TDataSetConverter.AsJSONStructure: TJSONArray; begin Result := StructureToJSON(GetDataSet); end; function TDataSetConverter.StructureToJSON(dataSet: TDataSet): TJSONArray; var i: Integer; jo: TJSONObject; begin Result := TJSONArray.Create; if Assigned(dataSet) and (dataSet.FieldCount > 0) then begin for i := 0 to Pred(dataSet.FieldCount) do begin jo := TJSONObject.Create; jo.AddPair('FieldName', TJSONString.Create(dataSet.Fields[i].FieldName)); jo.AddPair('DataType', TJSONString.Create(GetEnumName(TypeInfo(TFieldType), Integer(dataSet.Fields[i].DataType)))); jo.AddPair('Size', TJSONNumber.Create(dataSet.Fields[i].Size)); Result.AddElement(jo); end; end; end; function TDataSetConverter.Source(dataSet: TDataSet): IDataSetConverter; begin Result := Source(dataSet, False); end; { TJSONConverter } constructor TJSONConverter.Create; begin inherited Create; fJSONObject := nil; fJSONArray := nil; fOwns := False; fIsRecord := False; end; destructor TJSONConverter.Destroy; begin ClearJSONs; inherited Destroy; end; procedure TJSONConverter.ClearJSONs; begin if fOwns then begin if Assigned(fJSONObject) then fJSONObject.Free; if Assigned(fJSONArray) then fJSONArray.Free; end; fJSONObject := nil; fJSONArray := nil; end; procedure TJSONConverter.JSONArrayToDataSet(json: TJSONArray; dataSet: TDataSet; const isRecord: Boolean); var jv: TJSONValue; recNo: Integer; begin if Assigned(json) and Assigned(dataSet) then begin recNo := 0; for jv in json do begin if not dataSet.IsEmpty then Inc(recNo); if (jv is TJSONArray) then JSONArrayToDataSet(jv as TJSONArray, dataSet, isRecord) else JSONObjectToDataSet(jv as TJSONObject, dataSet, recNo, isRecord); end; end; end; procedure TJSONConverter.JSONObjectToDataSet(json: TJSONObject; dataSet: TDataSet; const recNo: Integer; const isRecord: Boolean); var field: TField; jv: TJSONValue; dft: TDataSetFieldType; nestedDataSet: TDataSet; booleanValue: Boolean; ss: TStringStream; sm: TMemoryStream; begin if Assigned(json) and Assigned(dataSet) then begin if (recNo > 0) and (dataSet.RecordCount > 1) then dataSet.RecNo := recNo; if isRecord then dataSet.Edit else dataSet.Append; for field in dataSet.Fields do begin if Assigned(json.Get(field.FieldName)) then jv := json.Get(field.FieldName).JsonValue else Continue; if field.ReadOnly then Continue; case field.DataType of TFieldType.ftBoolean: begin if jv is TJSONNull then field.Clear else if jv.TryGetValue(booleanValue) then field.AsBoolean := booleanValue; end; TFieldType.ftInteger, TFieldType.ftSmallint, TFieldType.ftShortint, TFieldType.ftLongWord: begin if jv is TJSONNull then field.Clear else field.AsInteger := StrToIntDef(jv.Value, 0); end; TFieldType.ftLargeint, TFieldType.ftAutoInc: begin if jv is TJSONNull then field.Clear else field.AsLargeInt := StrToInt64Def(jv.Value, 0); end; TFieldType.ftCurrency: begin if jv is TJSONNull then field.Clear else field.AsCurrency := StrToCurr(jv.Value); end; TFieldType.ftFloat, TFieldType.ftFMTBcd, TFieldType.ftBCD, TFieldType.ftSingle: begin if jv is TJSONNull then field.Clear else field.AsFloat := jv.GetValue; end; ftString, ftWideString, ftMemo, ftWideMemo: begin if jv is TJSONNull then field.Clear else field.AsString := jv.Value; end; TFieldType.ftDate: begin if jv is TJSONNull then field.Clear else field.AsDateTime := ISODateToDate(jv.Value); end; TFieldType.ftTimeStamp, TFieldType.ftDateTime: begin if jv is TJSONNull then field.Clear else field.AsDateTime := ISOTimeStampToDateTime(jv.Value); end; TFieldType.ftTime: begin if jv is TJSONNull then field.Clear else field.AsDateTime := ISOTimeToTime(jv.Value); end; TFieldType.ftDataSet: begin dft := DataSetFieldToType(TDataSetField(field)); nestedDataSet := TDataSetField(field).NestedDataSet; case dft of dfJSONObject: JSONObjectToDataSet(jv as TJSONObject, nestedDataSet, 0, True); dfJSONArray: begin nestedDataSet.First; while not nestedDataSet.Eof do nestedDataSet.Delete; JSONArrayToDataSet(jv as TJSONArray, nestedDataSet, False); end; end; end; TFieldType.ftGraphic, TFieldType.ftBlob, TFieldType.ftStream: begin if jv is TJSONNull then field.Clear else begin ss := TStringStream.Create((Jv as TJSONString).Value); try ss.Position := 0; sm := TMemoryStream.Create; try TNetEncoding.Base64.Decode(ss, sm); TBlobField(Field).LoadFromStream(sm); finally sm.Free; end; finally ss.Free; end; end; end; else raise EDataSetConverterException.CreateFmt('Cannot find type for field "%s"', [field.FieldName]); end; end; dataSet.Post; end; end; procedure TJSONConverter.JSONToStructure(json: TJSONArray; dataSet: TDataSet); var jv: TJSONValue; begin if Assigned(json) and Assigned(dataSet) then begin if dataSet.Active then raise EDataSetConverterException.Create('The DataSet can not be active.'); if (dataSet.FieldCount > 0) then raise EDataSetConverterException.Create('The DataSet can not have predefined Fields.'); for jv in json do begin NewDataSetField(dataSet, TFieldType(GetEnumValue(TypeInfo(TFieldType), (jv as TJSONObject).GetValue('DataType').Value)), (jv as TJSONObject).GetValue('FieldName').Value, StrToIntDef((jv as TJSONObject).GetValue('Size').Value, 0) ); end; end; end; class function TJSONConverter.New: IJSONConverter; begin Result := TJSONConverter.Create; end; function TJSONConverter.Source(json: TJSONObject; const owns: Boolean): IJSONConverter; begin ClearJSONs; fJSONObject := json; fOwns := owns; Result := Self; end; function TJSONConverter.Source(json: TJSONObject): IJSONConverter; begin Result := Source(json, false); end; function TJSONConverter.Source(json: TJSONArray; const owns: Boolean): IJSONConverter; begin ClearJSONs; fJSONArray := json; fOwns := owns; Result := Self; end; function TJSONConverter.Source(json: TJSONArray): IJSONConverter; begin Result := Source(json, false); end; procedure TJSONConverter.ToDataSet(dataSet: TDataSet); begin if Assigned(fJSONObject) then JSONObjectToDataSet(fJSONObject, dataSet, 0, fIsRecord) else if Assigned(fJSONArray) then JSONArrayToDataSet(fJSONArray, dataSet, fIsRecord) else raise EDataSetConverterException.Create('JSON Value Uninformed.'); end; procedure TJSONConverter.ToRecord(dataSet: TDataSet); begin fIsRecord := True; try ToDataSet(dataSet); finally fIsRecord := False; end; end; procedure TJSONConverter.ToStructure(dataSet: TDataSet); begin if Assigned(fJSONObject) then raise EDataSetConverterException.Create('To convert a structure only JSONArray is allowed.') else if Assigned(fJSONArray) then JSONToStructure(fJSONArray, dataSet) else raise EDataSetConverterException.Create('JSON Value Uninformed.'); end; { TConverter } function TConverter.DataSet: IDataSetConverter; begin Result := TDataSetConverter.New; end; function TConverter.DataSet(dataSet: TDataSet): IDataSetConverter; begin Result := Self.DataSet.Source(dataSet); end; function TConverter.DataSet(dataSet: TDataSet; const owns: Boolean): IDataSetConverter; begin Result := Self.DataSet.Source(dataSet, owns); end; function TConverter.JSON(json: TJSONObject; const owns: Boolean): IJSONConverter; begin Result := Self.JSON.Source(json, owns); end; function TConverter.JSON(json: TJSONObject): IJSONConverter; begin Result := Self.JSON.Source(json); end; function TConverter.JSON: IJSONConverter; begin Result := TJSONConverter.New; end; function TConverter.JSON(json: TJSONArray; const owns: Boolean): IJSONConverter; begin Result := Self.JSON.Source(json, owns); end; function TConverter.JSON(json: TJSONArray): IJSONConverter; begin Result := Self.JSON.Source(json); end; class function TConverter.New: IConverter; begin Result := TConverter.Create; end; end. ================================================ FILE: src/DataSetConverter4D.Util.pas ================================================ unit DataSetConverter4D.Util; interface uses System.SysUtils, System.DateUtils, System.JSON, Data.DB, DataSetConverter4D; function DateTimeToISOTimeStamp(const dateTime: TDateTime): string; function DateToISODate(const date: TDateTime): string; function TimeToISOTime(const time: TTime): string; function ISOTimeStampToDateTime(const dateTime: string): TDateTime; function ISODateToDate(const date: string): TDate; function ISOTimeToTime(const time: string): TTime; function NewDataSetField(dataSet: TDataSet; const fieldType: TFieldType; const fieldName: string; const size: Integer = 0; const origin: string = ''; const displaylabel: string = ''): TField; function BooleanToJSON(const value: Boolean): TJSONValue; function BooleanFieldToType(const booleanField: TBooleanField): TBooleanFieldType; function DataSetFieldToType(const dataSetField: TDataSetField): TDataSetFieldType; function MakeValidIdent(const s: string): string; implementation function DateTimeToISOTimeStamp(const dateTime: TDateTime): string; var fs: TFormatSettings; begin fs.TimeSeparator := ':'; Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', dateTime, fs); end; function DateToISODate(const date: TDateTime): string; begin Result := FormatDateTime('YYYY-MM-DD', date); end; function TimeToISOTime(const time: TTime): string; var fs: TFormatSettings; begin fs.TimeSeparator := ':'; Result := FormatDateTime('hh:nn:ss', time, fs); end; function ISOTimeStampToDateTime(const dateTime: string): TDateTime; begin Result := EncodeDateTime(StrToInt(Copy(dateTime, 1, 4)), StrToInt(Copy(dateTime, 6, 2)), StrToInt(Copy(dateTime, 9, 2)), StrToInt(Copy(dateTime, 12, 2)), StrToInt(Copy(dateTime, 15, 2)), StrToInt(Copy(dateTime, 18, 2)), 0); end; function ISODateToDate(const date: string): TDate; begin Result := EncodeDate(StrToInt(Copy(date, 1, 4)), StrToInt(Copy(date, 6, 2)), StrToInt(Copy(date, 9, 2))); end; function ISOTimeToTime(const time: string): TTime; begin Result := EncodeTime(StrToInt(Copy(time, 1, 2)), StrToInt(Copy(time, 4, 2)), StrToInt(Copy(time, 7, 2)), 0); end; function NewDataSetField(dataSet: TDataSet; const fieldType: TFieldType; const fieldName: string; const size: Integer = 0; const origin: string = ''; const displaylabel: string = ''): TField; begin Result := DefaultFieldClasses[fieldType].Create(dataSet); Result.FieldName := fieldName; if (Result.FieldName = '') then Result.FieldName := 'Field' + IntToStr(dataSet.FieldCount + 1); Result.FieldKind := fkData; Result.DataSet := dataSet; Result.Name := MakeValidIdent(dataSet.Name + Result.FieldName); Result.Size := size; Result.Origin := origin; if not(displaylabel.IsEmpty) then Result.DisplayLabel := displaylabel; if (fieldType in [ftString, ftWideString]) and (size <= 0) then raise EDataSetConverterException.CreateFmt('Size not defined for field "%s".', [fieldName]); end; function BooleanToJSON(const value: Boolean): TJSONValue; begin if value then Result := TJSONTrue.Create else Result := TJSONFalse.Create; end; function BooleanFieldToType(const booleanField: TBooleanField): TBooleanFieldType; const DESC_BOOLEAN_FIELD_TYPE: array [TBooleanFieldType] of string = ('Unknown', 'Boolean', 'Integer'); var index: Integer; origin: string; begin Result := bfUnknown; origin := Trim(booleanField.Origin); for index := Ord(Low(TBooleanFieldType)) to Ord(High(TBooleanFieldType)) do if (LowerCase(DESC_BOOLEAN_FIELD_TYPE[TBooleanFieldType(index)]) = LowerCase(origin)) then Exit(TBooleanFieldType(index)); end; function DataSetFieldToType(const dataSetField: TDataSetField): TDataSetFieldType; const DESC_DATASET_FIELD_TYPE: array [TDataSetFieldType] of string = ('Unknown', 'JSONObject', 'JSONArray'); var index: Integer; origin: string; begin Result := dfUnknown; origin := Trim(dataSetField.Origin); for index := Ord(Low(TDataSetFieldType)) to Ord(High(TDataSetFieldType)) do if (LowerCase(DESC_DATASET_FIELD_TYPE[TDataSetFieldType(index)]) = LowerCase(origin)) then Exit(TDataSetFieldType(index)); end; function MakeValidIdent(const s: string): string; var x: Integer; c: Char; begin SetLength(Result, Length(s)); x := 0; for c in s do begin if CharInSet(c, ['A'..'Z', 'a'..'z', '0'..'9', '_']) then begin Inc(x); Result[x] := c; end; end; SetLength(Result, x); if x = 0 then Result := '_' else if CharInSet(Result[1], ['0'..'9']) then Result := '_' + Result; end; end. ================================================ FILE: src/DataSetConverter4D.pas ================================================ unit DataSetConverter4D; interface uses System.SysUtils, System.JSON, Data.DB; type EDataSetConverterException = class(Exception); TBooleanFieldType = (bfUnknown, bfBoolean, bfInteger); TDataSetFieldType = (dfUnknown, dfJSONObject, dfJSONArray); IDataSetConverter = interface ['{8D995E50-A1DC-4426-A603-762E1387E691}'] function Source(dataSet: TDataSet): IDataSetConverter; overload; function Source(dataSet: TDataSet; const owns: Boolean): IDataSetConverter; overload; function AsJSONObject: TJSONObject; function AsJSONArray: TJSONArray; function AsJSONStructure: TJSONArray; end; IJSONConverter = interface ['{1B020937-438E-483F-ACB1-44B8B2707500}'] function Source(json: TJSONObject): IJSONConverter; overload; function Source(json: TJSONObject; const owns: Boolean): IJSONConverter; overload; function Source(json: TJSONArray): IJSONConverter; overload; function Source(json: TJSONArray; const owns: Boolean): IJSONConverter; overload; procedure ToDataSet(dataSet: TDataSet); procedure ToRecord(dataSet: TDataSet); procedure ToStructure(dataSet: TDataSet); end; IConverter = interface ['{52A3BE1E-5116-4A9A-A7B6-3AF0FCEB1D8E}'] function DataSet: IDataSetConverter; overload; function DataSet(dataSet: TDataSet): IDataSetConverter; overload; function DataSet(dataSet: TDataSet; const owns: Boolean): IDataSetConverter; overload; function JSON: IJSONConverter; overload; function JSON(json: TJSONObject): IJSONConverter; overload; function JSON(json: TJSONObject; const owns: Boolean): IJSONConverter; overload; function JSON(json: TJSONArray): IJSONConverter; overload; function JSON(json: TJSONArray; const owns: Boolean): IJSONConverter; overload; end; implementation end. ================================================ FILE: unittest/DataSetConverter4D.UnitTest.pas ================================================ unit DataSetConverter4D.UnitTest; interface uses TestFramework, System.Classes, System.SysUtils, System.JSON, Datasnap.DBClient, DataSetConverter4D, DataSetConverter4D.Impl, DataSetConverter4D.Util, DataSetConverter4D.Helper, Data.DB; type TTestsDataSetConverter = class(TTestCase) private fCdsCustomers: TClientDataSet; fCdsSales: TClientDataSet; fCdsProducts: TClientDataSet; protected procedure SetUp; override; procedure TearDown; override; published procedure TestConvertDataSetToJSONBasic; procedure TestConvertDataSetToJSONComplex; procedure TestConvertJSONToDataSetBasic; procedure TestConvertJSONToDataSetComplex; procedure TestConvertJSONToDataSetOwnsObject; procedure TestConvertDataSetToJSONBasicHelper; procedure TestJSONConverter; procedure Test_Inssue_2; procedure Test_Inssue_7; procedure TestBlobAndText; procedure TestConvertStructureToJSON; procedure TestConvertJSONToStructure; procedure TestConvertDataSetToJSONBasicInvisibleFields; procedure TestConvertJsonToFDMemTable_PR_32; end; implementation { TTestsDataSetJSONConverter } procedure TTestsDataSetConverter.SetUp; begin inherited; FormatSettings.LongDateFormat := 'dd/mm/yyyy hh:nn:ss'; FormatSettings.DateSeparator := '/'; fCdsSales := TClientDataSet.Create(nil); NewDataSetField(fCdsSales, ftInteger, 'Id'); NewDataSetField(fCdsSales, ftString, 'Description', 100); NewDataSetField(fCdsSales, ftDate, 'Date'); NewDataSetField(fCdsSales, ftTime, 'Time'); NewDataSetField(fCdsSales, ftDataSet, 'Customers', 0, 'JSONObject'); NewDataSetField(fCdsSales, ftDataSet, 'Products', 0, 'JSONArray'); fCdsCustomers := TClientDataSet.Create(nil); NewDataSetField(fCdsCustomers, ftInteger, 'Id'); NewDataSetField(fCdsCustomers, ftString, 'Name', 100); NewDataSetField(fCdsCustomers, ftDateTime, 'Birth'); fCdsCustomers.DataSetField := TDataSetField(fCdsSales.FieldByName('Customers')); fCdsProducts := TClientDataSet.Create(nil); NewDataSetField(fCdsProducts, ftInteger, 'Id'); NewDataSetField(fCdsProducts, ftString, 'Description', 100); NewDataSetField(fCdsProducts, ftFloat, 'Value'); fCdsProducts.DataSetField := TDataSetField(fCdsSales.FieldByName('Products')); fCdsSales.CreateDataSet; end; procedure TTestsDataSetConverter.TearDown; begin inherited; fCdsProducts.Free; fCdsSales.Free; fCdsCustomers.Free; end; procedure TTestsDataSetConverter.TestBlobAndText; const JSON = '{"Value":"RXplcXVpZWwgSnVsaWFubw=="}'; var cds: TClientDataSet; jo: TJSONObject; begin cds := TClientDataSet.Create(nil); try NewDataSetField(cds, ftBlob, 'Value'); cds.CreateDataSet; cds.Append; cds.FieldByName('Value').AsString := 'Ezequiel Juliano'; cds.Post; jo := TConverter.New.DataSet(cds).AsJSONObject; try CheckEqualsString(JSON, jo.ToString); finally jo.Free; end; jo := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(JSON), 0) as TJSONObject; try TConverter.New.JSON(jo).ToDataSet(cds); CheckFalse(cds.IsEmpty); CheckTrue(cds.FieldByName('Value').AsString = 'Ezequiel Juliano'); finally jo.Free; end; finally cds.Free; end; end; procedure TTestsDataSetConverter.TestConvertDataSetToJSONBasic; const JSON_ARRAY_EMPTY = '[]'; JSON_OBJECT_EMPTY = '{}'; JSON_ARRAY = '[{"Id":1,"Name":"Customers 1","Birth":"2014-01-22 14:05:03"},' + '{"Id":2,"Name":"Customers 2","Birth":"2014-01-22 14:05:03"}]'; JSON_OBJECT = '{"Id":2,"Name":"Customers 2","Birth":"2014-01-22 14:05:03"}'; var ja: TJSONArray; jo: TJSONObject; begin fCdsCustomers.DataSetField := nil; fCdsCustomers.CreateDataSet; CheckEqualsString(JSON_ARRAY_EMPTY, fCdsCustomers.AsJSONArrayString); CheckEqualsString(JSON_OBJECT_EMPTY, fCdsCustomers.AsJSONObjectString); fCdsCustomers.Append; fCdsCustomers.FieldByName('Id').AsInteger := 1; fCdsCustomers.FieldByName('Name').AsString := 'Customers 1'; fCdsCustomers.FieldByName('Birth').AsDateTime := StrToDateTime('22/01/2014 14:05:03'); fCdsCustomers.Post; fCdsCustomers.Append; fCdsCustomers.FieldByName('Id').AsInteger := 2; fCdsCustomers.FieldByName('Name').AsString := 'Customers 2'; fCdsCustomers.FieldByName('Birth').AsDateTime := StrToDateTime('22/01/2014 14:05:03'); fCdsCustomers.Post; ja := TConverter.New.DataSet(fCdsCustomers).AsJSONArray; CheckEqualsString(JSON_ARRAY, ja.ToString); jo := TConverter.New.DataSet.Source(fCdsCustomers).AsJSONObject; CheckEqualsString(JSON_OBJECT, jo.ToString); ja.Free; jo.Free; end; procedure TTestsDataSetConverter.TestConvertDataSetToJSONBasicHelper; const JSON_ARRAY = '[{"Id":1,"Name":"Customers 1","Birth":"2014-01-22 14:05:03"},' + '{"Id":2,"Name":"Customers 2","Birth":"2014-01-22 14:05:03"}]'; JSON_OBJECT = '{"Id":2,"Name":"Customers 2","Birth":"2014-01-22 14:05:03"}'; var ja: TJSONArray; jo: TJSONObject; begin fCdsCustomers.DataSetField := nil; fCdsCustomers.CreateDataSet; fCdsCustomers.Append; fCdsCustomers.FieldByName('Id').AsInteger := 1; fCdsCustomers.FieldByName('Name').AsString := 'Customers 1'; fCdsCustomers.FieldByName('Birth').AsDateTime := StrToDateTime('22/01/2014 14:05:03'); fCdsCustomers.Post; fCdsCustomers.Append; fCdsCustomers.FieldByName('Id').AsInteger := 2; fCdsCustomers.FieldByName('Name').AsString := 'Customers 2'; fCdsCustomers.FieldByName('Birth').AsDateTime := StrToDateTime('22/01/2014 14:05:03'); fCdsCustomers.Post; ja := fCdsCustomers.AsJSONArray; CheckEqualsString(JSON_ARRAY, ja.ToString); jo := fCdsCustomers.AsJSONObject; CheckEqualsString(JSON_OBJECT, jo.ToString); ja.Free; jo.Free; end; procedure TTestsDataSetConverter.TestConvertDataSetToJSONBasicInvisibleFields; const JSON_ARRAY = '[{"Id":1,"Birth":"2014-01-22 14:05:03"},' + '{"Id":2,"Birth":"2014-01-22 14:05:03"}]'; JSON_OBJECT = '{"Id":2,"Birth":"2014-01-22 14:05:03"}'; var ja: TJSONArray; jo: TJSONObject; begin fCdsCustomers.DataSetField := nil; fCdsCustomers.CreateDataSet; fCdsCustomers.FieldByName('Name').Visible := False; fCdsCustomers.Append; fCdsCustomers.FieldByName('Id').AsInteger := 1; fCdsCustomers.FieldByName('Name').AsString := 'Customers 1'; fCdsCustomers.FieldByName('Birth').AsDateTime := StrToDateTime('22/01/2014 14:05:03'); fCdsCustomers.Post; fCdsCustomers.Append; fCdsCustomers.FieldByName('Id').AsInteger := 2; fCdsCustomers.FieldByName('Name').AsString := 'Customers 2'; fCdsCustomers.FieldByName('Birth').AsDateTime := StrToDateTime('22/01/2014 14:05:03'); fCdsCustomers.Post; ja := TConverter.New.DataSet(fCdsCustomers).AsJSONArray; CheckEqualsString(JSON_ARRAY, ja.ToString); jo := TConverter.New.DataSet.Source(fCdsCustomers).AsJSONObject; CheckEqualsString(JSON_OBJECT, jo.ToString); ja.Free; jo.Free; end; procedure TTestsDataSetConverter.TestConvertDataSetToJSONComplex; const JSON = '{"Id":1,"Description":"Sales 1","Date":"2014-01-22","Time":"14:03:03",' + '"Customers":{"Id":2,"Name":"Customers 2","Birth":"2014-01-22 14:05:03"},' + '"Products":[{"Id":1,"Description":"Product 1","Value":100},' + '{"Id":2,"Description":"Product 2","Value":200.123456789}]}'; var jo: TJSONObject; begin fCdsSales.Append; fCdsSales.FieldByName('Id').AsInteger := 1; fCdsSales.FieldByName('Description').AsString := 'Sales 1'; fCdsSales.FieldByName('Date').AsDateTime := StrToDate('22/01/2014'); fCdsSales.FieldByName('Time').AsDateTime := StrToTime('14:03:03'); fCdsCustomers.Append; fCdsCustomers.FieldByName('Id').AsInteger := 2; fCdsCustomers.FieldByName('Name').AsString := 'Customers 2'; fCdsCustomers.FieldByName('Birth').AsDateTime := StrToDateTime('22/01/2014 14:05:03'); fCdsCustomers.Post; fCdsProducts.Append; fCdsProducts.FieldByName('Id').AsInteger := 1; fCdsProducts.FieldByName('Description').AsString := 'Product 1'; fCdsProducts.FieldByName('Value').AsFloat := 100; fCdsProducts.Post; fCdsProducts.Append; fCdsProducts.FieldByName('Id').AsInteger := 2; fCdsProducts.FieldByName('Description').AsString := 'Product 2'; fCdsProducts.FieldByName('Value').AsFloat := 200.123456789; fCdsProducts.Post; fCdsSales.Post; jo := TConverter.New.DataSet(fCdsSales).AsJSONObject; CheckEqualsString(JSON, jo.ToString); jo.Free; end; procedure TTestsDataSetConverter.TestConvertJSONToDataSetBasic; const JSON_ARRAY = '[{"Id":1,"Name":"Customers 1","Birth":"2014-01-22 14:05:03"},' + '{"Id":2,"Name":"Customers 2","Birth":"2014-01-22 14:05:03"}]'; JSON_OBJECT = '{"Id":2,"Name":"Customers 2","Birth":"2014-01-22 14:05:03"}'; var ja: TJSONArray; jo: TJSONObject; begin fCdsCustomers.DataSetField := nil; fCdsCustomers.CreateDataSet; ja := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(JSON_ARRAY), 0) as TJSONArray; jo := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(JSON_OBJECT), 0) as TJSONObject; TConverter.New.JSON(jo).ToDataSet(fCdsCustomers); CheckFalse(fCdsCustomers.IsEmpty); fCdsCustomers.EmptyDataSet; TConverter.New.JSON.Source(ja).ToDataSet(fCdsCustomers); CheckFalse(fCdsCustomers.IsEmpty); ja.Free; jo.Free; end; procedure TTestsDataSetConverter.TestConvertJSONToDataSetComplex; const JSON = '{"Id":1,"Description":"Sales 1","Date":"2014-01-22","Time":"14:03:03",' + '"Customers":{"Id":2,"Name":"Customers 2","Birth":"2014-01-22 14:05:03"},' + '"Products":[{"Id":1,"Description":"Product 1","Value":100},' + '{"Id":2,"Description":"Product 2","Value":200}]}'; var jo: TJSONObject; begin jo := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(JSON), 0) as TJSONObject; TConverter.New.JSON(jo).ToDataSet(fCdsSales); CheckFalse(fCdsSales.IsEmpty); CheckFalse(fCdsCustomers.IsEmpty); CheckFalse(fCdsProducts.IsEmpty); jo.Free; end; procedure TTestsDataSetConverter.TestConvertJSONToDataSetOwnsObject; const JSON_ARRAY = '[{"Id":1,"Name":"Customers 1","Birth":"2014-01-22 14:05:03"},' + '{"Id":2,"Name":"Customers 2","Birth":"2014-01-22 14:05:03"}]'; var ja: TJSONArray; begin fCdsCustomers.DataSetField := nil; fCdsCustomers.CreateDataSet; ja := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(JSON_ARRAY), 0) as TJSONArray; TConverter.New.JSON.Source(ja, True).ToDataSet(fCdsCustomers); CheckFalse(fCdsCustomers.IsEmpty); end; procedure TTestsDataSetConverter.TestConvertJSONToStructure; const JSON = '[{' + '"FieldName":"Id",' + '"DataType":"ftInteger",' + '"Size":0' + '},{' + '"FieldName":"Description",' + '"DataType":"ftString",' + '"Size":100' + '},{' + '"FieldName":"Value",' + '"DataType":"ftFloat",' + '"Size":0' + '}]'; var cds: TClientDataSet; ja: TJSONArray; begin cds := TClientDataSet.Create(nil); try ja := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(JSON), 0) as TJSONArray; try TConverter.New.JSON(ja).ToStructure(cds); cds.CreateDataSet; CheckTrue(cds.Fields[0].FieldName = 'Id'); CheckTrue(cds.Fields[0].DataType = ftInteger); CheckTrue(cds.Fields[0].Size = 0); CheckTrue(cds.Fields[1].FieldName = 'Description'); CheckTrue(cds.Fields[1].DataType = ftString); CheckTrue(cds.Fields[1].Size = 100); CheckTrue(cds.Fields[2].FieldName = 'Value'); CheckTrue(cds.Fields[2].DataType = ftFloat); CheckTrue(cds.Fields[2].Size = 0); finally ja.Free; end; finally cds.Free; end; end; procedure TTestsDataSetConverter.TestJSONConverter; const JSON_1 = '[{"Id":1,"Description":"Sales 1","Date":"2014-01-22","Time":"14:03:03",' + '"Customers":{"Id":2,"Name":"Customers 2","Birth":"2014-01-22 14:05:03"},' + '"Products":[{"Id":1,"Description":"Product 1","Value":100},' + '{"Id":2,"Description":"Product 2","Value":200}]},' + '{"Id":2,"Description":"Sales 2","Date":"2014-01-22","Time":"14:03:03",' + '"Customers":{"Id":2,"Name":"Customers 2","Birth":"2014-01-22 14:05:03"},' + '"Products":[{"Id":1,"Description":"Product 1","Value":100}]}]'; JSON_2 = '{"Id":3,"Description":"Sales 3","Date":"2014-01-22","Time":"14:03:03",' + '"Customers":{"Id":2,"Name":"Customers 2","Birth":"2014-01-22 14:05:03"},' + '"Products":[{"Id":100,"Description":"Product 100","Value":100},' + '{"Id":200,"Description":"Product 200","Value":200}]}'; var converter: IJSONConverter; ja: TJSONArray; jo: TJSONObject; begin converter := TJSONConverter.Create; ja := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(JSON_1), 0) as TJSONArray; try converter.Source(ja).ToDataSet(fCdsSales); fCdsSales.Last; CheckTrue(fCdsSales.RecordCount = 2); CheckTrue(fCdsCustomers.RecordCount = 1); CheckTrue(fCdsProducts.RecordCount = 1); jo := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(JSON_2), 0) as TJSONObject; try converter.Source(jo).ToRecord(fCdsSales); CheckTrue(fCdsSales.RecordCount = 2); CheckTrue(fCdsCustomers.RecordCount = 1); CheckTrue(fCdsProducts.RecordCount = 2); CheckEquals('3', fCdsSales.FieldByName('Id').AsString); CheckEquals('Sales 3', fCdsSales.FieldByName('Description').AsString); fCdsProducts.First; while not fCdsProducts.Eof do begin if (fCdsProducts.RecNo = 1) then begin CheckEquals('100', fCdsProducts.FieldByName('Id').AsString); CheckEquals('Product 100', fCdsProducts.FieldByName('Description').AsString); end else if (fCdsProducts.RecNo = 2) then begin CheckEquals('200', fCdsProducts.FieldByName('Id').AsString); CheckEquals('Product 200', fCdsProducts.FieldByName('Description').AsString); end; fCdsProducts.Next; end; finally jo.Free; end; finally ja.Free; end; end; procedure TTestsDataSetConverter.TestConvertStructureToJSON; const JSON_EMPTY = '[]'; JSON = '[{' + '"FieldName":"Id",' + '"DataType":"ftInteger",' + '"Size":0' + '},{' + '"FieldName":"Description",' + '"DataType":"ftString",' + '"Size":100' + '},{' + '"FieldName":"Value",' + '"DataType":"ftFloat",' + '"Size":0' + '}]'; var cds: TClientDataSet; ja: TJSONArray; begin cds := TClientDataSet.Create(nil); try ja := TConverter.New.DataSet(cds).AsJSONStructure; try CheckEqualsString(JSON_EMPTY, ja.ToString); finally ja.Free; end; NewDataSetField(cds, ftInteger, 'Id'); NewDataSetField(cds, ftString, 'Description', 100); NewDataSetField(cds, ftFloat, 'Value'); cds.CreateDataSet; ja := TConverter.New.DataSet(cds).AsJSONStructure; try CheckEqualsString(JSON, ja.ToString); finally ja.Free; end; finally cds.Free; end; end; procedure TTestsDataSetConverter.Test_Inssue_2; // https://github.com/ezequieljuliano/DataSetConverter4Delphi/issues/2 const JSON = '{"Value":50}'; var cds: TClientDataSet; jo: TJSONObject; begin cds := TClientDataSet.Create(nil); try NewDataSetField(cds, ftBCD, 'Value'); cds.CreateDataSet; cds.Append; cds.FieldByName('Value').AsBCD := 50; cds.Post; jo := TConverter.New.DataSet(cds).AsJSONObject; try CheckEqualsString(JSON, jo.ToString); finally jo.Free; end; jo := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(JSON), 0) as TJSONObject; try TConverter.New.JSON(jo).ToDataSet(cds); CheckFalse(cds.IsEmpty); CheckTrue(cds.FieldByName('Value').AsBCD = 50); finally jo.Free; end; finally cds.Free; end; end; procedure TTestsDataSetConverter.Test_Inssue_7; // https://github.com/ezequieljuliano/DataSetConverter4Delphi/issues/7 const JSON = '{"Value":"2014-01-22 14:05:03"}'; var cds: TClientDataSet; jo: TJSONObject; begin cds := TClientDataSet.Create(nil); try NewDataSetField(cds, ftTimeStamp, 'Value'); cds.CreateDataSet; cds.Append; cds.FieldByName('Value').AsDateTime := StrToDateTime('22/01/2014 14:05:03'); cds.Post; jo := TConverter.New.DataSet(cds).AsJSONObject; try CheckEqualsString(JSON, jo.ToString); finally jo.Free; end; jo := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(JSON), 0) as TJSONObject; try TConverter.New.JSON(jo).ToDataSet(cds); CheckFalse(cds.IsEmpty); CheckTrue(cds.FieldByName('Value').AsDateTime = StrToDateTime('22/01/2014 14:05:03')); finally jo.Free; end; finally cds.Free; end; end; procedure TTestsDataSetConverter.TestConvertJsonToFDMemTable_PR_32; const JSON = '{' + '"Structure": [' + '{' + '"FieldName": "Id",' + '"DataType": "ftInteger",' + '"Size": 0' + '},{' + '"FieldName": "Description",' + '"DataType": "ftString",' + '"Size": 100' + '},{' + '"FieldName": "Value",' + '"DataType": "ftBCD",' + '"Size": 2' + '}' + '],' + '"Products": [' + '{' + '"Id": 1,' + '"Description": "Product 1",' + '"Value": 100.12' + '},{' + '"Id": 2,' + '"Description": "Product 2",' + '"Value": 200' + '}' + ']' + '}'; var jo: TJSONObject; cds: TClientDataSet; begin cds := TClientDataSet.Create(nil); try jo := TJSONObject.ParseJSONValue(TEncoding.UTF8.GetBytes(JSON), 0) as TJSONObject; try cds.Close; cds.Fields.Clear; TConverter.New.JSON( jo.Values['Structure'].AsType).ToStructure(cds); cds.CreateDataSet; cds.Open; CheckException( procedure begin TConverter.New.JSON(jo.Values['Products'].AsType).ToDataSet(cds) end, nil); cds.First; while not cds.Eof do begin if (cds.RecNo = 1) then CheckEquals(100.12, cds.FieldByName('Value').AsFloat, 2) else if (cds.RecNo = 2) then CheckEquals(200, cds.FieldByName('Value').AsFloat); cds.Next; end; finally jo.Free; end; finally cds.Close; cds.Free; end; end; initialization RegisterTest(TTestsDataSetConverter.Suite); end. ================================================ FILE: unittest/DataSetConverter4DTests.dpr ================================================ program DataSetConverter4DTests; { Delphi DUnit Test Project ------------------------- This project contains the DUnit test framework and the GUI/Console test runners. Add "CONSOLE_TESTRUNNER" to the conditional defines entry in the project options to use the console test runner. Otherwise the GUI test runner will be used by default. } {$IFDEF CONSOLE_TESTRUNNER} {$APPTYPE CONSOLE} {$ENDIF} uses DUnitTestRunner, DataSetConverter4D in '..\src\DataSetConverter4D.pas', DataSetConverter4D.UnitTest in 'DataSetConverter4D.UnitTest.pas', DataSetConverter4D.Impl in '..\src\DataSetConverter4D.Impl.pas', DataSetConverter4D.Util in '..\src\DataSetConverter4D.Util.pas', DataSetConverter4D.Helper in '..\src\DataSetConverter4D.Helper.pas'; {$R *.RES} begin ReportMemoryLeaksOnShutdown := True; DUnitTestRunner.RunRegisteredTests; end. ================================================ FILE: unittest/DataSetConverter4DTests.dproj ================================================  {8707BA43-12EB-4235-A68B-515D30E96922} 18.4 None True Debug Win32 1 Console DataSetConverter4DTests.dpr true true Base true true Base true true Base true true Cfg_1 true true true Base true $(BDS)\bin\delphi_PROJECTICON.ico $(BDS)\bin\delphi_PROJECTICNS.icns DataSetConverter4DTests 1046 .\$(Platform)\$(Config)\pkg .\$(Platform)\$(Config)\dcp CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= None _CONSOLE_TESTRUNNER;$(DCC_Define) System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) $(BDS)\Source\DUnit\src;$(DCC_UnitSearchPath) .\$(Platform)\$(Config)\dcu .\$(Platform)\$(Config) false false false false false 1033 Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) IndyIPClient;FireDACASADriver;FireDACSqliteDriver;bindcompfmx;DBXSqliteDriver;vcldbx;FireDACPgDriver;FireDACODBCDriver;fmx;rtl;dbrtl;DbxClientDriver;IndySystem;FireDACCommon;bindcomp;inetdb;TeeDB;inetdbbde;vclib;DBXInterBaseDriver;DataSnapClient;DataSnapCommon;DBXOdbcDriver;DataSnapServer;Tee;vclFireDAC;DataSnapProviderClient;xmlrtl;DBXSybaseASEDriver;ibxpress;DbxCommonDriver;svnui;vclimg;IndyProtocols;DBXMySQLDriver;dbxcds;DatasnapConnectorsFreePascal;FireDACCommonDriver;MetropolisUILiveTile;bindengine;vclactnband;vcldb;bindcompdbx;FMXTee;vcldsnap;bindcompvcl;soaprtl;TeeUI;vclie;fmxFireDAC;FireDACADSDriver;DBXDb2Driver;vcltouch;DBXOracleDriver;CustomIPTransport;vclribbon;VCLRESTComponents;dsnap;DBXInformixDriver;FireDAC;FireDACMSSQLDriver;fmxase;vcl;DataSnapConnectors;FireDACDataSnapDriver;IndyCore;DBXMSSQLDriver;CloudService;Intraweb;DBXFirebirdDriver;FireDACIBDriver;FmxTeeUI;inet;IndyIPCommon;fmxobj;FireDACDBXDriver;IndyIPServer;dsnapcon;FireDACMySQLDriver;VclSmp;vclx;inetdbxpress;svn;DBXSybaseASADriver;FireDACOracleDriver;fmxdae;FireDACDb2Driver;RESTComponents;bdertl;FireDACMSAccDriver;dbexpress;adortl;DataSnapIndy10ServerTransport;$(DCC_UsePackage) CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(ModuleName);FileDescription=$(ModuleName);ProductName=$(ModuleName) IndyIPClient;FireDACASADriver;FireDACSqliteDriver;bindcompfmx;DBXSqliteDriver;FireDACPgDriver;FireDACODBCDriver;fmx;rtl;dbrtl;DbxClientDriver;IndySystem;FireDACCommon;bindcomp;inetdb;TeeDB;vclib;DBXInterBaseDriver;DataSnapClient;DataSnapCommon;DBXOdbcDriver;DataSnapServer;Tee;vclFireDAC;DataSnapProviderClient;xmlrtl;DBXSybaseASEDriver;ibxpress;DbxCommonDriver;vclimg;IndyProtocols;DBXMySQLDriver;dbxcds;DatasnapConnectorsFreePascal;FireDACCommonDriver;MetropolisUILiveTile;bindengine;vclactnband;vcldb;bindcompdbx;FMXTee;vcldsnap;bindcompvcl;soaprtl;TeeUI;vclie;fmxFireDAC;FireDACADSDriver;DBXDb2Driver;vcltouch;DBXOracleDriver;CustomIPTransport;vclribbon;VCLRESTComponents;dsnap;DBXInformixDriver;FireDAC;FireDACMSSQLDriver;fmxase;vcl;DataSnapConnectors;FireDACDataSnapDriver;IndyCore;DBXMSSQLDriver;CloudService;Intraweb;DBXFirebirdDriver;FireDACIBDriver;FmxTeeUI;inet;IndyIPCommon;fmxobj;FireDACDBXDriver;IndyIPServer;dsnapcon;FireDACMySQLDriver;VclSmp;vclx;inetdbxpress;DBXSybaseASADriver;FireDACOracleDriver;fmxdae;FireDACDb2Driver;RESTComponents;FireDACMSAccDriver;dbexpress;adortl;DataSnapIndy10ServerTransport;$(DCC_UsePackage) DEBUG;$(DCC_Define) true false true true true 1033 false false RELEASE;$(DCC_Define) 0 0 MainSource Cfg_2 Base Base Cfg_1 Base Delphi.Personality.12 False False 1 0 0 0 False False False False False 1046 1252 1.0.0.0 1.0.0.0 DataSetConverter4DTests.dpr Microsoft Office 2000 Sample Automation Server Wrapper Components Microsoft Office XP Sample Automation Server Wrapper Components true DataSetConverter4DTests.exe true true true true 1 Contents\MacOS 0 classes 1 library\lib\armeabi-v7a 1 library\lib\armeabi 1 library\lib\mips 1 library\lib\armeabi-v7a 1 res\drawable 1 res\values 1 res\drawable 1 res\drawable-xxhdpi 1 res\drawable-ldpi 1 res\drawable-mdpi 1 res\drawable-hdpi 1 res\drawable-xhdpi 1 res\drawable-small 1 res\drawable-normal 1 res\drawable-large 1 res\drawable-xlarge 1 1 1 0 1 .framework 0 1 .dylib 0 .dll;.bpl 1 .dylib 1 .dylib 1 .dylib 1 .dylib 0 .bpl 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 1 ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 1 1 1 1 Contents\Resources 1 library\lib\armeabi-v7a 1 1 1 1 1 1 0 1 1 Assets 1 Assets 1 Assets 1 Assets 1 False True False DUnit / Delphi Win32 GUI 12