├── RESTMapper.res ├── JsonToDelphiClass.res ├── JsonToDelphiClass_Icon.ico ├── JsonToDelphiClass_Icon1.ico ├── JsonToDelphiClass.dpr ├── LICENSE ├── .gitignore ├── uSaveUnitForm.pas ├── README.md ├── uUpdateForm.pas ├── uUpdate.pas ├── FMX.ConstrainedForm.pas ├── uUpdateForm.fmx ├── JsonToDelphiClass.mes ├── uMainForm.pas ├── uGitHub.pas ├── Pkg.Json.Mapper.pas └── JsonToDelphiClass.dproj /RESTMapper.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PKGeorgiev/Delphi-JsonToDelphiClass/HEAD/RESTMapper.res -------------------------------------------------------------------------------- /JsonToDelphiClass.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PKGeorgiev/Delphi-JsonToDelphiClass/HEAD/JsonToDelphiClass.res -------------------------------------------------------------------------------- /JsonToDelphiClass_Icon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PKGeorgiev/Delphi-JsonToDelphiClass/HEAD/JsonToDelphiClass_Icon.ico -------------------------------------------------------------------------------- /JsonToDelphiClass_Icon1.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PKGeorgiev/Delphi-JsonToDelphiClass/HEAD/JsonToDelphiClass_Icon1.ico -------------------------------------------------------------------------------- /JsonToDelphiClass.dpr: -------------------------------------------------------------------------------- 1 | program JsonToDelphiClass; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | uMainForm in 'uMainForm.pas' {MainForm}, 7 | Pkg.Json.Mapper in 'Pkg.Json.Mapper.pas', 8 | uSaveUnitForm in 'uSaveUnitForm.pas' {SaveUnitForm}, 9 | uGitHub in 'uGitHub.pas', 10 | FMX.ConstrainedForm in 'FMX.ConstrainedForm.pas' {/ IdSSLOpenSSLHeaders,}, 11 | uUpdate in 'uUpdate.pas', 12 | uUpdateForm in 'uUpdateForm.pas' {UpdateForm}; 13 | 14 | {$R *.res} 15 | 16 | {$WEAKLINKRTTI OFF} 17 | 18 | begin 19 | Application.Initialize; 20 | Application.CreateForm(TMainForm, MainForm); 21 | Application.CreateForm(TSaveUnitForm, SaveUnitForm); 22 | Application.CreateForm(TUpdateForm, UpdateForm); 23 | Application.Run; 24 | end. 25 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2017 Petar Georgiev 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | 25 | # Delphi compiler-generated binaries (safe to delete) 26 | *.exe 27 | *.dll 28 | *.bpl 29 | *.bpi 30 | *.dcp 31 | *.so 32 | *.apk 33 | *.drc 34 | *.map 35 | *.dres 36 | *.rsm 37 | *.tds 38 | *.dcu 39 | *.lib 40 | 41 | # Delphi autogenerated files (duplicated info) 42 | *.cfg 43 | *Resource.rc 44 | 45 | # Delphi local files (user-specific info) 46 | *.local 47 | *.identcache 48 | *.projdata 49 | *.tvsconfig 50 | *.dsk 51 | 52 | # Delphi history and backups 53 | __history/ 54 | *.~* -------------------------------------------------------------------------------- /uSaveUnitForm.pas: -------------------------------------------------------------------------------- 1 | unit uSaveUnitForm; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 7 | FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls, 8 | FMX.Layouts, FMX.Memo; 9 | 10 | type 11 | TSaveUnitForm = class(TForm) 12 | Memo1: TMemo; 13 | Panel1: TPanel; 14 | btnClose: TButton; 15 | btnSave: TButton; 16 | sd: TSaveDialog; 17 | Label1: TLabel; 18 | StyleBook1: TStyleBook; 19 | procedure btnCloseClick(Sender: TObject); 20 | procedure btnSaveClick(Sender: TObject); 21 | procedure Memo1KeyUp(Sender: TObject; var Key: Word; var KeyChar: Char; 22 | Shift: TShiftState); 23 | procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; 24 | Shift: TShiftState); 25 | procedure FormShow(Sender: TObject); 26 | private 27 | { Private declarations } 28 | public 29 | { Public declarations } 30 | end; 31 | 32 | var 33 | SaveUnitForm: TSaveUnitForm; 34 | 35 | implementation 36 | 37 | {$R *.fmx} 38 | 39 | uses uMainForm; 40 | 41 | procedure TSaveUnitForm.btnCloseClick(Sender: TObject); 42 | begin 43 | ModalResult := mrCancel; 44 | end; 45 | 46 | procedure TSaveUnitForm.btnSaveClick(Sender: TObject); 47 | begin 48 | if sd.Execute then 49 | begin 50 | 51 | end; 52 | end; 53 | 54 | procedure TSaveUnitForm.FormKeyDown(Sender: TObject; var Key: Word; 55 | var KeyChar: Char; Shift: TShiftState); 56 | begin 57 | if Key = 27 then 58 | ModalResult := mrCancel; 59 | end; 60 | 61 | procedure TSaveUnitForm.FormShow(Sender: TObject); 62 | begin 63 | SaveUnitForm.width := MainForm.Width - 50; 64 | SaveUnitForm.height := MainForm.Height - 50; 65 | SaveUnitForm.left := MainForm.Left + 25; 66 | SaveUnitForm.top := MainForm.Top + 25; 67 | end; 68 | 69 | procedure TSaveUnitForm.Memo1KeyUp(Sender: TObject; var Key: Word; 70 | var KeyChar: Char; Shift: TShiftState); 71 | begin 72 | if Key = 27 then 73 | ModalResult := mrCancel; 74 | end; 75 | 76 | end. 77 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Delphi-JsonToDelphiClass 2 | ======================== 3 | 4 | Generates Delphi Classes based on JSON string. Just like XML Data Binding, but for JSON. 5 | 6 | Main features: 7 | 8 | - Build entirely on the RTL (no external dependencies) so it's cross-platform; 9 | - Accepts any valid JSON string, no matter how complex the object is; 10 | - Visualizes the structure of the JSON objects in a treeview; 11 | - Generates complete delphi unit (declaration and implementation), based on the JSON string input; 12 | - Automatically prefixes reserved Delphi words with "&" (ampersand); 13 | - * Blocks unit generation if the JSON string contains empty Array; 14 | - Adds support code to automatically destroy complex sub types. So you don't have to manage subobject's lifetime manually; 15 | - ** Uses TArray to represent lists; 16 | - Adds helper serialization/deserialization functions; 17 | - Serialization and deserialization results in the same JSON structure! 18 | - Automatically detects date/datetime parts and maps them to TDate/TDateTime (as long as dates are ISO8601 compliant); 19 | - Maps all numbers to Double; 20 | - Maps true/false values to Boolean; 21 | - Allows you to change property names (keys); 22 | - Allows you to change the names of the stub classes; 23 | - Supports JSON pretty print to format the input string; 24 | - Simple and responsive GUI; 25 | - *** Automatic check for update, based on ITask (Parallel Programming Library)! 26 | - It's open source! You can find the source code and binary releases on GitHub. 27 | - The program uses MadExcept to report unhanded exceptions; 28 | 29 | * If the JSON array is empty the contained type is unknown. Unit generation works only with known and supported types. 30 | 31 | ** This is because serialization of TList adds "noise" i.e. includes internal properties that did not exist in the original JSON string. 32 | 33 | *** The releases of JsonToDelphiClass (source and binaries) are public and reside on GitHub. The update unit uses GitHub's REST API to enumerate tags/releases. 34 | 35 | Report any problems/suggestions using GitHub's facilities. 36 | 37 | You can find more information here: http://www.pgeorgiev.com/?p=1832 38 | -------------------------------------------------------------------------------- /uUpdateForm.pas: -------------------------------------------------------------------------------- 1 | unit uUpdateForm; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 7 | FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls, 8 | FMX.Layouts, FMX.Memo, uGitHub, FMX.Objects; 9 | 10 | type 11 | TUpdateForm = class(TForm) 12 | Memo1: TMemo; 13 | Panel1: TPanel; 14 | Button1: TButton; 15 | Panel2: TPanel; 16 | Label1: TLabel; 17 | lblVersion: TLabel; 18 | Label3: TLabel; 19 | lblReleasesLink: TLabel; 20 | Label5: TLabel; 21 | Panel3: TPanel; 22 | StyleBook1: TStyleBook; 23 | Label6: TLabel; 24 | lblDownloadLink: TLabel; 25 | Label2: TLabel; 26 | lblDownloadCount: TLabel; 27 | procedure Button1Click(Sender: TObject); 28 | procedure FormShow(Sender: TObject); 29 | procedure lblReleasesLinkClick(Sender: TObject); 30 | procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; 31 | Shift: TShiftState); 32 | private 33 | { Private declarations } 34 | public 35 | { Public declarations } 36 | FRelease: TReleaseClass; 37 | end; 38 | 39 | var 40 | UpdateForm: TUpdateForm; 41 | 42 | implementation 43 | 44 | uses System.UIConsts, 45 | {$IFDEF MSWINDOWS} 46 | Winapi.ShellAPI, Winapi.Windows; 47 | {$ENDIF MSWINDOWS} 48 | {$IFDEF POSIX} 49 | Posix.Stdlib; 50 | {$ENDIF POSIX} 51 | 52 | {$R *.fmx} 53 | 54 | procedure TUpdateForm.Button1Click(Sender: TObject); 55 | begin 56 | ModalResult := mrCancel; 57 | end; 58 | 59 | procedure TUpdateForm.FormKeyDown(Sender: TObject; var Key: Word; 60 | var KeyChar: Char; Shift: TShiftState); 61 | begin 62 | if key = 27 then 63 | ModalResult := mrCancel; 64 | end; 65 | 66 | procedure TUpdateForm.FormShow(Sender: TObject); 67 | begin 68 | lblVersion.Text := FRelease.tag_name; 69 | lblReleasesLink.Text := FRelease.html_url; //FRelease.assets[0].browser_download_url; 70 | 71 | if length(FRelease.assets) > 0 then 72 | begin 73 | lblDownloadLink.Text := FRelease.assets[0].browser_download_url; 74 | lblDownloadCount.text := FRelease.assets[0].download_count.ToString(); 75 | end 76 | else 77 | begin 78 | lblDownloadLink.Text := lblReleasesLink.Text; 79 | lblDownloadCount.text := '0'; 80 | end; 81 | 82 | memo1.Text := FRelease.body; 83 | (lblReleasesLink.FindStyleResource('text') as TText).OnClick := lblReleasesLinkClick; 84 | (lblDownloadLink.FindStyleResource('text') as TText).OnClick := lblReleasesLinkClick; 85 | end; 86 | 87 | procedure TUpdateForm.lblReleasesLinkClick(Sender: TObject); 88 | var 89 | LUrl: string; 90 | begin 91 | // http://monkeystyler.com/blog/entry/a-clickable-hotlink-urllabel-for-firemonkey 92 | LUrl := (Sender as TText).Text; 93 | {$IFDEF MSWINDOWS} 94 | ShellExecute(0, 'OPEN', PChar(LUrl), '', '', SW_SHOWNORMAL); 95 | {$ENDIF MSWINDOWS} 96 | {$IFDEF POSIX} 97 | _system(PAnsiChar('open ' + AnsiString(LUrl))); 98 | {$ENDIF POSIX} 99 | 100 | ModalResult := mrOk; 101 | end; 102 | 103 | end. 104 | -------------------------------------------------------------------------------- /uUpdate.pas: -------------------------------------------------------------------------------- 1 | unit uUpdate; 2 | 3 | interface 4 | uses REST.Client, uGitHub, REST.JSON, JSON, 5 | IPPeerClient, SysUtils, System.Threading, Classes, Pkg.Json.Mapper; 6 | 7 | const 8 | ProgramVersion : double = 0.65; 9 | UpdateUrl = 'https://api.github.com/repos/PKGeorgiev/Delphi-JsonToDelphiClass/releases'; 10 | ProgramUrl = 'https://github.com/PKGeorgiev/Delphi-JsonToDelphiClass'; 11 | 12 | function InternalCheckForUpdate: TObject; 13 | procedure NewCheckForUpdateTask(AOnFinish: TProc); 14 | 15 | implementation 16 | uses Math; 17 | 18 | function InternalCheckForUpdate: TObject; 19 | var 20 | LRestClient: TRESTClient; 21 | LRestRequest: TRESTRequest; 22 | LRestResponse: TRESTResponse; 23 | LRelease, 24 | LResult: TObject; 25 | LJsonArray: TJsonArray; 26 | LJsonValue: TJsonValue; 27 | LTag: double; 28 | begin 29 | LResult := nil; 30 | try 31 | LRestClient := TRESTClient.Create(''); 32 | try 33 | LRestClient.BaseURL := UpdateUrl; 34 | LRestResponse := TRESTResponse.Create(nil); 35 | try 36 | LRestRequest := TRESTRequest.Create(nil); 37 | try 38 | LRestRequest.Client := LRestClient; 39 | LRestRequest.Response := LRestResponse; 40 | LRestRequest.Timeout := 10000; 41 | 42 | LRestRequest.Execute; 43 | 44 | if LRestResponse.StatusCode = 200 then 45 | begin 46 | LJsonArray := TJSONObject.ParseJSONValue(LRestResponse.Content) as TJSONArray; 47 | try 48 | for LJsonValue in LJsonArray do 49 | begin 50 | LRelease := TReleaseClass.FromJsonString(LJsonValue.ToJSON); 51 | LTag := StrToFloat((LRelease as TReleaseClass).tag_name, PointDsFormatSettings); 52 | if Math.CompareValue(LTag, ProgramVersion) = 1 then 53 | begin 54 | LResult := LRelease; 55 | break; 56 | end 57 | else 58 | LRelease.Free; 59 | end; 60 | finally 61 | LJsonArray.Free; 62 | end; 63 | end 64 | else 65 | LResult := TErrorClass.FromJsonString(LRestResponse.Content); 66 | 67 | finally 68 | LRestRequest.Free; 69 | end; 70 | 71 | finally 72 | LRestResponse.Free; 73 | end; 74 | 75 | finally 76 | LRestClient.Free; 77 | end; 78 | 79 | except 80 | on e: Exception do 81 | begin 82 | LResult := TErrorClass.Create; 83 | (LResult as TErrorClass).message := e.Message; 84 | end; 85 | end; 86 | 87 | result := LResult; 88 | end; 89 | 90 | procedure NewCheckForUpdateTask(AOnFinish: TProc); 91 | begin 92 | TTask.Run( 93 | procedure 94 | var 95 | LResult: TObject; 96 | begin 97 | // Asynchronously check for update 98 | LResult := InternalCheckForUpdate(); 99 | try 100 | // Execute AOnFinish in the context of the Main Thread 101 | TThread.Synchronize(nil, 102 | procedure 103 | begin 104 | AOnFinish(LResult); 105 | end 106 | ); 107 | except 108 | end; 109 | end 110 | ); 111 | end; 112 | 113 | end. 114 | -------------------------------------------------------------------------------- /FMX.ConstrainedForm.pas: -------------------------------------------------------------------------------- 1 | unit FMX.ConstrainedForm; 2 | 3 | // http://stackoverflow.com/a/8044518 4 | 5 | interface 6 | 7 | uses 8 | System.Classes, System.Types, System.UITypes, FMX.Forms, FMX.Platform, FMX.Types; 9 | 10 | type 11 | TFormConstraints = class(TPersistent) 12 | private 13 | FMaxHeight: Integer; 14 | FMaxLeft: Integer; 15 | FMaxWidth: Integer; 16 | FMaxTop: Integer; 17 | FMinHeight: Integer; 18 | FMinLeft: Integer; 19 | FMinWidth: Integer; 20 | FMinTop: Integer; 21 | public 22 | constructor Create; 23 | published 24 | property MaxHeight: Integer read FMaxHeight write FMaxHeight default 0; 25 | property MaxLeft: Integer read FMaxLeft write FMaxLeft default 0; 26 | property MaxWidth: Integer read FMaxWidth write FMaxWidth default 0; 27 | property MaxTop: Integer read FMaxTop write FMaxTop default 0; 28 | property MinHeight: Integer read FMinHeight write FMinHeight default 0; 29 | property MinLeft: Integer read FMinLeft write FMinLeft default 0; 30 | property MinWidth: Integer read FMinWidth write FMinWidth default 0; 31 | property MinTop: Integer read FMinTop write FMinTop default 0; 32 | end; 33 | 34 | TConstrainedForm = class(TCustomForm) 35 | private 36 | FConstraints: TFormConstraints; 37 | protected 38 | public 39 | constructor Create(AOwner: TComponent); override; 40 | destructor Destroy; override; 41 | procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; 42 | procedure StartWindowResize; override; 43 | procedure StartWindowDrag; override; 44 | published 45 | property Constraints: TFormConstraints read FConstraints write FConstraints; 46 | property BiDiMode; 47 | property Caption; 48 | property Cursor default crDefault; 49 | property BorderStyle default TFmxFormBorderStyle.Sizeable; 50 | property BorderIcons default [TBorderIcon.biSystemMenu, TBorderIcon.biMinimize, TBorderIcon.biMaximize]; 51 | property ClientHeight; 52 | property ClientWidth; 53 | property Left; 54 | property Top; 55 | // property Margins; 56 | property Position default TFormPosition.DefaultPosOnly; 57 | property Width; 58 | property Height; 59 | // property ShowActivated default True; 60 | // property StaysOpen default True; 61 | property Transparency; 62 | // property TopMost default False; 63 | property Visible; 64 | property WindowState default TWindowState.wsNormal; 65 | property OnCreate; 66 | property OnDestroy; 67 | property OnClose; 68 | property OnCloseQuery; 69 | property OnActivate; 70 | property OnDeactivate; 71 | property OnResize; 72 | property Fill; 73 | property StyleBook; 74 | property ActiveControl; 75 | property StyleLookup; 76 | property OnPaint; 77 | // XE7 78 | property Padding; 79 | property FormFactor; 80 | property OnKeyDown; 81 | end; 82 | 83 | procedure Register; 84 | 85 | implementation 86 | 87 | { TFormConstraints } 88 | 89 | constructor TFormConstraints.Create; 90 | begin 91 | inherited; 92 | FMaxHeight := 0; 93 | FMaxLeft := 0; 94 | FMaxWidth := 0; 95 | FMaxTop := 0; 96 | FMinHeight := 0; 97 | FMinLeft := 0; 98 | FMinWidth := 0; 99 | FMinTop := 0; 100 | end; 101 | 102 | { TConstrainedForm } 103 | 104 | constructor TConstrainedForm.Create(AOwner: TComponent); 105 | begin 106 | FConstraints := TFormConstraints.Create; 107 | inherited; 108 | end; 109 | 110 | destructor TConstrainedForm.Destroy; 111 | begin 112 | FConstraints.Free; 113 | inherited; 114 | end; 115 | 116 | procedure TConstrainedForm.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); 117 | begin 118 | if (FConstraints.FMinWidth > 0) and (AWidth < FConstraints.FMinWidth) then 119 | AWidth := FConstraints.FMinWidth; 120 | 121 | if (FConstraints.FMaxWidth > 0) and (AWidth > FConstraints.FMaxWidth) then 122 | AWidth := FConstraints.FMaxWidth; 123 | 124 | if (FConstraints.FMinHeight > 0) and (AHeight < FConstraints.FMinHeight) then 125 | AHeight := FConstraints.FMinHeight; 126 | 127 | if (FConstraints.FMaxHeight > 0) and (AHeight > FConstraints.FMaxHeight) then 128 | AHeight := FConstraints.FMaxHeight; 129 | 130 | if (FConstraints.FMinLeft > 0) and (ALeft < FConstraints.FMinLeft) then 131 | ALeft := FConstraints.FMinLeft; 132 | 133 | if (FConstraints.FMaxLeft > 0) and (ALeft > FConstraints.FMaxLeft) then 134 | ALeft := FConstraints.FMaxLeft; 135 | 136 | if (FConstraints.FMinTop > 0) and (ATop < FConstraints.FMinTop) then 137 | ATop := FConstraints.FMinTop; 138 | 139 | if (FConstraints.FMaxTop > 0) and (ATop > FConstraints.FMaxTop) then 140 | ATop := FConstraints.FMaxTop; 141 | 142 | FWinService.SetWindowRect(Self, RectF(ALeft, ATop, ALeft + AWidth, ATop + AHeight)); 143 | inherited SetBounds(ALeft, ATop, AWidth, AHeight); 144 | end; 145 | 146 | procedure TConstrainedForm.StartWindowDrag; 147 | begin 148 | inherited; 149 | 150 | end; 151 | 152 | procedure TConstrainedForm.StartWindowResize; 153 | begin 154 | inherited; 155 | end; 156 | 157 | procedure Register; 158 | begin 159 | RegisterClass(TConstrainedForm); 160 | end; 161 | 162 | end. 163 | -------------------------------------------------------------------------------- /uUpdateForm.fmx: -------------------------------------------------------------------------------- 1 | object UpdateForm: TUpdateForm 2 | Left = 0 3 | Top = 0 4 | BorderIcons = [biSystemMenu] 5 | BorderStyle = Single 6 | Caption = 'New Version Information' 7 | ClientHeight = 331 8 | ClientWidth = 674 9 | Padding.Left = 10.000000000000000000 10 | Padding.Top = 10.000000000000000000 11 | Padding.Right = 10.000000000000000000 12 | Padding.Bottom = 10.000000000000000000 13 | StyleBook = StyleBook1 14 | FormFactor.Width = 320 15 | FormFactor.Height = 480 16 | FormFactor.Devices = [Desktop] 17 | OnKeyDown = FormKeyDown 18 | OnShow = FormShow 19 | DesignerMasterStyle = 0 20 | object Panel1: TPanel 21 | Align = Bottom 22 | Position.X = 10.000000000000000000 23 | Position.Y = 296.000000000000000000 24 | Size.Width = 654.000000000000000000 25 | Size.Height = 25.000000000000000000 26 | Size.PlatformDefault = False 27 | StyleLookup = 'Panel1Style1' 28 | TabOrder = 0 29 | object Button1: TButton 30 | Align = Right 31 | Position.X = 574.000000000000000000 32 | Size.Width = 80.000000000000000000 33 | Size.Height = 25.000000000000000000 34 | Size.PlatformDefault = False 35 | TabOrder = 0 36 | Text = 'Close' 37 | OnClick = Button1Click 38 | end 39 | end 40 | object Panel2: TPanel 41 | Align = Top 42 | Margins.Bottom = 4.000000000000000000 43 | Position.X = 10.000000000000000000 44 | Position.Y = 10.000000000000000000 45 | Size.Width = 654.000000000000000000 46 | Size.Height = 152.000000000000000000 47 | Size.PlatformDefault = False 48 | StyleLookup = 'Panel1Style1' 49 | TabOrder = 1 50 | object Label1: TLabel 51 | Align = Top 52 | Size.Width = 654.000000000000000000 53 | Size.Height = 17.000000000000000000 54 | Size.PlatformDefault = False 55 | StyleLookup = 'Label1Style1' 56 | Text = 'Version:' 57 | end 58 | object lblVersion: TLabel 59 | Align = Top 60 | Position.Y = 17.000000000000000000 61 | Size.Width = 654.000000000000000000 62 | Size.Height = 17.000000000000000000 63 | Size.PlatformDefault = False 64 | Text = 'lblVersion' 65 | end 66 | object Label3: TLabel 67 | Align = Top 68 | Margins.Top = 6.000000000000000000 69 | Position.Y = 40.000000000000000000 70 | Size.Width = 654.000000000000000000 71 | Size.Height = 17.000000000000000000 72 | Size.PlatformDefault = False 73 | StyleLookup = 'Label1Style1' 74 | Text = 'Release Page Link:' 75 | end 76 | object lblReleasesLink: TLabel 77 | Align = Top 78 | HitTest = True 79 | Position.Y = 57.000000000000000000 80 | Size.Width = 654.000000000000000000 81 | Size.Height = 17.000000000000000000 82 | Size.PlatformDefault = False 83 | StyleLookup = 'Label4Style1' 84 | Text = 'Release Link' 85 | OnClick = lblReleasesLinkClick 86 | end 87 | object Label6: TLabel 88 | Align = Top 89 | Margins.Top = 6.000000000000000000 90 | Position.Y = 80.000000000000000000 91 | Size.Width = 654.000000000000000000 92 | Size.Height = 17.000000000000000000 93 | Size.PlatformDefault = False 94 | StyleLookup = 'Label1Style1' 95 | Text = 'Direct Download Link:' 96 | end 97 | object lblDownloadLink: TLabel 98 | Align = Top 99 | HitTest = True 100 | Margins.Bottom = 6.000000000000000000 101 | Position.Y = 97.000000000000000000 102 | Size.Width = 654.000000000000000000 103 | Size.Height = 17.000000000000000000 104 | Size.PlatformDefault = False 105 | StyleLookup = 'Label4Style1' 106 | Text = 'Download Link' 107 | OnClick = lblReleasesLinkClick 108 | end 109 | object Label2: TLabel 110 | Align = Top 111 | Position.Y = 120.000000000000000000 112 | Size.Width = 654.000000000000000000 113 | Size.Height = 17.000000000000000000 114 | Size.PlatformDefault = False 115 | StyleLookup = 'Label1Style1' 116 | Text = 'Download Count:' 117 | end 118 | object lblDownloadCount: TLabel 119 | Align = Top 120 | Position.Y = 137.000000000000000000 121 | Size.Width = 654.000000000000000000 122 | Size.Height = 17.000000000000000000 123 | Size.PlatformDefault = False 124 | Text = '0' 125 | end 126 | end 127 | object Panel3: TPanel 128 | Align = Client 129 | Margins.Bottom = 4.000000000000000000 130 | Size.Width = 654.000000000000000000 131 | Size.Height = 126.000000000000000000 132 | Size.PlatformDefault = False 133 | StyleLookup = 'Panel1Style1' 134 | TabOrder = 2 135 | object Label5: TLabel 136 | Align = Top 137 | Margins.Bottom = 4.000000000000000000 138 | Size.Width = 654.000000000000000000 139 | Size.Height = 17.000000000000000000 140 | Size.PlatformDefault = False 141 | StyleLookup = 'Label1Style1' 142 | Text = 'Description:' 143 | end 144 | object Memo1: TMemo 145 | Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] 146 | Align = Client 147 | Margins.Bottom = 4.000000000000000000 148 | Size.Width = 654.000000000000000000 149 | Size.Height = 101.000000000000000000 150 | Size.PlatformDefault = False 151 | TabOrder = 1 152 | ReadOnly = True 153 | end 154 | end 155 | object StyleBook1: TStyleBook 156 | Left = 496 157 | Top = 24 158 | ResourcesBin = { 159 | 464D585F5354594C4520322E3501060C50616E656C315374796C653103E10006 160 | 0C4C6162656C345374796C6531037F01060C4C6162656C315374796C65310365 161 | 0100545046300A5452656374616E676C6500095374796C654E616D65060C5061 162 | 6E656C315374796C65310A46696C6C2E436F6C6F720709784646463446344634 163 | 0748697454657374080A506F736974696F6E2E5805000000000000009A07400A 164 | 506F736974696F6E2E590500000000000000A507400553696465730B000A5369 165 | 7A652E576964746805000000000000008908400B53697A652E48656967687405 166 | 00000000000000F003401453697A652E506C6174666F726D44656661756C7408 167 | 0C5374726F6B652E436F6C6F7207097846463937393739370756697369626C65 168 | 0800005450463007544C61796F757400095374796C654E616D65060C4C616265 169 | 6C345374796C653106437572736F72070B637248616E64506F696E7407486974 170 | 54657374090A506F736974696F6E2E5805000000000000009A07400A506F7369 171 | 74696F6E2E590500000000000000A807400A53697A652E576964746805000000 172 | 000000008908400B53697A652E48656967687405000000000000008803401453 173 | 697A652E506C6174666F726D44656661756C74080756697369626C6508085461 174 | 624F7264657202010005545465787400095374796C654E616D65060474657874 175 | 05416C69676E0706436C69656E74064C6F636B6564090A53697A652E57696474 176 | 6805000000000000008908400B53697A652E4865696768740500000000000000 177 | 8803401453697A652E506C6174666F726D44656661756C740817546578745365 178 | 7474696E67732E466F6E742E5374796C650B0B6673556E6465726C696E650016 179 | 5465787453657474696E67732E466F6E74436F6C6F720707636C61426C756500 180 | 00005450463007544C61796F757400095374796C654E616D65060C4C6162656C 181 | 315374796C653106437572736F72070B637248616E64506F696E740748697454 182 | 657374090A506F736974696F6E2E5805000000000000009407400A506F736974 183 | 696F6E2E590500000000000000A807400A53697A652E57696474680500000000 184 | 0000C08E08400B53697A652E4865696768740500000000000000880340145369 185 | 7A652E506C6174666F726D44656661756C7408085461624F7264657202020005 186 | 545465787400095374796C654E616D6506047465787405416C69676E0706436C 187 | 69656E7406437572736F72070B637248616E64506F696E74064C6F636B656409 188 | 0A53697A652E576964746805000000000000C08E08400B53697A652E48656967 189 | 687405000000000000008803401453697A652E506C6174666F726D4465666175 190 | 6C7408175465787453657474696E67732E466F6E742E5374796C650B06667342 191 | 6F6C6400000000} 192 | end 193 | end 194 | -------------------------------------------------------------------------------- /JsonToDelphiClass.mes: -------------------------------------------------------------------------------- 1 | [GeneralSettings] 2 | MesVersion=4 3 | HandleExceptions=1 4 | LinkInCode=1 5 | AppendMapFileToBinary=1 6 | NoOwnMadExceptSettings=0 7 | CheckFileCrc=1 8 | CheckForFrozenMainThread=0 9 | FreezeTimeout=60000 10 | ReportLeaks=0 11 | WindowsLogo=0 12 | CrashOnBuffer=0 13 | CrashOnUnderrun=0 14 | AutomaticallySaveBugReport=1 15 | AutoSaveBugReportIfNotSent=1 16 | AutomaticallyMailBugReport=0 17 | AutoMailProgressBox=0 18 | CopyBugReportToClipboard=0 19 | SuspendAllRunningThreads=0 20 | ShowPleaseWaitBox=1 21 | PleaseWaitIcon=plwait1 22 | AutomaticallyContinueApplication=0 23 | AutomaticallyRestartApplication=0 24 | AutomaticallyCloseApplication=0 25 | SendInBackground=1 26 | SendHelper=196608 27 | Send32Icon=send321 28 | UploadViaHttp=0 29 | HttpServer= 30 | HttpSsl=0 31 | HttpPort=0 32 | HttpAccount= 33 | HttpPassword= 34 | UploadToFogBugz=0 35 | UploadToBugZilla=0 36 | UploadToMantis=0 37 | BugTrackerAccount= 38 | BugTrackerPassword= 39 | BugTrackerProject= 40 | BugTrackerArea= 41 | BugTrackerAssignTo= 42 | MailAsSmtpServer=0 43 | MailAsSmtpClient=0 44 | SmtpServer= 45 | SmtpSsl=0 46 | SmtpTls=0 47 | SmtpPort=0 48 | SmtpAccount= 49 | SmtpPassword= 50 | MailViaMapi=1 51 | MailViaMailto=1 52 | MailAddress=petar@pgeorgiev.com 53 | BugReportFile=bugreport.txt 54 | AttachBugReport=1 55 | AttachBugReportFile=1 56 | DeleteBugReportFile=1 57 | BugReportSendAs=bugreport.txt 58 | BugReportZip= 59 | ScreenShotDepth=8 60 | ScreenShotAppOnly=1 61 | ScreenShotSendAs=screenshot.png 62 | ScreenShotZip= 63 | AdditionalAttachments= 64 | AppendBugReports=1 65 | BugReportFileSize=100000 66 | DontSaveDuplicateExceptions=1 67 | DontSaveDuplicateFreezings=1 68 | DuplicateExceptionDefinition=1 69 | DuplicateFreezeDefinition=2 70 | ShowExceptionBox=1 71 | OkBtnText=&OK 72 | DetailsBtnText=&Details 73 | PleaseWaitTitle=Information 74 | PleaseWaitText=Please wait a moment... 75 | BugTrackerTitle=%25appname%25, %25exceptMsg%25 76 | BugTrackerDescr=error details: %0d%0a%25errorDetails%25 77 | MailSubject=bug report 78 | MailBody=please find the bug report attached 79 | SendBoxTitle=Sending bug report... 80 | PrepareAttachMsg=Preparing attachments... 81 | MxLookupMsg=Searching for mail server... 82 | ConnectMsg=Connecting to server... 83 | SendMailMsg=Sending mail... 84 | FieldsMsg=Setting fields... 85 | SendAttachMsg=Sending attachments... 86 | SendFinalizeMsg=Finalizing... 87 | MailFailureMsg=Sorry, sending the bug report didn't work. 88 | VersionVariable= 89 | [ExceptionBox] 90 | ShowButtonMailBugReport=1 91 | ShowButtonSaveBugReport=0 92 | ShowButtonPrintBugReport=0 93 | ShowButtonShowBugReport=1 94 | ShowButtonContinueApplication=1 95 | ShowButtonRestartApplication=1 96 | ShowButtonCloseApplication=1 97 | IconButtonSendBugReport=send1 98 | IconButtonSaveBugReport=save1 99 | IconButtonPrintBugReport=print1 100 | IconButtonShowBugReport=show1 101 | IconButtonContinueApplication=continue1 102 | IconButtonCantContinueApplication=cantContinue1 103 | IconButtonRestartApplication=restart1 104 | IconButtonCloseApplication=close1 105 | FocusedButton=0 106 | SendAssistant=SendAssistant 107 | SaveAssistant=SaveAssistant 108 | PrintAssistant=PrintAssistant 109 | AutomaticallyShowBugReport=0 110 | NoOwnerDrawButtons=0 111 | BigExceptionIcon=big1 112 | TitleBar=%25appname%25 113 | ExceptionMessage=An error occurred in the application. 114 | FrozenMessage=The application seems to be frozen. 115 | BitFaultMsg=The file "%25modname%25" seems to be corrupt! 116 | MailBugReportText=send bug report 117 | SaveBugReportText=save bug report 118 | PrintBugReportText=print bug report 119 | ShowBugReportText=show bug report 120 | ContinueApplicationText=continue application 121 | RestartApplicationText=restart application 122 | CloseApplicationText=close application 123 | [BugReport] 124 | ListThreads=1 125 | ListModules=1 126 | ListHardware=1 127 | ShowCpuRegisters=1 128 | ShowStackDump=1 129 | Disassembly=1 130 | HideUglyItems=0 131 | ShowRelativeAddrs=1 132 | ShowRelativeLines=1 133 | FormatDisassembly=0 134 | LimitDisassembly=5 135 | EnabledPlugins=modules|processes|hardware 136 | [Filters] 137 | Filter1ExceptionClasses=EDBEditError, EJsonMapper 138 | Filter1DontCreateBugReport=1 139 | Filter1DontCreateScreenshot=1 140 | Filter1DontSuspendThreads=1 141 | Filter1DontCallHandlers=1 142 | Filter1ShowBox=3 143 | Filter1Assis= 144 | Filter2ExceptionClasses= 145 | Filter2DontCreateBugReport=0 146 | Filter2DontCreateScreenshot=0 147 | Filter2DontSuspendThreads=0 148 | Filter2DontCallHandlers=0 149 | Filter2ShowBox=0 150 | Filter2Assis= 151 | GeneralDontCreateBugReport=0 152 | GeneralDontCreateScreenshot=0 153 | GeneralDontSuspendThreads=0 154 | GeneralDontCallHandlers=0 155 | GeneralShowBox=0 156 | GeneralAssis= 157 | [Assistants] 158 | Assistant1=SendAssistant|Send Assistant|ContactForm|DetailsForm|ScrShotForm 159 | Assistant2=SaveAssistant|Save Assistant|ContactForm|DetailsForm 160 | Assistant3=PrintAssistant|Print Assistant|ContactForm|DetailsForm 161 | Forms1=TPF0%0eTMEContactForm%0bContactForm%07Message%0c%13%00%00%00Contact Information%08MinWidth%04%00%00%00%00%08OnAction%0c%1b%00%00%00madExcept.HandleContactForm%05Timer%04%00%00%00%00%00%09INVButton%0bContinueBtn%07Caption%0c%08%00%00%00Continue%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%09INVButton%07SkipBtn%07Caption%0c%04%00%00%00Skip%07Enabled%08%0bNoOwnerDraw%08%07Visible%09%00%00%09INVButton%09CancelBtn%07Caption%0c%06%00%00%00Cancel%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%08INVLabel%06Label1%07Caption%0c%0a%00%00%00your name:%07Enabled%09%07Spacing%04%00%00%00%00%00%00%07INVEdit%08NameEdit%07Colored%09%07Enabled%09%05Lines%04%01%00%00%00%08Optional%09%0aOutputName%0c%0c%00%00%00contact name%0aOutputType%07%09nvoHeader%07Spacing%04%00%00%00%00%04Text%0c%00%00%00%00%05Valid%09%00%00%08INVLabel%06Label2%07Caption%0c%0b%00%00%00your email:%07Enabled%09%07Spacing%04%00%00%00%00%00%00%07INVEdit%09EmailEdit%07Colored%09%07Enabled%09%05Lines%04%01%00%00%00%08Optional%08%0aOutputName%0c%0d%00%00%00contact email%0aOutputType%07%09nvoHeader%07Spacing%04%00%00%00%00%04Text%0c%00%00%00%00%05Valid%09%00%00%0bINVCheckBox%08MemCheck%07Caption%0c%0b%00%00%00remember me%07Checked%08%07Enabled%09%0aOutputName%0c%00%00%00%00%07Spacing%04%00%00%00%00%00%00%00 162 | Forms2=TPF0%0eTMEDetailsForm%0bDetailsForm%07Message%0c%0d%00%00%00Error Details%08MinWidth%04%00%00%00%00%08OnAction%0c%00%00%00%00%05Timer%04%00%00%00%00%00%09INVButton%0bContinueBtn%07Caption%0c%08%00%00%00Continue%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%09INVButton%07SkipBtn%07Caption%0c%04%00%00%00Skip%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%09INVButton%09CancelBtn%07Caption%0c%06%00%00%00Cancel%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%08INVLabel%06Label1%07Caption%0c,%00%00%00what were you doing when the error occurred?%07Enabled%09%07Spacing%04%00%00%00%00%00%00%07INVEdit%0bDetailsMemo%07Colored%09%07Enabled%09%05Lines%04%09%00%00%00%08Optional%08%0aOutputName%0c%0d%00%00%00error details%0aOutputType%07%0dnvoOwnSection%07Spacing%04%00%00%00%00%04Text%0c%00%00%00%00%05Valid%09%00%00%00 163 | Forms3=TPF0%0eTMEScrShotForm%0bScrShotForm%0dActiveControl%07%0bContinueBtn%07Message%0c%18%00%00%00Screenshot Configuration%08MinWidth%04%00%00%00%00%08OnAction%0c%1e%00%00%00madExcept.HandleScreenshotForm%05Timer%04%fa%00%00%00%00%09INVButton%0bContinueBtn%07Caption%0c%08%00%00%00Continue%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%09INVButton%07SkipBtn%07Caption%0c%04%00%00%00Skip%07Enabled%08%0bNoOwnerDraw%08%07Visible%09%00%00%09INVButton%09CancelBtn%07Caption%0c%06%00%00%00Cancel%07Enabled%09%0bNoOwnerDraw%08%07Visible%09%00%00%0bINVCheckBox%0bAttachCheck%07Caption%0c%25%00%00%00attach a screenshot to the bug report%07Checked%09%07Enabled%09%0aOutputName%0c%00%00%00%00%07Spacing%04%00%00%00%00%00%00%08INVImage%0aScrShotImg%06Border%09%09Clickable%09%07Enabled%09%04File%0c%00%00%00%00%06Height%04%00%00%00%00%07Spacing%04%00%00%00%00%05Width%04%00%00%00%00%00%00%08INVLabel%06Label1%07Caption%0c%15%00%00%00(click to edit image)%07Enabled%09%07Spacing%04%00%00%00%00%00%00%00 164 | -------------------------------------------------------------------------------- /uMainForm.pas: -------------------------------------------------------------------------------- 1 | unit uMainForm; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 7 | FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls, 8 | FMX.Layouts, FMX.Memo, System.Json, Rest.Json, FMX.TreeView, TypInfo, RTTI, 9 | regularexpressions, generics.collections, Pkg.Json.Mapper, NetEncoding, 10 | FMX.Menus, FMX.Controls.Presentation, FMX.Edit, FMX.ConstrainedForm, REST.Client, 11 | uUpdate, System.Threading, uGitHub, FMX.Objects, uUpdateForm, SyncObjs, 12 | FMX.ScrollBox; 13 | 14 | const JsonValidatorUrl = 'http://jsonlint.com'; 15 | 16 | type 17 | 18 | TMainForm = class(TConstrainedForm) 19 | Memo1: TMemo; 20 | tv: TTreeView; 21 | StyleBook1: TStyleBook; 22 | StatusBar1: TStatusBar; 23 | Label1: TLabel; 24 | MainPopupMenu: TPopupMenu; 25 | MenuItem1: TMenuItem; 26 | MenuItem2: TMenuItem; 27 | MenuItem3: TMenuItem; 28 | Panel1: TPanel; 29 | Panel2: TPanel; 30 | Splitter1: TSplitter; 31 | Panel3: TPanel; 32 | btnVisualize: TButton; 33 | btnOnlineJsonValidator: TButton; 34 | btnExit: TButton; 35 | Label3: TLabel; 36 | Label4: TLabel; 37 | Edit2: TEdit; 38 | Label5: TLabel; 39 | MemoPopupMenu: TPopupMenu; 40 | MenuItem4: TMenuItem; 41 | MenuItem5: TMenuItem; 42 | MenuItem6: TMenuItem; 43 | MenuItem7: TMenuItem; 44 | Panel4: TPanel; 45 | MenuItem8: TMenuItem; 46 | btnGenerateUnit: TButton; 47 | procedure btnVisualizeClick(Sender: TObject); 48 | procedure FormCreate(Sender: TObject); 49 | procedure FormDestroy(Sender: TObject); 50 | procedure PreviewUnitClick(Sender: TObject); 51 | procedure btnExitClick(Sender: TObject); 52 | procedure MainPopupMenuPopup(Sender: TObject); 53 | procedure tvDblClick(Sender: TObject); 54 | procedure Memo1DblClick(Sender: TObject); 55 | procedure MenuItem3Click(Sender: TObject); 56 | procedure MenuItem5Click(Sender: TObject); 57 | procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); 58 | procedure Label1Click(Sender: TObject); 59 | procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; 60 | Shift: TShiftState); 61 | procedure tvKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; 62 | Shift: TShiftState); 63 | procedure Panel1Resize(Sender: TObject); 64 | procedure MenuItem8Click(Sender: TObject); 65 | procedure btnOnlineJsonValidatorClick(Sender: TObject); 66 | private 67 | { Private declarations } 68 | procedure DisableMenuItems; 69 | procedure VisualizeClass; 70 | procedure PrepareMenu; 71 | procedure DisableGuiElements; 72 | public 73 | { Public declarations } 74 | jm: TPkgJsonMapper; 75 | FCheckVersionResponse: TObject; 76 | FChanged: boolean; 77 | // 0: Active 78 | // 1: Terminating 79 | // >=2: Terminated 80 | FApplicationStatus: integer; 81 | FUpdateCheckEvent: TEvent; 82 | end; 83 | 84 | var 85 | MainForm: TMainForm; 86 | 87 | implementation 88 | 89 | {$R *.fmx} 90 | 91 | uses uSaveUnitForm, 92 | {$IFDEF MSWINDOWS} 93 | Winapi.ShellAPI, Winapi.Windows; 94 | {$ENDIF MSWINDOWS} 95 | {$IFDEF POSIX} 96 | Posix.Stdlib; 97 | {$ENDIF POSIX} 98 | 99 | procedure TMainForm.btnOnlineJsonValidatorClick(Sender: TObject); 100 | begin 101 | MenuItem8Click(nil); 102 | end; 103 | 104 | procedure TMainForm.btnVisualizeClick(Sender: TObject); 105 | begin 106 | if FChanged then 107 | MessageDlg('You made changes to the structure. Do you want to load original class?', TMsgDlgType.mtWarning, [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo], 0, 108 | procedure(const AResult: TModalResult) 109 | begin 110 | if AResult = mrYes then 111 | VisualizeClass; 112 | end 113 | ) 114 | else 115 | VisualizeClass; 116 | end; 117 | 118 | procedure TMainForm.DisableGuiElements; 119 | begin 120 | edit2.Enabled := false; 121 | Memo1.Enabled := false; 122 | tv.Enabled := false; 123 | tv.PopupMenu := nil; 124 | btnExit.Enabled := false; 125 | btnVisualize.Enabled := false; 126 | btnGenerateUnit.Enabled := false; 127 | end; 128 | 129 | procedure TMainForm.DisableMenuItems; 130 | var 131 | k: integer; 132 | begin 133 | for k := 0 to MainPopupMenu.ItemsCount - 1 do 134 | begin 135 | MainPopupMenu.Items[k].Enabled := false; 136 | end; 137 | end; 138 | 139 | procedure TMainForm.PreviewUnitClick(Sender: TObject); 140 | begin 141 | if tv.Count = 0 then 142 | btnVisualizeClick(self); 143 | 144 | jm.DestinationUnitName := edit2.Text; 145 | SaveUnitForm.sd.FileName := jm.DestinationUnitName + '.pas'; 146 | 147 | SaveUnitForm.Memo1.DeleteSelection; 148 | SaveUnitForm.Memo1.Text := jm.GenerateUnit; 149 | SaveUnitForm.Caption := 'Preview Delphi Unit - ' + SaveUnitForm.sd.FileName; 150 | 151 | // ShowModal bug - QC129552 152 | // The same is declared in the SaveUnitForm's OnShow event 153 | SaveUnitForm.width := MainForm.Width - 50; 154 | SaveUnitForm.height := MainForm.Height - 50; 155 | SaveUnitForm.left := MainForm.Left + 25; 156 | SaveUnitForm.top := MainForm.Top + 25; 157 | 158 | SaveUnitForm.ShowModal; 159 | end; 160 | 161 | procedure TMainForm.btnExitClick(Sender: TObject); 162 | begin 163 | Close; 164 | end; 165 | 166 | procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); 167 | begin 168 | if FUpdateCheckEvent.WaitFor(0) = wrSignaled then 169 | CanClose := true 170 | else 171 | begin 172 | CanClose := false; 173 | 174 | case FApplicationStatus of 175 | 0: 176 | begin 177 | TInterlocked.Increment(FApplicationStatus); 178 | DisableGuiElements; 179 | 180 | label1.Text := 'Terminating application, please wait...'; 181 | 182 | // We start a termination task. 183 | // This way the main thread will not freeze 184 | TTask.Run( 185 | procedure 186 | begin 187 | FUpdateCheckEvent.WaitFor(); 188 | 189 | // Indicate next stage 190 | TInterlocked.Increment(FApplicationStatus); 191 | 192 | // We enqueue the handler 193 | TThread.Queue(nil, 194 | procedure 195 | begin 196 | Close; 197 | end 198 | ); 199 | end 200 | ); 201 | 202 | end; 203 | 1: ; 204 | else 205 | CanClose := true; 206 | end; 207 | end; 208 | end; 209 | 210 | procedure TMainForm.FormCreate(Sender: TObject); 211 | begin 212 | FApplicationStatus := 0; 213 | FUpdateCheckEvent := TEvent.Create(nil, true, false, ''); 214 | 215 | self.Constraints.MinWidth := 1024; 216 | self.Constraints.MinHeight := 560; 217 | 218 | Caption := 'JsonToDelphiClass - ' + FloatToStr(ProgramVersion, PointDsFormatSettings) + ' | By Petar Georgiev'; 219 | 220 | jm := TPkgJsonMapper.Create(tv); 221 | 222 | label1.Text := 'Checking for update...'; 223 | 224 | NewCheckForUpdateTask( 225 | procedure(ARelease: TObject) 226 | begin 227 | FCheckVersionResponse := ARelease; 228 | if FCheckVersionResponse is TReleaseClass then 229 | begin 230 | label1.StyleLookup := 'LabelLinkStyle'; 231 | label1.Text := 'Version ' + (FCheckVersionResponse as TReleaseClass).tag_name + ' is available! Click here to download!'; 232 | (label1.FindStyleResource('text') as TText).OnClick := label1Click; 233 | label1.HitTest := true; 234 | end 235 | else 236 | if FCheckVersionResponse is TErrorClass then 237 | begin 238 | label1.StyleLookup := 'LabelErrorStyle'; 239 | label1.Text := 'Error checking for new version: ' + (FCheckVersionResponse as TErrorClass).message; 240 | end 241 | else 242 | begin 243 | label1.StyleLookup := 'LabelGreenStyle'; 244 | label1.Text := 'Your version ' + FloatToStr(uUpdate.ProgramVersion, PointDsFormatSettings) + ' is up to date! For more information about JsonToDelphiClass click here!'; 245 | (label1.FindStyleResource('text') as TText).OnClick := label1Click; 246 | end; 247 | FUpdateCheckEvent.SetEvent; 248 | end 249 | ); 250 | 251 | end; 252 | 253 | procedure TMainForm.FormDestroy(Sender: TObject); 254 | begin 255 | FreeAndNil(FUpdateCheckEvent); 256 | FreeAndNil(jm); 257 | FreeAndNil(FCheckVersionResponse); 258 | end; 259 | 260 | procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word; 261 | var KeyChar: Char; Shift: TShiftState); 262 | begin 263 | if Key = 27 then 264 | close; 265 | end; 266 | 267 | procedure TMainForm.Label1Click(Sender: TObject); 268 | begin 269 | if FCheckVersionResponse <> nil then 270 | begin 271 | UpdateForm.FRelease := FCheckVersionResponse as TReleaseClass; 272 | UpdateForm.ShowModal; 273 | end 274 | else 275 | begin 276 | {$IFDEF MSWINDOWS} 277 | ShellExecute(0, 'OPEN', PChar(ProgramUrl), '', '', SW_SHOWNORMAL); 278 | {$ENDIF MSWINDOWS} 279 | {$IFDEF POSIX} 280 | _system(PAnsiChar('open ' + AnsiString(ProgramUrl))); 281 | {$ENDIF POSIX} 282 | end; 283 | end; 284 | 285 | procedure TMainForm.Memo1DblClick(Sender: TObject); 286 | var 287 | LTsl: TStringList; 288 | LJsonValue: TJSONValue; 289 | begin 290 | LTsl := TStringList.Create; 291 | try 292 | LJsonValue := TJSONObject.ParseJSONValue(memo1.Text); 293 | try 294 | if LJsonValue <> nil then 295 | PrettyPrintJSON(LJsonValue, LTsl); 296 | finally 297 | LJsonValue.Free; 298 | end; 299 | memo1.Text := LTsl.Text; 300 | finally 301 | LTsl.Free; 302 | end; 303 | end; 304 | 305 | procedure TMainForm.MenuItem3Click(Sender: TObject); 306 | var 307 | LString: string; 308 | LField: TStubField; 309 | begin 310 | LField := (Sender as TFmxObject).TagObject as TStubField; 311 | LString := InputBox('Rename Property ' + LField.Name, 'Enter new Property name', LField.Name); 312 | if (LString <> '') AND (LString.ToLower <> LField.Name.ToLower) then 313 | begin 314 | FChanged := true; 315 | LField.Name := LString; 316 | jm.Visualize(tv, 'TreeViewItem1Style1'); 317 | end; 318 | end; 319 | 320 | procedure TMainForm.MenuItem5Click(Sender: TObject); 321 | var 322 | LString: string; 323 | LClass: TStubClass; 324 | begin 325 | LClass := (Sender as TFmxObject).TagObject as TStubClass; 326 | LString := InputBox('Rename Class ' + LClass.Name, 'Enter new Class name', LClass.PureClassName); 327 | if (LString <> '') AND (LString.ToLower <> LClass.PureClassName.ToLower) then 328 | begin 329 | FChanged := true; 330 | LClass.Name := LString; 331 | jm.Visualize(tv, 'TreeViewItem1Style1'); 332 | end; 333 | end; 334 | 335 | procedure TMainForm.MenuItem8Click(Sender: TObject); 336 | begin 337 | {$IFDEF MSWINDOWS} 338 | ShellExecute(0, 'OPEN', PChar(JsonValidatorUrl), '', '', SW_SHOWNORMAL); 339 | {$ENDIF MSWINDOWS} 340 | {$IFDEF POSIX} 341 | _system(PAnsiChar('open ' + AnsiString(JsonValidatorUrl))); 342 | {$ENDIF POSIX} 343 | end; 344 | 345 | procedure TMainForm.Panel1Resize(Sender: TObject); 346 | begin 347 | if Panel1.Width < 200 then 348 | Panel1.Width := 200 349 | else 350 | if Panel1.Width > (MainForm.Width - 20) div 2 then 351 | Panel1.Width := (MainForm.Width - 20) div 2; 352 | end; 353 | 354 | procedure TMainForm.MainPopupMenuPopup(Sender: TObject); 355 | var 356 | LItem: TTreeViewItem; 357 | LPoint: TPointF; 358 | begin 359 | DisableMenuItems; 360 | MainPopupMenu.Items[0].Text := '---'; 361 | LPoint := tv.AbsoluteToLocal(ScreenToClient(MainPopupMenu.PopupPoint)); 362 | LItem := tv.ItemByPoint(LPoint.X, LPoint.Y); 363 | if LItem <> nil then 364 | LItem.Select; 365 | 366 | PrepareMenu; 367 | end; 368 | 369 | procedure TMainForm.PrepareMenu; 370 | var 371 | LField: TStubField; 372 | begin 373 | if tv.Selected <> nil then 374 | begin 375 | MainPopupMenu.Items[0].Text := tv.Selected.Text; 376 | 377 | if tv.Selected <> tv.Items[0] then 378 | begin 379 | LField := tv.Selected.TagObject as TStubField; 380 | 381 | MainPopupMenu.Items[2].Enabled := true; 382 | MainPopupMenu.Items[2].TagObject := LField; 383 | 384 | if (LField is TStubContainerField) AND ((LField as TStubContainerField).ContainedType = TJsonType.jtObject) then 385 | begin 386 | MainPopupMenu.Items[3].Enabled := true; 387 | MainPopupMenu.Items[3].TagObject := (LField as TStubContainerField).FieldClass; 388 | end; 389 | end 390 | else 391 | begin 392 | MainPopupMenu.Items[3].Enabled := true; 393 | MainPopupMenu.Items[3].TagObject := tv.Selected.TagObject; 394 | end; 395 | end; 396 | end; 397 | 398 | procedure TMainForm.tvDblClick(Sender: TObject); 399 | begin 400 | if tv.Selected <> nil then 401 | tv.Selected.IsExpanded := not tv.Selected.IsExpanded; 402 | end; 403 | 404 | procedure TMainForm.tvKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; 405 | Shift: TShiftState); 406 | begin 407 | if ((KeyChar = #0) AND (Key = 113)) AND (tv.Selected <> nil) then 408 | begin 409 | PrepareMenu; 410 | 411 | if tv.Selected = tv.Items[0] then 412 | MenuItem5Click(MenuItem5) 413 | else 414 | MenuItem3Click(MenuItem3); 415 | end; 416 | 417 | end; 418 | 419 | procedure TMainForm.VisualizeClass; 420 | begin 421 | FChanged := false; 422 | 423 | jm.Parse(memo1.Text, 'Root'); 424 | jm.Visualize(tv, 'TreeViewItem1Style1'); 425 | 426 | // Workarround for QC129540 427 | Panel1.Width := Panel1.Width + 1; 428 | Panel1.Width := Panel1.Width - 1; 429 | end; 430 | 431 | end. 432 | -------------------------------------------------------------------------------- /uGitHub.pas: -------------------------------------------------------------------------------- 1 | unit uGitHub; 2 | 3 | // ************************************************* 4 | // Generated By: JsonToDelphiClass - 0.64 5 | // Generated On: 2015-01-03 15:32:27 6 | // ************************************************* 7 | // Created By : Petar Georgiev - 2014 8 | // Web Site : http://pgeorgiev.com 9 | // ************************************************* 10 | 11 | interface 12 | 13 | uses Generics.Collections, Rest.Json, IdUri, IdHttp, 14 | IdSSLOpenSSL, System.JSON, SysUtils, Classes; 15 | 16 | type 17 | 18 | // Represents a serializable object with HTTP/REST capabilities (via Indy) 19 | // HTTPS connections require OpenSSL binaries! 20 | // Use the "AOnBeforeRequest" event to setup HTTP client's parameters like timeout, encoding etc. 21 | // 22 | TUGitHubSerializableObject = class abstract 23 | protected 24 | // As per http://www.restapitutorial.com/lessons/httpmethods.html 25 | class procedure EnsureHttpResponseCode(AHttpResponseCode: integer; AUrl: string; AValidValues: array of integer); 26 | class procedure EnsureHttpContentType(AHttp: TIdHttp); 27 | public 28 | // Generic Web Request method 29 | class function WebRequest(AUrl: string; AOnRequest: TProc): integer; 30 | // Returns an instance of T from a JSON string via GET request. AArrayProperty is intended for internal use only! 31 | // HttpGet is reintroduced in descendant classes to return concrete instance 32 | class function HttpGet 33 | (AUrl: string; AOnBeforeRequest: TProc = nil; AArrayProperty: string = ''): T; 34 | // Performs POST request, sends the current object as JSON string and returns server's response as text. 35 | function HttpPost (AUrl: string; AOnBeforeRequest: TProc = nil): string; 36 | // Performs PUT request, sends the current object as JSON string and returns server's response as text. 37 | function HttpPut (AUrl: string; AOnBeforeRequest: TProc = nil): string; 38 | // Performs DELETE request and returns server's response as text. This method exists just REST compliance. 39 | function HttpDelete(AUrl: string; AOnBeforeRequest: TProc = nil): string; 40 | end; 41 | 42 | TUploaderClass = class 43 | private 44 | FAvatar_url: String; 45 | FEvents_url: String; 46 | FFollowers_url: String; 47 | FFollowing_url: String; 48 | FGists_url: String; 49 | FGravatar_id: String; 50 | FHtml_url: String; 51 | FId: Extended; 52 | FLogin: String; 53 | FOrganizations_url: String; 54 | FReceived_events_url: String; 55 | FRepos_url: String; 56 | FSite_admin: Boolean; 57 | FStarred_url: String; 58 | FSubscriptions_url: String; 59 | FType: String; 60 | FUrl: String; 61 | public 62 | property avatar_url: String read FAvatar_url write FAvatar_url; 63 | property events_url: String read FEvents_url write FEvents_url; 64 | property followers_url: String read FFollowers_url write FFollowers_url; 65 | property following_url: String read FFollowing_url write FFollowing_url; 66 | property gists_url: String read FGists_url write FGists_url; 67 | property gravatar_id: String read FGravatar_id write FGravatar_id; 68 | property html_url: String read FHtml_url write FHtml_url; 69 | property id: Extended read FId write FId; 70 | property login: String read FLogin write FLogin; 71 | property organizations_url: String read FOrganizations_url write FOrganizations_url; 72 | property received_events_url: String read FReceived_events_url write FReceived_events_url; 73 | property repos_url: String read FRepos_url write FRepos_url; 74 | property site_admin: Boolean read FSite_admin write FSite_admin; 75 | property starred_url: String read FStarred_url write FStarred_url; 76 | property subscriptions_url: String read FSubscriptions_url write FSubscriptions_url; 77 | property &type: String read FType write FType; 78 | property url: String read FUrl write FUrl; 79 | function ToJsonString: string; 80 | class function FromJsonString(AJsonString: string): TUploaderClass; 81 | end; 82 | 83 | TAssetsClass = class 84 | private 85 | FBrowser_download_url: String; 86 | FContent_type: String; 87 | FCreated_at: String; 88 | FDownload_count: Extended; 89 | FId: Extended; 90 | FName: String; 91 | FSize: Extended; 92 | FState: String; 93 | FUpdated_at: String; 94 | FUploader: TUploaderClass; 95 | FUrl: String; 96 | public 97 | property browser_download_url: String read FBrowser_download_url write FBrowser_download_url; 98 | property content_type: String read FContent_type write FContent_type; 99 | property created_at: String read FCreated_at write FCreated_at; 100 | property download_count: Extended read FDownload_count write FDownload_count; 101 | property id: Extended read FId write FId; 102 | property name: String read FName write FName; 103 | property size: Extended read FSize write FSize; 104 | property state: String read FState write FState; 105 | property updated_at: String read FUpdated_at write FUpdated_at; 106 | property uploader: TUploaderClass read FUploader write FUploader; 107 | property url: String read FUrl write FUrl; 108 | constructor Create; 109 | destructor Destroy; override; 110 | function ToJsonString: string; 111 | class function FromJsonString(AJsonString: string): TAssetsClass; 112 | end; 113 | 114 | TAuthorClass = class 115 | private 116 | FAvatar_url: String; 117 | FEvents_url: String; 118 | FFollowers_url: String; 119 | FFollowing_url: String; 120 | FGists_url: String; 121 | FGravatar_id: String; 122 | FHtml_url: String; 123 | FId: Extended; 124 | FLogin: String; 125 | FOrganizations_url: String; 126 | FReceived_events_url: String; 127 | FRepos_url: String; 128 | FSite_admin: Boolean; 129 | FStarred_url: String; 130 | FSubscriptions_url: String; 131 | FType: String; 132 | FUrl: String; 133 | public 134 | property avatar_url: String read FAvatar_url write FAvatar_url; 135 | property events_url: String read FEvents_url write FEvents_url; 136 | property followers_url: String read FFollowers_url write FFollowers_url; 137 | property following_url: String read FFollowing_url write FFollowing_url; 138 | property gists_url: String read FGists_url write FGists_url; 139 | property gravatar_id: String read FGravatar_id write FGravatar_id; 140 | property html_url: String read FHtml_url write FHtml_url; 141 | property id: Extended read FId write FId; 142 | property login: String read FLogin write FLogin; 143 | property organizations_url: String read FOrganizations_url write FOrganizations_url; 144 | property received_events_url: String read FReceived_events_url write FReceived_events_url; 145 | property repos_url: String read FRepos_url write FRepos_url; 146 | property site_admin: Boolean read FSite_admin write FSite_admin; 147 | property starred_url: String read FStarred_url write FStarred_url; 148 | property subscriptions_url: String read FSubscriptions_url write FSubscriptions_url; 149 | property &type: String read FType write FType; 150 | property url: String read FUrl write FUrl; 151 | function ToJsonString: string; 152 | class function FromJsonString(AJsonString: string): TAuthorClass; 153 | end; 154 | 155 | TReleaseClass = class(TUGitHubSerializableObject) 156 | private 157 | FAssets: TArray; 158 | FAssets_url: String; 159 | FAuthor: TAuthorClass; 160 | FBody: String; 161 | FCreated_at: String; 162 | FDraft: Boolean; 163 | FHtml_url: String; 164 | FId: Extended; 165 | FName: String; 166 | FPrerelease: Boolean; 167 | FPublished_at: String; 168 | FTag_name: String; 169 | FTarball_url: String; 170 | FTarget_commitish: String; 171 | FUpload_url: String; 172 | FUrl: String; 173 | FZipball_url: String; 174 | public 175 | property assets: TArray read FAssets write FAssets; 176 | property assets_url: String read FAssets_url write FAssets_url; 177 | property author: TAuthorClass read FAuthor write FAuthor; 178 | property body: String read FBody write FBody; 179 | property created_at: String read FCreated_at write FCreated_at; 180 | property draft: Boolean read FDraft write FDraft; 181 | property html_url: String read FHtml_url write FHtml_url; 182 | property id: Extended read FId write FId; 183 | property name: String read FName write FName; 184 | property prerelease: Boolean read FPrerelease write FPrerelease; 185 | property published_at: String read FPublished_at write FPublished_at; 186 | property tag_name: String read FTag_name write FTag_name; 187 | property tarball_url: String read FTarball_url write FTarball_url; 188 | property target_commitish: String read FTarget_commitish write FTarget_commitish; 189 | property upload_url: String read FUpload_url write FUpload_url; 190 | property url: String read FUrl write FUrl; 191 | property zipball_url: String read FZipball_url write FZipball_url; 192 | constructor Create; 193 | destructor Destroy; override; 194 | function ToJsonString: string; 195 | class function FromJsonString(AJsonString: string): TReleaseClass; 196 | class function HttpGet(AUrl: string; AOnBeforeRequest: TProc = nil): TReleaseClass; 197 | end; 198 | 199 | TGitReleasesClass = class 200 | private 201 | FReleases: TArray; 202 | public 203 | property Releases: TArray read FReleases write FReleases; 204 | constructor Create; 205 | destructor Destroy; override; 206 | function ToJsonString: string; 207 | class function FromJsonString(AJsonString: string): TGitReleasesClass; 208 | class function FromUrl(AUrl: string; ATimeout: integer): TGitReleasesClass; 209 | end; 210 | 211 | TErrorClass = class 212 | private 213 | FDocumentation_url: String; 214 | FMessage: String; 215 | public 216 | property documentation_url: String read FDocumentation_url write FDocumentation_url; 217 | property message: String read FMessage write FMessage; 218 | function ToJsonString: string; 219 | class function FromJsonString(AJsonString: string): TErrorClass; 220 | end; 221 | 222 | implementation 223 | 224 | {TUploaderClass} 225 | 226 | 227 | function TUploaderClass.ToJsonString: string; 228 | begin 229 | result := TJson.ObjectToJsonString(self); 230 | end; 231 | 232 | class function TUploaderClass.FromJsonString(AJsonString: string): TUploaderClass; 233 | begin 234 | result := TJson.JsonToObject(AJsonString) 235 | end; 236 | 237 | {TAssetsClass} 238 | 239 | constructor TAssetsClass.Create; 240 | begin 241 | inherited; 242 | FUploader := TUploaderClass.Create(); 243 | end; 244 | 245 | destructor TAssetsClass.Destroy; 246 | begin 247 | FUploader.free; 248 | inherited; 249 | end; 250 | 251 | function TAssetsClass.ToJsonString: string; 252 | begin 253 | result := TJson.ObjectToJsonString(self); 254 | end; 255 | 256 | class function TAssetsClass.FromJsonString(AJsonString: string): TAssetsClass; 257 | begin 258 | result := TJson.JsonToObject(AJsonString) 259 | end; 260 | 261 | {TAuthorClass} 262 | 263 | 264 | function TAuthorClass.ToJsonString: string; 265 | begin 266 | result := TJson.ObjectToJsonString(self); 267 | end; 268 | 269 | class function TAuthorClass.FromJsonString(AJsonString: string): TAuthorClass; 270 | begin 271 | result := TJson.JsonToObject(AJsonString) 272 | end; 273 | 274 | {TReleaseClass} 275 | 276 | constructor TReleaseClass.Create; 277 | begin 278 | inherited; 279 | FAuthor := TAuthorClass.Create(); 280 | end; 281 | 282 | destructor TReleaseClass.Destroy; 283 | var 284 | LassetsItem: TAssetsClass; 285 | begin 286 | 287 | for LassetsItem in FAssets do 288 | LassetsItem.free; 289 | 290 | FAuthor.free; 291 | inherited; 292 | end; 293 | 294 | function TReleaseClass.ToJsonString: string; 295 | begin 296 | result := TJson.ObjectToJsonString(self); 297 | end; 298 | 299 | class function TReleaseClass.FromJsonString(AJsonString: string): TReleaseClass; 300 | begin 301 | result := TJson.JsonToObject(AJsonString) 302 | end; 303 | 304 | class function TReleaseClass.HttpGet(AUrl: string; AOnBeforeRequest: TProc): TReleaseClass; 305 | begin 306 | result := inherited HttpGet(AUrl, AOnBeforeRequest); 307 | end; 308 | 309 | {TGitReleasesClass} 310 | 311 | constructor TGitReleasesClass.Create; 312 | begin 313 | inherited; 314 | end; 315 | 316 | destructor TGitReleasesClass.Destroy; 317 | var 318 | LReleasesItem: TReleaseClass; 319 | begin 320 | 321 | for LReleasesItem in FReleases do 322 | LReleasesItem.free; 323 | 324 | inherited; 325 | end; 326 | 327 | function TGitReleasesClass.ToJsonString: string; 328 | begin 329 | result := TJson.ObjectToJsonString(self); 330 | end; 331 | 332 | class function TGitReleasesClass.FromJsonString(AJsonString: string): TGitReleasesClass; 333 | begin 334 | result := TJson.JsonToObject(AJsonString) 335 | end; 336 | 337 | 338 | class function TGitReleasesClass.FromUrl(AUrl: string; 339 | ATimeout: integer): TGitReleasesClass; 340 | var 341 | LUri: TIdUri; 342 | LHttp: TIdHttp; 343 | LSslIoHandler: TIdSSLIOHandlerSocketOpenSSL; 344 | LString: string; 345 | LJsonValue: TJsonValue; 346 | LJsonObject: TJsonObject; 347 | begin 348 | result := nil; 349 | LUri := TIdURI.Create(AUrl); 350 | try 351 | LHttp := TIdHTTP.Create; 352 | try 353 | LHttp.ConnectTimeout := ATimeout; 354 | LHttp.ReadTimeout := ATimeout; 355 | LHttp.HandleRedirects := true; 356 | 357 | if LUri.Protocol.ToLower = 'https' then 358 | begin 359 | LSslIoHandler := TIdSSLIOHandlerSocketOpenSSL.Create(LHttp); 360 | LHttp.IOHandler := LSslIoHandler; 361 | end; 362 | 363 | LString := LHttp.Get(AUrl); 364 | 365 | if LHttp.ResponseCode <> 200 then 366 | raise Exception.CreateFmt('Error getting JSON string from %s. Http error code: %d', [AUrl, LHttp.ResponseCode]); 367 | 368 | LJsonValue := TJSONObject.ParseJSONValue(LString); 369 | 370 | if LJsonValue = nil then 371 | raise Exception.Create('Unable to parse JSON string!'); 372 | 373 | try 374 | LJsonValue.Owned := false; 375 | if LJsonValue is TJSONArray then 376 | begin 377 | LJsonObject := TJSONObject.Create; 378 | try 379 | LJsonObject.AddPair('Releases', LJsonValue); 380 | LString := LJsonObject.ToJSON; 381 | finally 382 | LJsonObject.Free; 383 | end; 384 | end; 385 | 386 | result := TGitReleasesClass.FromJsonString(LString); 387 | 388 | finally 389 | LJsonValue.Free; 390 | end; 391 | finally 392 | LHttp.Free; 393 | end; 394 | finally 395 | LUri.Free; 396 | end; 397 | end; 398 | 399 | {TErrorClass} 400 | 401 | function TErrorClass.ToJsonString: string; 402 | begin 403 | result := TJson.ObjectToJsonString(self); 404 | end; 405 | 406 | class function TErrorClass.FromJsonString(AJsonString: string): TErrorClass; 407 | begin 408 | result := TJson.JsonToObject(AJsonString) 409 | end; 410 | 411 | { TUGitHubSerializableObject } 412 | 413 | class procedure TUGitHubSerializableObject.EnsureHttpContentType( 414 | AHttp: TIdHttp); 415 | begin 416 | if AHttp.Response.ContentType <> 'application/json' then 417 | raise Exception.CreateFmt('Invalid content type %s!', [AHttp.Response.ContentType]); 418 | end; 419 | 420 | class procedure TUGitHubSerializableObject.EnsureHttpResponseCode( 421 | AHttpResponseCode: integer; AUrl: string; AValidValues: array of integer); 422 | var 423 | LValue: integer; 424 | begin 425 | for LValue in AValidValues do 426 | if LValue = AHttpResponseCode then exit; 427 | 428 | raise Exception.CreateFmt('The request to %s has failed with code %d', [AUrl, AHttpResponseCode]); 429 | end; 430 | 431 | function TUGitHubSerializableObject.HttpDelete(AUrl: string; 432 | AOnBeforeRequest: TProc): string; 433 | var 434 | LResult: string; 435 | begin 436 | 437 | WebRequest(AUrl, 438 | procedure(LHttp: TIdHttp) 439 | begin 440 | 441 | // Allow HTTP client pre-configuration 442 | if assigned(AOnBeforeRequest) then 443 | AOnBeforeRequest(LHttp); 444 | 445 | LResult := LHttp.Delete(AUrl); 446 | EnsureHttpResponseCode(LHttp.ResponseCode, AUrl, [200, 204]); 447 | 448 | end 449 | ); 450 | 451 | result := LResult; 452 | end; 453 | 454 | class function TUGitHubSerializableObject.HttpGet(AUrl: string; AOnBeforeRequest: TProc; AArrayProperty: string): T; 455 | var 456 | LResult: T; 457 | begin 458 | 459 | WebRequest(AUrl, 460 | procedure(LHttp: TIdHttp) 461 | var 462 | LString: string; 463 | LJsonValue: TJsonValue; 464 | LJsonObject: TJsonObject; 465 | begin 466 | 467 | // Allow HTTP client pre-configuration 468 | if assigned(AOnBeforeRequest) then 469 | AOnBeforeRequest(LHttp); 470 | 471 | LString := LHttp.Get(AUrl); 472 | EnsureHttpResponseCode(LHttp.ResponseCode, AUrl, [200, 304]); 473 | EnsureHttpContentType(LHttp); 474 | 475 | LJsonValue := TJSONObject.ParseJSONValue(LString); 476 | 477 | if LJsonValue = nil then 478 | raise Exception.Create('Unable to parse JSON string!'); 479 | 480 | try 481 | LJsonValue.Owned := false; 482 | if LJsonValue is TJSONArray then 483 | if (AArrayProperty <> '') then 484 | begin 485 | LJsonObject := TJSONObject.Create; 486 | try 487 | LJsonObject.AddPair(AArrayProperty, LJsonValue); 488 | LString := LJsonObject.ToJSON; 489 | finally 490 | LJsonObject.Free; 491 | end; 492 | end 493 | else 494 | raise Exception.CreateFmt('The class %s does not accept array values!', [LResult.className]); 495 | finally 496 | LJsonValue.Free; 497 | end; 498 | 499 | LResult := TJson.JsonToObject(LString); 500 | 501 | end 502 | ); 503 | 504 | result := LResult; 505 | end; 506 | 507 | function TUGitHubSerializableObject.HttpPost(AUrl: string; 508 | AOnBeforeRequest: TProc): string; 509 | var 510 | LResult: string; 511 | begin 512 | 513 | WebRequest(AUrl, 514 | procedure(LHttp: TIdHttp) 515 | var 516 | LStringStream: TStringStream; 517 | begin 518 | 519 | // Allow HTTP client pre-configuration 520 | if assigned(AOnBeforeRequest) then 521 | AOnBeforeRequest(LHttp); 522 | 523 | LResult := TJson.ObjectToJsonString(self); 524 | 525 | LStringStream := TStringStream.Create(LResult, TEncoding.GetEncoding(LHttp.Request.ContentEncoding)); 526 | try 527 | LResult := LHttp.Post(AUrl, LStringStream); 528 | EnsureHttpResponseCode(LHttp.ResponseCode, AUrl, [200, 201, 202, 204]); 529 | EnsureHttpContentType(LHttp); 530 | finally 531 | LStringStream.Free; 532 | end; 533 | 534 | end 535 | ); 536 | 537 | result := LResult; 538 | end; 539 | 540 | function TUGitHubSerializableObject.HttpPut(AUrl: string; 541 | AOnBeforeRequest: TProc): string; 542 | var 543 | LResult: string; 544 | begin 545 | 546 | WebRequest(AUrl, 547 | procedure(LHttp: TIdHttp) 548 | var 549 | LStringStream: TStringStream; 550 | begin 551 | 552 | // Allow HTTP client pre-configuration 553 | if assigned(AOnBeforeRequest) then 554 | AOnBeforeRequest(LHttp); 555 | 556 | LResult := TJson.ObjectToJsonString(self); 557 | 558 | LStringStream := TStringStream.Create(LResult, TEncoding.GetEncoding(LHttp.Request.ContentEncoding)); 559 | try 560 | LResult := LHttp.Put(AUrl, LStringStream); 561 | EnsureHttpResponseCode(LHttp.ResponseCode, AUrl, [200, 204]); 562 | EnsureHttpContentType(LHttp); 563 | finally 564 | LStringStream.Free; 565 | end; 566 | 567 | end 568 | ); 569 | 570 | result := LResult; 571 | end; 572 | 573 | 574 | class function TUGitHubSerializableObject.WebRequest(AUrl: string; AOnRequest: TProc): integer; 575 | var 576 | LUri: TIdUri; 577 | LHttp: TIdHttp; 578 | LSslIoHandler: TIdSSLIOHandlerSocketOpenSSL; 579 | begin 580 | LUri := TIdURI.Create(AUrl); 581 | try 582 | LHttp := TIdHTTP.Create; 583 | try 584 | LHttp.HandleRedirects := true; 585 | // Default encoding 586 | LHttp.Request.ContentEncoding := 'utf-8'; 587 | // Specify Content-Type header 588 | LHttp.Request.ContentType := 'application/json'; 589 | 590 | // Replace default IOHandler with TIdSSLIOHandlerSocketOpenSSL if the connection is SSL based 591 | if LUri.Protocol.ToLower = 'https' then 592 | begin 593 | LSslIoHandler := TIdSSLIOHandlerSocketOpenSSL.Create(LHttp); 594 | LHttp.IOHandler := LSslIoHandler; 595 | end; 596 | 597 | try 598 | AOnRequest(LHttp); 599 | finally 600 | result := LHttp.ResponseCode; 601 | end; 602 | 603 | finally 604 | LHttp.Free; 605 | end; 606 | finally 607 | LUri.Free; 608 | end; 609 | end; 610 | 611 | end. 612 | 613 | 614 | -------------------------------------------------------------------------------- /Pkg.Json.Mapper.pas: -------------------------------------------------------------------------------- 1 | unit Pkg.Json.Mapper; 2 | 3 | interface 4 | uses FMX.TreeView, System.JSON, Rest.Json, RTTI, RegularExpressions, TypInfo, 5 | SysUtils, classes, Generics.Collections, Generics.Defaults; 6 | 7 | type 8 | 9 | EJsonMapper = class(Exception); 10 | 11 | TJsonType = (jtUnknown, jtObject, jtArray, jtString, jtTrue, 12 | jtFalse, jtNumber, jtDate, jtDateTime, jtBytes); 13 | 14 | TStubClass = class; 15 | TPkgJsonMapper = class; 16 | 17 | TStubField = class 18 | private 19 | FName: string; 20 | FPropertyName: string; 21 | FFieldName: string; 22 | FFieldType: TJsonType; 23 | FParentClass: TStubClass; 24 | procedure SetName(const Value: string); 25 | public 26 | constructor Create(AParentClass: TStubClass; AItemName: string; AFieldType: TJsonType); 27 | destructor Destroy; override; 28 | property Name: string read FName write SetName; 29 | property FieldName: string read FFieldName write FFieldName; 30 | property PropertyName: string read FPropertyName write FPropertyName; 31 | property FieldType: TJsonType read FFieldType write FFieldType; 32 | function GetTypeAsString: string; overload; virtual; 33 | class function GetTypeAsString(AType: TJsonType): string; overload; 34 | end; 35 | 36 | TStubContainerField = class(TStubField) 37 | private 38 | FFieldClass: TStubClass; 39 | FContainedType: TJsonType; 40 | public 41 | property ContainedType: TJsonType read FContainedType write FContainedType; 42 | property FieldClass: TStubClass read FFieldClass write FFieldClass; 43 | end; 44 | 45 | TStubObjectField = class(TStubContainerField) 46 | private 47 | public 48 | constructor Create(AParentClass: TStubClass; AItemName: string; AItemClass: TStubClass); 49 | function GetTypeAsString: string; override; 50 | end; 51 | 52 | TStubArrayField = class(TStubContainerField) 53 | private 54 | public 55 | constructor Create(AClass: TStubClass; AItemName: string; AItemSubType: TJsonType; AItemClass: TStubClass); 56 | function GetTypeAsString: string; override; 57 | end; 58 | 59 | TStubClass = class 60 | private 61 | FItems, 62 | FComplexItems, 63 | FArrayItems: TList; 64 | FName: string; 65 | FComparison: TComparison; 66 | FComparer: IComparer; 67 | FParentClass: TStubClass; 68 | FMapper: TPkgJsonMapper; 69 | FPureClassName: string; 70 | FArrayProperty: string; 71 | procedure SortFields; 72 | procedure SetName(const Value: string); 73 | procedure SetPureClassName(const Value: string); 74 | public 75 | constructor Create(AParentClass: TStubClass; AClassName: string; AMapper: TPkgJsonMapper; AArrayProperty: string = ''); 76 | destructor Destroy; override; 77 | property Name: string read FName write SetName; 78 | property Items: TList read FItems write FItems; 79 | function GetDeclarationPart: string; 80 | function GetImplementationPart: string; 81 | property PureClassName: string read FPureClassName write SetPureClassName; 82 | property ArrayProperty: string read FArrayProperty write FArrayProperty; 83 | 84 | end; 85 | 86 | TPkgJsonMapper = class 87 | private 88 | FTreeView: TTreeView; 89 | FClasses: TList; 90 | FRootClass: TStubClass; 91 | FUnitName: string; 92 | procedure SetUnitName(const Value: string); 93 | protected 94 | function GetJsonType(AJsonValue: TJsonValue): TJsonType; 95 | function GetFirstArrayItem(AJsonValue: TJsonValue): TJsonValue; 96 | procedure ProcessJsonObject(AJsonValue: TJsonValue; AParentClass: TStubClass); 97 | procedure ClearClasses; 98 | procedure InternalFormatTreeViewFields(AItem: TTreeViewItem); 99 | procedure FormatFields(ATreeView: TTreeView); 100 | procedure InternalVisualize(ATreeViewItem: TTreeViewItem; AClass: TStubClass; AItemStyleLookup: string); 101 | function SuggestClassName(ASuggestedClassName: string): string; 102 | public 103 | constructor Create(ATreeView: TTreeView); 104 | destructor Destroy; override; 105 | // Parses a JSON string and creates internal stub class structure 106 | procedure Parse(AJsonString: string; ARootClassName: string = 'Root'); 107 | // Generates resultant unit 108 | function GenerateUnit: string; 109 | procedure Debug(ALines: TStrings); 110 | // Visualizes stub class structure in a treeview 111 | procedure Visualize(ATreeView: TTreeView; AItemStyleLookup: string); 112 | property DestinationUnitName: string read FUnitName write SetUnitName; 113 | end; 114 | 115 | procedure PrettyPrintJSON(JSONValue: TJSONValue; OutputStrings: TStrings; indent: integer = 0); 116 | 117 | var 118 | PointDsFormatSettings: TFormatSettings; 119 | 120 | implementation 121 | 122 | uses uUpdate; 123 | 124 | var 125 | ReservedWords: TList; 126 | 127 | const INDENT_SIZE = 2; 128 | 129 | // http://stackoverflow.com/a/12198174 130 | procedure PrettyPrintPair(JSONValue: TJSONPair; OutputStrings: TStrings; last: boolean; indent: integer); 131 | const TEMPLATE = '%s:%s'; 132 | var 133 | line: string; 134 | newList: TStringList; 135 | begin 136 | newList := TStringList.Create; 137 | try 138 | PrettyPrintJSON(JSONValue.JsonValue, newList, indent); 139 | line := format(TEMPLATE, [JSONValue.JsonString.ToString, Trim(newList.Text)]); 140 | finally 141 | newList.Free; 142 | end; 143 | 144 | line := StringOfChar(' ', indent + INDENT_SIZE) + line; 145 | if not last then 146 | line := line + ','; 147 | OutputStrings.add(line); 148 | end; 149 | 150 | procedure PrettyPrintArray(JSONValue: TJSONArray; OutputStrings: TStrings; last: boolean; indent: integer); 151 | var i: integer; 152 | begin 153 | OutputStrings.add(StringOfChar(' ', indent + INDENT_SIZE) + '['); 154 | for i := 0 to JSONValue.Count - 1 do 155 | begin 156 | PrettyPrintJSON(JSONValue.Items[i], OutputStrings, indent); 157 | if i < JSONValue.Count - 1 then 158 | OutputStrings[OutputStrings.Count-1] := OutputStrings[OutputStrings.Count-1] + ','; 159 | end; 160 | OutputStrings.add(StringOfChar(' ', indent + INDENT_SIZE - 2) + ']'); 161 | end; 162 | 163 | procedure PrettyPrintJSON(JSONValue: TJSONValue; OutputStrings: TStrings; indent: integer = 0); 164 | var 165 | i: integer; 166 | LIdent: integer; 167 | begin 168 | LIdent := indent + INDENT_SIZE; 169 | i := 0; 170 | 171 | if JSONValue is TJSONObject then 172 | begin 173 | OutputStrings.add(StringOfChar(' ', LIdent) + '{'); 174 | for i := 0 to TJSONObject(JSONValue).Count - 1 do 175 | PrettyPrintPair(TJSONObject(JSONValue).Pairs[i], OutputStrings, i = TJSONObject(JSONValue).Count - 1, LIdent); 176 | OutputStrings.add(StringOfChar(' ', LIdent) + '}'); 177 | end 178 | else if JSONValue is TJSONArray then 179 | PrettyPrintArray(TJSONArray(JSONValue), OutputStrings, i = TJSONObject(JSONValue).Count - 1, LIdent) 180 | else OutputStrings.add(StringOfChar(' ', LIdent) + JSONValue.ToString); 181 | end; 182 | 183 | 184 | { TPkgJsonMapper } 185 | 186 | 187 | procedure TPkgJsonMapper.ProcessJsonObject(AJsonValue: TJsonValue; AParentClass: TStubClass); 188 | var 189 | LJsonObj: TJSONObject; 190 | LJsonPair: TJSONPair; 191 | LJsonVal, 192 | LJsonVal2: TJSONValue; 193 | LJsonType, 194 | LJsonType2: TJsonType; 195 | LClass: TStubClass; 196 | begin 197 | LJsonObj := AJsonValue as TJSONObject; 198 | 199 | for LJsonPair in LJsonObj do 200 | begin 201 | LJsonVal := LJsonPair.JsonValue; 202 | LJsonType := GetJsonType(LJsonVal); 203 | 204 | case LJsonType of 205 | jtObject: 206 | begin 207 | LClass := TStubClass.Create(AParentClass, LJsonPair.JsonString.Value, self); 208 | TStubObjectField.Create(AParentClass, LJsonPair.JsonString.Value, LClass); 209 | ProcessJsonObject(LJsonVal, LClass); 210 | end; 211 | 212 | jtArray: 213 | begin 214 | LClass := nil; 215 | LJsonType2 := jtUnknown; 216 | 217 | LJsonVal2 := GetFirstArrayItem(LJsonVal); 218 | if LJsonVal2 <> nil then 219 | begin 220 | LJsonType2 := GetJsonType(LJsonVal2); 221 | case LJsonType2 of 222 | jtObject: 223 | begin 224 | LClass := TStubClass.Create(AParentClass, LJsonPair.JsonString.Value, self); 225 | ProcessJsonObject(LJsonVal2, LClass); 226 | end; 227 | jtArray: raise EJsonMapper.Create('Nested Arrays are not supported!'); 228 | end; 229 | end; 230 | 231 | TStubArrayField.Create(AParentClass, LJsonPair.JsonString.Value, LJsonType2, LClass); 232 | 233 | end; 234 | jtNumber, 235 | jtString, 236 | jtDate, 237 | jtDateTime, 238 | jtTrue, 239 | jtFalse: TStubField.Create(AParentClass, LJsonPair.JsonString.Value, LJsonType); 240 | end; 241 | end; 242 | 243 | AParentClass.SortFields; 244 | end; 245 | 246 | 247 | function TPkgJsonMapper.GenerateUnit: string; 248 | var 249 | LClass: TStubClass; 250 | k: integer; 251 | LList: TStringList; 252 | begin 253 | 254 | LList := TStringList.Create; 255 | try 256 | 257 | LList.Add('unit ' + FUnitName + ';'); 258 | LList.Add(''); 259 | LList.Add('// *************************************************'); 260 | LList.Add('// Generated By: JsonToDelphiClass - ' + FloatToStr(ProgramVersion, PointDsFormatSettings)); 261 | LList.Add('// Project link: https://github.com/PKGeorgiev/Delphi-JsonToDelphiClass'); 262 | LList.Add('// Generated On: ' + FormatDateTime('yyyy-mm-dd hh:nn:ss', now)); 263 | LList.Add('// *************************************************'); 264 | LList.Add('// Created By : Petar Georgiev - 2014'); 265 | LList.Add('// WebSite : http://pgeorgiev.com'); 266 | LList.Add('// *************************************************'); 267 | LList.Add(''); 268 | LList.Add('interface'); 269 | LList.Add(''); 270 | LList.Add('uses Generics.Collections, Rest.Json;'); 271 | LList.Add(''); 272 | LList.Add('type'); 273 | 274 | for k := FClasses.Count - 1 downto 0 do 275 | begin 276 | LClass := FClasses[k]; 277 | LList.Add(LClass.GetDeclarationPart.TrimRight); 278 | end; 279 | 280 | LList.Add(''); 281 | LList.Add('implementation'); 282 | 283 | for k := FClasses.Count - 1 downto 0 do 284 | begin 285 | LClass := FClasses[k]; 286 | LList.Add(LClass.GetImplementationPart.TrimRight); 287 | end; 288 | 289 | LList.Add(''); 290 | LList.Add('end.'); 291 | 292 | result := LList.Text; 293 | 294 | finally 295 | LList.Free; 296 | end; 297 | 298 | end; 299 | 300 | procedure TPkgJsonMapper.Visualize(ATreeView: TTreeView; AItemStyleLookup: string); 301 | var 302 | LItem: TTreeViewItem; 303 | begin 304 | ATreeView.Clear; 305 | if FRootClass <> nil then 306 | begin 307 | ATreeView.BeginUpdate; 308 | LItem := TTreeViewItem.Create(ATreeView); 309 | LItem.Text := FRootClass.Name; 310 | LItem.TagObject := FRootClass; 311 | LItem.WordWrap := false; 312 | ATreeView.AddObject(LItem); 313 | InternalVisualize(LItem, FRootClass, AItemStyleLookup); 314 | FormatFields(ATreeView); 315 | ATreeView.EndUpdate; 316 | ATreeView.ExpandAll; 317 | end; 318 | end; 319 | 320 | function TPkgJsonMapper.GetFirstArrayItem(AJsonValue: TJsonValue): TJsonValue; 321 | var 322 | LJsonArray: TJsonArray; 323 | LJsonValue: TJSONValue; 324 | begin 325 | result := nil; 326 | LJsonArray := AJsonValue as TJsonArray; 327 | for LJsonValue in LJsonArray do 328 | begin 329 | result := LJsonValue; 330 | break; 331 | end; 332 | end; 333 | 334 | procedure TPkgJsonMapper.ClearClasses; 335 | var 336 | LClass: TStubClass; 337 | begin 338 | for LClass in FClasses do 339 | begin 340 | LClass.Free; 341 | end; 342 | 343 | FClasses.Clear; 344 | end; 345 | 346 | constructor TPkgJsonMapper.Create(ATreeView: TTreeView); 347 | begin 348 | inherited Create; 349 | FTreeView := ATreeView; 350 | FClasses := TList.Create; 351 | end; 352 | 353 | procedure TPkgJsonMapper.Debug(ALines: TStrings); 354 | var 355 | LClass: TStubClass; 356 | LField: TStubField; 357 | begin 358 | ALines.Clear; 359 | 360 | for LClass in FClasses do 361 | begin 362 | ALines.Add('-------'); 363 | ALines.Add(LClass.Name); 364 | for LField in LClass.FItems do 365 | begin 366 | ALines.Add(format('%-15s | %s', [LField.FieldName, LField.GetTypeAsString])); 367 | end; 368 | end; 369 | end; 370 | 371 | destructor TPkgJsonMapper.Destroy; 372 | begin 373 | ClearClasses; 374 | FreeAndNil(FClasses); 375 | inherited; 376 | end; 377 | 378 | procedure TPkgJsonMapper.FormatFields(ATreeView: TTreeView); 379 | begin 380 | if ATreeView.Count = 1 then 381 | begin 382 | InternalFormatTreeViewFields(ATreeView.Items[0]); 383 | end; 384 | end; 385 | 386 | procedure TPkgJsonMapper.SetUnitName(const Value: string); 387 | begin 388 | FUnitName := Value; 389 | end; 390 | 391 | function TPkgJsonMapper.SuggestClassName(ASuggestedClassName: string): string; 392 | var 393 | LClass: TStubClass; 394 | LMax, LVal: integer; 395 | LString: string; 396 | begin 397 | result := ASuggestedClassName; 398 | LMax := 0; 399 | for LClass in FClasses do 400 | begin 401 | if LClass.Name.StartsWith(ASuggestedClassName, true) then 402 | begin 403 | LString := Copy(LClass.Name, length(ASuggestedClassName) + 2); 404 | if (LString.Length = 3) then 405 | begin 406 | if TryStrToInt(LString, LVal) then 407 | begin 408 | inc(LVal); 409 | if LVal > LMax then 410 | LMax := LVal; 411 | end; 412 | end 413 | else 414 | LMax := 1; 415 | end; 416 | end; 417 | 418 | if LMax > 0 then 419 | result := format('%s_%0.3d', [ASuggestedClassName, LMax]); 420 | end; 421 | 422 | function TPkgJsonMapper.GetJsonType(AJsonValue: TJsonValue): TJsonType; 423 | var 424 | LJsonString: TJSONString; 425 | begin 426 | if AJsonValue is TJSONObject then 427 | result := jtObject 428 | else 429 | if AJsonValue is TJSONArray then 430 | result := jtArray 431 | else 432 | if (AJsonValue is TJSONNumber) then 433 | result := jtNumber 434 | else 435 | if AJsonValue is TJSONTrue then 436 | result := jtTrue 437 | else 438 | if AJsonValue is TJSONFalse then 439 | result := jtFalse 440 | else 441 | if AJsonValue is TJSONString then 442 | begin 443 | LJsonString := (AJsonValue as TJSONString); 444 | if TRegEx.IsMatch(LJsonString.Value, '^([0-9]{4})-?(1[0-2]|0[1-9])-?(3[01]|0[1-9]|[12][0-9])(T| )(2[0-3]|[01][0-9]):?([0-5][0-9]):?([0-5][0-9])$') then 445 | result := jtDateTime 446 | else 447 | if TRegEx.IsMatch(LJsonString.Value, '^([0-9]{4})(-?)(1[0-2]|0[1-9])\2(3[01]|0[1-9]|[12][0-9])$') then 448 | result := jtDate 449 | else 450 | result := jtString 451 | end 452 | else 453 | result := jtUnknown; 454 | end; 455 | 456 | procedure TPkgJsonMapper.InternalFormatTreeViewFields(AItem: TTreeViewItem); 457 | var 458 | LItem: TTreeViewItem; 459 | k: Integer; 460 | LSize, LPos: integer; 461 | begin 462 | LSize := 0; 463 | 464 | // Find max len 465 | for k := 0 to AItem.Count - 1 do 466 | begin 467 | LItem := AItem.Items[k]; 468 | LPos := Pos(':', LItem.Text); 469 | if (LPos > 0) AND (LPos > LSize) then 470 | LSize := LPos; 471 | end; 472 | 473 | for k := 0 to AItem.Count - 1 do 474 | begin 475 | LItem := AItem.Items[k]; 476 | LPos := LSize - Pos(':', LItem.Text); 477 | if (LPos > 0) then 478 | LItem.Text := LItem.Text.Replace(':', StringOfChar(' ', LPos) + ':'); 479 | 480 | InternalFormatTreeViewFields(LItem); 481 | end; 482 | 483 | end; 484 | 485 | procedure TPkgJsonMapper.InternalVisualize(ATreeViewItem: TTreeViewItem; 486 | AClass: TStubClass; AItemStyleLookup: string); 487 | var 488 | LField: TStubField; 489 | LItem: TTreeViewItem; 490 | begin 491 | for LField in AClass.FItems do 492 | begin 493 | 494 | LItem := TTreeViewItem.Create(ATreeViewItem); 495 | LItem.StyleLookup := AItemStyleLookup; 496 | LItem.TagObject := LField; 497 | LItem.WordWrap := false; 498 | 499 | case LField.FieldType of 500 | jtObject: 501 | begin 502 | LItem.Text := LField.Name + ': {} ' + LField.GetTypeAsString; 503 | InternalVisualize(LItem, (LField as TStubObjectField).FieldClass, AItemStyleLookup); 504 | end; 505 | 506 | jtArray: 507 | begin 508 | LItem.Text := LField.Name + ': [] ' + LField.GetTypeAsString; 509 | if (LField as TStubArrayField).ContainedType = jtObject then 510 | begin 511 | InternalVisualize(LItem, (LField as TStubArrayField).FieldClass, AItemStyleLookup); 512 | end; 513 | end; 514 | 515 | else 516 | begin 517 | LItem.Text := LField.Name + ': ' + LField.GetTypeAsString; 518 | end; 519 | end; 520 | 521 | ATreeViewItem.AddObject(LItem); 522 | 523 | end; 524 | end; 525 | 526 | procedure TPkgJsonMapper.Parse(AJsonString: string; ARootClassName: string); 527 | var 528 | LJsonValue, 529 | LJsonValue2: TJSONValue; 530 | LJsonType: TJsonType; 531 | LClass: TStubClass; 532 | begin 533 | 534 | ClearClasses; 535 | 536 | LJsonValue := TJSONObject.ParseJSONValue(AJsonString); 537 | if LJsonValue <> nil then 538 | begin 539 | try 540 | FRootClass := TStubClass.Create(nil, ARootClassName, self); 541 | 542 | case GetJsonType(LJsonValue) of 543 | jtObject: 544 | begin 545 | ProcessJsonObject(LJsonValue, FRootClass); 546 | end; 547 | 548 | jtArray: 549 | begin 550 | LJsonType := jtUnknown; 551 | LClass := nil; 552 | 553 | LJsonValue2 := GetFirstArrayItem(LJsonValue); 554 | if LJsonValue2 <> nil then 555 | begin 556 | LJsonType := GetJsonType(LJsonValue2); 557 | LClass := TStubClass.Create(FRootClass, 'Item', self); 558 | end; 559 | 560 | FRootClass.ArrayProperty := 'Items'; 561 | TStubArrayField.Create(FRootClass, 'Items', LJsonType, LClass); 562 | ProcessJsonObject(LJsonValue2, LClass); 563 | end; 564 | end; 565 | finally 566 | LJsonValue.Free; 567 | end; 568 | end 569 | else 570 | raise EJsonMapper.Create('Unable to parse the JSON String!'); 571 | 572 | FTreeView.ExpandAll; 573 | end; 574 | 575 | { TVirtualClass } 576 | 577 | constructor TStubClass.Create(AParentClass: TStubClass; AClassName: string; AMapper: TPkgJsonMapper; AArrayProperty: string); 578 | begin 579 | inherited Create; 580 | FMapper := AMapper; 581 | Name := AClassName; 582 | 583 | FItems := TList.Create; 584 | FComplexItems := TList.Create; 585 | FArrayItems := TList.Create; 586 | FMapper.FClasses.Add(self); 587 | FArrayProperty := AArrayProperty; 588 | 589 | FParentClass := AParentClass; 590 | 591 | FComparison := 592 | function(const Left, Right: TStubField): Integer 593 | begin 594 | if Left.FName > Right.FName then 595 | result := 1 596 | else 597 | if Left.FName < Right.FName then 598 | result := -1 599 | else 600 | result := 0; 601 | end; 602 | 603 | FComparer := TComparer.Construct(FComparison); 604 | 605 | end; 606 | 607 | destructor TStubClass.Destroy; 608 | var 609 | LItem: TStubField; 610 | begin 611 | 612 | // ToArray is needed because stub field remove themselves from FItems 613 | for LItem in FItems.ToArray do 614 | begin 615 | LItem.Free; 616 | end; 617 | 618 | FreeAndNil(FComplexItems); 619 | FreeAndNil(FItems); 620 | FreeAndNil(FArrayItems); 621 | inherited; 622 | end; 623 | 624 | function TStubClass.GetImplementationPart: string; 625 | var 626 | LLines: TStringList; 627 | LString: string; 628 | LClassName: string; 629 | LItem: TStubField; 630 | begin 631 | LLines := TStringList.Create; 632 | try 633 | LClassName := format('%s', [FName]); 634 | LLines.Add(''); 635 | LLines.Add(format('{%s}', [LClassName])); 636 | LLines.Add(''); 637 | if FComplexItems.Count > 0 then 638 | begin 639 | 640 | LLines.Add(format('constructor %s.Create;', [LClassName])); 641 | LLines.Add('begin'); 642 | LLines.Add(' inherited;'); 643 | 644 | for LItem in FComplexItems do 645 | begin 646 | LString := format(' %s := %s.Create();', [LItem.FieldName, (LItem).GetTypeAsString]); 647 | LLines.Add(LString); 648 | end; 649 | 650 | LLines.Add('end;'); 651 | LLines.Add(''); 652 | end; 653 | 654 | if (FComplexItems.Count > 0) OR (FArrayItems.Count > 0) then 655 | begin 656 | 657 | LLines.Add(format('destructor %s.Destroy;', [LClassName])); 658 | 659 | if FArrayItems.Count > 0 then 660 | begin 661 | LLines.Add('var'); 662 | for LItem in FArrayItems do 663 | begin 664 | LString := format(' L%sItem: %s;', [LItem.FName, (LItem as TStubContainerField).FFieldClass.Name]); 665 | LLines.Add(LString); 666 | end; 667 | end; 668 | 669 | 670 | LLines.Add('begin'); 671 | 672 | if FArrayItems.Count > 0 then 673 | begin 674 | LLines.Add(''); 675 | for LItem in FArrayItems do 676 | begin 677 | LLines.Add(format(' for L%sItem in %s do', [LItem.FName, LItem.FieldName])); 678 | LLines.Add(format(' L%sItem.free;', [LItem.FName])); 679 | end; 680 | LLines.Add(''); 681 | end; 682 | 683 | 684 | for LItem in FComplexItems do 685 | begin 686 | LString := format(' %s.free;', [LItem.FieldName]); 687 | LLines.Add(LString); 688 | end; 689 | 690 | LLines.Add(' inherited;'); 691 | LLines.Add('end;') 692 | end; 693 | 694 | LLines.Add(''); 695 | LLines.Add(format('function %s.ToJsonString: string;', [LClassName])); 696 | LLines.Add('begin'); 697 | LLines.Add(' result := TJson.ObjectToJsonString(self);'); 698 | LLines.Add('end;'); 699 | 700 | LLines.Add(''); 701 | LLines.Add(format('class function %s.FromJsonString(AJsonString: string): %s;', [LClassName, LClassName])); 702 | LLines.Add('begin'); 703 | LLines.Add(format(' result := TJson.JsonToObject<%s>(AJsonString)', [LClassName])); 704 | LLines.Add('end;'); 705 | 706 | result := LLines.Text; 707 | finally 708 | LLines.Free; 709 | end; 710 | end; 711 | 712 | procedure TStubClass.SetName(const Value: string); 713 | var 714 | LName: string; 715 | begin 716 | FPureClassName := String(Copy(Value, 1, 1)).ToUpper + Copy(Value, 2); 717 | 718 | LName := 'T' + FPureClassName + 'Class'; 719 | 720 | FName := FMapper.SuggestClassName(LName); 721 | end; 722 | 723 | procedure TStubClass.SetPureClassName(const Value: string); 724 | begin 725 | FPureClassName := Value; 726 | end; 727 | 728 | procedure TStubClass.SortFields; 729 | begin 730 | FItems.Sort(FComparer); 731 | end; 732 | 733 | function TStubClass.GetDeclarationPart: string; 734 | var 735 | LLines: TStringList; 736 | LString: string; 737 | LItem: TStubField; 738 | begin 739 | LLines := TStringList.Create; 740 | try 741 | LLines.Add(''); 742 | LLines.Add(FName + ' = class'); 743 | LLines.Add('private'); 744 | 745 | for LItem in FItems do 746 | begin 747 | LString := format(' %s: %s;', [LItem.FieldName, LItem.GetTypeAsString]); 748 | LLines.Add(LString); 749 | end; 750 | 751 | LLines.Add('public'); 752 | 753 | for LItem in FItems do 754 | begin 755 | if (LItem.FieldType = jtUnknown) OR ((LItem is TStubContainerField) AND ((LItem as TStubContainerField).ContainedType = jtUnknown)) then 756 | raise EJsonMapper.CreateFmt('The property [%s] has unknown type!', [LItem.PropertyName]); 757 | 758 | LString := format(' property %s: %s read %s write %s;', [LItem.PropertyName, LItem.GetTypeAsString, LItem.FieldName, LItem.FieldName]); 759 | LLines.Add(LString); 760 | end; 761 | 762 | if FComplexItems.Count > 0 then 763 | begin 764 | LLines.Add(' constructor Create;'); 765 | end; 766 | 767 | if (FComplexItems.Count > 0) OR (FArrayItems.Count > 0) then 768 | begin 769 | LLines.Add(' destructor Destroy; override;'); 770 | end; 771 | 772 | LLines.Add(' function ToJsonString: string;'); 773 | LLines.Add(format(' class function FromJsonString(AJsonString: string): %s;', [FName])); 774 | 775 | LLines.Add('end;'); 776 | 777 | result := LLines.Text; 778 | finally 779 | LLines.Free; 780 | end; 781 | end; 782 | 783 | { TVirtualClassItemBase } 784 | 785 | constructor TStubField.Create(AParentClass: TStubClass; AItemName: string; AFieldType: TJsonType); 786 | begin 787 | inherited Create; 788 | 789 | if AItemName.Contains('-') then 790 | raise EJsonMapper.CreateFmt('%s: Hyphens are not allowed!', [AItemName]); 791 | 792 | FParentClass := AParentClass; 793 | FFieldType := AFieldType; 794 | Name := AItemName; 795 | 796 | if FParentClass <> nil then 797 | FParentClass.FItems.Add(self); 798 | end; 799 | 800 | destructor TStubField.Destroy; 801 | begin 802 | if FParentClass <> nil then 803 | FParentClass.FItems.Remove(self); 804 | inherited; 805 | end; 806 | 807 | class function TStubField.GetTypeAsString(AType: TJsonType): string; 808 | begin 809 | case AType of 810 | jtUnknown: result := 'Unknown'; 811 | jtString: result := 'String'; 812 | jtTrue, 813 | jtFalse: result := 'Boolean'; 814 | jtNumber: result := 'Extended'; 815 | jtDate: result := 'TDate'; 816 | jtDateTime: result := 'TDateTime'; 817 | jtBytes: result := 'Byte'; 818 | end; 819 | end; 820 | 821 | procedure TStubField.SetName(const Value: string); 822 | begin 823 | 824 | if (FParentClass.FArrayProperty <> '') AND (FParentClass.FArrayProperty = FName) then 825 | FParentClass.FArrayProperty := Value; 826 | 827 | FName := Value; 828 | 829 | FFieldName := 'F' + String(Copy(Value, 1, 1)).ToUpper + Copy(Value, 2); 830 | 831 | if ReservedWords.Contains(Value.ToLower) then 832 | FPropertyName := '&' + Value 833 | else 834 | FPropertyName := Value; 835 | 836 | 837 | 838 | end; 839 | 840 | function TStubField.GetTypeAsString: string; 841 | begin 842 | result := GetTypeAsString(FFieldType); 843 | end; 844 | 845 | { TArrayItem } 846 | 847 | constructor TStubArrayField.Create(AClass: TStubClass; AItemName: string; AItemSubType: TJsonType; AItemClass: TStubClass); 848 | begin 849 | inherited Create(AClass, AItemName, jtArray); 850 | FContainedType := AItemSubType; 851 | FFieldClass := AItemClass; 852 | if FContainedType = TJsonType.jtObject then 853 | AClass.FArrayItems.Add(self); 854 | end; 855 | 856 | function TStubArrayField.GetTypeAsString: string; 857 | var 858 | LSubType: string; 859 | begin 860 | case FContainedType of 861 | jtObject: LSubType := FFieldClass.Name; 862 | jtArray: raise EJsonMapper.Create('Nested arrays are not supported!'); 863 | else 864 | LSubType := GetTypeAsString(FContainedType); 865 | end; 866 | result := format('TArray<%s>', [LSubType]); 867 | end; 868 | 869 | { TStubObjectField } 870 | 871 | constructor TStubObjectField.Create(AParentClass: TStubClass; AItemName: string; AItemClass: TStubClass); 872 | begin 873 | inherited Create(AParentClass, AItemName, jtObject); 874 | FFieldClass := AItemClass; 875 | AParentClass.FComplexItems.Add(self); 876 | FContainedType := jtObject; 877 | end; 878 | 879 | function TStubObjectField.GetTypeAsString: string; 880 | begin 881 | result := FFieldClass.Name; 882 | end; 883 | 884 | initialization 885 | 886 | PointDsFormatSettings := TFormatSettings.Create(); 887 | PointDsFormatSettings.DecimalSeparator := '.'; 888 | 889 | ReservedWords := TList.Create; 890 | ReservedWords.Add('type'); 891 | ReservedWords.Add('for'); 892 | ReservedWords.Add('var'); 893 | ReservedWords.Add('begin'); 894 | ReservedWords.Add('end'); 895 | ReservedWords.Add('function'); 896 | ReservedWords.Add('procedure'); 897 | ReservedWords.Add('class'); 898 | ReservedWords.Add('record'); 899 | ReservedWords.Add('string'); 900 | ReservedWords.Add('initialization'); 901 | ReservedWords.Add('finalization'); 902 | 903 | 904 | finalization 905 | 906 | FreeAndNil(ReservedWords); 907 | 908 | end. 909 | -------------------------------------------------------------------------------- /JsonToDelphiClass.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {FC0815BD-2831-42AD-BC2C-0CC105026B1F} 4 | 18.1 5 | FMX 6 | JsonToDelphiClass.dpr 7 | True 8 | Debug 9 | Win32 10 | 7 11 | Application 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Base 34 | true 35 | 36 | 37 | true 38 | Cfg_1 39 | true 40 | true 41 | 42 | 43 | true 44 | Cfg_1 45 | true 46 | true 47 | 48 | 49 | true 50 | Base 51 | true 52 | 53 | 54 | true 55 | Cfg_2 56 | true 57 | true 58 | 59 | 60 | $(BDS)\bin\default_app.manifest 61 | JsonToDelphiClass 62 | System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 63 | .\$(Platform)\$(Config) 64 | .\$(Platform)\$(Config) 65 | false 66 | false 67 | false 68 | false 69 | false 70 | 71 | 72 | true 73 | FireDACASADriver;FireDACSqliteDriver;bindcompfmx;DBXSqliteDriver;FireDACPgDriver;FireDACODBCDriver;RESTBackendComponents;emsclientfiredac;fmx;rtl;dbrtl;DbxClientDriver;IndySystem;FireDACCommon;bindcomp;inetdb;tethering;DBXInterBaseDriver;xmlrtl;DbxCommonDriver;IndyProtocols;dbxcds;DBXMySQLDriver;FireDACCommonDriver;bindcompdbx;bindengine;soaprtl;FMXTee;fmxFireDAC;emsclient;CustomIPTransport;FireDAC;dsnap;fmxase;IndyCore;IndyIPServer;IndyIPCommon;CloudService;FireDACIBDriver;FmxTeeUI;inet;fmxobj;FireDACMySQLDriver;soapmidas;soapserver;inetdbxpress;dsnapxml;fmxdae;RESTComponents;dbexpress;IndyIPClient;$(DCC_UsePackage) 74 | CFBundleName=$(MSBuildProjectName);CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleVersion=1.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);NSHighResolutionCapable=true;LSApplicationCategoryType=public.app-category.utilities;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user 75 | 76 | 77 | 1033 78 | TAutomagicFormInterceptorPkg;madBasic_;FireDACASADriver;FireDACSqliteDriver;bindcompfmx;DBXSqliteDriver;FireDACPgDriver;FireDACODBCDriver;RESTBackendComponents;emsclientfiredac;fmx;rtl;dbrtl;DbxClientDriver;IndySystem;FireDACCommon;bindcomp;inetdb;tethering;TeeDB;tsc;DBXInterBaseDriver;Tee;log4delphi_D7_PROF;vclFireDAC;madDisAsm_;xmlrtl;svnui;DbxCommonDriver;vclimg;IndyProtocols;dbxcds;DBXMySQLDriver;FireDACCommonDriver;MetropolisUILiveTile;TMSFMXPackPkgDXE7;bindcompdbx;bindengine;vclactnband;vcldb;soaprtl;vcldsnap;bindcompvcl;FMXTee;TeeUI;vclie;fmxFireDAC;FireDACADSDriver;vcltouch;madExcept_;emsclient;CustomIPTransport;vclribbon;VCLRESTComponents;FireDAC;VclSmp;dsnap;Intraweb;fmxase;vcl;IndyCore;IndyIPServer;TMSFMXPackPkgDEDXE7;IndyIPCommon;CloudService;CodeSiteExpressPkg;dsnapcon;FireDACIBDriver;FmxTeeUI;inet;fmxobj;FireDACMySQLDriver;soapmidas;vclx;soapserver;inetdbxpress;svn;ChromiumFMX;dsnapxml;fmxdae;RESTComponents;FireDACMSAccDriver;dbexpress;adortl;IndyIPClient;$(DCC_UsePackage) 79 | true 80 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 81 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 82 | 83 | 84 | 1033 85 | FireDACASADriver;FireDACSqliteDriver;bindcompfmx;DBXSqliteDriver;FireDACPgDriver;FireDACODBCDriver;RESTBackendComponents;emsclientfiredac;fmx;rtl;dbrtl;DbxClientDriver;IndySystem;FireDACCommon;bindcomp;inetdb;tethering;TeeDB;DBXInterBaseDriver;Tee;vclFireDAC;xmlrtl;DbxCommonDriver;vclimg;IndyProtocols;dbxcds;DBXMySQLDriver;FireDACCommonDriver;MetropolisUILiveTile;bindcompdbx;bindengine;vclactnband;vcldb;soaprtl;vcldsnap;bindcompvcl;FMXTee;TeeUI;vclie;fmxFireDAC;FireDACADSDriver;vcltouch;emsclient;CustomIPTransport;vclribbon;VCLRESTComponents;FireDAC;VclSmp;dsnap;Intraweb;fmxase;vcl;IndyCore;IndyIPServer;IndyIPCommon;CloudService;dsnapcon;FireDACIBDriver;FmxTeeUI;inet;fmxobj;FireDACMySQLDriver;soapmidas;vclx;soapserver;inetdbxpress;dsnapxml;fmxdae;RESTComponents;FireDACMSAccDriver;dbexpress;adortl;IndyIPClient;$(DCC_UsePackage) 86 | true 87 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) 88 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 89 | 90 | 91 | DEBUG;$(DCC_Define) 92 | true 93 | false 94 | true 95 | true 96 | true 97 | 98 | 99 | Debug 100 | 101 | 102 | JsonToDelphiClass_Icon1.ico 103 | $(BDS)\bin\delphi_PROJECTICNS.icns 104 | madExcept;$(DCC_Define) 105 | 1033 106 | true 107 | 3 108 | 1 109 | false 110 | 111 | 112 | false 113 | RELEASE;$(DCC_Define) 114 | 0 115 | 0 116 | 117 | 118 | 3 119 | 1 120 | JsonToDelphiClass_Icon.ico 121 | true 122 | madExcept;$(DCC_Define) 123 | $(BDS)\bin\delphi_PROJECTICNS.icns 124 | 1033 125 | true 126 | 127 | 128 | 129 | MainSource 130 | 131 | 132 |
MainForm
133 | fmx 134 | 135 | 136 | 137 |
SaveUnitForm
138 | fmx 139 | 140 | 141 | 142 |
/ IdSSLOpenSSLHeaders,
143 | 144 | 145 | 146 |
UpdateForm
147 | fmx 148 | 149 | 150 | Cfg_2 151 | Base 152 | 153 | 154 | Base 155 | 156 | 157 | Cfg_1 158 | Base 159 | 160 | 161 | 162 | Delphi.Personality.12 163 | Application 164 | 165 | 166 | 167 | JsonToDelphiClass.dpr 168 | 169 | 170 | Microsoft Office 2000 Sample Automation Server Wrapper Components 171 | Microsoft Office XP Sample Automation Server Wrapper Components 172 | 173 | 174 | 175 | 176 | 177 | true 178 | 179 | 180 | 181 | 182 | true 183 | 184 | 185 | 186 | 187 | true 188 | 189 | 190 | 191 | 192 | JsonToDelphiClass.exe 193 | true 194 | 195 | 196 | 197 | 198 | JsonToDelphiClass.exe 199 | true 200 | 201 | 202 | 203 | 204 | 0 205 | .dll;.bpl 206 | 207 | 208 | 1 209 | .dylib 210 | 211 | 212 | Contents\MacOS 213 | 1 214 | .dylib 215 | 216 | 217 | 1 218 | .dylib 219 | 220 | 221 | 1 222 | .dylib 223 | 224 | 225 | 226 | 227 | Contents\Resources 228 | 1 229 | 230 | 231 | 232 | 233 | classes 234 | 1 235 | 236 | 237 | 238 | 239 | res\drawable-xxhdpi 240 | 1 241 | 242 | 243 | 244 | 245 | Contents\MacOS 246 | 0 247 | 248 | 249 | 1 250 | 251 | 252 | Contents\MacOS 253 | 1 254 | 255 | 256 | 257 | 258 | library\lib\mips 259 | 1 260 | 261 | 262 | 263 | 264 | 1 265 | 266 | 267 | 1 268 | 269 | 270 | 1 271 | 272 | 273 | 274 | 275 | 0 276 | 277 | 278 | 1 279 | 280 | 281 | Contents\MacOS 282 | 1 283 | 284 | 285 | 1 286 | 287 | 288 | library\lib\armeabi-v7a 289 | 1 290 | 291 | 292 | 1 293 | 294 | 295 | 296 | 297 | 0 298 | 299 | 300 | Contents\MacOS 301 | 1 302 | .framework 303 | 304 | 305 | 306 | 307 | 1 308 | 309 | 310 | 1 311 | 312 | 313 | 1 314 | 315 | 316 | 317 | 318 | library\lib\x86 319 | 1 320 | 321 | 322 | 323 | 324 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 325 | 1 326 | 327 | 328 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 329 | 1 330 | 331 | 332 | 333 | 334 | 1 335 | 336 | 337 | 1 338 | 339 | 340 | 1 341 | 342 | 343 | 344 | 345 | 1 346 | 347 | 348 | 1 349 | 350 | 351 | 1 352 | 353 | 354 | 355 | 356 | 1 357 | 358 | 359 | 1 360 | 361 | 362 | 1 363 | 364 | 365 | 366 | 367 | library\lib\armeabi 368 | 1 369 | 370 | 371 | 372 | 373 | 0 374 | 375 | 376 | 1 377 | 378 | 379 | Contents\MacOS 380 | 1 381 | 382 | 383 | 384 | 385 | 1 386 | 387 | 388 | 1 389 | 390 | 391 | 1 392 | 393 | 394 | 395 | 396 | res\drawable-normal 397 | 1 398 | 399 | 400 | 401 | 402 | res\drawable-xhdpi 403 | 1 404 | 405 | 406 | 407 | 408 | res\drawable-large 409 | 1 410 | 411 | 412 | 413 | 414 | 1 415 | 416 | 417 | 1 418 | 419 | 420 | 1 421 | 422 | 423 | 424 | 425 | ../ 426 | 1 427 | 428 | 429 | ../ 430 | 1 431 | 432 | 433 | 434 | 435 | library\lib\armeabi-v7a 436 | 1 437 | 438 | 439 | 440 | 441 | res\drawable-hdpi 442 | 1 443 | 444 | 445 | 446 | 447 | Contents 448 | 1 449 | 450 | 451 | 452 | 453 | ../ 454 | 1 455 | 456 | 457 | 458 | 459 | 1 460 | 461 | 462 | 1 463 | 464 | 465 | 1 466 | 467 | 468 | 469 | 470 | res\values 471 | 1 472 | 473 | 474 | 475 | 476 | res\drawable-small 477 | 1 478 | 479 | 480 | 481 | 482 | res\drawable 483 | 1 484 | 485 | 486 | 487 | 488 | 1 489 | 490 | 491 | 1 492 | 493 | 494 | 1 495 | 496 | 497 | 498 | 499 | 1 500 | 501 | 502 | 503 | 504 | res\drawable 505 | 1 506 | 507 | 508 | 509 | 510 | 0 511 | 512 | 513 | 0 514 | 515 | 516 | Contents\Resources\StartUp\ 517 | 0 518 | 519 | 520 | 0 521 | 522 | 523 | 0 524 | 525 | 526 | 0 527 | 528 | 529 | 530 | 531 | library\lib\armeabi-v7a 532 | 1 533 | 534 | 535 | 536 | 537 | 0 538 | .bpl 539 | 540 | 541 | 1 542 | .dylib 543 | 544 | 545 | Contents\MacOS 546 | 1 547 | .dylib 548 | 549 | 550 | 1 551 | .dylib 552 | 553 | 554 | 1 555 | .dylib 556 | 557 | 558 | 559 | 560 | res\drawable-mdpi 561 | 1 562 | 563 | 564 | 565 | 566 | res\drawable-xlarge 567 | 1 568 | 569 | 570 | 571 | 572 | res\drawable-ldpi 573 | 1 574 | 575 | 576 | 577 | 578 | 1 579 | 580 | 581 | 1 582 | 583 | 584 | 585 | 586 | 587 | 588 | 589 | 590 | 591 | 592 | 593 | True 594 | True 595 | True 596 | 597 | 598 | 12 599 | 600 | 601 | 602 | 603 | 604 | --------------------------------------------------------------------------------