├── .gitattributes ├── Auto Tables for RAD Server.pdf ├── AutoTablesEditor.dpr ├── AutoTablesEditor.dproj ├── README.md ├── Samples ├── Logger │ ├── AutoTablesClient.dpr │ ├── AutoTablesClient.dproj │ ├── AutoTablesDelphiSDK.pas │ ├── AutoTablesForRADServer.dpk │ ├── AutoTablesForRADServer.dproj │ ├── Docs │ │ ├── apispec.json │ │ ├── favicon-16x16.png │ │ ├── favicon-32x32.png │ │ ├── index.html │ │ ├── oauth2-redirect.html │ │ ├── swagger-ui-bundle.js │ │ ├── swagger-ui-bundle.js.map │ │ ├── swagger-ui-standalone-preset.js │ │ ├── swagger-ui-standalone-preset.js.map │ │ ├── swagger-ui.css │ │ ├── swagger-ui.css.map │ │ ├── swagger-ui.js │ │ └── swagger-ui.js.map │ ├── LOGGER.IB │ ├── apispec.json │ ├── readme.txt │ ├── uAutoTablesClientDM.dfm │ ├── uAutoTablesClientDM.pas │ ├── uAutoTablesClientDM.vlb │ ├── uMainForm.fmx │ ├── uMainForm.pas │ ├── uMainForm.vlb │ ├── uMainServer.dfm │ └── uMainServer.pas └── OpenEMR │ ├── AutoTablesClient.dpr │ ├── AutoTablesClient.dproj │ ├── AutoTablesDelphiSDK.pas │ ├── AutoTablesForRADServer.dpk │ ├── AutoTablesForRADServer.dproj │ ├── Docs │ ├── apispec.json │ ├── favicon-16x16.png │ ├── favicon-32x32.png │ ├── index.html │ ├── oauth2-redirect.html │ ├── swagger-ui-bundle.js │ ├── swagger-ui-bundle.js.map │ ├── swagger-ui-standalone-preset.js │ ├── swagger-ui-standalone-preset.js.map │ ├── swagger-ui.css │ ├── swagger-ui.css.map │ ├── swagger-ui.js │ └── swagger-ui.js.map │ ├── README.md │ ├── Screenshots │ ├── detail.jpg │ └── list.jpg │ ├── apispec.json │ ├── openemr.sql │ ├── uAutoTablesClientDM.dfm │ ├── uAutoTablesClientDM.pas │ ├── uMainForm.fmx │ ├── uMainForm.pas │ ├── uMainServer.dfm │ └── uMainServer.pas ├── Screenshots ├── clientgen.jpg ├── docs.jpg ├── endpoint_editor.jpg ├── endpoints.jpg ├── endpoints_wizard.jpg └── openapi.jpg ├── Swag.Common.Consts.pas ├── Swag.Common.Types.Helpers.pas ├── Swag.Common.Types.pas ├── Swag.Doc.Definition.pas ├── Swag.Doc.Info.Contact.pas ├── Swag.Doc.Info.License.pas ├── Swag.Doc.Info.pas ├── Swag.Doc.Path.Operation.RequestParameter.pas ├── Swag.Doc.Path.Operation.Response.pas ├── Swag.Doc.Path.Operation.ResponseHeaders.pas ├── Swag.Doc.Path.Operation.pas ├── Swag.Doc.Path.pas ├── Swag.Doc.SecurityDefinition.pas ├── Swag.Doc.SecurityDefinitionApiKey.pas ├── Swag.Doc.pas ├── Templates ├── Client │ └── Object Pascal │ │ ├── AutoTablesClient.dpr │ │ ├── AutoTablesClient.dproj │ │ ├── uAutoTablesClientDM.dfm │ │ ├── uAutoTablesClientDM.pas │ │ ├── uMainForm.fmx │ │ ├── uMainForm.pas │ │ ├── uMainFormA.fmx │ │ ├── uMainFormA.pas │ │ ├── uMainFormB.fmx │ │ ├── uMainFormB.pas │ │ ├── uMainFormC.fmx │ │ └── uMainFormC.pas ├── Server │ └── Object Pascal │ │ ├── AutoTablesForRADServer.dpk │ │ ├── AutoTablesForRADServer.dproj │ │ ├── AutoTablesForRADServer.dproj.local │ │ ├── AutoTablesForRADServer.identcache │ │ ├── AutoTablesForRADServer.stat │ │ ├── uMainServer.dfm │ │ ├── uMainServer.pas │ │ └── uMainServer.vlb └── swagger-ui.zip ├── Win.Webbrowser.pas ├── license.txt ├── uActivityFrame.fmx ├── uActivityFrame.pas ├── uAngularJSSDK.fmx ├── uAngularJSSDK.pas ├── uDelphiSDK.fmx ├── uDelphiSDK.pas ├── uDelphiSDK.vlb ├── uMainForm.fmx ├── uMainForm.pas ├── uMainForm.vlb ├── uOpenAPI.dfm ├── uOpenAPI.pas ├── uPicker.fmx ├── uPicker.pas ├── uPicker.vlb ├── uSelector.fmx ├── uSelector.pas └── uSelector.vlb /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | 4 | # Custom for Visual Studio 5 | *.cs diff=csharp 6 | 7 | # Standard to msysgit 8 | *.doc diff=astextplain 9 | *.DOC diff=astextplain 10 | *.docx diff=astextplain 11 | *.DOCX diff=astextplain 12 | *.dot diff=astextplain 13 | *.DOT diff=astextplain 14 | *.pdf diff=astextplain 15 | *.PDF diff=astextplain 16 | *.rtf diff=astextplain 17 | *.RTF diff=astextplain 18 | -------------------------------------------------------------------------------- /Auto Tables for RAD Server.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/FMXExpress/AutoTablesForRADServer/67d5f358d7276036b45797a6072d5e4cdc731af4/Auto Tables for RAD Server.pdf -------------------------------------------------------------------------------- /AutoTablesEditor.dpr: -------------------------------------------------------------------------------- 1 | program AutoTablesEditor; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | uMainForm in 'uMainForm.pas' {MainForm}, 7 | uPicker in 'uPicker.pas' {PickerForm}, 8 | uSelector in 'uSelector.pas' {SelectorForm}, 9 | uOpenAPI in 'uOpenAPI.pas' {OpenAPIDM: TDataModule}, 10 | uDelphiSDK in 'uDelphiSDK.pas' {DelphiSDKFrame: TFrame}, 11 | uActivityFrame in 'uActivityFrame.pas' {ActivityFrame: TFrame}, 12 | uAngularJSSDK in 'uAngularJSSDK.pas' {AngularJSSDKFrame: TFrame}; 13 | 14 | {$R *.res} 15 | 16 | begin 17 | Application.Initialize; 18 | Application.CreateForm(TMainForm, MainForm); 19 | Application.CreateForm(TPickerForm, PickerForm); 20 | Application.CreateForm(TSelectorForm, SelectorForm); 21 | Application.CreateForm(TOpenAPIDM, OpenAPIDM); 22 | Application.Run; 23 | end. 24 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # AutoTablesForRADServer 2 | Automate REST API Development With Auto Tables For RAD Server 3 | 4 | # Product Overview 5 | Auto Tables is an automatic low code REST API generator for RAD Server. The server and clients can be compiled in Embarcadero Delphi. The easy to use interface allows for the quick automatic configuration of a REST server with dynamic endpoints providing read, write, and delete access to your data. Database tables can be made available with enterprise permissions for over 30 different databases including databases such as MySQL, Microsoft SQL Server, and InterBase. Additionally, you can automatically generate endpoints for over 80 more data sources using the Embarcadero Enterprise Connectors. Auto Tables provides similar functionality to DreamFactory, Sandman, and LoopBack. 6 | 7 | A graphical Auto Tables for RAD Server Endpoint Editor is provided to help you set up, create, and edit your Auto Tables for RAD Server endpoints. Once you configure your endpoints you can either generate a new RAD Server project or you can save them out for loading into an existing Auto Tables for RAD Server ResourceModule. The configuration format is the standard FireDAC JSON. 8 | Full source code for the Auto Tables RAD Server ResourceModule is provided so you control your REST API server. This gives you the freedom to enhance and modify the source code as needed for your own solutions. 9 | 10 | # FireDAC Databases: 11 | SAP Advantage 12 | SAP SQL Anywhere 13 | IBM DB2 Server 14 | Firebird 15 | InterBase 16 | IBM Informix 17 | Microsoft Access 18 | Microsoft SQL Server 19 | MySQL Server 20 | MariaDB 21 | Oracle Server 22 | PostgreSQL 23 | PostgreSQL Enterprise Server 24 | SQLite 25 | Teradata 26 | Generic ODBC sources: 27 | 28 | SAP Adaptive Server Enterprise 29 | IBM DB2 AS/400 30 | QuickBooks 31 | InterSystems Cache 32 | Pervasive SQL 33 | DBase 34 | Excel 35 | MicroFocus Cobol 36 | Ingres Database 37 | SAP MaxDB 38 | Clarion 39 | SolidDB 40 | Unify SQLBase 41 | 42 | # Endpoints Wizard 43 | ![Alt text](Screenshots/endpoints_wizard.jpg?raw=true "Endpoints wizard") 44 | 45 | # Endpoints 46 | ![Alt text](Screenshots/endpoints.jpg?raw=true "Endpoints") 47 | 48 | # Endpoint Editor 49 | ![Alt text](Screenshots/endpoint_editor.jpg?raw=true "Endpoint Editor") 50 | 51 | AutoTables for RAD Server outputs a Delphi RAD Server project, a Delphi REST client project suitable for LiveBindings, a Delphi REST SDK, an OpenAPI 2.0 api spec file, and a Swagger UI documentation interface. 52 | 53 | The OpenAPI 2.0 api spec file allows you to generate clients for your REST API in the following languages: 54 | ActionScript, Ada, Apex, Bash, C#, C++, Clojure, Dart, Elixir, Elm, Eiffel, Erlang, Go, Groovy, Haskell, Java, Kotlin, Lua, Node.js, Objective-C, Perl, PHP, PowerShell, Python, R, Ruby, Rust, Scala, Swift, Typescript 55 | 56 | # OpenAPI Generator 57 | ![Alt text](Screenshots/openapi.jpg?raw=true "OpenAPI Generator") 58 | 59 | # Documentation 60 | ![Alt text](Screenshots/docs.jpg?raw=true "Documentation") 61 | 62 | 63 | # Uses SwagDoc 64 | https://github.com/marcelojaloto/SwagDoc 65 | 66 | # Uses Win.WebBrowser.pas 67 | https://github.com/ortuagustin/Delphi-Utils 68 | 69 | # Uses Swagger-UI 70 | https://github.com/swagger-api/swagger-ui 71 | 72 | 73 | -------------------------------------------------------------------------------- /Samples/Logger/AutoTablesClient.dpr: -------------------------------------------------------------------------------- 1 | program AutoTablesClient; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | uMainForm in 'uMainForm.pas' {MainForm}, 7 | uAutoTablesClientDM in 'uAutoTablesClientDM.pas' {AutoTablesClientDM: TDataModule}; 8 | 9 | {$R *.res} 10 | 11 | begin 12 | Application.Initialize; 13 | Application.CreateForm(TMainForm, MainForm); 14 | Application.CreateForm(TAutoTablesClientDM, AutoTablesClientDM); 15 | Application.Run; 16 | end. 17 | -------------------------------------------------------------------------------- /Samples/Logger/AutoTablesDelphiSDK.pas: -------------------------------------------------------------------------------- 1 | unit AutoTablesDelphiSDK; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Classes, System.JSON, FireDAC.Stan.Intf, System.StrUtils, 7 | FireDAC.Stan.Option, FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, 8 | FireDAC.Phys.Intf, FireDAC.DApt.Intf, Data.DB, FireDAC.Comp.DataSet, 9 | FireDAC.Comp.Client, REST.Client, REST.Backend.Endpoint, REST.Types, 10 | REST.Backend.EMSProvider, REST.Backend.ServiceComponents, REST.Backend.Providers; 11 | 12 | type 13 | TSDKClient = class(TComponent) 14 | private 15 | { Private declarations } 16 | FUserName, FPassword: String; 17 | public 18 | { Public declarations } 19 | FEMSProvider: TEMSProvider; 20 | FBackendAuth: TBackendAuth; 21 | 22 | constructor Create(AOwner: TComponent); 23 | destructor Destroy; 24 | 25 | function LoginAPI(const UserName, Password: String): Boolean; 26 | function GetAPI(const APath: String): TBytesStream; 27 | function PostAPI(const APath: String; ABytesStream: TBytesStream): TBytesStream; 28 | function DeleteAPI(const APath: String): TBytesStream; 29 | 30 | function getlogger(Aformat: String = ''): TBytesStream; 31 | 32 | function postlogger(Aformat: String = ''; ABytesStream: TBytesStream = nil): TBytesStream; 33 | 34 | function deletelogger(AID: String; Aformat: String = ''): TBytesStream; 35 | 36 | 37 | published 38 | property Username: String read FUsername write FUsername; 39 | property Password: String read FPassword write FPassword; 40 | end; 41 | 42 | implementation 43 | 44 | 45 | constructor TSDKClient.Create(AOwner: TComponent); 46 | begin 47 | inherited Create(AOwner); 48 | FEMSProvider := TEMSProvider.Create(AOwner); 49 | FBackendAuth := TBackendAuth.Create(AOwner); 50 | FEMSProvider.URLHost := 'localhost'; 51 | FEMSProvider.URLPort := StrToInt('8080'); 52 | FEMSProvider.URLBasePath := ''; 53 | FEMSProvider.URLProtocol := 'http'; 54 | FBackendAuth.Provider := FEMSProvider; 55 | FUserName := ''; 56 | FPassword := ''; 57 | end; 58 | 59 | destructor TSDKClient.Destroy; 60 | begin 61 | inherited Destroy; 62 | FBackendAuth.DisposeOf; 63 | end; 64 | 65 | function TSDKClient.LoginAPI(const UserName, Password: String): Boolean; 66 | begin 67 | if not FBackendAuth.LoggedIn then 68 | begin 69 | FBackendAuth.UserName := UserName; 70 | FBackendAuth.Password := Password; 71 | FBAckendAuth.Login; 72 | 73 | if FBackendAuth.LoggedIn then 74 | begin 75 | if FBackendAuth.LoggedInToken = '' then 76 | begin 77 | FBackendAuth.Authentication := TBackendAuthentication.Default; 78 | Result := False; 79 | end 80 | else 81 | begin 82 | FBackendAuth.Authentication := TBackendAuthentication.Session; 83 | Result := True; 84 | end; 85 | end; 86 | end 87 | else 88 | Result := True; 89 | end; 90 | 91 | function TSDKClient.GetAPI(const APath: String): TBytesStream; 92 | var 93 | EndPoint: TBackendEndpoint; 94 | begin 95 | Result := TBytesStream.Create; 96 | EndPoint := TBackendEndpoint.Create(Self); 97 | EndPoint.Provider := FEMSProvider; 98 | EndPoint.Auth := FBackendAuth; 99 | try 100 | EndPoint.Resource := APath; 101 | EndPoint.Method := TRESTRequestMethod.rmGET; 102 | EndPoint.Execute; 103 | Result := TBytesStream.Create(EndPoint.Response.RawBytes); 104 | if EndPoint.Response.StatusCode>=400 then 105 | begin 106 | raise Exception.Create(EndPoint.Response.StatusText); 107 | end; 108 | finally 109 | EndPoint.DisposeOf; 110 | end; 111 | end; 112 | 113 | function TSDKClient.PostAPI(const APath: String; ABytesStream: TBytesStream): TBytesStream; 114 | var 115 | EndPoint: TBackendEndpoint; 116 | begin 117 | EndPoint := TBackendEndpoint.Create(Self); 118 | EndPoint.Provider := FEMSProvider; 119 | EndPoint.Auth := FBackendAuth; 120 | try 121 | EndPoint.Resource := APath; 122 | EndPoint.Method := TRESTRequestMethod.rmPOST; 123 | EndPoint.AddBody(ABytesStream,TRESTContentType.ctAPPLICATION_JSON); 124 | EndPoint.Execute; 125 | Result := TBytesStream.Create(EndPoint.Response.RawBytes); 126 | if EndPoint.Response.StatusCode>=400 then 127 | begin 128 | raise Exception.Create(EndPoint.Response.StatusText); 129 | end; 130 | finally 131 | EndPoint.DisposeOf; 132 | end; 133 | end; 134 | 135 | function TSDKClient.DeleteAPI(const APath: String): TBytesStream; 136 | var 137 | EndPoint: TBackendEndpoint; 138 | begin 139 | Result := TBytesStream.Create; 140 | EndPoint := TBackendEndpoint.Create(Self); 141 | EndPoint.Provider := FEMSProvider; 142 | EndPoint.Auth := FBackendAuth; 143 | try 144 | EndPoint.Resource := APath; 145 | EndPoint.Method := TRESTRequestMethod.rmDELETE; 146 | EndPoint.Execute; 147 | Result := TBytesStream.Create(EndPoint.Response.RawBytes); 148 | if EndPoint.Response.StatusCode>=400 then 149 | begin 150 | raise Exception.Create(EndPoint.Response.StatusText); 151 | end; 152 | finally 153 | EndPoint.DisposeOf; 154 | end; 155 | end; 156 | 157 | function TSDKClient.getlogger(Aformat: String = ''): TBytesStream; 158 | begin 159 | if Self.LoginAPI(FUserName,FPassword) then 160 | Result := Self.GetAPI('/v1/getlogger/'+IfThen(Aformat<>'','?format='+Aformat,'')); 161 | end; 162 | 163 | function TSDKClient.postlogger(Aformat: String = ''; ABytesStream: TBytesStream = nil): TBytesStream; 164 | begin 165 | if Self.LoginAPI(FUserName,FPassword) then 166 | Result := Self.PostAPI('/v1/postlogger/'+IfThen(Aformat<>'','?format='+Aformat,''),ABytesStream); 167 | end; 168 | 169 | function TSDKClient.deletelogger(AID: String; Aformat: String = ''): TBytesStream; 170 | begin 171 | if Self.LoginAPI(FUserName,FPassword) then 172 | Result := Self.DeleteAPI('/v1/deletelogger/?ID='+AID+''+IfThen(Aformat<>'','&format='+Aformat,'')); 173 | end; 174 | 175 | 176 | 177 | end. 178 | -------------------------------------------------------------------------------- /Samples/Logger/AutoTablesForRADServer.dpk: -------------------------------------------------------------------------------- 1 | package AutoTablesForRADServer; 2 | 3 | {$R *.res} 4 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 5 | {$ALIGN 8} 6 | {$ASSERTIONS ON} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO OFF} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS ON} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION OFF} 16 | {$OVERFLOWCHECKS OFF} 17 | {$RANGECHECKS OFF} 18 | {$REFERENCEINFO ON} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES ON} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DEFINE DEBUG} 27 | {$ENDIF IMPLICITBUILDING} 28 | {$RUNONLY} 29 | {$IMPLICITBUILD ON} 30 | 31 | requires 32 | rtl, 33 | emsserverapi, 34 | dbrtl, 35 | FireDAC, 36 | FireDACSqliteDriver, 37 | FireDACCommonDriver, 38 | FireDACCommon, 39 | bindengine, 40 | bindcomp, 41 | FireDACIBDriver; 42 | 43 | contains 44 | uMainServer in 'uMainServer.pas' {AutoTablesResource: TDataModule}; 45 | 46 | end. 47 | -------------------------------------------------------------------------------- /Samples/Logger/Docs/apispec.json: -------------------------------------------------------------------------------- 1 | { 2 | "swagger":"2.0", 3 | "info": 4 | { 5 | "version":"v1.0", 6 | "title":"Auto Tables for RAD Server Sample", 7 | "description":"Sample API for Auto Tables", 8 | "termsOfService":"http://www.example.com/tos/", 9 | "contact": 10 | { 11 | "name":"Sample Name", 12 | "email":"sample@example.com", 13 | "url":"http://www.example.com/contact/" 14 | } 15 | , 16 | "license": 17 | { 18 | "name":"Sample API License", 19 | "url":"http://www.example.com/license/" 20 | } 21 | } 22 | , 23 | "host":"example.com", 24 | "basePath":"/v1", 25 | "schemes": 26 | [ 27 | "http", 28 | "https" 29 | ] 30 | , 31 | "consumes": 32 | [ 33 | "application/json" 34 | ] 35 | , 36 | "produces": 37 | [ 38 | "application/xml", 39 | "application/json", 40 | "application/octet-stream", 41 | "text/csv" 42 | ] 43 | , 44 | "paths": 45 | { 46 | "getlogger/": 47 | { 48 | "get": 49 | { 50 | "description":"Requests some data", 51 | "operationId":"RequestData", 52 | "tags": 53 | [ 54 | "getlogger" 55 | ] 56 | , 57 | "parameters": 58 | [ 59 | { 60 | "in":"header", 61 | "name":"X-Embarcadero-Session-Token", 62 | "description":"EMS User Authentication", 63 | "required":false, 64 | "type":"string" 65 | } 66 | , 67 | 68 | { 69 | "in":"header", 70 | "name":"X-Embarcadero-Tenant-Id", 71 | "description":"EMS Tenant Id", 72 | "required":false, 73 | "type":"string" 74 | } 75 | , 76 | 77 | { 78 | "in":"header", 79 | "name":"X-Embarcadero-Tenant-Secret", 80 | "description":"EMS Tenant Secret", 81 | "required":false, 82 | "type":"string" 83 | } 84 | ] 85 | , 86 | "responses": 87 | { 88 | "200": 89 | { 90 | "description":"Successfully retrieved data" 91 | } 92 | , 93 | "default": 94 | { 95 | "description":"Error occured" 96 | } 97 | } 98 | } 99 | } 100 | , 101 | "postlogger/": 102 | { 103 | "post": 104 | { 105 | "description":"Add or update some data", 106 | "operationId":"AddOrUpdateData", 107 | "tags": 108 | [ 109 | "postlogger" 110 | ] 111 | , 112 | "parameters": 113 | [ 114 | { 115 | "in":"header", 116 | "name":"X-Embarcadero-Session-Token", 117 | "description":"EMS User Authentication", 118 | "required":false, 119 | "type":"string" 120 | } 121 | , 122 | 123 | { 124 | "in":"header", 125 | "name":"X-Embarcadero-Tenant-Id", 126 | "description":"EMS Tenant Id", 127 | "required":false, 128 | "type":"string" 129 | } 130 | , 131 | 132 | { 133 | "in":"header", 134 | "name":"X-Embarcadero-Tenant-Secret", 135 | "description":"EMS Tenant Secret", 136 | "required":false, 137 | "type":"string" 138 | } 139 | , 140 | 141 | { 142 | "in":"body", 143 | "name":"Body", 144 | "description":"Post Body", 145 | "required":false, 146 | "type":"string" 147 | } 148 | ] 149 | , 150 | "responses": 151 | { 152 | "200": 153 | { 154 | "description":"Successfully retrieved data" 155 | } 156 | , 157 | "default": 158 | { 159 | "description":"Error occured" 160 | } 161 | } 162 | } 163 | } 164 | , 165 | "deletelogger/?ID={ID}": 166 | { 167 | "delete": 168 | { 169 | "description":"Delete some data", 170 | "operationId":"DeleteData", 171 | "tags": 172 | [ 173 | "deletelogger" 174 | ] 175 | , 176 | "parameters": 177 | [ 178 | { 179 | "in":"header", 180 | "name":"X-Embarcadero-Session-Token", 181 | "description":"EMS User Authentication", 182 | "required":false, 183 | "type":"string" 184 | } 185 | , 186 | 187 | { 188 | "in":"header", 189 | "name":"X-Embarcadero-Tenant-Id", 190 | "description":"EMS Tenant Id", 191 | "required":false, 192 | "type":"string" 193 | } 194 | , 195 | 196 | { 197 | "in":"header", 198 | "name":"X-Embarcadero-Tenant-Secret", 199 | "description":"EMS Tenant Secret", 200 | "required":false, 201 | "type":"string" 202 | } 203 | , 204 | 205 | { 206 | "in":"query", 207 | "name":"ID", 208 | "description":"A param called ID", 209 | "required":true, 210 | "type":"string" 211 | } 212 | ] 213 | , 214 | "responses": 215 | { 216 | "200": 217 | { 218 | "description":"Successfully retrieved data" 219 | } 220 | , 221 | "default": 222 | { 223 | "description":"Error occured" 224 | } 225 | } 226 | } 227 | } 228 | } 229 | } 230 | -------------------------------------------------------------------------------- /Samples/Logger/Docs/favicon-16x16.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/FMXExpress/AutoTablesForRADServer/67d5f358d7276036b45797a6072d5e4cdc731af4/Samples/Logger/Docs/favicon-16x16.png -------------------------------------------------------------------------------- /Samples/Logger/Docs/favicon-32x32.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/FMXExpress/AutoTablesForRADServer/67d5f358d7276036b45797a6072d5e4cdc731af4/Samples/Logger/Docs/favicon-32x32.png -------------------------------------------------------------------------------- /Samples/Logger/Docs/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | Swagger UI 7 | 8 | 9 | 10 | 31 | 32 | 33 | 34 |
35 | 36 | 37 | 38 | 288 | 289 | 290 | -------------------------------------------------------------------------------- /Samples/Logger/Docs/oauth2-redirect.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 68 | -------------------------------------------------------------------------------- /Samples/Logger/Docs/swagger-ui.css.map: -------------------------------------------------------------------------------- 1 | {"version":3,"sources":[],"names":[],"mappings":"","file":"swagger-ui.css","sourceRoot":""} -------------------------------------------------------------------------------- /Samples/Logger/LOGGER.IB: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/FMXExpress/AutoTablesForRADServer/67d5f358d7276036b45797a6072d5e4cdc731af4/Samples/Logger/LOGGER.IB -------------------------------------------------------------------------------- /Samples/Logger/apispec.json: -------------------------------------------------------------------------------- 1 | { 2 | "swagger":"2.0", 3 | "info": 4 | { 5 | "version":"v1.0", 6 | "title":"Auto Tables for RAD Server Sample", 7 | "description":"Sample API for Auto Tables", 8 | "termsOfService":"http://www.example.com/tos/", 9 | "contact": 10 | { 11 | "name":"Sample Name", 12 | "email":"sample@example.com", 13 | "url":"http://www.example.com/contact/" 14 | } 15 | , 16 | "license": 17 | { 18 | "name":"Sample API License", 19 | "url":"http://www.example.com/license/" 20 | } 21 | } 22 | , 23 | "host":"example.com", 24 | "basePath":"/v1", 25 | "schemes": 26 | [ 27 | "http", 28 | "https" 29 | ] 30 | , 31 | "consumes": 32 | [ 33 | "application/json" 34 | ] 35 | , 36 | "produces": 37 | [ 38 | "application/xml", 39 | "application/json", 40 | "application/octet-stream", 41 | "text/csv" 42 | ] 43 | , 44 | "paths": 45 | { 46 | "getlogger/": 47 | { 48 | "get": 49 | { 50 | "description":"Requests some data", 51 | "operationId":"RequestData", 52 | "tags": 53 | [ 54 | "getlogger" 55 | ] 56 | , 57 | "parameters": 58 | [ 59 | { 60 | "in":"header", 61 | "name":"X-Embarcadero-Session-Token", 62 | "description":"EMS User Authentication", 63 | "required":false, 64 | "type":"string" 65 | } 66 | , 67 | 68 | { 69 | "in":"header", 70 | "name":"X-Embarcadero-Tenant-Id", 71 | "description":"EMS Tenant Id", 72 | "required":false, 73 | "type":"string" 74 | } 75 | , 76 | 77 | { 78 | "in":"header", 79 | "name":"X-Embarcadero-Tenant-Secret", 80 | "description":"EMS Tenant Secret", 81 | "required":false, 82 | "type":"string" 83 | } 84 | ] 85 | , 86 | "responses": 87 | { 88 | "200": 89 | { 90 | "description":"Successfully retrieved data" 91 | } 92 | , 93 | "default": 94 | { 95 | "description":"Error occured" 96 | } 97 | } 98 | } 99 | } 100 | , 101 | "postlogger/": 102 | { 103 | "post": 104 | { 105 | "description":"Add or update some data", 106 | "operationId":"AddOrUpdateData", 107 | "tags": 108 | [ 109 | "postlogger" 110 | ] 111 | , 112 | "parameters": 113 | [ 114 | { 115 | "in":"header", 116 | "name":"X-Embarcadero-Session-Token", 117 | "description":"EMS User Authentication", 118 | "required":false, 119 | "type":"string" 120 | } 121 | , 122 | 123 | { 124 | "in":"header", 125 | "name":"X-Embarcadero-Tenant-Id", 126 | "description":"EMS Tenant Id", 127 | "required":false, 128 | "type":"string" 129 | } 130 | , 131 | 132 | { 133 | "in":"header", 134 | "name":"X-Embarcadero-Tenant-Secret", 135 | "description":"EMS Tenant Secret", 136 | "required":false, 137 | "type":"string" 138 | } 139 | , 140 | 141 | { 142 | "in":"body", 143 | "name":"Body", 144 | "description":"Post Body", 145 | "required":false, 146 | "type":"string" 147 | } 148 | ] 149 | , 150 | "responses": 151 | { 152 | "200": 153 | { 154 | "description":"Successfully retrieved data" 155 | } 156 | , 157 | "default": 158 | { 159 | "description":"Error occured" 160 | } 161 | } 162 | } 163 | } 164 | , 165 | "deletelogger/?ID={ID}": 166 | { 167 | "delete": 168 | { 169 | "description":"Delete some data", 170 | "operationId":"DeleteData", 171 | "tags": 172 | [ 173 | "deletelogger" 174 | ] 175 | , 176 | "parameters": 177 | [ 178 | { 179 | "in":"header", 180 | "name":"X-Embarcadero-Session-Token", 181 | "description":"EMS User Authentication", 182 | "required":false, 183 | "type":"string" 184 | } 185 | , 186 | 187 | { 188 | "in":"header", 189 | "name":"X-Embarcadero-Tenant-Id", 190 | "description":"EMS Tenant Id", 191 | "required":false, 192 | "type":"string" 193 | } 194 | , 195 | 196 | { 197 | "in":"header", 198 | "name":"X-Embarcadero-Tenant-Secret", 199 | "description":"EMS Tenant Secret", 200 | "required":false, 201 | "type":"string" 202 | } 203 | , 204 | 205 | { 206 | "in":"query", 207 | "name":"ID", 208 | "description":"A param called ID", 209 | "required":true, 210 | "type":"string" 211 | } 212 | ] 213 | , 214 | "responses": 215 | { 216 | "200": 217 | { 218 | "description":"Successfully retrieved data" 219 | } 220 | , 221 | "default": 222 | { 223 | "description":"Error occured" 224 | } 225 | } 226 | } 227 | } 228 | } 229 | } 230 | -------------------------------------------------------------------------------- /Samples/Logger/readme.txt: -------------------------------------------------------------------------------- 1 | Installation 2 | Copy Logger.IB to C:\Users\Public\Documents\Embarcadero\EMS 3 | Open AutoTablesForRADServer.dpr and Run project. 4 | Open AutoTablesClient.dpr and Run project. -------------------------------------------------------------------------------- /Samples/Logger/uAutoTablesClientDM.dfm: -------------------------------------------------------------------------------- 1 | object AutoTablesClientDM: TAutoTablesClientDM 2 | OldCreateOrder = False 3 | Height = 484 4 | Width = 669 5 | object BackendEndpoint1: TBackendEndpoint 6 | Provider = EMSProvider1 7 | Auth = BackendAuth1 8 | Params = < 9 | item 10 | Kind = pkURLSEGMENT 11 | name = 'format' 12 | Options = [poAutoCreated] 13 | end> 14 | Resource = 'v1/getlogger/?format={format}' 15 | Response = RESTResponse1 16 | Left = 50 17 | Top = 26 18 | end 19 | object RESTResponse1: TRESTResponse 20 | Left = 244 21 | Top = 28 22 | end 23 | object getloggerMemTable1: TFDMemTable 24 | FieldDefs = < 25 | item 26 | Name = 'ID' 27 | Attributes = [faRequired] 28 | DataType = ftInteger 29 | end 30 | item 31 | Name = 'CATEGORY' 32 | DataType = ftString 33 | Size = 255 34 | end 35 | item 36 | Name = 'NAME' 37 | DataType = ftString 38 | Size = 255 39 | end 40 | item 41 | Name = 'MESSAGE' 42 | DataType = ftString 43 | Size = 4096 44 | end 45 | item 46 | Name = 'LAST_MODIFIED' 47 | DataType = ftTimeStamp 48 | end> 49 | IndexDefs = <> 50 | FetchOptions.AssignedValues = [evMode] 51 | FetchOptions.Mode = fmAll 52 | ResourceOptions.AssignedValues = [rvSilentMode] 53 | ResourceOptions.SilentMode = True 54 | UpdateOptions.AssignedValues = [uvCheckRequired, uvAutoCommitUpdates] 55 | UpdateOptions.CheckRequired = False 56 | UpdateOptions.AutoCommitUpdates = True 57 | StoreDefs = True 58 | Left = 201 59 | Top = 313 60 | end 61 | object BackendEndpoint2: TBackendEndpoint 62 | Provider = EMSProvider1 63 | Auth = BackendAuth1 64 | Method = rmPOST 65 | Params = <> 66 | Resource = 'v1/postlogger/' 67 | Response = RESTResponse2 68 | Left = 36 69 | Top = 108 70 | end 71 | object RESTResponse2: TRESTResponse 72 | Left = 136 73 | Top = 40 74 | end 75 | object postloggerPostMemTable2: TFDMemTable 76 | Active = True 77 | FieldDefs = < 78 | item 79 | Name = 'ID' 80 | Attributes = [faRequired] 81 | DataType = ftInteger 82 | end 83 | item 84 | Name = 'CATEGORY' 85 | DataType = ftString 86 | Size = 255 87 | end 88 | item 89 | Name = 'NAME' 90 | DataType = ftString 91 | Size = 255 92 | end 93 | item 94 | Name = 'MESSAGE' 95 | DataType = ftString 96 | Size = 4096 97 | end 98 | item 99 | Name = 'LAST_MODIFIED' 100 | DataType = ftTimeStamp 101 | end> 102 | IndexDefs = <> 103 | FetchOptions.AssignedValues = [evMode] 104 | FetchOptions.Mode = fmAll 105 | ResourceOptions.AssignedValues = [rvPersistent, rvSilentMode] 106 | ResourceOptions.Persistent = True 107 | ResourceOptions.SilentMode = True 108 | UpdateOptions.AssignedValues = [uvCheckRequired, uvAutoCommitUpdates] 109 | UpdateOptions.CheckRequired = False 110 | UpdateOptions.AutoCommitUpdates = True 111 | StoreDefs = True 112 | Left = 273 113 | Top = 249 114 | Content = { 115 | 414442530F00A037E3020000FF00010001FF02FF0304002E00000070006F0073 116 | 0074006C006F00670067006500720050006F00730074004D0065006D00540061 117 | 0062006C006500320005000A0000005400610062006C00650006000000000007 118 | 0000080032000000090000FF0AFF0B0400040000004900440005000400000049 119 | 0044000C00010000000E000D000F000110000111000112000113000400000049 120 | 004400FEFF0B040010000000430041005400450047004F005200590005001000 121 | 0000430041005400450047004F00520059000C00020000000E0014001500FF00 122 | 00000F0001160001100001170001110001120001130010000000430041005400 123 | 450047004F00520059001800FF000000FEFF0B0400080000004E0041004D0045 124 | 000500080000004E0041004D0045000C00030000000E0014001500FF0000000F 125 | 00011600011000011700011100011200011300080000004E0041004D00450018 126 | 00FF000000FEFF0B04000E0000004D0045005300530041004700450005000E00 127 | 00004D004500530053004100470045000C00040000000E001400150000100000 128 | 0F000116000119000110000117000111000112000113000E0000004D00450053 129 | 005300410047004500180000100000FEFF0B04001A0000004C00410053005400 130 | 5F004D004F0044004900460049004500440005001A0000004C00410053005400 131 | 5F004D004F004400490046004900450044000C00050000000E001A000F000116 132 | 000110000117000111000112000113001A0000004C004100530054005F004D00 133 | 4F00440049004600490045004400FEFEFF1BFEFF1CFEFF1DFF1E1F0000000000 134 | FF20000000000000010005000000446562756702000D0000004465627567204D 135 | 657373616765030042000000546869732069732061206D657373616765207375 136 | 626D697474656420746F20746865207365727665722076696120746865204175 137 | 746F205461626C6573204150492EFEFEFEFEFEFF21FEFF22230001000000FF24 138 | FEFEFE0E004D0061006E0061006700650072001E005500700064006100740065 139 | 0073005200650067006900730074007200790012005400610062006C0065004C 140 | 006900730074000A005400610062006C00650008004E0061006D006500140053 141 | 006F0075007200630065004E0061006D0065000A005400610062004900440024 142 | 0045006E0066006F0072006300650043006F006E00730074007200610069006E 143 | 00740073001E004D0069006E0069006D0075006D004300610070006100630069 144 | 0074007900180043006800650063006B004E006F0074004E0075006C006C0014 145 | 0043006F006C0075006D006E004C006900730074000C0043006F006C0075006D 146 | 006E00100053006F007500720063006500490044000E006400740049006E0074 147 | 0033003200100044006100740061005400790070006500140053006500610072 148 | 0063006800610062006C0065000800420061007300650012004F0049006E0055 149 | 007000640061007400650010004F0049006E00570068006500720065001A004F 150 | 0072006900670069006E0043006F006C004E0061006D00650018006400740041 151 | 006E007300690053007400720069006E0067000800530069007A006500120041 152 | 006C006C006F0077004E0075006C006C0014004F0041006C006C006F0077004E 153 | 0075006C006C00140053006F007500720063006500530069007A006500100042 154 | 006C006F00620044006100740061001E00640074004400610074006500540069 155 | 006D0065005300740061006D0070001C0043006F006E00730074007200610069 156 | 006E0074004C00690073007400100056006900650077004C006900730074000E 157 | 0052006F0077004C00690073007400060052006F0077000A0052006F00770049 158 | 00440010004F0072006900670069006E0061006C001800520065006C00610074 159 | 0069006F006E004C006900730074001C0055007000640061007400650073004A 160 | 006F00750072006E0061006C001200530061007600650050006F0069006E0074 161 | 000E004300680061006E00670065007300} 162 | end 163 | object postloggerMemTable2: TFDMemTable 164 | FieldDefs = < 165 | item 166 | Name = 'ID' 167 | DataType = ftLargeint 168 | end> 169 | IndexDefs = <> 170 | FetchOptions.AssignedValues = [evMode] 171 | FetchOptions.Mode = fmAll 172 | ResourceOptions.AssignedValues = [rvSilentMode] 173 | ResourceOptions.SilentMode = True 174 | UpdateOptions.AssignedValues = [uvCheckRequired, uvAutoCommitUpdates] 175 | UpdateOptions.CheckRequired = False 176 | UpdateOptions.AutoCommitUpdates = True 177 | StoreDefs = True 178 | Left = 417 179 | Top = 321 180 | end 181 | object BackendEndpoint3: TBackendEndpoint 182 | Provider = EMSProvider1 183 | Auth = BackendAuth1 184 | Method = rmDELETE 185 | Params = < 186 | item 187 | Kind = pkURLSEGMENT 188 | name = 'ID' 189 | Options = [poAutoCreated] 190 | end> 191 | Resource = 'v1/deletelogger/?ID={ID}' 192 | Response = RESTResponse3 193 | Left = 54 194 | Top = 166 195 | end 196 | object RESTResponse3: TRESTResponse 197 | Left = 148 198 | Top = 148 199 | end 200 | object BackendAuth1: TBackendAuth 201 | Provider = EMSProvider1 202 | LoginPrompt = False 203 | UserDetails = <> 204 | DefaultAuthentication = Application 205 | Left = 392 206 | Top = 88 207 | end 208 | object EMSProvider1: TEMSProvider 209 | ApiVersion = '1' 210 | URLHost = 'localhost' 211 | URLPort = 8080 212 | Left = 240 213 | Top = 144 214 | end 215 | end 216 | -------------------------------------------------------------------------------- /Samples/Logger/uAutoTablesClientDM.pas: -------------------------------------------------------------------------------- 1 | unit uAutoTablesClientDM; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Classes, IPPeerClient, REST.Backend.ServiceTypes, 7 | System.JSON, REST.Backend.EMSServices, REST.Backend.MetaTypes, 8 | REST.Backend.BindSource, REST.Backend.ServiceComponents, Data.Bind.Components, 9 | Data.Bind.ObjectScope, REST.Client, REST.Backend.EndPoint, REST.Types, 10 | REST.Backend.EMSProvider, FireDAC.Comp.Client, FireDAC.Stan.Intf, 11 | FireDAC.Stan.Option, FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, 12 | FireDAC.Phys.Intf, FireDAC.DApt.Intf, Data.DB, FireDAC.Comp.DataSet, 13 | FireDAC.Stan.StorageJSON, FireDAC.Stan.StorageBin; 14 | 15 | type 16 | TAutoTablesClientDM = class(TDataModule) 17 | BackendEndpoint1: TBackendEndpoint; 18 | RESTResponse1: TRESTResponse; 19 | getloggerMemTable1: TFDMemTable; 20 | BackendEndpoint2: TBackendEndpoint; 21 | RESTResponse2: TRESTResponse; 22 | postloggerMemTable2: TFDMemTable; 23 | postloggerPostMemTable2: TFDMemTable; 24 | BackendEndpoint3: TBackendEndpoint; 25 | RESTResponse3: TRESTResponse; 26 | BackendAuth1: TBackendAuth; 27 | EMSProvider1: TEMSProvider; 28 | private 29 | { Private declarations } 30 | public 31 | { Public declarations } 32 | procedure getloggerExecute; 33 | procedure postloggerExecute; 34 | procedure deleteloggerExecute(const ID: String); 35 | end; 36 | 37 | var 38 | AutoTablesClientDM: TAutoTablesClientDM; 39 | 40 | implementation 41 | 42 | {%CLASSGROUP 'System.Classes.TPersistent'} 43 | 44 | {$R *.dfm} 45 | 46 | 47 | procedure TAutoTablesClientDM.getloggerExecute; 48 | var 49 | BS: TBytesStream; 50 | begin 51 | BackendEndpoint1.Execute; 52 | if RESTResponse1.StatusCode<400 then 53 | begin 54 | BS := TBytesStream.Create(RESTResponse1.RawBytes); 55 | getloggerMemTable1.LoadFromStream(BS,sfJSON); 56 | BS.Free; 57 | end; 58 | end; 59 | 60 | procedure TAutoTablesClientDM.postloggerExecute; 61 | var 62 | BS: TBytesStream; 63 | SS: TStringStream; 64 | begin 65 | SS := TStringStream.Create('',TEncoding.UTF8); 66 | postloggerPostMemTable2.SaveToStream(SS,sfJSON); 67 | SS.Position := 0; 68 | BackendEndpoint2.AddBody(SS.DataString, TRESTContentType.ctAPPLICATION_JSON); 69 | SS.Free; 70 | BackendEndpoint2.Execute; 71 | if RESTResponse2.StatusCode<400 then 72 | begin 73 | BS := TBytesStream.Create(RESTResponse2.RawBytes); 74 | postloggerMemTable2.LoadFromStream(BS,sfJSON); 75 | BS.Free; 76 | end; 77 | end; 78 | 79 | procedure TAutoTablesClientDM.deleteloggerExecute(const ID: String); 80 | begin 81 | BackendEndpoint3.Params.ParameterByName('ID').Value := ID; 82 | BackendEndpoint3.Execute; 83 | end; 84 | 85 | end. 86 | 87 | -------------------------------------------------------------------------------- /Samples/Logger/uAutoTablesClientDM.vlb: -------------------------------------------------------------------------------- 1 | [RESTResponse2] 2 | Coordinates=222,10,96,285 3 | 4 | [getloggerMemTable1] 5 | Coordinates=483,10,117,141 6 | 7 | [EMSProvider1] 8 | Coordinates=458,1,84,33 9 | 10 | [BackendEndpoint3] 11 | Coordinates=610,10,107,123 12 | 13 | [BackendEndpoint1] 14 | Coordinates=10,305,107,123 15 | 16 | [BackendEndpoint2] 17 | Coordinates=127,305,107,105 18 | 19 | [postloggerMemTable2] 20 | Coordinates=340,305,123,69 21 | 22 | [RESTResponse1] 23 | Coordinates=116,10,96,285 24 | 25 | [RESTResponse3] 26 | Coordinates=10,10,96,285 27 | 28 | [postloggerPostMemTable2] 29 | Coordinates=328,10,145,141 30 | 31 | [BackendAuth1] 32 | Coordinates=244,305,86,87 33 | 34 | -------------------------------------------------------------------------------- /Samples/Logger/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, System.Rtti, 8 | FMX.Grid.Style, Data.Bind.EngExt, Fmx.Bind.DBEngExt, Fmx.Bind.Grid, 9 | System.Bindings.Outputs, Fmx.Bind.Editors, FMX.Edit, Data.Bind.Components, 10 | Data.Bind.Grid, Data.Bind.DBScope, FMX.StdCtrls, FMX.Controls.Presentation, 11 | FMX.ScrollBox, FMX.Grid, FMX.TabControl, FMX.Objects, FMX.Memo; 12 | 13 | type 14 | TMainForm = class(TForm) 15 | TabControl1: TTabControl; 16 | TabItem1: TTabItem; 17 | TabItem2: TTabItem; 18 | TabItem3: TTabItem; 19 | GetStringGrid: TStringGrid; 20 | ToolBar1: TToolBar; 21 | BindSourceDB1: TBindSourceDB; 22 | BindingsList1: TBindingsList; 23 | LinkGridToDataSourceBindSourceDB1: TLinkGridToDataSource; 24 | PostStringGrid: TStringGrid; 25 | PostResultStringGrid: TStringGrid; 26 | DeleteBTN: TButton; 27 | PostBTN: TButton; 28 | GetBTN: TButton; 29 | DeleteIdEdit: TEdit; 30 | BindSourceDB2: TBindSourceDB; 31 | LinkGridToDataSourceBindSourceDB2: TLinkGridToDataSource; 32 | BindSourceDB3: TBindSourceDB; 33 | LinkGridToDataSourceBindSourceDB3: TLinkGridToDataSource; 34 | Label1: TLabel; 35 | JetStyleBook: TStyleBook; 36 | BackgroundImage: TRectangle; 37 | DeleteMemo: TMemo; 38 | procedure DeleteBTNClick(Sender: TObject); 39 | procedure GetBTNClick(Sender: TObject); 40 | procedure PostBTNClick(Sender: TObject); 41 | procedure GetStringGridSelChanged(Sender: TObject); 42 | private 43 | { Private declarations } 44 | public 45 | { Public declarations } 46 | end; 47 | 48 | var 49 | MainForm: TMainForm; 50 | 51 | implementation 52 | 53 | {$R *.fmx} 54 | 55 | uses 56 | uAutoTablesClientDM; 57 | 58 | procedure TMainForm.DeleteBTNClick(Sender: TObject); 59 | begin 60 | if DeleteIdEdit.Text<>'' then 61 | begin 62 | AutoTablesClientDM.deleteloggerExecute(DeleteIdEdit.Text); 63 | DeleteMemo.Lines.Append('Delete ' + DeleteIdEdit.Text + ' sent successfully!'); 64 | DeleteIdEdit.Text := ''; 65 | GetBTNClick(Self); 66 | end; 67 | end; 68 | 69 | procedure TMainForm.PostBTNClick(Sender: TObject); 70 | begin 71 | AutoTablesClientDM.postloggerExecute; 72 | GetBTNClick(Self); 73 | end; 74 | 75 | procedure TMainForm.GetBTNClick(Sender: TObject); 76 | begin 77 | AutoTablesClientDM.getloggerExecute; 78 | end; 79 | 80 | procedure TMainForm.GetStringGridSelChanged(Sender: TObject); 81 | begin 82 | DeleteIdEdit.Text := GetStringGrid.Cells[0,GetStringGrid.Selected]; 83 | end; 84 | 85 | end. 86 | -------------------------------------------------------------------------------- /Samples/Logger/uMainForm.vlb: -------------------------------------------------------------------------------- 1 | [TabControl1] 2 | Coordinates=10,124,74,33 3 | 4 | [TabItem3] 5 | Coordinates=168,78,59,33 6 | 7 | [TabItem1] 8 | Coordinates=89,78,59,33 9 | 10 | [TabItem2] 11 | Coordinates=10,78,59,33 12 | 13 | [ToolBar1] 14 | Coordinates=169,10,58,33 15 | 16 | [] 17 | Coordinates=100,10,53,51 18 | 19 | [AutoTablesClientDM.RESTResponse1] 20 | Coordinates=246,1,200,285 21 | 22 | [AutoTablesClientDM.BackendAuth1] 23 | Coordinates=752,1,190,87 24 | 25 | [AutoTablesClientDM.postloggerMemTable2] 26 | Coordinates=484,1,227,33 27 | Visible=False 28 | 29 | [AutoTablesClientDM.postloggerPostMemTable2] 30 | Coordinates=465,249,249,33 31 | Visible=False 32 | 33 | [AutoTablesClientDM.BackendEndpoint1] 34 | Coordinates=37,499,211,123 35 | 36 | [AutoTablesClientDM.RESTResponse2] 37 | Coordinates=37,176,200,285 38 | 39 | [AutoTablesClientDM.getloggerMemTable1] 40 | Coordinates=494,89,220,33 41 | Visible=False 42 | 43 | [AutoTablesClientDM.RESTResponse3] 44 | Coordinates=256,305,200,285 45 | 46 | [AutoTablesClientDM.BackendEndpoint2] 47 | Coordinates=484,409,211,105 48 | 49 | [AutoTablesClientDM.BackendEndpoint3] 50 | Coordinates=752,107,211,123 51 | 52 | [BindSourceDB1] 53 | Coordinates=494,89,200,159 54 | 55 | [BindingsList1] 56 | Coordinates=752,249,82,33 57 | 58 | [BindSourceDB2] 59 | Coordinates=484,1,206,87 60 | 61 | [BindSourceDB3] 62 | Coordinates=465,249,226,159 63 | 64 | [GetBTN] 65 | Coordinates=494,533,53,51 66 | 67 | [PostBTN] 68 | Coordinates=475,660,53,51 69 | 70 | [DeleteBTN] 71 | Coordinates=494,603,53,51 72 | 73 | [GetStringGrid] 74 | Coordinates=10,10,70,51 75 | Visible=True 76 | 77 | [PostStringGrid] 78 | Coordinates=752,301,70,51 79 | Visible=True 80 | 81 | [PostResultStringGrid] 82 | Coordinates=730,40,70,51 83 | Visible=True 84 | 85 | [DeleteIdEdit] 86 | Coordinates=426,660,40,51 87 | 88 | -------------------------------------------------------------------------------- /Samples/Logger/uMainServer.dfm: -------------------------------------------------------------------------------- 1 | object AutoTablesResource: TAutoTablesResource 2 | OldCreateOrder = False 3 | Height = 402 4 | Width = 604 5 | object EndpointQuery: TFDQuery 6 | Connection = FDConnection 7 | SQL.Strings = ( 8 | 'SELECT * FROM EndPointTable') 9 | Left = 184 10 | Top = 104 11 | end 12 | object EndPointTable: TFDMemTable 13 | Active = True 14 | FieldDefs = < 15 | item 16 | Name = 'ID' 17 | DataType = ftAutoInc 18 | end 19 | item 20 | Name = 'EndPoint' 21 | DataType = ftString 22 | Size = 256 23 | end 24 | item 25 | Name = 'RequestType' 26 | DataType = ftString 27 | Size = 20 28 | end 29 | item 30 | Name = 'Action' 31 | DataType = ftString 32 | Size = 128 33 | end 34 | item 35 | Name = 'TableName' 36 | DataType = ftString 37 | Size = 256 38 | end 39 | item 40 | Name = 'SQL' 41 | DataType = ftMemo 42 | end 43 | item 44 | Name = 'Method' 45 | DataType = ftString 46 | Size = 256 47 | end 48 | item 49 | Name = 'Params' 50 | DataType = ftMemo 51 | end 52 | item 53 | Name = 'Macros' 54 | DataType = ftMemo 55 | end 56 | item 57 | Name = 'Groups' 58 | DataType = ftMemo 59 | end 60 | item 61 | Name = 'UniqueID' 62 | DataType = ftString 63 | Size = 256 64 | end> 65 | IndexDefs = <> 66 | FetchOptions.AssignedValues = [evMode] 67 | FetchOptions.Mode = fmAll 68 | ResourceOptions.AssignedValues = [rvPersistent, rvSilentMode] 69 | ResourceOptions.Persistent = True 70 | ResourceOptions.SilentMode = True 71 | UpdateOptions.AssignedValues = [uvCheckRequired, uvAutoCommitUpdates] 72 | UpdateOptions.CheckRequired = False 73 | UpdateOptions.AutoCommitUpdates = True 74 | StoreDefs = True 75 | Left = 144 76 | Top = 360 77 | Content = { 78 | 414442530F00A10A89050000FF00010001FF02FF0304001A00000045006E0064 79 | 0050006F0069006E0074005400610062006C00650005000A0000005400610062 80 | 006C006500060000000000070000080032000000090000FF0AFF0B0400040000 81 | 0049004400050004000000490044000C00010000000E000D000F000110000111 82 | 000112000113000114000115000116000117000400000049004400FEFF0B0400 83 | 1000000045006E00640050006F0069006E00740005001000000045006E006400 84 | 50006F0069006E0074000C00020000000E0018001900000100000F0001100001 85 | 12000113000114000115000117001000000045006E00640050006F0069006E00 86 | 74001A0000010000FEFF0B040016000000520065007100750065007300740054 87 | 0079007000650005001600000052006500710075006500730074005400790070 88 | 0065000C00030000000E0018001900140000000F000110000112000113000114 89 | 0001150001170016000000520065007100750065007300740054007900700065 90 | 001A0014000000FEFF0B04000C00000041006300740069006F006E0005000C00 91 | 000041006300740069006F006E000C00040000000E0018001900800000000F00 92 | 0110000112000113000114000115000117000C00000041006300740069006F00 93 | 6E001A0080000000FEFF0B0400120000005400610062006C0065004E0061006D 94 | 0065000500120000005400610062006C0065004E0061006D0065000C00050000 95 | 000E0018001900000100000F0001100001120001130001140001150001170012 96 | 0000005400610062006C0065004E0061006D0065001A0000010000FEFF0B0400 97 | 06000000530051004C00050006000000530051004C000C00060000000E001B00 98 | 0F00011000011C0001120001130001140001150001170006000000530051004C 99 | 00FEFF0B04000C0000004D006500740068006F00640005000C0000004D006500 100 | 740068006F0064000C00070000000E0018001900000100000F00011000011200 101 | 0113000114000115000117000C0000004D006500740068006F0064001A000001 102 | 0000FEFF0B04000C00000050006100720061006D00730005000C000000500061 103 | 00720061006D0073000C00080000000E001B000F00011000011C000112000113 104 | 000114000115000117000C00000050006100720061006D007300FEFF0B04000C 105 | 0000004D006100630072006F00730005000C0000004D006100630072006F0073 106 | 000C00090000000E001B000F00011000011C0001120001130001140001150001 107 | 17000C0000004D006100630072006F007300FEFF0B04000C000000470072006F 108 | 0075007000730005000C000000470072006F007500700073000C000A0000000E 109 | 001B000F00011000011C000112000113000114000115000117000C0000004700 110 | 72006F00750070007300FEFF0B04001000000055006E00690071007500650049 111 | 00440005001000000055006E006900710075006500490044000C000B0000000E 112 | 0018001900000100000F00011000011200011300011400011500011700100000 113 | 0055006E006900710075006500490044001A0000010000FEFEFF1DFEFF1EFEFF 114 | 1FFF20210000000000FF220000010000000100090000006765746C6F67676572 115 | 0200030000004745540300050000005461626C650400060000004C4F47474552 116 | 090000000000FEFEFF20210001000000FF2200000200000001000A000000706F 117 | 73746C6F67676572020004000000504F53540300050000005461626C65040006 118 | 0000004C4F474745520A00020000004944090000000000FEFEFF202100020000 119 | 00FF2200000300000001000C00000064656C6574656C6F676765720200060000 120 | 0044454C4554450300050000005461626C650400060000004C4F474745520A00 121 | 0200000049440700020000004944090000000000FEFEFEFEFEFF23FEFF242500 122 | 08000000FF26FEFEFE0E004D0061006E0061006700650072001E005500700064 123 | 0061007400650073005200650067006900730074007200790012005400610062 124 | 006C0065004C006900730074000A005400610062006C00650008004E0061006D 125 | 006500140053006F0075007200630065004E0061006D0065000A005400610062 126 | 0049004400240045006E0066006F0072006300650043006F006E007300740072 127 | 00610069006E00740073001E004D0069006E0069006D0075006D004300610070 128 | 0061006300690074007900180043006800650063006B004E006F0074004E0075 129 | 006C006C00140043006F006C0075006D006E004C006900730074000C0043006F 130 | 006C0075006D006E00100053006F007500720063006500490044000E00640074 131 | 0049006E00740033003200100044006100740061005400790070006500140053 132 | 0065006100720063006800610062006C006500120041006C006C006F0077004E 133 | 0075006C006C000E004100750074006F0049006E006300080042006100730065 134 | 0014004F0041006C006C006F0077004E0075006C006C0012004F0049006E0055 135 | 007000640061007400650010004F0049006E005700680065007200650020004F 136 | 004100660074006500720049006E0073004300680061006E006700650064001A 137 | 004F0072006900670069006E0043006F006C004E0061006D0065001800640074 138 | 0041006E007300690053007400720069006E0067000800530069007A00650014 139 | 0053006F007500720063006500530069007A0065000C00640074004D0065006D 140 | 006F00100042006C006F00620044006100740061001C0043006F006E00730074 141 | 007200610069006E0074004C00690073007400100056006900650077004C0069 142 | 00730074000E0052006F0077004C00690073007400060052006F0077000A0052 143 | 006F0077004900440010004F0072006900670069006E0061006C001800520065 144 | 006C006100740069006F006E004C006900730074001C00550070006400610074 145 | 00650073004A006F00750072006E0061006C001200530061007600650050006F 146 | 0069006E0074000E004300680061006E00670065007300} 147 | end 148 | 149 | object BindingsList1: TBindingsList 150 | Methods = <> 151 | OutputConverters = <> 152 | Left = 36 153 | Top = 29 154 | end 155 | object FDStanStorageJSONLink1: TFDStanStorageJSONLink 156 | Left = 418 157 | Top = 40 158 | end 159 | object EndPoints: TBindSourceDB 160 | DataSet = EndPointTable 161 | ScopeMappings = <> 162 | Left = 288 163 | Top = 48 164 | end 165 | object FDPhysIBDriverLink1: TFDPhysIBDriverLink 166 | Left = 184 167 | Top = 32 168 | end 169 | object FDConnection: TFDConnection 170 | Params.Strings = ( 171 | 'Server=localhost' 172 | 'User_Name=sysdba' 173 | 'Password=masterkey' 174 | 'Database=C:\Users\Public\Documents\Embarcadero\EMS\Logger.IB' 175 | 'DriverID=IB' 176 | 'OpenMode=OpenOrCreate') 177 | Connected = True 178 | LoginPrompt = False 179 | Left = 688 180 | Top = 499 181 | end 182 | 183 | object AggregateSQL: TFDMemTable 184 | FetchOptions.AssignedValues = [evMode] 185 | FetchOptions.Mode = fmAll 186 | ResourceOptions.AssignedValues = [rvSilentMode] 187 | ResourceOptions.SilentMode = True 188 | UpdateOptions.AssignedValues = [uvCheckRequired, uvAutoCommitUpdates] 189 | UpdateOptions.CheckRequired = False 190 | UpdateOptions.AutoCommitUpdates = True 191 | Left = 144 192 | Top = 160 193 | end 194 | object FDBatchMoveCSV: TFDBatchMove 195 | Reader = FDBatchMoveDataSetReader 196 | Writer = FDBatchMoveTextWriter 197 | Mappings = <> 198 | LogFileName = 'Data.log' 199 | Left = 392 200 | Top = 192 201 | end 202 | object FDBatchMoveTextWriter: TFDBatchMoveTextWriter 203 | DataDef.Fields = <> 204 | Encoding = ecUTF8 205 | Left = 448 206 | Top = 248 207 | end 208 | object FDBatchMoveDataSetReader: TFDBatchMoveDataSetReader 209 | Left = 496 210 | Top = 168 211 | end 212 | end 213 | -------------------------------------------------------------------------------- /Samples/OpenEMR/AutoTablesClient.dpr: -------------------------------------------------------------------------------- 1 | program AutoTablesClient; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | uMainForm in 'uMainForm.pas' {MainForm}, 7 | uAutoTablesClientDM in 'uAutoTablesClientDM.pas' {AutoTablesClientDM: TDataModule}; 8 | 9 | {$R *.res} 10 | 11 | begin 12 | Application.Initialize; 13 | Application.CreateForm(TMainForm, MainForm); 14 | Application.CreateForm(TAutoTablesClientDM, AutoTablesClientDM); 15 | Application.Run; 16 | end. 17 | -------------------------------------------------------------------------------- /Samples/OpenEMR/AutoTablesForRADServer.dpk: -------------------------------------------------------------------------------- 1 | package AutoTablesForRADServer; 2 | 3 | {$R *.res} 4 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 5 | {$ALIGN 8} 6 | {$ASSERTIONS ON} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO OFF} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS ON} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION OFF} 16 | {$OVERFLOWCHECKS OFF} 17 | {$RANGECHECKS OFF} 18 | {$REFERENCEINFO ON} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES ON} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DEFINE DEBUG} 27 | {$ENDIF IMPLICITBUILDING} 28 | {$RUNONLY} 29 | {$IMPLICITBUILD ON} 30 | 31 | requires 32 | rtl, 33 | emsserverapi, 34 | dbrtl, 35 | FireDAC, 36 | FireDACSqliteDriver, 37 | FireDACCommonDriver, 38 | FireDACCommon, 39 | bindengine, 40 | bindcomp, 41 | FireDACIBDriver; 42 | 43 | contains 44 | uMainServer in 'uMainServer.pas' {AutoTablesResource: TDataModule}; 45 | 46 | end. 47 | -------------------------------------------------------------------------------- /Samples/OpenEMR/Docs/favicon-16x16.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/FMXExpress/AutoTablesForRADServer/67d5f358d7276036b45797a6072d5e4cdc731af4/Samples/OpenEMR/Docs/favicon-16x16.png -------------------------------------------------------------------------------- /Samples/OpenEMR/Docs/favicon-32x32.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/FMXExpress/AutoTablesForRADServer/67d5f358d7276036b45797a6072d5e4cdc731af4/Samples/OpenEMR/Docs/favicon-32x32.png -------------------------------------------------------------------------------- /Samples/OpenEMR/Docs/oauth2-redirect.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 68 | -------------------------------------------------------------------------------- /Samples/OpenEMR/Docs/swagger-ui.css.map: -------------------------------------------------------------------------------- 1 | {"version":3,"sources":[],"names":[],"mappings":"","file":"swagger-ui.css","sourceRoot":""} -------------------------------------------------------------------------------- /Samples/OpenEMR/README.md: -------------------------------------------------------------------------------- 1 | # OpenEMR REST API Client Server 2 | Automatically generated OpenEMR REST API client and server. 3 | 4 | # Product Overview 5 | The OpenEMR REST API Client Server was generated using AutoTables for RAD Server using the OpenEMR database schema from https://github.com/openemr/openemr OpenEMR is a "leading open-source electronic medical record and practice management software." The Auto Tables for RAD Server project is not affiliated with the OpenEMR project. The OpenEMR REST client compiles for Android, IOS, macOS, Windows, and Linux (using FMXLinux). The OpenEMR REST Server compiles for RAD Server. This project provides basic CRUD operations for the OpenEMR database. It includes listing data in a table, adding a new record in a table, editing a record in a table, and deleting a record in a table. There are over 500 tables in OpenEMR which provides a good demo of the AutoTables for RAD Server project. The API is fully documented in the Swagger 2.0 format. 6 | 7 | # Compilation 8 | 9 | The REST API client and server compile using Embarcadero Delphi 10.3.1. 10 | 11 | The REST API client may compile using the free Embarcadero Delphi 10.3.1 Community Edition. 12 | https://www.embarcadero.com/products/delphi/starter 13 | 14 | The REST API server will compile using Embarcadero Delphi 10.3.1 Enterprise or Architect. It supports IIS and Apache on Windows, Apache on Linux, and a stand alone server on Windows and Linux. 15 | 16 | # Configuration 17 | You will need to edit the FDConnection component in the RAD Server project to enter your MySQL username, password, and hostname. Additionally, your database should be named openemr. Otherwise you will need to re-generate the project with Auto Tables for RAD Server using your specific database name. 18 | 19 | 20 | # OpenEMR REST Client List View 21 | ![Alt text](Screenshots/list.jpg?raw=true "List View") 22 | 23 | # OpenEMR REST Client Details View 24 | ![Alt text](Screenshots/detail.jpg?raw=true "Detail View") 25 | 26 | # Workaround: 27 | 28 | If you experience a EArgumentOutOfRangeException copy the Delphi FMX.Grid.Style.pas source file to your project directory and change the two raise lines in the CellRect event to Exit as follows: 29 | 30 | ``` 31 | function TStyledGrid.CellRect(const ACol, ARow: Integer): TRect; 32 | var 33 | I, X, Y: Integer; 34 | HiddenFound: Boolean; 35 | begin 36 | if (ACol < 0) or (ACol > ColumnCount) then 37 | Exit;//raise EArgumentOutOfRangeException.CreateResFmt(@SInvalidColumnIndex, [ACol]); 38 | if (ARow < 0) or (ARow > RowCount) then 39 | Exit;//raise EArgumentOutOfRangeException.CreateResFmt(@SInvalidRowIndex, [ARow]); 40 | ``` 41 | -------------------------------------------------------------------------------- /Samples/OpenEMR/Screenshots/detail.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/FMXExpress/AutoTablesForRADServer/67d5f358d7276036b45797a6072d5e4cdc731af4/Samples/OpenEMR/Screenshots/detail.jpg -------------------------------------------------------------------------------- /Samples/OpenEMR/Screenshots/list.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/FMXExpress/AutoTablesForRADServer/67d5f358d7276036b45797a6072d5e4cdc731af4/Samples/OpenEMR/Screenshots/list.jpg -------------------------------------------------------------------------------- /Screenshots/clientgen.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/FMXExpress/AutoTablesForRADServer/67d5f358d7276036b45797a6072d5e4cdc731af4/Screenshots/clientgen.jpg -------------------------------------------------------------------------------- /Screenshots/docs.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/FMXExpress/AutoTablesForRADServer/67d5f358d7276036b45797a6072d5e4cdc731af4/Screenshots/docs.jpg -------------------------------------------------------------------------------- /Screenshots/endpoint_editor.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/FMXExpress/AutoTablesForRADServer/67d5f358d7276036b45797a6072d5e4cdc731af4/Screenshots/endpoint_editor.jpg -------------------------------------------------------------------------------- /Screenshots/endpoints.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/FMXExpress/AutoTablesForRADServer/67d5f358d7276036b45797a6072d5e4cdc731af4/Screenshots/endpoints.jpg -------------------------------------------------------------------------------- /Screenshots/endpoints_wizard.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/FMXExpress/AutoTablesForRADServer/67d5f358d7276036b45797a6072d5e4cdc731af4/Screenshots/endpoints_wizard.jpg -------------------------------------------------------------------------------- /Screenshots/openapi.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/FMXExpress/AutoTablesForRADServer/67d5f358d7276036b45797a6072d5e4cdc731af4/Screenshots/openapi.jpg -------------------------------------------------------------------------------- /Swag.Common.Consts.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi SwagDoc Library } 4 | { Copyright (c) 2018 Marcelo Jaloto } 5 | { https://github.com/marcelojaloto/SwagDoc } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | 23 | unit Swag.Common.Consts; 24 | 25 | interface 26 | 27 | uses 28 | Swag.Common.Types; 29 | 30 | const 31 | c_SwaggerFileName = 'swagger.json'; 32 | c_SwaggerVersion = '2.0'; 33 | c_SwagTransferProtocolScheme: array[TSwagTransferProtocolScheme] of string = ('', 'http', 'https', 'ws', 'wss'); 34 | c_SwagSecurityDefinitionType: array[TSwagSecurityDefinitionType] of string = ('', 'basic', 'apiKey', 'oauth2'); 35 | c_SwagPathOperationHttpVerbs: array[TSwagPathTypeOperation] of string = 36 | ('', 'get', 'post', 'put', 'delete', 'options', 'head', 'patch'); 37 | c_SwagRequestParameterInLocation: array[TSwagRequestParameterInLocation] of string = 38 | ('', 'query', 'header', 'path', 'formData', 'body'); 39 | 40 | implementation 41 | 42 | end. -------------------------------------------------------------------------------- /Swag.Common.Types.Helpers.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi SwagDoc Library } 4 | { Copyright (c) 2018 Marcelo Jaloto } 5 | { https://github.com/marcelojaloto/SwagDoc } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | 23 | unit Swag.Common.Types.Helpers; 24 | 25 | interface 26 | 27 | uses 28 | Swag.Common.Types; 29 | 30 | type 31 | TSwagPathTypeOperationHelper = record helper for TSwagPathTypeOperation 32 | public 33 | procedure ToType(const pHttpVerbString: string); 34 | end; 35 | 36 | TSwagRequestParameterInLocationHelper = record helper for TSwagRequestParameterInLocation 37 | public 38 | procedure ToType(const pInLocationString: string); 39 | end; 40 | 41 | TSwagTransferProtocolSchemeHelper = record helper for TSwagTransferProtocolScheme 42 | public 43 | procedure ToType(const pTransferProtocolSchemeString: string); 44 | end; 45 | 46 | TSwagTransferProtocolSchemesHelper = record helper for TSwagTransferProtocolSchemes 47 | public 48 | procedure Add(const pScheme: TSwagTransferProtocolScheme); overload; 49 | procedure Add(const pSchemeString: string); overload; 50 | end; 51 | 52 | implementation 53 | 54 | uses 55 | System.SysUtils, 56 | Swag.Common.Consts; 57 | 58 | { TSwagPathTypeOperationHelper } 59 | 60 | procedure TSwagPathTypeOperationHelper.ToType(const pHttpVerbString: string); 61 | var 62 | vPathTypeOperation: TSwagPathTypeOperation; 63 | begin 64 | Self := ohvNotDefined; 65 | for vPathTypeOperation := Low(TSwagPathTypeOperation) to High(TSwagPathTypeOperation) do 66 | if (LowerCase(c_SwagPathOperationHttpVerbs[vPathTypeOperation]) = LowerCase(pHttpVerbString)) then 67 | begin 68 | Self := vPathTypeOperation; 69 | Break; 70 | end; 71 | end; 72 | 73 | { TSwagRequestParameterInLocationHelper } 74 | 75 | procedure TSwagRequestParameterInLocationHelper.ToType(const pInLocationString: string); 76 | var 77 | vRequestParameterInLocation: TSwagRequestParameterInLocation; 78 | begin 79 | Self := rpiNotDefined; 80 | for vRequestParameterInLocation := Low(TSwagRequestParameterInLocation) to High(TSwagRequestParameterInLocation) do 81 | if (LowerCase(c_SwagRequestParameterInLocation[vRequestParameterInLocation]) = LowerCase(pInLocationString)) then 82 | begin 83 | Self := vRequestParameterInLocation; 84 | Break; 85 | end; 86 | end; 87 | 88 | { TSwagTransferProtocolSchemeHelper } 89 | 90 | procedure TSwagTransferProtocolSchemeHelper.ToType(const pTransferProtocolSchemeString: string); 91 | var 92 | vTransferProtocolScheme: TSwagTransferProtocolScheme; 93 | begin 94 | Self := tpsNotDefined; 95 | for vTransferProtocolScheme := Low(TSwagTransferProtocolScheme) to High(TSwagTransferProtocolScheme) do 96 | if (LowerCase(c_SwagTransferProtocolScheme[vTransferProtocolScheme]) = LowerCase(pTransferProtocolSchemeString)) then 97 | begin 98 | Self := vTransferProtocolScheme; 99 | Break; 100 | end; 101 | end; 102 | 103 | { TSwagTransferProtocolSchemesHelper } 104 | 105 | procedure TSwagTransferProtocolSchemesHelper.Add(const pScheme: TSwagTransferProtocolScheme); 106 | begin 107 | Self := Self + [pScheme]; 108 | end; 109 | 110 | procedure TSwagTransferProtocolSchemesHelper.Add(const pSchemeString: string); 111 | var 112 | vScheme: TSwagTransferProtocolScheme; 113 | begin 114 | vScheme.ToType(pSchemeString); 115 | Self.Add(vScheme); 116 | end; 117 | 118 | end. 119 | -------------------------------------------------------------------------------- /Swag.Common.Types.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi SwagDoc Library } 4 | { Copyright (c) 2018 Marcelo Jaloto } 5 | { https://github.com/marcelojaloto/SwagDoc } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | 23 | unit Swag.Common.Types; 24 | 25 | interface 26 | 27 | uses 28 | System.Generics.Collections; 29 | 30 | type 31 | TSwagStatusCode = string; 32 | TSwagMimeType = string; 33 | TSwagJsonExampleDescription = string; 34 | 35 | TSwagSecuritySchemaName = string; 36 | TSwagSecurityDefinitionType = (ssdNotDefined, ssdBasic, ssdApiKey, ssdOAuth2); 37 | TSwagSecurityDefinitionsType = set of TSwagSecurityDefinitionType; 38 | TSwagSecurityScopesSchemaName = string; 39 | TSwagSecurityScopesSchemaDescription = string; 40 | TSwagSecurityScopes = TDictionary; 41 | 42 | TSwagTransferProtocolScheme = (tpsNotDefined, tpsHttp, tpsHttps, tpsWs, tpsWss); 43 | TSwagTransferProtocolSchemes = set of TSwagTransferProtocolScheme; 44 | 45 | TSwagRequestParameterInLocation = (rpiNotDefined, rpiQuery, rpiHeader, rpiPath, rpiFormData, rpiBody); 46 | 47 | TSwagPathTypeOperation = (ohvNotDefined, ohvGet, ohvPost, ohvPut, ohvDelete, ohvOptions, ohvHead, ohvPatch); 48 | 49 | implementation 50 | 51 | end. 52 | -------------------------------------------------------------------------------- /Swag.Doc.Definition.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi SwagDoc Library } 4 | { Copyright (c) 2018 Marcelo Jaloto } 5 | { https://github.com/marcelojaloto/SwagDoc } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | 23 | unit Swag.Doc.Definition; 24 | 25 | interface 26 | 27 | uses 28 | System.JSON; 29 | 30 | type 31 | TSwagDefinition = class(TObject) 32 | private 33 | fName: string; 34 | fJsonSchema: TJsonObject; 35 | procedure SetName(const Value: string); 36 | procedure SetJsonSchema(const Value: TJsonObject); 37 | public 38 | function GenerateJsonRefDefinition: TJsonObject; 39 | 40 | property Name: string read fName write SetName; 41 | property JsonSchema: TJsonObject read fJsonSchema write SetJsonSchema; // http://json-schema.org 42 | end; 43 | 44 | implementation 45 | 46 | uses 47 | System.SysUtils; 48 | 49 | { TSwagDefinition } 50 | 51 | procedure TSwagDefinition.SetJsonSchema(const Value: TJsonObject); 52 | begin 53 | fJsonSchema := Value; 54 | end; 55 | 56 | procedure TSwagDefinition.SetName(const Value: string); 57 | begin 58 | fName := Value; 59 | end; 60 | 61 | { TSwagDefinition } 62 | 63 | function TSwagDefinition.GenerateJsonRefDefinition: TJsonObject; 64 | const 65 | c_SchemaRef = '$ref'; 66 | c_PrefixDefinitionName = '#/definitions/'; 67 | begin 68 | Result := TJsonObject.Create; 69 | Result.AddPair(c_SchemaRef, c_PrefixDefinitionName + fName); 70 | end; 71 | 72 | end. 73 | -------------------------------------------------------------------------------- /Swag.Doc.Info.Contact.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi SwagDoc Library } 4 | { Copyright (c) 2018 Marcelo Jaloto } 5 | { https://github.com/marcelojaloto/SwagDoc } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | 23 | unit Swag.Doc.Info.Contact; 24 | 25 | interface 26 | 27 | uses 28 | System.JSON; 29 | 30 | type 31 | TSwagInfoContact = class(TObject) 32 | private 33 | fName: string; 34 | fEmail: string; 35 | fUrl: string; 36 | public 37 | function GenerateJsonObject: TJSONObject; 38 | function IsEmpty: Boolean; 39 | procedure Load(pJson: TJSONObject); 40 | 41 | property Name: string read fName write fName; 42 | property Email: string read fEmail write fEmail; 43 | property Url: string read fUrl write fUrl; 44 | end; 45 | 46 | implementation 47 | 48 | uses System.SysUtils; 49 | 50 | const 51 | c_SwagInfoContactName = 'name'; 52 | c_SwagInfoContactEmail = 'email'; 53 | c_SwagInfoContactUrl = 'url'; 54 | 55 | { TSwagInfoContact } 56 | 57 | function TSwagInfoContact.GenerateJsonObject: TJSONObject; 58 | begin 59 | Result := TJsonObject.Create; 60 | Result.AddPair(c_SwagInfoContactName, fName); 61 | Result.AddPair(c_SwagInfoContactEmail, fEmail); 62 | Result.AddPair(c_SwagInfoContactUrl, fUrl); 63 | end; 64 | 65 | function TSwagInfoContact.IsEmpty: Boolean; 66 | begin 67 | Result := fName.IsEmpty and fEmail.IsEmpty and fUrl.IsEmpty; 68 | end; 69 | 70 | procedure TSwagInfoContact.Load(pJson: TJSONObject); 71 | begin 72 | if Assigned(pJson.Values[c_SwagInfoContactName]) then 73 | fName := pJson.Values[c_SwagInfoContactName].Value; 74 | 75 | if Assigned(pJson.Values[c_SwagInfoContactEmail]) then 76 | fEmail := pJson.Values[c_SwagInfoContactEmail].Value; 77 | 78 | if Assigned(pJson.Values[c_SwagInfoContactUrl]) then 79 | fUrl := pJson.Values[c_SwagInfoContactUrl].Value; 80 | end; 81 | 82 | end. 83 | -------------------------------------------------------------------------------- /Swag.Doc.Info.License.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi SwagDoc Library } 4 | { Copyright (c) 2018 Marcelo Jaloto } 5 | { https://github.com/marcelojaloto/SwagDoc } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | 23 | unit Swag.Doc.Info.License; 24 | 25 | interface 26 | 27 | uses 28 | System.JSON; 29 | 30 | type 31 | TSwagInfoLicense = class(TObject) 32 | private 33 | fName: string; 34 | fUrl: string; 35 | public 36 | function GenerateJsonObject: TJsonObject; 37 | procedure Load(pJson: TJsonObject); 38 | function isEmpty: Boolean; 39 | 40 | property Name: string read fName write fName; 41 | property Url: string read fUrl write fUrl; 42 | end; 43 | 44 | implementation 45 | 46 | uses 47 | System.SysUtils; 48 | 49 | const 50 | c_SwagInfoLicenseName = 'name'; 51 | c_SwagInfoLicenseUrl = 'url'; 52 | 53 | { TSwagInfoLicense } 54 | 55 | function TSwagInfoLicense.GenerateJsonObject: TJsonObject; 56 | begin 57 | Result := TJsonObject.Create; 58 | Result.AddPair(c_SwagInfoLicenseName, fName); 59 | Result.AddPair(c_SwagInfoLicenseUrl, fUrl); 60 | end; 61 | 62 | function TSwagInfoLicense.isEmpty: Boolean; 63 | begin 64 | Result := fName.IsEmpty and fUrl.IsEmpty; 65 | end; 66 | 67 | procedure TSwagInfoLicense.Load(pJson: TJsonObject); 68 | begin 69 | if not Assigned(pJson) then 70 | Exit; 71 | 72 | if Assigned(pJson.Values[c_SwagInfoLicenseName]) then 73 | fName := pJson.Values[c_SwagInfoLicenseName].Value; 74 | 75 | if Assigned(pJson.Values[c_SwagInfoLicenseUrl]) then 76 | fUrl := pJson.Values[c_SwagInfoLicenseUrl].Value; 77 | end; 78 | 79 | end. 80 | -------------------------------------------------------------------------------- /Swag.Doc.Info.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi SwagDoc Library } 4 | { Copyright (c) 2018 Marcelo Jaloto } 5 | { https://github.com/marcelojaloto/SwagDoc } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | 23 | unit Swag.Doc.Info; 24 | 25 | interface 26 | 27 | uses 28 | System.JSON, 29 | Swag.Doc.Info.License, 30 | Swag.Doc.Info.Contact; 31 | 32 | type 33 | TSwagInfo = class(TObject) 34 | private 35 | fVersion: string; 36 | fTitle: string; 37 | fDescription: string; 38 | fContact: TSwagInfoContact; 39 | fTermsOfService: string; 40 | fLicense: TSwagInfoLicense; 41 | public 42 | constructor Create; reintroduce; 43 | destructor Destroy; override; 44 | 45 | function GenerateJsonObject: TJSONObject; 46 | procedure Load(pJson: TJSONObject); 47 | 48 | property Version: string read fVersion write fVersion; 49 | property Title: string read fTitle write fTitle; 50 | property TermsOfService: string read fTermsOfService write fTermsOfService; 51 | property Description: string read fDescription write fDescription; 52 | property Contact: TSwagInfoContact read fContact write fContact; 53 | property License: TSwagInfoLicense read fLicense; 54 | end; 55 | 56 | implementation 57 | 58 | uses 59 | System.SysUtils; 60 | 61 | const 62 | c_SwagInfoVersion = 'version'; 63 | c_SwagInfoTitle = 'title'; 64 | c_SwagInfoDescription = 'description'; 65 | c_SwagInfoContact = 'contact'; 66 | c_SwagInfoTermsOfService = 'termsOfService'; 67 | c_SwagLicense = 'license'; 68 | 69 | { TSwagInfo } 70 | 71 | procedure TSwagInfo.Load(pJson: TJSONObject); 72 | begin 73 | if Assigned(pJson.Values[c_SwagInfoVersion]) then 74 | fVersion := pJson.Values[c_SwagInfoVersion].Value; 75 | 76 | if Assigned(pJson.Values[c_SwagInfoTitle]) then 77 | fTitle := pJson.Values[c_SwagInfoTitle].Value; 78 | 79 | if Assigned(pJson.Values[c_SwagInfoDescription]) then 80 | fDescription := pJson.Values[c_SwagInfoDescription].Value; 81 | 82 | if Assigned(pJson.Values[c_SwagInfoTermsOfService]) then 83 | FTermsOfService := pJson.Values[c_SwagInfoTermsOfService].Value; 84 | 85 | if Assigned(pJson.Values[c_SwagInfoContact]) then 86 | fContact.Load(pJson.Values[c_SwagInfoContact] as TJSONObject); 87 | 88 | fLicense.Load((pJson as TJSONObject).Values[c_SwagLicense] as TJSONObject); 89 | end; 90 | 91 | constructor TSwagInfo.Create; 92 | begin 93 | inherited Create; 94 | fContact := TSwagInfoContact.Create; 95 | fLicense := TSwagInfoLicense.Create; 96 | end; 97 | 98 | destructor TSwagInfo.Destroy; 99 | begin 100 | FreeAndNil(fContact); 101 | FreeAndNil(fLicense); 102 | inherited Destroy; 103 | end; 104 | 105 | function TSwagInfo.GenerateJsonObject: TJSONObject; 106 | begin 107 | Result := TJsonObject.Create; 108 | Result.AddPair(c_SwagInfoVersion, fVersion); 109 | Result.AddPair(c_SwagInfoTitle, fTitle); 110 | Result.AddPair(c_SwagInfoDescription, fDescription); 111 | if not fTermsOfService.IsEmpty then 112 | Result.AddPair(c_SwagInfoTermsOfService, fTermsOfService); 113 | if not fContact.IsEmpty then 114 | Result.AddPair(c_SwagInfoContact, fContact.GenerateJsonObject); 115 | if not fLicense.isEmpty then 116 | Result.AddPair(c_SwagLicense,fLicense.GenerateJsonObject); 117 | end; 118 | 119 | 120 | end. 121 | -------------------------------------------------------------------------------- /Swag.Doc.Path.Operation.RequestParameter.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi SwagDoc Library } 4 | { Copyright (c) 2018 Marcelo Jaloto } 5 | { https://github.com/marcelojaloto/SwagDoc } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | 23 | unit Swag.Doc.Path.Operation.RequestParameter; 24 | 25 | interface 26 | 27 | uses 28 | System.JSON, 29 | Swag.Common.Types, 30 | Swag.Doc.Definition; 31 | 32 | type 33 | TSwagRequestParameter = class(TObject) 34 | private 35 | fName: string; 36 | fInLocation: TSwagRequestParameterInLocation; 37 | fRequired: Boolean; 38 | fSchema: TSwagDefinition; 39 | fDescription: string; 40 | fTypeParameter: string; 41 | fPattern: string; 42 | protected 43 | function ReturnInLocationToString: string; 44 | public 45 | constructor Create; reintroduce; 46 | destructor Destroy; override; 47 | 48 | function GenerateJsonObject: TJSONObject; 49 | procedure Load(pJson: TJSONObject); 50 | 51 | property InLocation: TSwagRequestParameterInLocation read fInLocation write fInLocation; 52 | property Name: string read fName write fName; 53 | property Description: string read fDescription write fDescription; 54 | property Required: Boolean read fRequired write fRequired; 55 | property Pattern: string read fPattern write fPattern; 56 | property Schema: TSwagDefinition read fSchema; 57 | property TypeParameter: string read fTypeParameter write fTypeParameter; 58 | end; 59 | 60 | implementation 61 | 62 | uses 63 | System.SysUtils, 64 | System.StrUtils, 65 | Swag.Common.Consts, 66 | Swag.Common.Types.Helpers; 67 | 68 | const 69 | c_SwagRequestParameterIn = 'in'; 70 | c_SwagRequestParameterName = 'name'; 71 | c_SwagRequestParameterDescription = 'description'; 72 | c_SwagRequestParameterRequired = 'required'; 73 | c_SwagRequestParameterSchema = 'schema'; 74 | c_SwagRequestParameterType = 'type'; 75 | 76 | { TSwagRequestParameter } 77 | 78 | constructor TSwagRequestParameter.Create; 79 | begin 80 | inherited Create; 81 | fSchema := TSwagDefinition.Create; 82 | end; 83 | 84 | destructor TSwagRequestParameter.Destroy; 85 | begin 86 | FreeAndNil(fSchema); 87 | inherited Destroy; 88 | end; 89 | 90 | function TSwagRequestParameter.GenerateJsonObject: TJSONObject; 91 | var 92 | vJsonObject: TJsonObject; 93 | begin 94 | vJsonObject := TJsonObject.Create; 95 | vJsonObject.AddPair(c_SwagRequestParameterIn, ReturnInLocationToString); 96 | vJsonObject.AddPair(c_SwagRequestParameterName, fName); 97 | if not fDescription.IsEmpty then 98 | vJsonObject.AddPair(c_SwagRequestParameterDescription, fDescription); 99 | if not fPattern.IsEmpty then 100 | vJsonObject.AddPair('pattern', fPattern); 101 | 102 | vJsonObject.AddPair(c_SwagRequestParameterRequired, TJSONBool.Create(fRequired)); 103 | 104 | if (not fSchema.Name.IsEmpty) then 105 | vJsonObject.AddPair(c_SwagRequestParameterSchema, fSchema.GenerateJsonRefDefinition) 106 | else if Assigned(fSchema.JsonSchema) then 107 | vJsonObject.AddPair(c_SwagRequestParameterSchema, fSchema.JsonSchema) 108 | else if not fTypeParameter.IsEmpty then 109 | vJsonObject.AddPair(c_SwagRequestParameterType, fTypeParameter); 110 | 111 | Result := vJsonObject; 112 | end; 113 | 114 | procedure TSwagRequestParameter.Load(pJson: TJSONObject); 115 | begin 116 | if Assigned(pJson.Values[c_SwagRequestParameterRequired]) then 117 | fRequired := (pJson.Values[c_SwagRequestParameterRequired] as TJSONBool).AsBoolean 118 | else 119 | fRequired := False; 120 | 121 | if Assigned(pJson.Values['pattern']) then 122 | fPattern := pJson.Values['pattern'].Value; 123 | 124 | if Assigned(pJson.Values[c_SwagRequestParameterName]) then 125 | fName := pJson.Values[c_SwagRequestParameterName].Value; 126 | 127 | if Assigned(pJson.Values['in']) then 128 | fInLocation.ToType(pJson.Values['in'].Value); 129 | 130 | fTypeParameter := pJson.Values[c_SwagRequestParameterType].Value; 131 | end; 132 | 133 | function TSwagRequestParameter.ReturnInLocationToString: string; 134 | begin 135 | Result := c_SwagRequestParameterInLocation[fInLocation]; 136 | end; 137 | 138 | end. 139 | -------------------------------------------------------------------------------- /Swag.Doc.Path.Operation.Response.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi SwagDoc Library } 4 | { Copyright (c) 2018 Marcelo Jaloto } 5 | { https://github.com/marcelojaloto/SwagDoc } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | 23 | unit Swag.Doc.Path.Operation.Response; 24 | 25 | interface 26 | 27 | uses 28 | System.Generics.Collections, 29 | System.JSON, 30 | Swag.Common.Types, 31 | Swag.Doc.Path.Operation.ResponseHeaders, 32 | Swag.Doc.Definition; 33 | 34 | type 35 | TSwagResponse = class(TObject) 36 | private 37 | fStatusCode: TSwagStatusCode; 38 | fSchema: TSwagDefinition; 39 | fHeaders: TObjectList; 40 | fDescription: string; 41 | fExamples: TDictionary; 42 | protected 43 | function GenerateExamplesJsonObject: TJSONObject; 44 | public 45 | constructor Create; reintroduce; 46 | destructor Destroy; override; 47 | 48 | function GenerateJsonObject: TJSONObject; 49 | procedure Load(pJson : TJSONObject); 50 | 51 | property StatusCode: TSwagStatusCode read fStatusCode write fStatusCode; 52 | property Description: string read fDescription write fDescription; 53 | property Schema: TSwagDefinition read fSchema; 54 | property Headers : TObjectList read fHeaders; 55 | property Examples: TDictionary read fExamples; 56 | end; 57 | 58 | implementation 59 | 60 | uses 61 | System.SysUtils; 62 | 63 | const 64 | c_SwagResponseDescription = 'description'; 65 | c_SwagResponseSchema = 'schema'; 66 | c_SwagResponseExamples = 'examples'; 67 | c_SwagResponseHeaders = 'headers'; 68 | 69 | { TSwagResponse } 70 | 71 | constructor TSwagResponse.Create; 72 | begin 73 | inherited Create; 74 | fExamples := TDictionary.Create; 75 | fSchema := TSwagDefinition.Create; 76 | fHeaders := TObjectList.Create; 77 | end; 78 | 79 | destructor TSwagResponse.Destroy; 80 | begin 81 | FreeAndNil(fExamples); 82 | FreeAndNil(fSchema); 83 | FreeAndNil(fHeaders); 84 | inherited Destroy; 85 | end; 86 | 87 | function TSwagResponse.GenerateExamplesJsonObject: TJSONObject; 88 | var 89 | vKey: TSwagJsonExampleDescription; 90 | begin 91 | Result := TJsonObject.Create; 92 | for vKey in fExamples.Keys do 93 | Result.AddPair(vKey, fExamples.Items[vKey]); 94 | end; 95 | 96 | function TSwagResponse.GenerateJsonObject: TJSONObject; 97 | var 98 | vJsonObject: TJsonObject; 99 | vIndex: Integer; 100 | vJsonHeaders: TJSONObject; 101 | begin 102 | vJsonObject := TJsonObject.Create; 103 | vJsonObject.AddPair(c_SwagResponseDescription, fDescription); 104 | 105 | if (not fSchema.Name.IsEmpty) then 106 | vJsonObject.AddPair(c_SwagResponseSchema, fSchema.GenerateJsonRefDefinition) 107 | else if Assigned(fSchema.JsonSchema) then 108 | vJsonObject.AddPair(c_SwagResponseSchema, fSchema.JsonSchema); 109 | 110 | if (fExamples.Count > 0) then 111 | vJsonObject.AddPair(c_SwagResponseExamples, GenerateExamplesJsonObject); 112 | 113 | if fHeaders.Count > 0 then 114 | begin 115 | vJsonHeaders := TJSONObject.Create; 116 | for vIndex := 0 to fHeaders.Count - 1 do 117 | begin 118 | vJsonHeaders.AddPair(fHeaders[vIndex].Name, fHeaders[vIndex].GenerateJsonObject); 119 | end; 120 | vJsonObject.AddPair(c_SwagResponseHeaders, vJsonHeaders); 121 | end; 122 | 123 | Result := vJsonObject; 124 | end; 125 | 126 | procedure TSwagResponse.Load(pJson: TJSONObject); 127 | var 128 | vJSONHeaders: TJSONObject; 129 | vIndex: Integer; 130 | vHeader: TSwagHeaders; 131 | begin 132 | if Assigned(pJson.Values[c_SwagResponseDescription]) then 133 | fDescription := pJson.Values[c_SwagResponseDescription].Value; 134 | 135 | if Assigned(pJson.Values[c_SwagResponseHeaders]) then 136 | begin 137 | vJSONHeaders := pJson.Values[c_SwagResponseHeaders] as TJSONObject; 138 | for vIndex := 0 to vJSONHeaders.Count - 1 do 139 | begin 140 | vHeader := TSwagHeaders.Create; 141 | vHeader.Load(vJSONHeaders.Pairs[vIndex].JsonValue as TJSONObject); 142 | vHeader.Name := vJSONHeaders.Pairs[vIndex].JsonString.Value; 143 | fHeaders.Add(vheader); 144 | end; 145 | end; 146 | end; 147 | 148 | end. 149 | -------------------------------------------------------------------------------- /Swag.Doc.Path.Operation.ResponseHeaders.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi SwagDoc Library } 4 | { Copyright (c) 2018 Marcelo Jaloto } 5 | { https://github.com/marcelojaloto/SwagDoc } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | 23 | unit Swag.Doc.Path.Operation.ResponseHeaders; 24 | 25 | interface 26 | 27 | uses 28 | System.SysUtils, 29 | System.Json; 30 | 31 | type 32 | 33 | TSwagHeaders = class(TObject) 34 | private 35 | fName: string; 36 | fDescription: string; 37 | fType: string; 38 | public 39 | function GenerateJsonObject: TJSONObject; 40 | procedure Load(pJson : TJSONObject); 41 | 42 | property Name: string read fName write fName; 43 | property Description: string read fDescription write fDescription; 44 | property ValueType: string read fType write fType; 45 | end; 46 | 47 | implementation 48 | 49 | { TSwagHeaders } 50 | 51 | function TSwagHeaders.GenerateJsonObject: TJSONObject; 52 | var 53 | vJsonObject: TJsonObject; 54 | begin 55 | vJsonObject := TJSONObject.Create; 56 | if fDescription.Length > 0 then 57 | vJsonObject.AddPair('description', fDescription); 58 | if fType.Length > 0 then 59 | vJsonObject.AddPair('type', fType); 60 | Result := vJsonObject; 61 | end; 62 | 63 | procedure TSwagHeaders.Load(pJson: TJSONObject); 64 | begin 65 | if Assigned(pJson.Values['description']) then 66 | fDescription := pJson.Values['description'].Value; 67 | if Assigned(pJson.Values['type']) then 68 | fType := pJson.Values['type'].Value; 69 | end; 70 | 71 | end. 72 | -------------------------------------------------------------------------------- /Swag.Doc.Path.Operation.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi SwagDoc Library } 4 | { Copyright (c) 2018 Marcelo Jaloto } 5 | { https://github.com/marcelojaloto/SwagDoc } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | 23 | unit Swag.Doc.Path.Operation; 24 | 25 | interface 26 | 27 | uses 28 | System.Generics.Collections, 29 | System.JSON, 30 | Swag.Common.Types, 31 | Swag.Doc.Path.Operation.Response, 32 | Swag.Doc.Path.Operation.RequestParameter; 33 | 34 | type 35 | 36 | TSwagPathOperation = class(TObject) 37 | private 38 | fOperation: TSwagPathTypeOperation; 39 | fDescription: string; 40 | fConsumes: TList; 41 | fProduces: TList; 42 | fParameters: TObjectList; 43 | fResponses: TObjectDictionary; 44 | fSecurity: TList; 45 | fTags: TList; 46 | fOperationId: string; 47 | fDeprecated: Boolean; 48 | function GetOperationToString: string; 49 | protected 50 | function GenerateTagsJsonArray(pTagList: TList): TJSONArray; 51 | function GenerateMimeTypesJsonArray(pMimeTypesList: TList): TJSONArray; 52 | function GenerateParametersJsonArray: TJSONArray; 53 | function GenarateResponsesJsonObject: TJSONObject; 54 | function GenerateSecurityJsonArray: TJSONArray; 55 | public 56 | constructor Create; reintroduce; 57 | destructor Destroy; override; 58 | 59 | function GenerateJsonObject: TJSONObject; 60 | 61 | property Operation: TSwagPathTypeOperation read fOperation write fOperation; 62 | property OperationToString: string read GetOperationToString; 63 | property OperationId : string read fOperationId write fOperationId; 64 | 65 | property Description: string read fDescription write fDescription; 66 | property Tags: TList read fTags; 67 | property Consumes: TList read fConsumes; 68 | property Produces: TList read fProduces; 69 | property Deprecated: Boolean read fDeprecated write fDeprecated; 70 | property Parameters: TObjectList read fParameters; 71 | property Responses: TObjectDictionary read fResponses; 72 | property Security: TList read fSecurity; 73 | end; 74 | 75 | implementation 76 | 77 | uses 78 | System.SysUtils, 79 | Swag.Common.Consts; 80 | 81 | const 82 | c_SwagPathOperationDescription = 'description'; 83 | c_SwagPathOperationTags = 'tags'; 84 | c_SwagPathOperationOperationId = 'operationId'; 85 | c_SwagPathOperationDeprecated = 'deprecated'; 86 | c_SwagPathOperationProduces = 'produces'; 87 | c_SwagPathOperationConsumes = 'consumes'; 88 | c_SwagPathOperationParameters = 'parameters'; 89 | c_SwagPathOperationResponses = 'responses'; 90 | c_SwagPathOperationSecurity = 'security'; 91 | 92 | { TSwagPathOperation } 93 | 94 | constructor TSwagPathOperation.Create; 95 | begin 96 | inherited Create; 97 | 98 | fTags := TList.Create; 99 | fConsumes := TList.Create; 100 | fProduces := TList.Create; 101 | fParameters := TObjectList.Create; 102 | fResponses := TObjectDictionary.Create([doOwnsValues]); 103 | fSecurity := TList.Create; 104 | end; 105 | 106 | destructor TSwagPathOperation.Destroy; 107 | begin 108 | FreeAndNil(fProduces); 109 | FreeAndNil(fConsumes); 110 | FreeAndNil(fResponses); 111 | FreeAndNil(fParameters); 112 | FreeAndNil(fSecurity); 113 | FreeAndNil(fTags); 114 | 115 | inherited Destroy; 116 | end; 117 | 118 | function TSwagPathOperation.GetOperationToString: string; 119 | begin 120 | Result := c_SwagPathOperationHttpVerbs[fOperation]; 121 | end; 122 | 123 | function TSwagPathOperation.GenarateResponsesJsonObject: TJSONObject; 124 | var 125 | vResponse: TSwagResponse; 126 | vResponsesSortedArray: TArray; 127 | vStatusCode: TSwagStatusCode; 128 | begin 129 | Result := TJsonObject.Create; 130 | vResponsesSortedArray := fResponses.Keys.ToArray; 131 | TArray.Sort(vResponsesSortedArray); 132 | for vStatusCode in vResponsesSortedArray do 133 | begin 134 | vResponse := fResponses.Items[vStatusCode]; 135 | Result.AddPair(vResponse.StatusCode, vResponse.GenerateJsonObject); 136 | end; 137 | end; 138 | 139 | function TSwagPathOperation.GenerateMimeTypesJsonArray(pMimeTypesList: TList): TJSONArray; 140 | var 141 | vIndex: Integer; 142 | begin 143 | Result := TJSONArray.Create; 144 | for vIndex := 0 to pMimeTypesList.Count -1 do 145 | Result.Add(pMimeTypesList.Items[vIndex]); 146 | end; 147 | 148 | function TSwagPathOperation.GenerateParametersJsonArray: TJSONArray; 149 | var 150 | vIndex: Integer; 151 | begin 152 | Result := TJSONArray.Create; 153 | for vIndex := 0 to fParameters.Count - 1 do 154 | Result.Add(fParameters.Items[vIndex].GenerateJsonObject); 155 | end; 156 | 157 | // suports only JWT in swagger version 2.0 158 | function TSwagPathOperation.GenerateSecurityJsonArray: TJSONArray; 159 | var 160 | vIndex: Integer; 161 | vJsonItem: TJsonObject; 162 | vJsonListSecurityScopes: TJSONArray; 163 | begin 164 | Result := TJSONArray.Create; 165 | for vIndex := 0 to fSecurity.Count - 1 do 166 | begin 167 | vJsonListSecurityScopes := TJSONArray.Create; 168 | vJsonItem := TJsonObject.Create; 169 | vJsonItem.AddPair(fSecurity.Items[vIndex], vJsonListSecurityScopes); 170 | Result.Add(vJsonItem); 171 | end; 172 | end; 173 | 174 | function TSwagPathOperation.GenerateTagsJsonArray(pTagList: TList): TJSONArray; 175 | var 176 | vIndex: Integer; 177 | begin 178 | Result := TJSONArray.Create; 179 | for vIndex := 0 to pTagList.Count -1 do 180 | Result.Add(pTagList.Items[vIndex]); 181 | end; 182 | 183 | function TSwagPathOperation.GenerateJsonObject: TJSONObject; 184 | var 185 | vJsonObject: TJsonObject; 186 | begin 187 | vJsonObject := TJsonObject.Create; 188 | vJsonObject.AddPair(c_SwagPathOperationDescription, fDescription); 189 | if fDeprecated then 190 | vJsonObject.AddPair(c_SwagPathOperationDeprecated, TJSONBool.Create(FDeprecated)); 191 | if not fOperationId.IsEmpty then 192 | vJsonObject.AddPair(c_SwagPathOperationOperationId, fOperationId); 193 | if (fTags.Count > 0) then 194 | vJsonObject.AddPair(c_SwagPathOperationTags, GenerateTagsJsonArray(fTags)); 195 | if (fConsumes.Count > 0) then 196 | vJsonObject.AddPair(c_SwagPathOperationConsumes, GenerateMimeTypesJsonArray(fConsumes)); 197 | if (fProduces.Count > 0) then 198 | vJsonObject.AddPair(c_SwagPathOperationProduces, GenerateMimeTypesJsonArray(fProduces)); 199 | if (fParameters.Count > 0) then 200 | vJsonObject.AddPair(c_SwagPathOperationParameters, GenerateParametersJsonArray); 201 | if (fResponses.Count > 0) then 202 | vJsonObject.AddPair(c_SwagPathOperationResponses, GenarateResponsesJsonObject); 203 | if (fSecurity.Count > 0) then 204 | vJsonObject.AddPair(c_SwagPathOperationSecurity, GenerateSecurityJsonArray); 205 | Result := vJsonObject; 206 | end; 207 | 208 | end. 209 | -------------------------------------------------------------------------------- /Swag.Doc.Path.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi SwagDoc Library } 4 | { Copyright (c) 2018 Marcelo Jaloto } 5 | { https://github.com/marcelojaloto/SwagDoc } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | 23 | unit Swag.Doc.Path; 24 | 25 | interface 26 | 27 | uses 28 | System.Classes, 29 | System.Generics.Collections, 30 | System.JSON, 31 | Swag.Common.Types, 32 | Swag.Doc.Path.Operation.RequestParameter, 33 | Swag.Doc.Path.Operation.Response, 34 | Swag.Doc.Path.Operation; 35 | 36 | type 37 | TSwagPath = class(TObject) 38 | private 39 | fOperations: TObjectList; 40 | fUri: string; 41 | procedure LoadResponse(pOperation: TSwagPathOperation; pJsonResponse: TJSONObject); 42 | procedure LoadParameters(pOperation: TSwagPathOperation; pJsonRequestParams: TJSONArray); 43 | procedure LoadTags(pOperation: TSwagPathOperation; pJsonTags: TJSONArray); 44 | public 45 | constructor Create; reintroduce; 46 | destructor Destroy; override; 47 | 48 | function GenerateJsonObject: TJSONObject; 49 | procedure Load(pJson: TJSONObject); 50 | 51 | property Uri: string read fUri write fUri; 52 | property Operations: TObjectList read fOperations; 53 | end; 54 | 55 | implementation 56 | 57 | uses 58 | System.SysUtils, 59 | Swag.Common.Types.Helpers; 60 | 61 | { TSwagPath } 62 | 63 | constructor TSwagPath.Create; 64 | begin 65 | inherited Create; 66 | fOperations := TObjectList.Create; 67 | end; 68 | 69 | destructor TSwagPath.Destroy; 70 | begin 71 | FreeAndNil(fOperations); 72 | inherited Destroy; 73 | end; 74 | 75 | function TSwagPath.GenerateJsonObject: TJSONObject; 76 | var 77 | vIndex: integer; 78 | begin 79 | Result := TJsonObject.Create; 80 | for vIndex := 0 to fOperations.Count -1 do 81 | Result.AddPair(fOperations.Items[vIndex].OperationToString, fOperations.Items[vIndex].GenerateJsonObject); 82 | end; 83 | 84 | procedure TSwagPath.Load(pJson: TJSONObject); 85 | var 86 | vIndex: Integer; 87 | vOperation: TSwagPathOperation; 88 | vOperationJson: TJSONObject; 89 | begin 90 | if not Assigned(pJson) then 91 | Exit; 92 | 93 | for vIndex := 0 to pJson.Count - 1 do 94 | begin 95 | vOperation := TSwagPathOperation.Create; 96 | vOperationJson := pJson.Pairs[vIndex].JsonValue as TJSONObject; 97 | vOperation.Description := vOperationJson.Values['description'].Value; 98 | vOperation.Operation.ToType(pJson.Pairs[vIndex].JsonString.Value); 99 | 100 | if Assigned(vOperationJson.Values['operationId']) then 101 | vOperation.OperationId := vOperationJson.Values['operationId'].Value; 102 | 103 | if Assigned(vOperationJson.Values['deprecated']) then 104 | vOperation.Deprecated := (vOperationJson.Values['deprecated'] as TJSONBool).AsBoolean; 105 | 106 | LoadTags(vOperation, vOperationJson.Values['tags'] as TJSONArray); 107 | LoadParameters(vOperation, vOperationJson.Values['parameters'] as TJSONArray); 108 | LoadResponse(vOperation, vOperationJson.Values['responses'] as TJSONObject); 109 | 110 | fOperations.Add(vOperation); 111 | end; 112 | end; 113 | 114 | procedure TSwagPath.LoadTags(pOperation: TSwagPathOperation; pJsonTags: TJSONArray); 115 | var 116 | vIndex: Integer; 117 | vTag: string; 118 | begin 119 | if not Assigned(pJsonTags) then 120 | Exit; 121 | 122 | for vIndex := 0 to pJsonTags.Count - 1 do 123 | begin 124 | vTag := pJsonTags.Items[vIndex].Value; 125 | pOperation.Tags.Add(vTag); 126 | end; 127 | end; 128 | 129 | procedure TSwagPath.LoadParameters(pOperation: TSwagPathOperation; pJsonRequestParams: TJSONArray); 130 | var 131 | vIndex: Integer; 132 | vRequestParam: TSwagRequestParameter; 133 | begin 134 | if not Assigned(pJsonRequestParams) then 135 | Exit; 136 | 137 | for vIndex := 0 to pJsonRequestParams.Count - 1 do 138 | begin 139 | vRequestParam := TSwagRequestParameter.Create; 140 | vRequestParam.Load(pJsonRequestParams.Items[vIndex] as TJSONObject); 141 | pOperation.Parameters.Add(vRequestParam); 142 | end; 143 | end; 144 | 145 | procedure TSwagPath.LoadResponse(pOperation: TSwagPathOperation; pJsonResponse: TJSONObject); 146 | var 147 | vIndex: Integer; 148 | vResponse: TSwagResponse; 149 | begin 150 | if not Assigned(pJsonResponse) then 151 | Exit; 152 | 153 | for vIndex := 0 to pJsonResponse.Count - 1 do 154 | begin 155 | vResponse := TSwagResponse.Create; 156 | vResponse.StatusCode := pJsonResponse.Pairs[vIndex].JsonString.Value; 157 | vResponse.Load(pJsonResponse.Pairs[vIndex].JsonValue as TJSONObject); 158 | pOperation.Responses.Add(vResponse.StatusCode, vResponse); 159 | end; 160 | end; 161 | 162 | end. 163 | -------------------------------------------------------------------------------- /Swag.Doc.SecurityDefinition.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi SwagDoc Library } 4 | { Copyright (c) 2018 Marcelo Jaloto } 5 | { https://github.com/marcelojaloto/SwagDoc } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | 23 | unit Swag.Doc.SecurityDefinition; 24 | 25 | interface 26 | 27 | uses 28 | System.JSON, 29 | Swag.Common.Types; 30 | 31 | type 32 | TSwagSecurityDefinition = class abstract(TObject) 33 | protected 34 | fSchemaName: TSwagSecuritySchemaName; 35 | fDescription: string; 36 | 37 | function GetTypeSecurity: TSwagSecurityDefinitionType; virtual; abstract; 38 | function ReturnTypeSecurityToString: string; virtual; 39 | public 40 | function GenerateJsonObject: TJSONObject; virtual; abstract; 41 | 42 | property SchemaName: TSwagSecuritySchemaName read fSchemaName write fSchemaName; 43 | property TypeSecurity: TSwagSecurityDefinitionType read GetTypeSecurity; 44 | property Description: string read fDescription write fDescription; 45 | end; 46 | 47 | implementation 48 | 49 | uses 50 | Swag.Common.Consts; 51 | 52 | { TSwagSecurityDefinition } 53 | 54 | function TSwagSecurityDefinition.ReturnTypeSecurityToString: string; 55 | begin 56 | Result := c_SwagSecurityDefinitionType[GetTypeSecurity]; 57 | end; 58 | 59 | end. 60 | -------------------------------------------------------------------------------- /Swag.Doc.SecurityDefinitionApiKey.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi SwagDoc Library } 4 | { Copyright (c) 2018 Marcelo Jaloto } 5 | { https://github.com/marcelojaloto/SwagDoc } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | 23 | unit Swag.Doc.SecurityDefinitionApiKey; 24 | 25 | interface 26 | 27 | uses 28 | System.JSON, 29 | Swag.Common.Types, 30 | Swag.Doc.SecurityDefinition; 31 | 32 | type 33 | TSwagSecurityDefinitionApiKeyInLocation = (kilNotDefined, kilQuery, kilHeader); 34 | 35 | TSwagSecurityDefinitionApiKey = class(TSwagSecurityDefinition) 36 | private 37 | fName: string; 38 | fInLocation: TSwagSecurityDefinitionApiKeyInLocation; 39 | protected 40 | function GetTypeSecurity: TSwagSecurityDefinitionType; override; 41 | function ReturnInLocationToString: string; 42 | public 43 | function GenerateJsonObject: TJSONObject; override; 44 | 45 | property InLocation: TSwagSecurityDefinitionApiKeyInLocation read fInLocation write fInLocation; 46 | property Name: string read fName write fName; 47 | end; 48 | 49 | implementation 50 | 51 | const 52 | c_SwagSecurityDefinitionApiKeyType = 'type'; 53 | c_SwagSecurityDefinitionApiKeyDescription = 'description'; 54 | c_SwagSecurityDefinitionApiKeyIn = 'in'; 55 | c_SwagSecurityDefinitionApiKeyName = 'name'; 56 | 57 | { TSwagSecurityDefinitionApiKey } 58 | 59 | function TSwagSecurityDefinitionApiKey.GenerateJsonObject: TJSONObject; 60 | var 61 | vJsonItem: TJsonObject; 62 | begin 63 | vJsonItem := TJsonObject.Create; 64 | vJsonItem.AddPair(c_SwagSecurityDefinitionApiKeyType, ReturnTypeSecurityToString); 65 | vJsonItem.AddPair(c_SwagSecurityDefinitionApiKeyDescription, fDescription); 66 | vJsonItem.AddPair(c_SwagSecurityDefinitionApiKeyIn, ReturnInLocationToString); 67 | vJsonItem.AddPair(c_SwagSecurityDefinitionApiKeyName, fName); 68 | 69 | Result := vJsonItem; 70 | end; 71 | 72 | function TSwagSecurityDefinitionApiKey.ReturnInLocationToString: string; 73 | begin 74 | case fInLocation of 75 | kilQuery: Result := 'query'; 76 | kilHeader: Result := 'header'; 77 | else 78 | Result := ''; 79 | end; 80 | end; 81 | 82 | function TSwagSecurityDefinitionApiKey.GetTypeSecurity: TSwagSecurityDefinitionType; 83 | begin 84 | Result := ssdApiKey; 85 | end; 86 | 87 | end. 88 | -------------------------------------------------------------------------------- /Templates/Client/Object Pascal/AutoTablesClient.dpr: -------------------------------------------------------------------------------- 1 | program AutoTablesClient; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | uMainForm in 'uMainForm.pas' {MainForm}, 7 | uAutoTablesClientDM in 'uAutoTablesClientDM.pas' {AutoTablesClientDM: TDataModule}; 8 | 9 | {$R *.res} 10 | 11 | begin 12 | Application.Initialize; 13 | Application.CreateForm(TMainForm, MainForm); 14 | Application.CreateForm(TAutoTablesClientDM, AutoTablesClientDM); 15 | Application.Run; 16 | end. 17 | -------------------------------------------------------------------------------- /Templates/Client/Object Pascal/uAutoTablesClientDM.dfm: -------------------------------------------------------------------------------- 1 | object AutoTablesClientDM: TAutoTablesClientDM 2 | OldCreateOrder = False 3 | Height = 484 4 | Width = 669 5 | {#EndPointComponent#} 6 | end 7 | -------------------------------------------------------------------------------- /Templates/Client/Object Pascal/uAutoTablesClientDM.pas: -------------------------------------------------------------------------------- 1 | unit uAutoTablesClientDM; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Classes, IPPeerClient, REST.Backend.ServiceTypes, 7 | System.JSON, REST.Backend.EMSServices, REST.Backend.MetaTypes, 8 | REST.Backend.BindSource, REST.Backend.ServiceComponents, Data.Bind.Components, 9 | Data.Bind.ObjectScope, REST.Client, REST.Backend.EndPoint, REST.Types, 10 | REST.Backend.EMSProvider, FireDAC.Comp.Client, FireDAC.Stan.Intf, 11 | FireDAC.Stan.Option, FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, 12 | FireDAC.Phys.Intf, FireDAC.DApt.Intf, Data.DB, FireDAC.Comp.DataSet, 13 | FireDAC.Stan.StorageJSON, REST.Backend.Providers; 14 | 15 | type 16 | TGetFuncType = procedure of object; 17 | TPostFuncType = procedure of object; 18 | TDeleteFuncType = procedure(const ID: String) of object; 19 | TAutoTablesClientDM = class(TDataModule) 20 | {#CompHeaderList#} 21 | private 22 | { Private declarations } 23 | public 24 | { Public declarations } 25 | procedure CallGet(MethodName: string); 26 | procedure CallPost(MethodName: string); 27 | procedure CallDelete(MethodName: string; const ID: String); 28 | function Login(const UserName, Password: String): Boolean; 29 | procedure Logout; 30 | published 31 | {#HeaderList#} 32 | end; 33 | 34 | var 35 | AutoTablesClientDM: TAutoTablesClientDM; 36 | 37 | implementation 38 | 39 | {%CLASSGROUP 'System.Classes.TPersistent'} 40 | 41 | {$R *.dfm} 42 | 43 | // https://stackoverflow.com/questions/4186458/delphi-call-a-function-whose-name-is-stored-in-a-string 44 | procedure TAutoTablesClientDM.CallGet(MethodName: string); 45 | var M: System.TMethod; 46 | begin 47 | M.Code := Self.MethodAddress(MethodName); //find method code 48 | M.Data := Pointer(Self); //store pointer to object instance 49 | TGetFuncType(m)(); 50 | end; 51 | 52 | procedure TAutoTablesClientDM.CallPost(MethodName: string); 53 | var M: System.TMethod; 54 | begin 55 | M.Code := Self.MethodAddress(MethodName); //find method code 56 | M.Data := Pointer(Self); //store pointer to object instance 57 | TPostFuncType(m)(); 58 | end; 59 | 60 | procedure TAutoTablesClientDM.CallDelete(MethodName: string; const ID: String); 61 | var M: System.TMethod; 62 | begin 63 | M.Code := Self.MethodAddress(MethodName); //find method code 64 | M.Data := Pointer(Self); //store pointer to object instance 65 | TDeleteFuncType(m)(ID); 66 | end; 67 | 68 | function TAutoTablesClientDM.Login(const UserName, Password: String): Boolean; 69 | begin 70 | if not BackendAuth1.LoggedIn then 71 | begin 72 | BackendAuth1.UserName := UserName; 73 | BackendAuth1.Password := Password; 74 | BackendAuth1.Login; 75 | 76 | if BackendAuth1.LoggedIn then 77 | begin 78 | if BackendAuth1.LoggedInToken = '' then 79 | begin 80 | BackendAuth1.Authentication := TBackendAuthentication.Default; 81 | Result := False; 82 | end 83 | else 84 | begin 85 | BackendAuth1.Authentication := TBackendAuthentication.Session; 86 | Result := True; 87 | end; 88 | end; 89 | end 90 | else 91 | Result := True; 92 | end; 93 | 94 | procedure TAutoTablesClientDM.Logout; 95 | begin 96 | BackendAuth1.Logout; 97 | BackendAuth1.Authentication := TBackendAuthentication.Default; 98 | end; 99 | 100 | {#FunctionList#} 101 | 102 | end. 103 | -------------------------------------------------------------------------------- /Templates/Client/Object Pascal/uMainForm.fmx: -------------------------------------------------------------------------------- 1 | object MainForm: TMainForm 2 | Left = 0 3 | Top = 0 4 | Caption = 'Auto Tables Client' 5 | ClientHeight = 480 6 | ClientWidth = 640 7 | FormFactor.Width = 320 8 | FormFactor.Height = 480 9 | FormFactor.Devices = [Desktop] 10 | DesignerMasterStyle = 0 11 | end 12 | -------------------------------------------------------------------------------- /Templates/Client/Object Pascal/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; 8 | 9 | type 10 | TMainForm = class(TForm) 11 | private 12 | { Private declarations } 13 | public 14 | { Public declarations } 15 | end; 16 | 17 | var 18 | MainForm: TMainForm; 19 | 20 | implementation 21 | 22 | {$R *.fmx} 23 | 24 | uses 25 | uAutoTablesClientDM; 26 | 27 | end. 28 | -------------------------------------------------------------------------------- /Templates/Client/Object Pascal/uMainFormA.fmx: -------------------------------------------------------------------------------- 1 | object MainForm: TMainForm 2 | Left = 0 3 | Top = 0 4 | Caption = 'Auto Tables Client' 5 | ClientHeight = 480 6 | ClientWidth = 640 7 | FormFactor.Width = 320 8 | FormFactor.Height = 480 9 | FormFactor.Devices = [Desktop] 10 | DesignerMasterStyle = 0 11 | end 12 | -------------------------------------------------------------------------------- /Templates/Client/Object Pascal/uMainFormA.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; 8 | 9 | type 10 | TMainForm = class(TForm) 11 | private 12 | { Private declarations } 13 | public 14 | { Public declarations } 15 | end; 16 | 17 | var 18 | MainForm: TMainForm; 19 | 20 | implementation 21 | 22 | {$R *.fmx} 23 | 24 | uses 25 | uAutoTablesClientDM; 26 | 27 | end. 28 | -------------------------------------------------------------------------------- /Templates/Client/Object Pascal/uMainFormC.fmx: -------------------------------------------------------------------------------- 1 | object MainForm: TMainForm 2 | Left = 0 3 | Top = 0 4 | Caption = 'Auto Tables Client' 5 | ClientHeight = 480 6 | ClientWidth = 640 7 | FormFactor.Width = 320 8 | FormFactor.Height = 480 9 | FormFactor.Devices = [Desktop] 10 | DesignerMasterStyle = 0 11 | end 12 | -------------------------------------------------------------------------------- /Templates/Client/Object Pascal/uMainFormC.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; 8 | 9 | type 10 | TMainForm = class(TForm) 11 | private 12 | { Private declarations } 13 | public 14 | { Public declarations } 15 | end; 16 | 17 | var 18 | MainForm: TMainForm; 19 | 20 | implementation 21 | 22 | {$R *.fmx} 23 | 24 | uses 25 | uAutoTablesClientDM; 26 | 27 | end. 28 | -------------------------------------------------------------------------------- /Templates/Server/Object Pascal/AutoTablesForRADServer.dpk: -------------------------------------------------------------------------------- 1 | package AutoTablesForRADServer; 2 | 3 | {$R *.res} 4 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 5 | {$ALIGN 8} 6 | {$ASSERTIONS ON} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO OFF} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS ON} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION OFF} 16 | {$OVERFLOWCHECKS OFF} 17 | {$RANGECHECKS OFF} 18 | {$REFERENCEINFO ON} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES ON} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DEFINE DEBUG} 27 | {$ENDIF IMPLICITBUILDING} 28 | {$RUNONLY} 29 | {$IMPLICITBUILD ON} 30 | 31 | requires 32 | rtl, 33 | emsserverapi, 34 | dbrtl, 35 | FireDAC, 36 | FireDACSqliteDriver, 37 | FireDACCommonDriver, 38 | FireDACCommon, 39 | bindengine, 40 | bindcomp, 41 | FireDACIBDriver; 42 | 43 | contains 44 | uMainServer in 'uMainServer.pas' {AutoTablesResource: TDataModule}; 45 | 46 | end. 47 | -------------------------------------------------------------------------------- /Templates/Server/Object Pascal/AutoTablesForRADServer.dproj.local: -------------------------------------------------------------------------------- 1 |  2 | 3 | -------------------------------------------------------------------------------- /Templates/Server/Object Pascal/AutoTablesForRADServer.identcache: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/FMXExpress/AutoTablesForRADServer/67d5f358d7276036b45797a6072d5e4cdc731af4/Templates/Server/Object Pascal/AutoTablesForRADServer.identcache -------------------------------------------------------------------------------- /Templates/Server/Object Pascal/AutoTablesForRADServer.stat: -------------------------------------------------------------------------------- 1 | [Stats] 2 | EditorSecs=109 3 | DesignerSecs=1 4 | InspectorSecs=1 5 | CompileSecs=1 6 | OtherSecs=3 7 | StartTime=9/18/2018 6:04:56 PM 8 | RealKeys=0 9 | EffectiveKeys=0 10 | DebugSecs=1 11 | -------------------------------------------------------------------------------- /Templates/Server/Object Pascal/uMainServer.dfm: -------------------------------------------------------------------------------- 1 | object AutoTablesResource: TAutoTablesResource 2 | OldCreateOrder = False 3 | Height = 402 4 | Width = 604 5 | object EndpointQuery: TFDQuery 6 | Connection = FDConnection 7 | SQL.Strings = ( 8 | 'SELECT * FROM EndPointTable') 9 | Left = 184 10 | Top = 104 11 | end 12 | {#EndPointComponent#} 13 | object BindingsList1: TBindingsList 14 | Methods = <> 15 | OutputConverters = <> 16 | Left = 36 17 | Top = 29 18 | end 19 | object FDStanStorageJSONLink1: TFDStanStorageJSONLink 20 | Left = 418 21 | Top = 40 22 | end 23 | object EndPoints: TBindSourceDB 24 | DataSet = EndPointTable 25 | ScopeMappings = <> 26 | Left = 288 27 | Top = 48 28 | end 29 | object FDPhysIBDriverLink1: TFDPhysIBDriverLink 30 | Left = 184 31 | Top = 32 32 | end 33 | {#EndPointConnection#} 34 | object AggregateSQL: TFDMemTable 35 | FetchOptions.AssignedValues = [evMode] 36 | FetchOptions.Mode = fmAll 37 | ResourceOptions.AssignedValues = [rvSilentMode] 38 | ResourceOptions.SilentMode = True 39 | UpdateOptions.AssignedValues = [uvCheckRequired, uvAutoCommitUpdates] 40 | UpdateOptions.CheckRequired = False 41 | UpdateOptions.AutoCommitUpdates = True 42 | Left = 144 43 | Top = 160 44 | end 45 | object FDBatchMoveCSV: TFDBatchMove 46 | Reader = FDBatchMoveDataSetReader 47 | Writer = FDBatchMoveTextWriter 48 | Mappings = <> 49 | LogFileName = 'Data.log' 50 | Left = 392 51 | Top = 192 52 | end 53 | object FDBatchMoveTextWriter: TFDBatchMoveTextWriter 54 | DataDef.Fields = <> 55 | Encoding = ecUTF8 56 | Left = 448 57 | Top = 248 58 | end 59 | object FDBatchMoveDataSetReader: TFDBatchMoveDataSetReader 60 | Left = 496 61 | Top = 168 62 | end 63 | end 64 | -------------------------------------------------------------------------------- /Templates/Server/Object Pascal/uMainServer.vlb: -------------------------------------------------------------------------------- 1 | [EndPointTable] 2 | Visible=False 3 | 4 | -------------------------------------------------------------------------------- /Templates/swagger-ui.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/FMXExpress/AutoTablesForRADServer/67d5f358d7276036b45797a6072d5e4cdc731af4/Templates/swagger-ui.zip -------------------------------------------------------------------------------- /Win.Webbrowser.pas: -------------------------------------------------------------------------------- 1 | unit Win.WebBrowser; 2 | 3 | interface 4 | 5 | (* 6 | 7 | Special thanks to David Esperalta, aka Dec @ http://www.clubdelphi.com/foros/member.php?u=4681 8 | 9 | http://www.clubdelphi.com/foros/showthread.php?p=507565 10 | 11 | *) 12 | 13 | uses 14 | System.Win.Registry; 15 | 16 | type 17 | {$REGION 'TInternetExplorerVersion'} 18 | {$SCOPEDENUMS ON} 19 | /// Version Numbers for Windows Internet Explorer 20 | TInternetExplorerVersion = ( 21 | /// Internet Explorer 11 22 | IE11, 23 | /// Internet Explorer 10 24 | IE10, 25 | /// Internet Explorer 9 26 | IE9, 27 | /// Internet Explorer 8 28 | IE8, 29 | /// Internet Explorer 7 30 | IE7 31 | ); 32 | {$SCOPEDENUMS OFF} 33 | {$ENDREGION} 34 | 35 | {$REGION 'TInternetExplorerVersionHelper'} 36 | TInternetExplorerVersionHelper = record helper for TInternetExplorerVersion 37 | public 38 | /// Returns the Flag specified by Windows API for the given Internet Explorer Version 39 | function Value: Integer; 40 | end; 41 | {$ENDREGION} 42 | 43 | {$REGION 'TWinWebBrowserEmulation'} 44 | /// Class that tweaks the Windows Registry to enable TWebBrowser emulation support 45 | TWinWebBrowserEmulation = class 46 | strict private 47 | /// Creates and returns a TRegistry pointing to the FEATURE_BROWSER_EMULATION Key 48 | function OpenWebBrowserEmulationRegistry(out ARegistry: TRegistry): Boolean; 49 | strict protected 50 | /// Returns the full Key Path to the FEATURE_BROWSER_EMULATION 51 | function GetFeatureBrowserEmulationRegistryKey: string; virtual; 52 | /// Returns the Name of the Application Executable 53 | function GetExeName: string; virtual; 54 | public 55 | /// Tweaks the Windows Registry allowing TWebBrowser Support for the given Internet Explorer Version 56 | procedure EnableBrowserEmulation(const Version: TInternetExplorerVersion); 57 | /// Restores any changes done to the Windows Registry 58 | procedure RestoreBrowserEmulation; 59 | end; 60 | {$ENDREGION} 61 | 62 | implementation 63 | 64 | uses 65 | Winapi.Windows, 66 | System.SysUtils; 67 | 68 | {$REGION 'TWinWebBrowserEmulation'} 69 | 70 | function TWinWebBrowserEmulation.GetExeName: string; 71 | begin 72 | Result := ExtractFileName(ParamStr(0)); 73 | end; 74 | 75 | function TWinWebBrowserEmulation.GetFeatureBrowserEmulationRegistryKey: string; 76 | begin 77 | Result := 'Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION'; 78 | end; 79 | 80 | function TWinWebBrowserEmulation.OpenWebBrowserEmulationRegistry(out ARegistry: TRegistry): Boolean; 81 | begin 82 | Result := False; 83 | ARegistry := TRegistry.Create; 84 | try 85 | ARegistry.RootKey := HKEY_CURRENT_USER; 86 | Result := ARegistry.OpenKey(GetFeatureBrowserEmulationRegistryKey, True); 87 | finally 88 | if not Result then 89 | ARegistry.Free; 90 | end; 91 | end; 92 | 93 | procedure TWinWebBrowserEmulation.RestoreBrowserEmulation; 94 | var 95 | Registry: TRegistry; 96 | begin 97 | if not OpenWebBrowserEmulationRegistry(Registry) then 98 | Exit; 99 | 100 | try 101 | if Registry.ValueExists(GetExeName) then 102 | Registry.DeleteKey(GetExeName); 103 | Registry.CloseKey 104 | finally 105 | Registry.Free; 106 | end; 107 | end; 108 | 109 | procedure TWinWebBrowserEmulation.EnableBrowserEmulation(const Version: TInternetExplorerVersion); 110 | var 111 | Registry: TRegistry; 112 | begin 113 | if not OpenWebBrowserEmulationRegistry(Registry) then 114 | Exit; 115 | 116 | try 117 | if not Registry.ValueExists(GetExeName) then 118 | Registry.WriteInteger(GetExeName, Version.Value); 119 | Registry.CloseKey 120 | finally 121 | Registry.Free; 122 | end; 123 | end; 124 | 125 | {$ENDREGION} 126 | 127 | {$REGION 'TInternetExplorerVersionHelper'} 128 | 129 | function TInternetExplorerVersionHelper.Value: Integer; 130 | begin 131 | // Values from http://msdn.microsoft.com/en-us/library/ee330730(VS.85).aspx#browser_emulation 132 | case Self of 133 | TInternetExplorerVersion.IE11: Result := 11000; 134 | TInternetExplorerVersion.IE10: Result := 10000; 135 | TInternetExplorerVersion.IE9: Result := 9000; 136 | TInternetExplorerVersion.IE8: Result := 8000; 137 | TInternetExplorerVersion.IE7: Result := 7000; 138 | else 139 | raise Exception.Create('TInternetExplorerVersionHelper.Value: Unknown value'); 140 | end; 141 | end; 142 | 143 | {$ENDREGION} 144 | 145 | end. -------------------------------------------------------------------------------- /license.txt: -------------------------------------------------------------------------------- 1 | Copyright 2018 Peacekeeper Enterprises, LLC. 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 4 | 5 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -------------------------------------------------------------------------------- /uActivityFrame.fmx: -------------------------------------------------------------------------------- 1 | object ActivityFrame: TActivityFrame 2 | Size.Width = 633.000000000000000000 3 | Size.Height = 504.000000000000000000 4 | Size.PlatformDefault = False 5 | object BackgroundRect: TRectangle 6 | Align = Contents 7 | Fill.Color = claBlack 8 | Opacity = 0.750000000000000000 9 | Size.Width = 633.000000000000000000 10 | Size.Height = 504.000000000000000000 11 | Size.PlatformDefault = False 12 | Stroke.Kind = None 13 | end 14 | object ActivityCircle: TCircle 15 | Align = Center 16 | Fill.Kind = None 17 | Size.Width = 105.000000000000000000 18 | Size.Height = 105.000000000000000000 19 | Size.PlatformDefault = False 20 | Stroke.Color = claAqua 21 | object ActivityArc: TArc 22 | Align = Client 23 | Size.Width = 105.000000000000000000 24 | Size.Height = 105.000000000000000000 25 | Size.PlatformDefault = False 26 | Stroke.Color = claAqua 27 | Stroke.Thickness = 5.000000000000000000 28 | Stroke.Cap = Round 29 | Stroke.Dash = Dot 30 | StartAngle = -45.000000000000000000 31 | EndAngle = -45.000000000000000000 32 | object ActivityFloatAni: TFloatAnimation 33 | Duration = 1.000000000000000000 34 | Loop = True 35 | PropertyName = 'RotationAngle' 36 | StartValue = 0.000000000000000000 37 | StopValue = 360.000000000000000000 38 | end 39 | end 40 | object ClipCircle: TCircle 41 | Align = Client 42 | Fill.Kind = None 43 | Margins.Left = 5.000000000000000000 44 | Margins.Top = 5.000000000000000000 45 | Margins.Right = 5.000000000000000000 46 | Margins.Bottom = 5.000000000000000000 47 | Size.Width = 95.000000000000000000 48 | Size.Height = 95.000000000000000000 49 | Size.PlatformDefault = False 50 | Stroke.Color = claAqua 51 | end 52 | end 53 | end 54 | -------------------------------------------------------------------------------- /uActivityFrame.pas: -------------------------------------------------------------------------------- 1 | unit uActivityFrame; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 7 | FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls, 8 | FMX.Ani, FMX.Objects; 9 | 10 | type 11 | TActivityFrame = class(TFrame) 12 | BackgroundRect: TRectangle; 13 | ActivityCircle: TCircle; 14 | ActivityArc: TArc; 15 | ActivityFloatAni: TFloatAnimation; 16 | ClipCircle: TCircle; 17 | private 18 | { Private declarations } 19 | public 20 | { Public declarations } 21 | procedure Start; 22 | procedure Stop; 23 | end; 24 | 25 | implementation 26 | 27 | {$R *.fmx} 28 | 29 | procedure TActivityFrame.Start; 30 | begin 31 | Self.Tag := Self.Tag+1; 32 | Self.Visible := True; 33 | ActivityFloatAni.Start; 34 | end; 35 | 36 | procedure TActivityFrame.Stop; 37 | begin 38 | Self.Tag := Self.Tag-1; 39 | if Self.Tag=0 then 40 | begin 41 | ActivityFloatAni.Stop; 42 | Self.Visible := False; 43 | end; 44 | end; 45 | 46 | end. 47 | -------------------------------------------------------------------------------- /uAngularJSSDK.fmx: -------------------------------------------------------------------------------- 1 | object AngularJSSDKFrame: TAngularJSSDKFrame 2 | Size.Width = 539.000000000000000000 3 | Size.Height = 441.000000000000000000 4 | Size.PlatformDefault = False 5 | object HeaderFunctionMemo: TMemo 6 | Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] 7 | DataDetectorTypes = [] 8 | Align = Bottom 9 | Position.Y = 10.000000000000000000 10 | Size.Width = 539.000000000000000000 11 | Size.Height = 24.000000000000000000 12 | Size.PlatformDefault = False 13 | TabOrder = 4 14 | Viewport.Width = 539.000000000000000000 15 | Viewport.Height = 24.000000000000000000 16 | end 17 | object GetFunctionMemo: TMemo 18 | Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] 19 | DataDetectorTypes = [] 20 | Lines.Strings = ( 21 | '$scope.{#EndPoint#}{#ParamString#} {' 22 | ' if ($scope.LoginAPI($scope.Username,$scope.Password)==true) {' 23 | 24 | ' return $scope.GetAPI('#39'/{#RootSegment#}/{#EndPoint#}/{#QueryS' + 25 | 'tring#});' 26 | ' }' 27 | '}') 28 | Align = Bottom 29 | Position.Y = 34.000000000000000000 30 | Size.Width = 539.000000000000000000 31 | Size.Height = 88.000000000000000000 32 | Size.PlatformDefault = False 33 | TabOrder = 3 34 | Viewport.Width = 539.000000000000000000 35 | Viewport.Height = 88.000000000000000000 36 | end 37 | object SDKMemo: TMemo 38 | Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] 39 | DataDetectorTypes = [] 40 | Lines.Strings = ( 41 | 42 | ' angular.module('#39'{#Filename#}'#39', ['#39'ui.bootstrap'#39', '#39'ngCooki' + 43 | 'es'#39'])' 44 | 45 | ' .controller('#39'AutoTablesClientApp'#39', function($scope, ' + 46 | '$http, $cookies, $timeout) {' 47 | '' 48 | ' $scope.URLHost = '#39'{#URLHost#}'#39';' 49 | ' $scope.URLPort = '#39'{#URLPort#}'#39';' 50 | ' $scope.Username = '#39'{#Username#}'#39';' 51 | '' 52 | ' $scope.Password = '#39'{#Password#}'#39';' 53 | #9#9'$scope.LoggedIn = false;' 54 | #9#9'$scope.SessionToken = '#39#39';' 55 | 56 | ' $scope.TenantId = $cookies.get('#39'TenantId'#39'); //'#39'0' + 57 | '0000000-0000-0000-0000-000000000001'#39';' 58 | 59 | ' $scope.TenantSecret = $cookies.get('#39'TenantSecret' + 60 | #39'); //'#39'secret'#39';' 61 | #9#9 62 | '' 63 | ' $scope.getServerURL = function() {' 64 | #9#9'return '#39'http://'#39'+$scope.URLHost+'#39':'#39'+$scope.URLPort;' 65 | #9#9'}' 66 | '' 67 | ' $scope.getTenantId = function() {' 68 | ' return $scope.TenantId;' 69 | ' }' 70 | '' 71 | ' $scope.getTenantSecret = function() {' 72 | ' return $scope.TenantSecret;' 73 | ' }' 74 | '' 75 | ' $scope.getSessionToken = function() {' 76 | ' return $scope.SessionToken;' 77 | ' }' 78 | '' 79 | ' $scope.GetHeader = function() {' 80 | ' if ($scope.LoggedIn==true) {' 81 | 82 | ' '#9'return { headers: {'#39'X-Embarcadero-Session-T' + 83 | 'oken'#39': $scope.getSessionToken(), '#39'X-Embarcadero-Tenant-Id'#39': $sco' + 84 | 'pe.getTenantId(),'#39'X-Embarcadero-Tenant-Secret'#39': $scope.getTenant' + 85 | 'Secret() } }' 86 | ' } else {' 87 | 88 | ' '#9'return { headers: { '#39'X-Embarcadero-Tenant-I' + 89 | 'd'#39': $scope.getTenantId(), '#39'X-Embarcadero-Tenant-Secret'#39': $scope.' + 90 | 'getTenantSecret() } }' 91 | ' }' 92 | ' } ' 93 | '' 94 | '' 95 | ' $scope.LoginAPI = function(username, password) {' 96 | ' if ($scope.LoggedIn==false) {' 97 | #9#9#9' var post_data = JSON.stringify({' 98 | #9#9#9#9'"username": username,' 99 | #9#9#9#9'"password": password' 100 | #9#9#9' });' 101 | 102 | #9#9#9' $http.post($scope.getServerURL() + '#39'users/login'#39', post_da' + 103 | 'ta, {' 104 | #9#9#9#9' headers: {' 105 | #9#9#9#9#9#39'X-Embarcadero-Tenant-Id'#39': $scope.getTenantId(),' 106 | #9#9#9#9#9#39'X-Embarcadero-Tenant-Secret'#39': $scope.getTenantSecret()' 107 | #9#9#9#9' }' 108 | #9#9#9#9'})' 109 | #9#9#9#9'.then(function(response) {' 110 | #9#9#9#9' $scope.SessionToken = response.data.sessionToken;' 111 | #9#9#9#9' $cookies.put('#39'username'#39', username);' 112 | #9#9#9#9' $cookies.put('#39'password'#39', password);' 113 | #9#9#9#9' $scope.LoggedIn = true;' 114 | '' 115 | #9#9#9#9' return true;' 116 | #9#9#9#9'}, function(response) {' 117 | #9#9#9#9' $scope.errormsg = response.data' 118 | #9#9#9#9' $scope.LoggedIn = false;' 119 | #9#9#9#9' return false; ' 120 | #9#9#9#9'});' 121 | #9#9#9'} else {' 122 | #9#9#9#9'return true;' 123 | #9#9#9'}' 124 | ' }' 125 | '' 126 | ' $scope.GetAPI = function(apath) {' 127 | 128 | ' $http.get($scope.getServerURL() + apath, $sc' + 129 | 'ope.getHeader()).' 130 | ' then(function(response) {' 131 | 132 | ' return response.data["FDBS"]["Manager"][' + 133 | '"TableList"][0]["RowList"];' 134 | ' }, function(response) {' 135 | ' return response.data' 136 | ' });' 137 | '' 138 | ' }' 139 | '' 140 | ' $scope.PostAPI = function(apath,abody) {' 141 | 142 | ' $http.post($scope.getServerURL() + apath, ab' + 143 | 'ody, $scope.getHeader()).' 144 | ' then(function(response) {' 145 | 146 | ' return response.data["FDBS"]["Manager"][' + 147 | '"TableList"][0]["RowList"];' 148 | ' }, function(response) {' 149 | ' return response.data' 150 | ' });' 151 | '' 152 | ' }' 153 | '' 154 | ' $scope.DeleteAPI = function(apath) {' 155 | 156 | ' $http.get($scope.getServerURL() + apath, $sc' + 157 | 'ope.getHeader()).' 158 | ' then(function(response) {' 159 | 160 | ' return response.data["FDBS"]["Manager"][' + 161 | '"TableList"][0]["RowList"];' 162 | ' }, function(response) {' 163 | ' return response.data' 164 | ' });' 165 | '' 166 | ' }' 167 | '' 168 | '{#SDKFunctionList#}' 169 | '' 170 | ' });') 171 | Align = Bottom 172 | Position.Y = 210.000000000000000000 173 | Size.Width = 539.000000000000000000 174 | Size.Height = 143.000000000000000000 175 | Size.PlatformDefault = False 176 | TabOrder = 0 177 | Viewport.Width = 539.000000000000000000 178 | Viewport.Height = 143.000000000000000000 179 | end 180 | object PostFunctionMemo: TMemo 181 | Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] 182 | DataDetectorTypes = [] 183 | Lines.Strings = ( 184 | '$scope.{#EndPoint#}{#ParamString#} {' 185 | ' if ($scope.LoginAPI($scope.Username,$scope.Password)==true) {' 186 | 187 | ' return $scope.PostAPI('#39'/{#RootSegment#}/{#EndPoint#}/{#Query' + 188 | 'String#},abody);' 189 | ' }' 190 | '}') 191 | Align = Bottom 192 | Position.Y = 122.000000000000000000 193 | Size.Width = 539.000000000000000000 194 | Size.Height = 88.000000000000000000 195 | Size.PlatformDefault = False 196 | TabOrder = 2 197 | Viewport.Width = 539.000000000000000000 198 | Viewport.Height = 88.000000000000000000 199 | end 200 | object DeleteFunctionMemo: TMemo 201 | Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] 202 | DataDetectorTypes = [] 203 | Lines.Strings = ( 204 | '$scope.{#EndPoint#}{#ParamString#} {' 205 | ' if ($scope.LoginAPI($scope.Username,$scope.Password)==true) {' 206 | 207 | ' return $scope.DeleteAPI('#39'/{#RootSegment#}/{#EndPoint#}/{#Que' + 208 | 'ryString#});' 209 | ' }' 210 | '}') 211 | Align = Bottom 212 | Position.Y = 353.000000000000000000 213 | Size.Width = 539.000000000000000000 214 | Size.Height = 88.000000000000000000 215 | Size.PlatformDefault = False 216 | TabOrder = 1 217 | Viewport.Width = 539.000000000000000000 218 | Viewport.Height = 88.000000000000000000 219 | end 220 | object ActionList1: TActionList 221 | Left = 80 222 | Top = 96 223 | object GenerateSDKAction: TAction 224 | Text = 'GenerateSDKAction' 225 | end 226 | end 227 | end 228 | -------------------------------------------------------------------------------- /uAngularJSSDK.pas: -------------------------------------------------------------------------------- 1 | unit uAngularJSSDK; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 7 | FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls, 8 | System.Actions, FMX.ActnList, FMX.Controls.Presentation, FMX.ScrollBox, 9 | FMX.Memo, FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Param, 10 | FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.DApt.Intf, 11 | Data.DB, FireDAC.Comp.DataSet, FireDAC.Comp.Client, System.IOUtils, StrUtils; 12 | 13 | type 14 | TAngularJSSDKFrame = class(TFrame) 15 | HeaderFunctionMemo: TMemo; 16 | GetFunctionMemo: TMemo; 17 | SDKMemo: TMemo; 18 | PostFunctionMemo: TMemo; 19 | DeleteFunctionMemo: TMemo; 20 | ActionList1: TActionList; 21 | GenerateSDKAction: TAction; 22 | private 23 | { Private declarations } 24 | Host,Port: String; 25 | EndPointTable: TFDDataSet; 26 | FDMemTableInfo: TFDDataSet; 27 | function GetQueryStringList(ADataSet: TFDDataSet): String; 28 | public 29 | { Public declarations } 30 | procedure Initialize(AHost,APort: String; ADataSet: TFDDataSet; AInfoDataSet: TFDDataSet); 31 | function GenerateSDK(AFileName: String): String; 32 | end; 33 | 34 | implementation 35 | 36 | {$R *.fmx} 37 | 38 | 39 | uses 40 | uMainForm; 41 | 42 | function TAngularJSSDKFrame.GetQueryStringList(ADataSet: TFDDataSet): String; 43 | begin 44 | Result := MainForm.GetQueryStringList(ADataSet); 45 | end; 46 | 47 | procedure TAngularJSSDKFrame.Initialize(AHost,APort: String; ADataSet: TFDDataSet; AInfoDataSet: TFDDataSet); 48 | begin 49 | Host := AHost; 50 | Port := APort; 51 | EndPointTable := ADataSet; 52 | FDMemTableInfo := AInfoDataSet; 53 | end; 54 | 55 | function TAngularJSSDKFrame.GenerateSDK(AFileName: String): String; 56 | var 57 | I: Integer; 58 | SL: TStringList; 59 | QueryString, ParamString: String; 60 | CompCount: Integer; 61 | FunctionList, HeaderList: TStringList; 62 | ATemplatePath: String; 63 | AOutputPath: String; 64 | begin 65 | 66 | CompCount := 1; 67 | EndPointTable.DisableControls; 68 | EndPointTable.First; 69 | FunctionList := TStringList.Create; 70 | HeaderList := TStringList.Create; 71 | SL := TStringList.Create; 72 | SL.StrictDelimiter := True; 73 | while not EndPointTable.EOF do 74 | begin 75 | QueryString := ''; 76 | ParamString := ''; 77 | SL.Clear; 78 | SL.CommaText := GetQueryStringList(EndPointTable) + IfThen((EndPointTable.FieldByName('Params').AsString<>'') OR (EndPointTable.FieldByName('Macros').AsString<>''),',format','format'); 79 | 80 | for I := 0 to SL.Count-1 do 81 | begin 82 | if SL[I]='format' then 83 | begin 84 | QueryString := QueryString + '''+(aformat!='''' ? '''+ IfThen(I=0,'?','&') + SL[I] + '=''+a' + SL[I] + IfThen(I=SL.Count-1,'','+''') + ' : '''')'; 85 | end 86 | else 87 | QueryString := QueryString + IfThen(I=0,'?','&') + SL[I] + '=''+a' + SL[I] + IfThen(I=SL.Count-1,'','+'''); 88 | ParamString := ParamString + IfThen(I=0,'',', ') + 'a' + SL[I] + IfThen(SL[I]='format',' = ''''',''); 89 | end; 90 | if EndPointTable.FieldByName('RequestType').AsString='POST' then 91 | begin 92 | ParamString := '('+ParamString+IfThen(ParamString<>'',',','')+'abody'+')'; 93 | end 94 | else 95 | begin 96 | ParamString := '('+ParamString+')'; 97 | end; 98 | SL.Clear; 99 | 100 | if EndPointTable.FieldByName('RequestType').AsString='GET' then 101 | begin 102 | SL.Append(GetFunctionMemo.Lines.Text 103 | .Replace('{#EndPoint#}',EndPointTable.FieldByName('EndPoint').AsString,[rfReplaceAll]) 104 | .Replace('{#RootSegment#}',FDMemTableInfo.FieldByName('RootSegment').AsString,[rfReplaceAll]) 105 | .Replace('{#ParamString#}',ParamString,[rfReplaceAll]) 106 | .Replace('{#QueryString#}',QueryString + IfThen(QueryString='','''',''),[rfReplaceAll])); 107 | end 108 | else 109 | if EndPointTable.FieldByName('RequestType').AsString='POST' then 110 | begin 111 | SL.Append(PostFunctionMemo.Lines.Text 112 | .Replace('{#EndPoint#}',EndPointTable.FieldByName('EndPoint').AsString,[rfReplaceAll]) 113 | .Replace('{#RootSegment#}',FDMemTableInfo.FieldByName('RootSegment').AsString,[rfReplaceAll]) 114 | .Replace('{#ParamString#}',ParamString,[rfReplaceAll]) 115 | .Replace('{#QueryString#}',QueryString + IfThen(QueryString='','''',''),[rfReplaceAll])); 116 | end 117 | else 118 | if EndPointTable.FieldByName('RequestType').AsString='DELETE' then 119 | begin 120 | SL.Append(DeleteFunctionMemo.Lines.Text 121 | .Replace('{#EndPoint#}',EndPointTable.FieldByName('EndPoint').AsString,[rfReplaceAll]) 122 | .Replace('{#RootSegment#}',FDMemTableInfo.FieldByName('RootSegment').AsString,[rfReplaceAll]) 123 | .Replace('{#ParamString#}',ParamString,[rfReplaceAll]) 124 | .Replace('{#QueryString#}',QueryString + IfThen(QueryString='','''',''),[rfReplaceAll])); 125 | end; 126 | 127 | 128 | FunctionList.Append(SL.Text); 129 | 130 | SL.Clear; 131 | 132 | SL.Append(HeaderFunctionMemo.Lines.Text.Replace('{#EndPoint#}',EndPointTable.FieldByName('EndPoint').AsString,[rfReplaceAll]).Replace('{#ParamString#}',ParamString,[])); 133 | 134 | HeaderList.Append(SL.Text); 135 | 136 | EndPointTable.Next; 137 | Inc(CompCount); 138 | end; 139 | SL.Free; 140 | EndPointTable.EnableControls; 141 | 142 | ATemplatePath := TPath.Combine(TPath.Combine(TPath.Combine(ExtractFilePath(ParamStr(0)),TemplatePath),SDKPath),OPLangPath); 143 | AOutputPath := TPath.Combine(ExtractFilePath(ParamStr(0)),OutputPath); 144 | if TDirectory.Exists(AOutputPath)=False then 145 | begin 146 | TDirectory.CreateDirectory(AOutputPath); 147 | end; 148 | 149 | SL := TStringList.Create; 150 | if TFile.Exists(TPath.Combine(ATemplatePath,AngularJSSDKTemplateFile)) then 151 | SL.LoadFromFile(TPath.Combine(ATemplatePath,AngularJSSDKTemplateFile)) 152 | else 153 | SL.Text := SDKMemo.Lines.Text; 154 | SL.Text := SL.Text.Replace('sdktemplatefile',AFileName.Replace(ExtractFileExt(AFileName),'',[rfIgnoreCase])); 155 | SL.Text := SL.Text.Replace('{#Filename#}',AFileName.Replace(ExtractFileExt(AFileName),'',[rfIgnoreCase])); 156 | SL.Text := SL.Text.Replace('{#URLHost#}',Host); 157 | SL.Text := SL.Text.Replace('{#URLPort#}',Port); 158 | SL.Text := SL.Text.Replace('{#Username#}',''); 159 | SL.Text := SL.Text.Replace('{#Password#}',''); 160 | SL.Text := SL.Text.Replace('{#SDKFunctionList#}',FunctionList.Text); 161 | SL.Text := SL.Text.Replace('{#SDKHeaderList#}',HeaderList.Text); 162 | SL.SaveToFile(TPath.Combine(AOutputPath,AFileName)); 163 | 164 | Result := SL.Text; 165 | 166 | SL.Free; 167 | FunctionList.Free; 168 | HeaderList.Free; 169 | 170 | end; 171 | 172 | end. 173 | -------------------------------------------------------------------------------- /uDelphiSDK.fmx: -------------------------------------------------------------------------------- 1 | object DelphiSDKFrame: TDelphiSDKFrame 2 | Size.Width = 531.000000000000000000 3 | Size.Height = 451.000000000000000000 4 | Size.PlatformDefault = False 5 | object HeaderFunctionMemo: TMemo 6 | Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] 7 | DataDetectorTypes = [] 8 | Lines.Strings = ( 9 | ' function {#EndPoint#}{#ParamString#}: TBytesStream;') 10 | Align = Bottom 11 | Position.Y = 20.000000000000000000 12 | Size.Width = 531.000000000000000000 13 | Size.Height = 24.000000000000000000 14 | Size.PlatformDefault = False 15 | TabOrder = 4 16 | Viewport.Width = 527.000000000000000000 17 | Viewport.Height = 20.000000000000000000 18 | end 19 | object GetFunctionMemo: TMemo 20 | Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] 21 | DataDetectorTypes = [] 22 | Lines.Strings = ( 23 | 'function TSDKClient.{#EndPoint#}{#ParamString#}: TBytesStream;' 24 | 'begin' 25 | ' if Self.LoginAPI(FUserName,FPassword) then' 26 | 27 | ' Result := Self.GetAPI('#39'/{#RootSegment#}/{#EndPoint#}/{#Quer' + 28 | 'yString#});' 29 | 'end;') 30 | Align = Bottom 31 | Position.Y = 44.000000000000000000 32 | Size.Width = 531.000000000000000000 33 | Size.Height = 88.000000000000000000 34 | Size.PlatformDefault = False 35 | TabOrder = 3 36 | Viewport.Width = 527.000000000000000000 37 | Viewport.Height = 84.000000000000000000 38 | end 39 | object SDKMemo: TMemo 40 | Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] 41 | DataDetectorTypes = [] 42 | Lines.Strings = ( 43 | 'unit {#Filename#};' 44 | '' 45 | 'interface' 46 | '' 47 | 'uses' 48 | 49 | ' System.SysUtils, System.Classes, System.JSON, FireDAC.Stan.Int' + 50 | 'f, System.StrUtils,' 51 | 52 | ' FireDAC.Stan.Option, FireDAC.Stan.Param, FireDAC.Stan.Error, F' + 53 | 'ireDAC.DatS,' 54 | 55 | ' FireDAC.Phys.Intf, FireDAC.DApt.Intf, Data.DB, FireDAC.Comp.Da' + 56 | 'taSet,' 57 | 58 | ' FireDAC.Comp.Client, REST.Client, REST.Backend.Endpoint, REST.' + 59 | 'Types,' 60 | 61 | ' REST.Backend.EMSProvider, REST.Backend.ServiceComponents, REST' + 62 | '.Backend.Providers;' 63 | '' 64 | 'type' 65 | ' TSDKClient = class(TComponent)' 66 | ' private' 67 | ' { Private declarations }' 68 | ' FUserName, FPassword: String;' 69 | ' public' 70 | ' { Public declarations }' 71 | ' FEMSProvider: TEMSProvider;' 72 | ' FBackendAuth: TBackendAuth;' 73 | '' 74 | ' constructor Create(AOwner: TComponent);' 75 | ' destructor Destroy;' 76 | '' 77 | 78 | ' function LoginAPI(const UserName, Password: String): Boolean' + 79 | ';' 80 | ' function GetAPI(const APath: String): TBytesStream;' 81 | 82 | ' function PostAPI(const APath: String; ABytesStream: TBytesSt' + 83 | 'ream): TBytesStream;' 84 | ' function DeleteAPI(const APath: String): TBytesStream;' 85 | '' 86 | '{#SDKHeaderList#}' 87 | ' published' 88 | ' property Username: String read FUsername write FUsername;' 89 | ' property Password: String read FPassword write FPassword;' 90 | ' end;' 91 | '' 92 | 'implementation' 93 | '' 94 | '' 95 | 'constructor TSDKClient.Create(AOwner: TComponent);' 96 | 'begin' 97 | ' inherited Create(AOwner);' 98 | ' FEMSProvider := TEMSProvider.Create(AOwner);' 99 | ' FBackendAuth := TBackendAuth.Create(AOwner);' 100 | ' FEMSProvider.URLHost := '#39'{#URLHost#}'#39';' 101 | ' FEMSProvider.URLPort := StrToInt('#39'{#URLPort#}'#39');' 102 | ' FEMSProvider.URLBasePath := '#39#39';' 103 | ' FEMSProvider.URLProtocol := '#39'http'#39';' 104 | ' FBackendAuth.Provider := FEMSProvider;' 105 | ' FUserName := '#39'{#Username#}'#39';' 106 | ' FPassword := '#39'{#Password#}'#39';' 107 | 'end;' 108 | '' 109 | 'destructor TSDKClient.Destroy;' 110 | 'begin' 111 | ' inherited Destroy;' 112 | ' FBackendAuth.DisposeOf;' 113 | 'end;' 114 | '' 115 | 116 | 'function TSDKClient.LoginAPI(const UserName, Password: String): ' + 117 | 'Boolean;' 118 | 'begin' 119 | ' if not FBackendAuth.LoggedIn then' 120 | ' begin' 121 | ' FBackendAuth.UserName := UserName;' 122 | ' FBackendAuth.Password := Password;' 123 | ' FBAckendAuth.Login;' 124 | '' 125 | ' if FBackendAuth.LoggedIn then' 126 | ' begin' 127 | ' if FBackendAuth.LoggedInToken = '#39#39' then' 128 | ' begin' 129 | 130 | ' FBackendAuth.Authentication := TBackendAuthenticat' + 131 | 'ion.Default;' 132 | ' Result := False;' 133 | ' end' 134 | ' else' 135 | ' begin' 136 | 137 | ' FBackendAuth.Authentication := TBackendAuthenticat' + 138 | 'ion.Session;' 139 | ' Result := True;' 140 | ' end;' 141 | ' end;' 142 | ' end' 143 | ' else' 144 | ' Result := True;' 145 | 'end;' 146 | '' 147 | 'function TSDKClient.GetAPI(const APath: String): TBytesStream;' 148 | 'var' 149 | ' EndPoint: TBackendEndpoint;' 150 | 'begin' 151 | ' Result := TBytesStream.Create;' 152 | ' EndPoint := TBackendEndpoint.Create(Self);' 153 | ' EndPoint.Provider := FEMSProvider;' 154 | ' EndPoint.Auth := FBackendAuth;' 155 | ' try' 156 | ' EndPoint.Resource := APath;' 157 | ' EndPoint.Method := TRESTRequestMethod.rmGET;' 158 | ' EndPoint.Execute;' 159 | ' Result := TBytesStream.Create(EndPoint.Response.RawBytes);' 160 | ' if EndPoint.Response.StatusCode>=400 then' 161 | ' begin' 162 | ' raise Exception.Create(EndPoint.Response.StatusText);' 163 | ' end;' 164 | ' finally' 165 | ' EndPoint.DisposeOf;' 166 | ' end;' 167 | 'end;' 168 | '' 169 | 170 | 'function TSDKClient.PostAPI(const APath: String; ABytesStream: T' + 171 | 'BytesStream): TBytesStream;' 172 | 'var' 173 | ' EndPoint: TBackendEndpoint;' 174 | 'begin' 175 | ' EndPoint := TBackendEndpoint.Create(Self);' 176 | ' EndPoint.Provider := FEMSProvider;' 177 | ' EndPoint.Auth := FBackendAuth;' 178 | ' try' 179 | ' EndPoint.Resource := APath;' 180 | ' EndPoint.Method := TRESTRequestMethod.rmPOST;' 181 | 182 | ' EndPoint.AddBody(ABytesStream,TRESTContentType.ctAPPLICATION' + 183 | '_JSON);' 184 | ' EndPoint.Execute;' 185 | ' Result := TBytesStream.Create(EndPoint.Response.RawBytes);' 186 | ' if EndPoint.Response.StatusCode>=400 then' 187 | ' begin' 188 | ' raise Exception.Create(EndPoint.Response.StatusText);' 189 | ' end;' 190 | ' finally' 191 | ' EndPoint.DisposeOf;' 192 | ' end;' 193 | 'end;' 194 | '' 195 | 196 | 'function TSDKClient.DeleteAPI(const APath: String): TBytesStream' + 197 | ';' 198 | 'var' 199 | ' EndPoint: TBackendEndpoint;' 200 | 'begin' 201 | ' Result := TBytesStream.Create;' 202 | ' EndPoint := TBackendEndpoint.Create(Self);' 203 | ' EndPoint.Provider := FEMSProvider;' 204 | ' EndPoint.Auth := FBackendAuth;' 205 | ' try' 206 | ' EndPoint.Resource := APath;' 207 | ' EndPoint.Method := TRESTRequestMethod.rmDELETE;' 208 | ' EndPoint.Execute;' 209 | ' Result := TBytesStream.Create(EndPoint.Response.RawBytes);' 210 | ' if EndPoint.Response.StatusCode>=400 then' 211 | ' begin' 212 | ' raise Exception.Create(EndPoint.Response.StatusText);' 213 | ' end;' 214 | ' finally' 215 | ' EndPoint.DisposeOf;' 216 | ' end;' 217 | 'end;' 218 | '' 219 | '{#SDKFunctionList#}' 220 | '' 221 | 'end.') 222 | Align = Bottom 223 | Position.Y = 308.000000000000000000 224 | Size.Width = 531.000000000000000000 225 | Size.Height = 143.000000000000000000 226 | Size.PlatformDefault = False 227 | TabOrder = 0 228 | Viewport.Width = 511.000000000000000000 229 | Viewport.Height = 139.000000000000000000 230 | end 231 | object PostFunctionMemo: TMemo 232 | Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] 233 | DataDetectorTypes = [] 234 | Lines.Strings = ( 235 | 'function TSDKClient.{#EndPoint#}{#ParamString#}: TBytesStream;' 236 | 'begin' 237 | ' if Self.LoginAPI(FUserName,FPassword) then' 238 | 239 | ' Result := Self.PostAPI('#39'/{#RootSegment#}/{#EndPoint#}/{#Quer' + 240 | 'yString#},ABytesStream);' 241 | 'end;') 242 | Align = Bottom 243 | Position.Y = 132.000000000000000000 244 | Size.Width = 531.000000000000000000 245 | Size.Height = 88.000000000000000000 246 | Size.PlatformDefault = False 247 | TabOrder = 2 248 | Viewport.Width = 527.000000000000000000 249 | Viewport.Height = 84.000000000000000000 250 | end 251 | object DeleteFunctionMemo: TMemo 252 | Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] 253 | DataDetectorTypes = [] 254 | Lines.Strings = ( 255 | 'function TSDKClient.{#EndPoint#}{#ParamString#}: TBytesStream;' 256 | 'begin' 257 | ' if Self.LoginAPI(FUserName,FPassword) then' 258 | 259 | ' Result := Self.DeleteAPI('#39'/{#RootSegment#}/{#EndPoint#}/{#Q' + 260 | 'ueryString#});' 261 | 'end;') 262 | Align = Bottom 263 | Position.Y = 220.000000000000000000 264 | Size.Width = 531.000000000000000000 265 | Size.Height = 88.000000000000000000 266 | Size.PlatformDefault = False 267 | TabOrder = 1 268 | Viewport.Width = 527.000000000000000000 269 | Viewport.Height = 84.000000000000000000 270 | end 271 | object ActionList1: TActionList 272 | Left = 80 273 | Top = 96 274 | object GenerateSDKAction: TAction 275 | Text = 'GenerateSDKAction' 276 | end 277 | end 278 | end 279 | -------------------------------------------------------------------------------- /uDelphiSDK.pas: -------------------------------------------------------------------------------- 1 | unit uDelphiSDK; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 7 | FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls, 8 | System.Actions, FMX.ActnList, FMX.Controls.Presentation, FMX.ScrollBox, 9 | FMX.Memo, FireDAC.Comp.DataSet, StrUtils, System.IOUtils; 10 | 11 | type 12 | TDelphiSDKFrame = class(TFrame) 13 | HeaderFunctionMemo: TMemo; 14 | GetFunctionMemo: TMemo; 15 | SDKMemo: TMemo; 16 | ActionList1: TActionList; 17 | GenerateSDKAction: TAction; 18 | PostFunctionMemo: TMemo; 19 | DeleteFunctionMemo: TMemo; 20 | private 21 | { Private declarations } 22 | Host,Port: String; 23 | EndPointTable: TFDDataSet; 24 | FDMemTableInfo: TFDDataSet; 25 | function GetQueryStringList(ADataSet: TFDDataSet): String; 26 | public 27 | { Public declarations } 28 | procedure Initialize(AHost,APort: String; ADataSet: TFDDataSet; AInfoDataSet: TFDDataSet); 29 | function GenerateSDK(AFileName: String): String; 30 | end; 31 | 32 | implementation 33 | 34 | {$R *.fmx} 35 | 36 | uses 37 | uMainForm; 38 | 39 | function TDelphiSDKFrame.GetQueryStringList(ADataSet: TFDDataSet): String; 40 | begin 41 | Result := MainForm.GetQueryStringList(ADataSet); 42 | end; 43 | 44 | procedure TDelphiSDKFrame.Initialize(AHost,APort: String; ADataSet: TFDDataSet; AInfoDataSet: TFDDataSet); 45 | begin 46 | Host := AHost; 47 | Port := APort; 48 | EndPointTable := ADataSet; 49 | FDMemTableInfo := AInfoDataSet; 50 | end; 51 | 52 | function TDelphiSDKFrame.GenerateSDK(AFileName: String): String; 53 | var 54 | I: Integer; 55 | SL: TStringList; 56 | QueryString, ParamString: String; 57 | CompCount: Integer; 58 | FunctionList, HeaderList: TStringList; 59 | ATemplatePath: String; 60 | AOutputPath: String; 61 | begin 62 | 63 | CompCount := 1; 64 | EndPointTable.DisableControls; 65 | EndPointTable.First; 66 | FunctionList := TStringList.Create; 67 | HeaderList := TStringList.Create; 68 | SL := TStringList.Create; 69 | SL.StrictDelimiter := True; 70 | while not EndPointTable.EOF do 71 | begin 72 | QueryString := ''; 73 | ParamString := ''; 74 | SL.Clear; 75 | SL.CommaText := GetQueryStringList(EndPointTable) + IfThen((EndPointTable.FieldByName('Params').AsString<>'') OR (EndPointTable.FieldByName('Macros').AsString<>''),',format','format'); 76 | 77 | for I := 0 to SL.Count-1 do 78 | begin 79 | if SL[I]='format' then 80 | begin 81 | QueryString := QueryString + '''+IfThen(Aformat<>'''','''+ IfThen(I=0,'?','&') + SL[I] + '=''+A' + SL[I] + IfThen(I=SL.Count-1,'','+''') + ','''')'; 82 | end 83 | else 84 | QueryString := QueryString + IfThen(I=0,'?','&') + SL[I] + '=''+A' + SL[I] + IfThen(I=SL.Count-1,'','+'''); 85 | ParamString := ParamString + IfThen(I=0,'','; ') + 'A' + SL[I] + ': String' + IfThen(SL[I]='format',' = ''''',''); 86 | end; 87 | if EndPointTable.FieldByName('RequestType').AsString='POST' then 88 | begin 89 | ParamString := '('+ParamString+IfThen(ParamString<>'',';','')+' ABytesStream: TBytesStream = nil'+')'; 90 | end 91 | else 92 | begin 93 | ParamString := '('+ParamString+')'; 94 | end; 95 | SL.Clear; 96 | 97 | if EndPointTable.FieldByName('RequestType').AsString='GET' then 98 | begin 99 | SL.Append(GetFunctionMemo.Lines.Text 100 | .Replace('{#EndPoint#}',EndPointTable.FieldByName('EndPoint').AsString,[rfReplaceAll]) 101 | .Replace('{#RootSegment#}',FDMemTableInfo.FieldByName('RootSegment').AsString,[rfReplaceAll]) 102 | .Replace('{#ParamString#}',ParamString,[rfReplaceAll]) 103 | .Replace('{#QueryString#}',QueryString + IfThen(QueryString='','''',''),[rfReplaceAll])); 104 | end 105 | else 106 | if EndPointTable.FieldByName('RequestType').AsString='POST' then 107 | begin 108 | SL.Append(PostFunctionMemo.Lines.Text 109 | .Replace('{#EndPoint#}',EndPointTable.FieldByName('EndPoint').AsString,[rfReplaceAll]) 110 | .Replace('{#RootSegment#}',FDMemTableInfo.FieldByName('RootSegment').AsString,[rfReplaceAll]) 111 | .Replace('{#ParamString#}',ParamString,[rfReplaceAll]) 112 | .Replace('{#QueryString#}',QueryString + IfThen(QueryString='','''',''),[rfReplaceAll])); 113 | end 114 | else 115 | if EndPointTable.FieldByName('RequestType').AsString='DELETE' then 116 | begin 117 | SL.Append(DeleteFunctionMemo.Lines.Text 118 | .Replace('{#EndPoint#}',EndPointTable.FieldByName('EndPoint').AsString,[rfReplaceAll]) 119 | .Replace('{#RootSegment#}',FDMemTableInfo.FieldByName('RootSegment').AsString,[rfReplaceAll]) 120 | .Replace('{#ParamString#}',ParamString,[rfReplaceAll]) 121 | .Replace('{#QueryString#}',QueryString + IfThen(QueryString='','''',''),[rfReplaceAll])); 122 | end; 123 | 124 | 125 | FunctionList.Append(SL.Text); 126 | 127 | SL.Clear; 128 | 129 | SL.Append(HeaderFunctionMemo.Lines.Text.Replace('{#EndPoint#}',EndPointTable.FieldByName('EndPoint').AsString,[rfReplaceAll]).Replace('{#ParamString#}',ParamString,[])); 130 | 131 | HeaderList.Append(SL.Text); 132 | 133 | EndPointTable.Next; 134 | Inc(CompCount); 135 | end; 136 | SL.Free; 137 | EndPointTable.EnableControls; 138 | 139 | ATemplatePath := TPath.Combine(TPath.Combine(TPath.Combine(ExtractFilePath(ParamStr(0)),TemplatePath),SDKPath),OPLangPath); 140 | AOutputPath := TPath.Combine(ExtractFilePath(ParamStr(0)),OutputPath); 141 | if TDirectory.Exists(AOutputPath)=False then 142 | begin 143 | TDirectory.CreateDirectory(AOutputPath); 144 | end; 145 | 146 | SL := TStringList.Create; 147 | if TFile.Exists(TPath.Combine(ATemplatePath,SDKTemplateFile)) then 148 | SL.LoadFromFile(TPath.Combine(ATemplatePath,SDKTemplateFile)) 149 | else 150 | SL.Text := SDKMemo.Lines.Text; 151 | SL.Text := SL.Text.Replace('sdktemplatefile',AFileName.Replace(ExtractFileExt(AFileName),'',[rfIgnoreCase])); 152 | SL.Text := SL.Text.Replace('{#Filename#}',AFileName.Replace(ExtractFileExt(AFileName),'',[rfIgnoreCase])); 153 | SL.Text := SL.Text.Replace('{#URLHost#}',Host); 154 | SL.Text := SL.Text.Replace('{#URLPort#}',Port); 155 | SL.Text := SL.Text.Replace('{#Username#}',''); 156 | SL.Text := SL.Text.Replace('{#Password#}',''); 157 | SL.Text := SL.Text.Replace('{#SDKFunctionList#}',FunctionList.Text); 158 | SL.Text := SL.Text.Replace('{#SDKHeaderList#}',HeaderList.Text); 159 | SL.SaveToFile(TPath.Combine(AOutputPath,AFileName)); 160 | 161 | Result := SL.Text; 162 | 163 | SL.Free; 164 | FunctionList.Free; 165 | HeaderList.Free; 166 | 167 | end; 168 | 169 | end. 170 | -------------------------------------------------------------------------------- /uDelphiSDK.vlb: -------------------------------------------------------------------------------- 1 | [MainForm.EndPointTable] 2 | Visible=False 3 | 4 | [MainForm.RequestTypeMemTable] 5 | Visible=False 6 | 7 | [MainForm.TableNameMemTable] 8 | Visible=False 9 | 10 | [MainForm.GroupsMemTable] 11 | Visible=False 12 | 13 | [MainForm.FDMemTableAction] 14 | Visible=False 15 | 16 | [MainForm.FDMemTableInfo] 17 | Visible=False 18 | 19 | -------------------------------------------------------------------------------- /uOpenAPI.dfm: -------------------------------------------------------------------------------- 1 | object OpenAPIDM: TOpenAPIDM 2 | OldCreateOrder = False 3 | Height = 312 4 | Width = 376 5 | end 6 | -------------------------------------------------------------------------------- /uOpenAPI.pas: -------------------------------------------------------------------------------- 1 | unit uOpenAPI; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Classes, System.JSON, FireDAC.Stan.Intf, 7 | FireDAC.Stan.Option, FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, 8 | FireDAC.Phys.Intf, FireDAC.DApt.Intf, Data.DB, FireDAC.Comp.DataSet, 9 | FireDAC.Comp.Client; 10 | 11 | type 12 | TOpenAPIDM = class(TDataModule) 13 | private 14 | { Private declarations } 15 | public 16 | { Public declarations } 17 | function CreateDoc(const AHost, APort: String; ADataSet, AInfoDataSet: TFDDataSet): String; 18 | end; 19 | 20 | var 21 | OpenAPIDM: TOpenAPIDM; 22 | 23 | implementation 24 | 25 | {%CLASSGROUP 'FMX.Controls.TControl'} 26 | 27 | {$R *.dfm} 28 | 29 | uses 30 | StrUtils, 31 | REST.JSON, 32 | Swag.Common.Types, 33 | Swag.Doc.Path, 34 | Swag.Doc.Path.Operation, 35 | Swag.Doc.Path.Operation.RequestParameter, 36 | Swag.Doc.Path.Operation.Response, 37 | Swag.Doc.Path.Operation.ResponseHeaders, 38 | Swag.Doc.Definition, 39 | Swag.Doc; 40 | 41 | function CreateJsonSomeSubType: TJsonObject; 42 | var 43 | vJsonType: TJsonObject; 44 | vJsonProperities: TJsonObject; 45 | begin 46 | Result := TJsonObject.Create; 47 | 48 | Result.AddPair('type','object'); 49 | 50 | vJsonType := TJsonObject.Create; 51 | vJsonType.AddPair('type', 'string'); 52 | 53 | vJsonProperities := TJsonObject.Create; 54 | vJsonProperities.AddPair('id', vJsonType); 55 | 56 | Result.AddPair('properties', vJsonProperities); 57 | end; 58 | 59 | function CreateJsonSomeType(pJsonObjectSubType: TJsonObject): TJsonObject; 60 | var 61 | vJsonId: TJsonObject; 62 | vJsonCost: TJsonObject; 63 | vJsonProperities: TJsonObject; 64 | begin 65 | Result := TJsonObject.Create; 66 | Result.AddPair('type', 'object'); 67 | 68 | vJsonId := TJsonObject.Create; 69 | vJsonId.AddPair('type', 'integer'); 70 | vJsonId.AddPair('format', 'int64'); 71 | 72 | vJsonProperities := TJsonObject.Create; 73 | vJsonProperities.AddPair('id', vJsonId); 74 | 75 | vJsonProperities.AddPair('subType', pJsonObjectSubType); 76 | 77 | vJsonCost := TJsonObject.Create; 78 | vJsonCost.AddPair('type', 'string'); 79 | vJsonCost.AddPair('format', 'decimel'); 80 | vJsonCost.AddPair('multipleOf', TJsonNumber.Create(0.01)); 81 | vJsonCost.AddPair('minimum', TJsonNumber.Create(-9999999999.99)); 82 | vJsonCost.AddPair('maximum', TJsonNumber.Create(9999999999.99)); 83 | vJsonCost.AddPair('title', 'Total Cost'); 84 | vJsonCost.AddPair('description', 'Total Cost'); 85 | vJsonCost.AddPair('example', TJsonNumber.Create(9999999999.99)); 86 | vJsonProperities.AddPair('cost', vJsonCost); 87 | 88 | Result.AddPair('properties', vJsonProperities); 89 | end; 90 | 91 | function TOpenAPIDM.CreateDoc(const AHost, APort: String; ADataSet,AInfoDataSet: TFDDataSet): String; 92 | var 93 | I: Integer; 94 | SL: TStringList; 95 | QueryString: String; 96 | vSwagDoc: TSwagDoc; 97 | vPath: TSwagPath; 98 | vOperation: TSwagPathOperation; 99 | vParam: TSwagRequestParameter; 100 | vResponse: TSwagResponse; 101 | vDefinitionSomeType: TSwagDefinition; 102 | vDefinitionResponseSomeType: TSwagDefinition; 103 | vDefinitionSomeSubType: TSwagDefinition; 104 | vResponseHeader: TSwagHeaders; 105 | begin 106 | SL := TStringList.Create; 107 | SL.StrictDelimiter := True; 108 | 109 | vSwagDoc := TSwagDoc.Create; 110 | try 111 | vSwagDoc.Info.Title := AInfoDataSet.FieldByName('Title').AsString; 112 | vSwagDoc.Info.Version := AInfoDataSet.FieldByName('Version').AsString; 113 | vSwagDoc.Info.TermsOfService := AInfoDataSet.FieldByName('TermsOfService').AsString; 114 | vSwagDoc.Info.Description := AInfoDataSet.FieldByName('Description').AsString; 115 | vSwagDoc.Info.Contact.Name := AInfoDataSet.FieldByName('ContactName').AsString; 116 | vSwagDoc.Info.Contact.Email := AInfoDataSet.FieldByName('ContactEmail').AsString; 117 | vSwagDoc.Info.Contact.Url := AInfoDataSet.FieldByName('ContactURL').AsString; 118 | vSwagDoc.Info.License.Name := AInfoDataSet.FieldByName('LicenseName').AsString; 119 | vSwagDoc.Info.License.Url := AInfoDataSet.FieldByName('LicenseURL').AsString; 120 | 121 | vSwagDoc.Host := AHost + ':' + APort; 122 | vSwagDoc.BasePath := '/'+AInfoDataSet.FieldByName('RootSegment').AsString; 123 | 124 | vSwagDoc.Consumes.Add('application/json'); 125 | 126 | vSwagDoc.Produces.Add('application/xml'); 127 | vSwagDoc.Produces.Add('application/json'); 128 | vSwagDoc.Produces.Add('application/octet-stream'); 129 | vSwagDoc.Produces.Add('text/csv'); 130 | 131 | vSwagDoc.Schemes := [tpsHttp,tpsHttps]; 132 | 133 | { vDefinitionSomeSubType := TSwagDefinition.Create; 134 | vDefinitionSomeSubType.Name := 'SomeSubType'; 135 | vDefinitionSomeSubType.JsonSchema := CreateJsonSomeSubType; 136 | vSwagDoc.Definitions.Add(vDefinitionSomeSubType); 137 | 138 | vDefinitionSomeType := TSwagDefinition.Create; 139 | vDefinitionSomeType.Name := 'SomeType'; 140 | vDefinitionSomeType.JsonSchema := CreateJsonSomeType(vDefinitionSomeSubType.GenerateJsonRefDefinition); 141 | vSwagDoc.Definitions.Add(vDefinitionSomeType); 142 | } 143 | 144 | ADataSet.First; 145 | 146 | while not ADataSet.Eof do 147 | begin 148 | 149 | SL.Clear; 150 | SL.CommaText := ADataSet.FieldByName('Params').AsString; 151 | 152 | QueryString := ''; 153 | for I := 0 to SL.Count-1 do 154 | begin 155 | QueryString := QueryString + IfThen(I=0,'?','&') + SL[I] + '={' + SL[I] + '}'; 156 | end; 157 | 158 | //ADataSet.FieldByName('RequestType').AsString + ' '; 159 | 160 | 161 | vPath := TSwagPath.Create; 162 | vPath.Uri := ADataSet.FieldByName('EndPoint').AsString + '/' + IfThen(QueryString<>'',QueryString,''); 163 | 164 | vOperation := TSwagPathOperation.Create; 165 | if ADataSet.FieldByName('RequestType').AsString='GET' then 166 | begin 167 | vOperation.Operation := ohvGet; 168 | vOperation.OperationId := 'RequestData'; 169 | vOperation.Description := 'Requests some data'; 170 | end 171 | else 172 | if ADataSet.FieldByName('RequestType').AsString='POST' then 173 | begin 174 | vOperation.Operation := ohvPost; 175 | vOperation.OperationId := 'AddOrUpdateData'; 176 | vOperation.Description := 'Add or update some data'; 177 | end 178 | else 179 | if ADataSet.FieldByName('RequestType').AsString='DELETE' then 180 | begin 181 | vOperation.Operation := ohvDelete; 182 | vOperation.OperationId := 'DeleteData'; 183 | vOperation.Description := 'Delete some data'; 184 | end; 185 | 186 | 187 | {vParam := TSwagRequestParameter.Create; 188 | vParam.Name := 'param1'; 189 | vParam.InLocation := rpiPath; 190 | vParam.Description := 'A param required'; 191 | vParam.Required := True; 192 | vParam.TypeParameter := 'string'; 193 | vOperation.Parameters.Add(vParam); 194 | } 195 | 196 | vParam := TSwagRequestParameter.Create; 197 | vParam.Name := 'X-Embarcadero-Session-Token'; 198 | vParam.InLocation := rpiHeader; 199 | vParam.Description := 'EMS User Authentication'; 200 | vParam.Required := False; 201 | vParam.TypeParameter := 'string'; 202 | vOperation.Parameters.Add(vParam); 203 | 204 | vParam := TSwagRequestParameter.Create; 205 | vParam.Name := 'X-Embarcadero-Tenant-Id'; 206 | vParam.InLocation := rpiHeader; 207 | vParam.Description := 'EMS Tenant Id'; 208 | vParam.Required := False; 209 | vParam.TypeParameter := 'string'; 210 | vOperation.Parameters.Add(vParam); 211 | 212 | vParam := TSwagRequestParameter.Create; 213 | vParam.Name := 'X-Embarcadero-Tenant-Secret'; 214 | vParam.InLocation := rpiHeader; 215 | vParam.Description := 'EMS Tenant Secret'; 216 | vParam.Required := False; 217 | vParam.TypeParameter := 'string'; 218 | vOperation.Parameters.Add(vParam); 219 | 220 | for I := 0 to SL.Count-1 do 221 | begin 222 | vParam := TSwagRequestParameter.Create; 223 | vParam.Name := SL[I]; 224 | vParam.InLocation := rpiQuery; 225 | vParam.Description := 'A param called '+SL[I]; 226 | vParam.Required := True; 227 | vParam.TypeParameter := 'string'; 228 | vOperation.Parameters.Add(vParam); 229 | end; 230 | 231 | if ADataSet.FieldByName('RequestType').AsString='POST' then 232 | begin 233 | vParam := TSwagRequestParameter.Create; 234 | vParam.Name := 'Body'; 235 | vParam.InLocation := rpiBody; 236 | vParam.Description := 'Post Body'; 237 | vParam.Required := False; 238 | vParam.TypeParameter := 'string'; 239 | vOperation.Parameters.Add(vParam); 240 | end; 241 | 242 | 243 | { 244 | vParam := TSwagRequestParameter.Create; 245 | vParam.Name := 'param3'; 246 | vParam.InLocation := rpiBody; 247 | vParam.Required := True; 248 | vParam.Schema.Name := 'SomeType'; 249 | vOperation.Parameters.Add(vParam); 250 | } 251 | 252 | vResponse := TSwagResponse.Create; 253 | vResponse.StatusCode := '200'; 254 | vResponse.Description := 'Successfully retrieved data'; 255 | //vResponse.Schema.Name := 'SomeType'; 256 | vOperation.Responses.Add('200', vResponse); 257 | 258 | {vResponseHeader := TSwagHeaders.Create; 259 | vResponseHeader.Name := 'X-Rate-Limit-Limit'; 260 | vResponseHeader.Description := 'The number of allowed requests in the current period'; 261 | vResponseHeader.ValueType := 'integer'; 262 | vResponse.Headers.Add(vResponseHeader); 263 | } 264 | 265 | vResponse := TSwagResponse.Create; 266 | vResponse.StatusCode := 'default'; 267 | vResponse.Description := 'Error occured'; 268 | 269 | vOperation.Responses.Add('default',vResponse); 270 | 271 | vOperation.Tags.Add(ADataSet.FieldByName('EndPoint').AsString); 272 | 273 | vPath.Operations.Add(vOperation); 274 | vSwagDoc.Paths.Add(vPath); 275 | 276 | ADataSet.Next; 277 | end; 278 | 279 | vSwagDoc.GenerateSwaggerJson; 280 | Result := REST.Json.TJson.Format(vSwagDoc.SwaggerJson); 281 | finally 282 | FreeAndNil(vSwagDoc); 283 | end; 284 | end; 285 | 286 | end. 287 | -------------------------------------------------------------------------------- /uPicker.fmx: -------------------------------------------------------------------------------- 1 | object PickerForm: TPickerForm 2 | Left = 0 3 | Top = 0 4 | Caption = 'Picker' 5 | ClientHeight = 480 6 | ClientWidth = 640 7 | FormFactor.Width = 320 8 | FormFactor.Height = 480 9 | FormFactor.Devices = [Desktop] 10 | OnClose = FormClose 11 | DesignerMasterStyle = 0 12 | object ToolBar1: TToolBar 13 | Size.Width = 640.000000000000000000 14 | Size.Height = 40.000000000000000000 15 | Size.PlatformDefault = False 16 | TabOrder = 0 17 | object HeaderText: TText 18 | Align = Contents 19 | Size.Width = 640.000000000000000000 20 | Size.Height = 40.000000000000000000 21 | Size.PlatformDefault = False 22 | end 23 | object BackBTN: TButton 24 | Align = Left 25 | Size.Width = 97.000000000000000000 26 | Size.Height = 40.000000000000000000 27 | Size.PlatformDefault = False 28 | StyleLookup = 'backtoolbutton' 29 | TabOrder = 0 30 | Text = 'Back' 31 | OnClick = BackBTNClick 32 | end 33 | object OtherBTN: TButton 34 | Align = Right 35 | Position.X = 560.000000000000000000 36 | Size.Width = 80.000000000000000000 37 | Size.Height = 40.000000000000000000 38 | Size.PlatformDefault = False 39 | StyleLookup = 'toolbuttonright' 40 | TabOrder = 1 41 | Text = 'Other' 42 | OnClick = OtherBTNClick 43 | end 44 | end 45 | object TabControl1: TTabControl 46 | Align = Client 47 | Size.Width = 640.000000000000000000 48 | Size.Height = 440.000000000000000000 49 | Size.PlatformDefault = False 50 | TabIndex = 0 51 | TabOrder = 5 52 | TabPosition = None 53 | Sizes = ( 54 | 640s 55 | 440s 56 | 640s 57 | 440s) 58 | object SelectTab: TTabItem 59 | CustomIcon = < 60 | item 61 | end> 62 | IsSelected = True 63 | Size.Width = 8.000000000000000000 64 | Size.Height = 8.000000000000000000 65 | Size.PlatformDefault = False 66 | StyleLookup = '' 67 | TabOrder = 0 68 | Text = 'SelectTab' 69 | ExplicitSize.cx = 8.000000000000000000 70 | ExplicitSize.cy = 8.000000000000000000 71 | object PickerLV: TListView 72 | ItemAppearanceClassName = 'TListItemAppearance' 73 | ItemEditAppearanceClassName = 'TListItemShowCheckAppearance' 74 | HeaderAppearanceClassName = 'TListHeaderObjects' 75 | FooterAppearanceClassName = 'TListHeaderObjects' 76 | AlternatingColors = True 77 | Align = Client 78 | Size.Width = 640.000000000000000000 79 | Size.Height = 440.000000000000000000 80 | Size.PlatformDefault = False 81 | TabOrder = 0 82 | CanSwipeDelete = False 83 | OnItemClickEx = PickerLVItemClickEx 84 | SearchVisible = True 85 | end 86 | end 87 | object OtherTab: TTabItem 88 | CustomIcon = < 89 | item 90 | end> 91 | IsSelected = False 92 | Size.Width = 8.000000000000000000 93 | Size.Height = 8.000000000000000000 94 | Size.PlatformDefault = False 95 | StyleLookup = '' 96 | TabOrder = 0 97 | Text = 'OtherTab' 98 | ExplicitSize.cx = 8.000000000000000000 99 | ExplicitSize.cy = 8.000000000000000000 100 | object OtherLayout: TLayout 101 | Align = Top 102 | Size.Width = 640.000000000000000000 103 | Size.Height = 50.000000000000000000 104 | Size.PlatformDefault = False 105 | TabOrder = 6 106 | object Layout12: TLayout 107 | Align = Left 108 | Size.Width = 169.000000000000000000 109 | Size.Height = 50.000000000000000000 110 | Size.PlatformDefault = False 111 | TabOrder = 0 112 | object Text6: TText 113 | Align = Client 114 | Size.Width = 169.000000000000000000 115 | Size.Height = 50.000000000000000000 116 | Size.PlatformDefault = False 117 | Text = 'Other' 118 | TextSettings.Font.StyleExt = {00070000000000000004000000} 119 | end 120 | end 121 | object OtherEdit: TEdit 122 | Touch.InteractiveGestures = [LongTap, DoubleTap] 123 | Align = Client 124 | TabOrder = 1 125 | Margins.Left = 10.000000000000000000 126 | Margins.Top = 10.000000000000000000 127 | Margins.Right = 10.000000000000000000 128 | Margins.Bottom = 10.000000000000000000 129 | Size.Width = 371.000000000000000000 130 | Size.Height = 30.000000000000000000 131 | Size.PlatformDefault = False 132 | object ClearEditButton2: TClearEditButton 133 | CanFocus = False 134 | Cursor = crArrow 135 | Size.Width = 28.000000000000000000 136 | Size.Height = 26.000000000000000000 137 | Size.PlatformDefault = False 138 | TabOrder = 0 139 | end 140 | end 141 | object SaveBTN: TButton 142 | Align = Right 143 | Position.X = 560.000000000000000000 144 | Size.Width = 80.000000000000000000 145 | Size.Height = 50.000000000000000000 146 | Size.PlatformDefault = False 147 | TabOrder = 2 148 | Text = 'Save' 149 | OnClick = SaveBTNClick 150 | end 151 | end 152 | end 153 | end 154 | object BindSourceDBTableName: TBindSourceDB 155 | DataSet = MainForm.TableNameMemTable 156 | ScopeMappings = <> 157 | Left = 336 158 | Top = 112 159 | end 160 | object BindingsListCB: TBindingsList 161 | Methods = <> 162 | OutputConverters = <> 163 | Left = 44 164 | Top = 45 165 | object LinkFillControlToField: TLinkFillControlToField 166 | Category = 'Quick Bindings' 167 | Control = PickerLV 168 | Track = False 169 | FillDataSource = BindSourceDBTableName 170 | FillDisplayFieldName = 'TableName' 171 | AutoFill = True 172 | FillExpressions = <> 173 | FillHeaderExpressions = <> 174 | FillBreakGroups = <> 175 | end 176 | object SCBindLink: TBindLink 177 | Category = 'Links' 178 | SourceMemberName = 'Signatures' 179 | SourceComponent = BindSourceDBGroups 180 | ParseExpressions = < 181 | item 182 | ControlExpression = 'Lines.Text' 183 | SourceExpression = 'AsString' 184 | end> 185 | FormatExpressions = < 186 | item 187 | ControlExpression = 'Lines.Text' 188 | SourceExpression = 'AsString' 189 | end> 190 | ClearExpressions = <> 191 | Track = False 192 | end 193 | end 194 | object BindSourceDBRequestType: TBindSourceDB 195 | DataSet = MainForm.RequestTypeMemTable 196 | ScopeMappings = <> 197 | Left = 208 198 | Top = 104 199 | end 200 | object BindSourceDBGroups: TBindSourceDB 201 | DataSet = MainForm.GroupsMemTable 202 | ScopeMappings = <> 203 | Left = 72 204 | Top = 170 205 | end 206 | object BindSourceDBAction: TBindSourceDB 207 | DataSet = MainForm.FDMemTableAction 208 | ScopeMappings = <> 209 | Left = 256 210 | Top = 216 211 | end 212 | end 213 | -------------------------------------------------------------------------------- /uPicker.pas: -------------------------------------------------------------------------------- 1 | unit uPicker; 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, 8 | FMX.ListView.Types, FMX.ListView.Appearances, FMX.ListView.Adapters.Base, 9 | System.Rtti, System.Bindings.Outputs, Fmx.Bind.Editors, Data.Bind.EngExt, 10 | Fmx.Bind.DBEngExt, Data.Bind.Components, Data.Bind.DBScope, FMX.ListView, 11 | FMX.StdCtrls, FMX.Controls.Presentation, Data.DB, FMX.Objects, FireDAC.Comp.Client, 12 | FMX.Edit, FMX.Layouts, FMX.TabControl, FireDAC.Stan.Intf, FireDAC.Stan.Option, 13 | FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf, 14 | FireDAC.DApt.Intf, FireDAC.Comp.DataSet, FMX.SearchBox, 15 | FireDAC.Stan.StorageBin, FMX.ScrollBox, FMX.Memo; 16 | 17 | type 18 | { TListViewHelper = class helper for TListView 19 | procedure SetSearchFilter2(const Filter: string); 20 | procedure SetFilterPredicate2(const Predicate: TPredicate); 21 | end; } 22 | 23 | TPickerForm = class(TForm) 24 | ToolBar1: TToolBar; 25 | BackBTN: TButton; 26 | PickerLV: TListView; 27 | BindSourceDBTableName: TBindSourceDB; 28 | BindingsListCB: TBindingsList; 29 | LinkFillControlToField: TLinkFillControlToField; 30 | BindSourceDBRequestType: TBindSourceDB; 31 | HeaderText: TText; 32 | OtherBTN: TButton; 33 | TabControl1: TTabControl; 34 | SelectTab: TTabItem; 35 | OtherTab: TTabItem; 36 | OtherLayout: TLayout; 37 | Layout12: TLayout; 38 | Text6: TText; 39 | OtherEdit: TEdit; 40 | ClearEditButton2: TClearEditButton; 41 | SaveBTN: TButton; 42 | SCBindLink: TBindLink; 43 | BindSourceDBGroups: TBindSourceDB; 44 | BindSourceDBAction: TBindSourceDB; 45 | procedure BackBTNClick(Sender: TObject); 46 | procedure PickerLVItemClickEx(const Sender: TObject; ItemIndex: Integer; 47 | const LocalClickPos: TPointF; const ItemObject: TListItemDrawable); 48 | procedure OtherBTNClick(Sender: TObject); 49 | procedure SaveBTNClick(Sender: TObject); 50 | procedure FormClose(Sender: TObject; var Action: TCloseAction); 51 | private 52 | { Private declarations } 53 | ResultField: String; 54 | BindSourceDBCBRemote: TBindSourceDB; 55 | public 56 | { Public declarations } 57 | procedure SetActionView; 58 | procedure SetRequestTypeView; 59 | procedure SetGroupsView; 60 | procedure SetTableNameView; 61 | procedure SaveValue(const S: String); 62 | procedure SetDataSetResult(const aField: String; BS: TBindSourceDB); 63 | procedure ClearSearchBox(Sender: TObject); 64 | end; 65 | 66 | var 67 | PickerForm: TPickerForm; 68 | 69 | implementation 70 | 71 | {$R *.fmx} 72 | 73 | uses 74 | uMainForm; 75 | 76 | procedure TPickerForm.ClearSearchBox(Sender: TObject); 77 | var 78 | I: Integer; 79 | SearchBox: TSearchBox; 80 | begin 81 | for I := 0 to TListView(Sender).Controls.Count-1 do 82 | if TListView(Sender).Controls[I].ClassType = TSearchBox then 83 | begin 84 | SearchBox := TSearchBox(TListView(Sender).Controls[I]); 85 | SearchBox.Text := ''; 86 | Break; 87 | end; 88 | end; 89 | 90 | procedure TPickerForm.FormClose(Sender: TObject; var Action: TCloseAction); 91 | begin 92 | BackBTNClick(Self); 93 | end; 94 | 95 | procedure TPickerForm.SetActionView; 96 | begin 97 | LinkFillControlToField.Active := False; 98 | LinkFillControlToField.FillDataSource := BindSourceDBAction; 99 | LinkFillControlToField.FillDisplayFieldName := 'Action'; 100 | LinkFillControlToField.Active := True; 101 | HeaderText.Text := 'Select Action'; 102 | OtherBTN.Visible := True; 103 | end; 104 | 105 | procedure TPickerForm.SetRequestTypeView; 106 | begin 107 | LinkFillControlToField.Active := False; 108 | LinkFillControlToField.FillDataSource := BindSourceDBRequestType; 109 | LinkFillControlToField.FillDisplayFieldName := 'RequestType'; 110 | LinkFillControlToField.Active := True; 111 | HeaderText.Text := 'Select Request Type'; 112 | OtherBTN.Visible := True; 113 | end; 114 | 115 | procedure TPickerForm.SetGroupsView; 116 | begin 117 | LinkFillControlToField.Active := False; 118 | LinkFillControlToField.FillDataSource := BindSourceDBGroups; 119 | LinkFillControlToField.FillDisplayFieldName := 'Group'; 120 | LinkFillControlToField.Active := True; 121 | HeaderText.Text := 'Select Group'; 122 | OtherBTN.Visible := True; 123 | end; 124 | 125 | procedure TPickerForm.SetTableNameView; 126 | begin 127 | LinkFillControlToField.Active := False; 128 | LinkFillControlToField.FillDataSource := BindSourceDBTableName; 129 | LinkFillControlToField.FillDisplayFieldName := 'TableName'; 130 | LinkFillControlToField.Active := True; 131 | HeaderText.Text := 'Select Table Name'; 132 | OtherBTN.Visible := True; 133 | end; 134 | 135 | 136 | procedure TPickerForm.SaveBTNClick(Sender: TObject); 137 | begin 138 | SaveValue(OtherEdit.Text); 139 | end; 140 | 141 | procedure TPickerForm.SetDataSetResult(const aField: String; BS: TBindSourceDB); 142 | begin 143 | BindSourceDBCBRemote := BS; 144 | ResultField := aField; 145 | end; 146 | 147 | procedure TPickerForm.BackBTNClick(Sender: TObject); 148 | begin 149 | OtherEdit.Text := ''; 150 | OtherBTN.Visible := True; 151 | ClearSearchBox(PickerLV); 152 | TabControl1.ActiveTab := SelectTab; 153 | PickerForm.Hide; 154 | MainForm.Show; 155 | end; 156 | 157 | procedure TPickerForm.OtherBTNClick(Sender: TObject); 158 | begin 159 | OtherBTN.Visible := False; 160 | TabControl1.ActiveTab := OtherTab; 161 | //ShowKeyboard(OtherEdit); 162 | end; 163 | 164 | procedure TPickerForm.SaveValue(const S: String); 165 | begin 166 | if BindSourceDBCBRemote.DataSet<>nil then 167 | begin 168 | if BindSourceDBCBRemote.DataSet.Active = False then 169 | begin 170 | BindSourceDBCBRemote.DataSet.Open; 171 | end; 172 | 173 | BindSourceDBCBRemote.DataSet.DisableControls; 174 | if not (BindSourceDBCBRemote.DataSet.State in [dsEdit, dsInsert]) then BindSourceDBCBRemote.DataSet.Edit; 175 | BindSourceDBCBRemote.DataSet.FieldByName(ResultField).AsString := S; 176 | BindSourceDBCBRemote.DataSet.Post; 177 | BindSourceDBCBRemote.DataSet.EnableControls; 178 | 179 | end; 180 | 181 | OtherEdit.Text := ''; 182 | OtherBTN.Visible := True; 183 | ClearSearchBox(PickerLV); 184 | TabControl1.ActiveTab := SelectTab; 185 | PickerForm.Hide; 186 | MainForm.Show; 187 | end; 188 | 189 | procedure TPickerForm.PickerLVItemClickEx(const Sender: TObject; 190 | ItemIndex: Integer; const LocalClickPos: TPointF; 191 | const ItemObject: TListItemDrawable); 192 | begin 193 | SaveValue(PickerLV.Items[ItemIndex].Text); 194 | end; 195 | 196 | end. 197 | -------------------------------------------------------------------------------- /uPicker.vlb: -------------------------------------------------------------------------------- 1 | [BackBTN] 2 | Coordinates=77,457,60,51 3 | 4 | [ToolBar1] 5 | Coordinates=446,457,58,33 6 | 7 | [DataForm.FDMemTableForm] 8 | Visible=False 9 | Coordinates=457,1565,155,33 10 | 11 | [DataForm.FDMemTableTabs] 12 | Visible=False 13 | Coordinates=674,53,153,33 14 | 15 | [DataForm.FDMemTablePeople] 16 | Visible=False 17 | Coordinates=674,1,163,33 18 | 19 | [DataForm.FDMemTableCustomer] 20 | Visible=False 21 | Coordinates=99,1699,177,33 22 | 23 | [DataForm.FDMemTableSOP] 24 | Visible=False 25 | Coordinates=457,1669,151,33 26 | 27 | [DataForm.FDMemTableLease] 28 | Visible=False 29 | Coordinates=457,1617,158,33 30 | 31 | [DataForm.FDMemTableHazards] 32 | Visible=False 33 | Coordinates=278,1699,169,33 34 | 35 | [BindingsListCB] 36 | Coordinates=145,197,91,33 37 | 38 | [PickerLV] 39 | Coordinates=226,10,89,141 40 | Visible=True 41 | 42 | [DataForm.BindSourceDBHazards] 43 | Coordinates=457,1157,178,195 44 | 45 | [DataForm.FDMemTableEC] 46 | Coordinates=457,1,143,231 47 | 48 | [DataForm.BindSourceDBJSAL] 49 | Coordinates=457,357,164,159 50 | 51 | [DataForm.FDMemTableYN] 52 | Coordinates=457,1477,143,69 53 | 54 | [DataForm.BindSourceDBJSAP] 55 | Coordinates=457,819,164,159 56 | 57 | [DataForm.BindSourceDBJSAF] 58 | Coordinates=255,80,164,1311 59 | 60 | [DataForm.BindSourceDBJSASOP] 61 | Coordinates=457,641,179,141 62 | 63 | [DataForm.BindSourceDBJSAC] 64 | Coordinates=457,997,165,141 65 | 66 | [DataForm.FDMemTablePos] 67 | Coordinates=457,1371,148,33 68 | Visible=False 69 | 70 | [DataForm.BindSourceDBJSAT] 71 | Coordinates=457,251,164,87 72 | 73 | [DataForm.FDMemTableLP] 74 | Coordinates=457,535,142,87 75 | 76 | [] 77 | Coordinates=457,1371,135,105 78 | Visible=True 79 | 80 | [OtherBTN] 81 | Coordinates=408,362,62,51 82 | 83 | [OtherTab] 84 | Coordinates=615,457,60,33 85 | 86 | [OtherEdit] 87 | Coordinates=163,457,61,51 88 | 89 | [SelectTab] 90 | Coordinates=235,534,62,33 91 | 92 | [SaveBTN] 93 | Coordinates=496,362,59,51 94 | 95 | [Text6] 96 | Coordinates=10,457,41,51 97 | 98 | [HeaderText] 99 | Coordinates=250,457,70,51 100 | 101 | [ClearEditButton2] 102 | Coordinates=111,534,98,33 103 | 104 | [TabControl1] 105 | Coordinates=346,457,74,33 106 | 107 | [Layout12] 108 | Coordinates=530,457,59,33 109 | 110 | [OtherLayout] 111 | Coordinates=10,534,75,33 112 | 113 | [DataForm.FDMemTableIcons] 114 | Coordinates=600,20,156,123 115 | 116 | [DataForm.FDMemTableHP] 117 | Coordinates=821,108,143,87 118 | 119 | [BindSourceDBGroups] 120 | Coordinates=10,231,137,87 121 | 122 | [BindSourceDBRequestType] 123 | Coordinates=173,231,165,87 124 | Visible=True 125 | 126 | [BindSourceDBTableName] 127 | Coordinates=395,28,157,87 128 | Visible=True 129 | 130 | [MainForm.EndPointTable] 131 | Visible=False 132 | Coordinates=242,195,138,33 133 | 134 | [MainForm.GroupsMemTable] 135 | Visible=False 136 | Coordinates=0,162,153,33 137 | 138 | [MainForm.RequestTypeMemTable] 139 | Visible=False 140 | Coordinates=810,1,181,33 141 | 142 | [MainForm.TableNameMemTable] 143 | Visible=False 144 | Coordinates=381,195,171,33 145 | 146 | [MainForm.BindSourceDBGroups] 147 | Coordinates=10,362,175,69 148 | 149 | [MainForm.BindSourceDBEndPoints] 150 | Coordinates=10,10,190,195 151 | 152 | [MainForm.BindSourceDBRequestTypes] 153 | Coordinates=364,231,209,69 154 | 155 | [MainForm.BindSourceDBTables] 156 | Coordinates=211,362,171,69 157 | 158 | -------------------------------------------------------------------------------- /uSelector.fmx: -------------------------------------------------------------------------------- 1 | object SelectorForm: TSelectorForm 2 | Left = 0 3 | Top = 0 4 | Caption = 'Selector' 5 | ClientHeight = 480 6 | ClientWidth = 640 7 | FormFactor.Width = 320 8 | FormFactor.Height = 480 9 | FormFactor.Devices = [Desktop] 10 | OnClose = FormClose 11 | OnShow = FormShow 12 | DesignerMasterStyle = 0 13 | object ToolBar1: TToolBar 14 | Size.Width = 640.000000000000000000 15 | Size.Height = 40.000000000000000000 16 | Size.PlatformDefault = False 17 | TabOrder = 0 18 | object HeaderText: TText 19 | Align = Contents 20 | Size.Width = 640.000000000000000000 21 | Size.Height = 40.000000000000000000 22 | Size.PlatformDefault = False 23 | end 24 | object BackBTN: TButton 25 | Align = Left 26 | Size.Width = 97.000000000000000000 27 | Size.Height = 40.000000000000000000 28 | Size.PlatformDefault = False 29 | StyleLookup = 'backtoolbutton' 30 | TabOrder = 0 31 | Text = 'Back' 32 | OnClick = BackBTNClick 33 | end 34 | object OtherBTN: TButton 35 | Align = Right 36 | Position.X = 560.000000000000000000 37 | Size.Width = 80.000000000000000000 38 | Size.Height = 40.000000000000000000 39 | Size.PlatformDefault = False 40 | StyleLookup = 'toolbuttonright' 41 | TabOrder = 1 42 | Text = 'Other' 43 | OnClick = OtherBTNClick 44 | end 45 | end 46 | object TabControl1: TTabControl 47 | Align = Client 48 | Size.Width = 640.000000000000000000 49 | Size.Height = 440.000000000000000000 50 | Size.PlatformDefault = False 51 | TabIndex = 0 52 | TabOrder = 4 53 | TabPosition = None 54 | Sizes = ( 55 | 640s 56 | 440s 57 | 640s 58 | 440s) 59 | object SelectTab: TTabItem 60 | CustomIcon = < 61 | item 62 | end> 63 | IsSelected = True 64 | Size.Width = 8.000000000000000000 65 | Size.Height = 8.000000000000000000 66 | Size.PlatformDefault = False 67 | StyleLookup = '' 68 | TabOrder = 0 69 | Text = 'SelectTab' 70 | ExplicitSize.cx = 8.000000000000000000 71 | ExplicitSize.cy = 8.000000000000000000 72 | object PickerLB: TListBox 73 | Align = Client 74 | Size.Width = 640.000000000000000000 75 | Size.Height = 400.000000000000000000 76 | Size.PlatformDefault = False 77 | TabOrder = 0 78 | DisableFocusEffect = True 79 | DefaultItemStyles.ItemStyle = '' 80 | DefaultItemStyles.GroupHeaderStyle = '' 81 | DefaultItemStyles.GroupFooterStyle = '' 82 | ShowCheckboxes = True 83 | Viewport.Width = 636.000000000000000000 84 | Viewport.Height = 396.000000000000000000 85 | end 86 | object Button1: TButton 87 | Align = Bottom 88 | Position.Y = 400.000000000000000000 89 | Size.Width = 640.000000000000000000 90 | Size.Height = 40.000000000000000000 91 | Size.PlatformDefault = False 92 | TabOrder = 1 93 | Text = '&Save' 94 | OnClick = Button1Click 95 | end 96 | end 97 | object OtherTab: TTabItem 98 | CustomIcon = < 99 | item 100 | end> 101 | IsSelected = False 102 | Size.Width = 8.000000000000000000 103 | Size.Height = 8.000000000000000000 104 | Size.PlatformDefault = False 105 | StyleLookup = '' 106 | TabOrder = 0 107 | Text = 'OtherTab' 108 | ExplicitSize.cx = 8.000000000000000000 109 | ExplicitSize.cy = 8.000000000000000000 110 | object OtherLayout: TLayout 111 | Align = Top 112 | Size.Width = 640.000000000000000000 113 | Size.Height = 50.000000000000000000 114 | Size.PlatformDefault = False 115 | TabOrder = 6 116 | object Layout12: TLayout 117 | Align = Left 118 | Size.Width = 169.000000000000000000 119 | Size.Height = 50.000000000000000000 120 | Size.PlatformDefault = False 121 | TabOrder = 0 122 | object Text6: TText 123 | Align = Client 124 | Size.Width = 169.000000000000000000 125 | Size.Height = 50.000000000000000000 126 | Size.PlatformDefault = False 127 | Text = 'Other' 128 | TextSettings.Font.StyleExt = {00070000000000000004000000} 129 | end 130 | end 131 | object OtherEdit: TEdit 132 | Touch.InteractiveGestures = [LongTap, DoubleTap] 133 | Align = Client 134 | TabOrder = 1 135 | Margins.Left = 10.000000000000000000 136 | Margins.Top = 10.000000000000000000 137 | Margins.Right = 10.000000000000000000 138 | Margins.Bottom = 10.000000000000000000 139 | Size.Width = 371.000000000000000000 140 | Size.Height = 30.000000000000000000 141 | Size.PlatformDefault = False 142 | object ClearEditButton2: TClearEditButton 143 | CanFocus = False 144 | Cursor = crArrow 145 | Size.Width = 28.000000000000000000 146 | Size.Height = 26.000000000000000000 147 | Size.PlatformDefault = False 148 | TabOrder = 0 149 | end 150 | end 151 | object SaveBTN: TButton 152 | Align = Right 153 | Position.X = 560.000000000000000000 154 | Size.Width = 80.000000000000000000 155 | Size.Height = 50.000000000000000000 156 | Size.PlatformDefault = False 157 | TabOrder = 2 158 | Text = 'Save' 159 | OnClick = SaveBTNClick 160 | end 161 | end 162 | end 163 | end 164 | object BindSourceDBTableName: TBindSourceDB 165 | DataSet = MainForm.TableNameMemTable 166 | ScopeMappings = <> 167 | Left = 336 168 | Top = 112 169 | end 170 | object BindingsListCB: TBindingsList 171 | Methods = <> 172 | OutputConverters = <> 173 | Left = 44 174 | Top = 45 175 | object LinkFillControlToField: TLinkFillControlToField 176 | Category = 'Quick Bindings' 177 | Control = PickerLB 178 | Track = False 179 | FillDataSource = BindSourceDBTableName 180 | FillDisplayFieldName = 'TableName' 181 | AutoFill = True 182 | FillExpressions = <> 183 | FillHeaderExpressions = <> 184 | FillBreakGroups = <> 185 | end 186 | object SCBindLink: TBindLink 187 | Category = 'Links' 188 | SourceMemberName = 'Signatures' 189 | SourceComponent = BindSourceDBGroups 190 | ParseExpressions = < 191 | item 192 | ControlExpression = 'Lines.Text' 193 | SourceExpression = 'AsString' 194 | end> 195 | FormatExpressions = < 196 | item 197 | ControlExpression = 'Lines.Text' 198 | SourceExpression = 'AsString' 199 | end> 200 | ClearExpressions = <> 201 | Track = False 202 | end 203 | end 204 | object BindSourceDBRequestType: TBindSourceDB 205 | DataSet = MainForm.RequestTypeMemTable 206 | ScopeMappings = <> 207 | Left = 208 208 | Top = 104 209 | end 210 | object BindSourceDBGroups: TBindSourceDB 211 | DataSet = MainForm.GroupsMemTable 212 | ScopeMappings = <> 213 | Left = 72 214 | Top = 170 215 | end 216 | end 217 | -------------------------------------------------------------------------------- /uSelector.pas: -------------------------------------------------------------------------------- 1 | unit uSelector; 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, 8 | FMX.ListView.Types, FMX.ListView.Appearances, FMX.ListView.Adapters.Base, 9 | System.Rtti, System.Bindings.Outputs, Fmx.Bind.Editors, Data.Bind.EngExt, 10 | Fmx.Bind.DBEngExt, Data.Bind.Components, Data.Bind.DBScope, FMX.ListView, 11 | FMX.StdCtrls, FMX.Controls.Presentation, Data.DB, FMX.Objects, FireDAC.Comp.Client, 12 | FMX.Edit, FMX.Layouts, FMX.TabControl, FireDAC.Stan.Intf, FireDAC.Stan.Option, 13 | FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf, 14 | FireDAC.DApt.Intf, FireDAC.Comp.DataSet, FMX.SearchBox, 15 | FireDAC.Stan.StorageBin, FMX.ScrollBox, FMX.Memo, FMX.ListBox; 16 | 17 | type 18 | TSelectorForm = class(TForm) 19 | ToolBar1: TToolBar; 20 | HeaderText: TText; 21 | BackBTN: TButton; 22 | OtherBTN: TButton; 23 | TabControl1: TTabControl; 24 | SelectTab: TTabItem; 25 | OtherTab: TTabItem; 26 | OtherLayout: TLayout; 27 | Layout12: TLayout; 28 | Text6: TText; 29 | OtherEdit: TEdit; 30 | ClearEditButton2: TClearEditButton; 31 | SaveBTN: TButton; 32 | BindSourceDBTableName: TBindSourceDB; 33 | BindingsListCB: TBindingsList; 34 | LinkFillControlToField: TLinkFillControlToField; 35 | SCBindLink: TBindLink; 36 | BindSourceDBRequestType: TBindSourceDB; 37 | BindSourceDBGroups: TBindSourceDB; 38 | PickerLB: TListBox; 39 | Button1: TButton; 40 | procedure FormClose(Sender: TObject; var Action: TCloseAction); 41 | procedure OtherBTNClick(Sender: TObject); 42 | procedure BackBTNClick(Sender: TObject); 43 | procedure SaveBTNClick(Sender: TObject); 44 | procedure Button1Click(Sender: TObject); 45 | procedure FormShow(Sender: TObject); 46 | private 47 | { Private declarations } 48 | ResultField: String; 49 | BindSourceDBCBRemote: TBindSourceDB; 50 | public 51 | { Public declarations } 52 | procedure SetParamsView; 53 | procedure SetGroupsView; 54 | procedure SaveValue(const S: String); 55 | procedure SetDataSetResult(const aField: String; BS: TBindSourceDB); 56 | procedure ClearSearchBox(Sender: TObject); 57 | end; 58 | 59 | var 60 | SelectorForm: TSelectorForm; 61 | 62 | implementation 63 | 64 | {$R *.fmx} 65 | 66 | uses 67 | uMainForm; 68 | 69 | procedure TSelectorForm.Button1Click(Sender: TObject); 70 | var 71 | I: Integer; 72 | SL: TStringList; 73 | begin 74 | SL := TStringList.Create; 75 | SL.StrictDelimiter := True; 76 | for I := 0 to PickerLB.Items.Count-1 do 77 | begin 78 | if PickerLB.ListItems[I].IsChecked=True then 79 | SL.Append(PickerLB.Items[I]); 80 | end; 81 | SaveValue(SL.CommaText); 82 | SL.Free; 83 | end; 84 | 85 | procedure TSelectorForm.ClearSearchBox(Sender: TObject); 86 | var 87 | I: Integer; 88 | SearchBox: TSearchBox; 89 | begin 90 | for I := 0 to TListView(Sender).Controls.Count-1 do 91 | if TListView(Sender).Controls[I].ClassType = TSearchBox then 92 | begin 93 | SearchBox := TSearchBox(TListView(Sender).Controls[I]); 94 | SearchBox.Text := ''; 95 | Break; 96 | end; 97 | end; 98 | 99 | procedure TSelectorForm.FormClose(Sender: TObject; var Action: TCloseAction); 100 | begin 101 | BackBTNClick(Self); 102 | end; 103 | 104 | procedure TSelectorForm.FormShow(Sender: TObject); 105 | var 106 | I: Integer; 107 | begin 108 | for I := 0 to PickerLB.Items.Count-1 do 109 | begin 110 | PickerLB.ListItems[I].Height := 50; 111 | end; 112 | end; 113 | 114 | procedure TSelectorForm.SetParamsView; 115 | begin 116 | LinkFillControlToField.Active := False; 117 | LinkFillControlToField.FillDataSource := BindSourceDBRequestType; 118 | LinkFillControlToField.FillDisplayFieldName := 'RequestType'; 119 | LinkFillControlToField.Active := True; 120 | HeaderText.Text := 'Select Request Type'; 121 | OtherBTN.Visible := True; 122 | end; 123 | 124 | procedure TSelectorForm.SaveBTNClick(Sender: TObject); 125 | begin 126 | SaveValue(OtherEdit.Text); 127 | end; 128 | 129 | procedure TSelectorForm.SetDataSetResult(const aField: String; BS: TBindSourceDB); 130 | begin 131 | BindSourceDBCBRemote := BS; 132 | ResultField := aField; 133 | end; 134 | 135 | procedure TSelectorForm.BackBTNClick(Sender: TObject); 136 | begin 137 | OtherEdit.Text := ''; 138 | OtherBTN.Visible := True; 139 | ClearSearchBox(PickerLB); 140 | TabControl1.ActiveTab := SelectTab; 141 | SelectorForm.Hide; 142 | MainForm.Show; 143 | end; 144 | 145 | procedure TSelectorForm.OtherBTNClick(Sender: TObject); 146 | begin 147 | OtherBTN.Visible := False; 148 | TabControl1.ActiveTab := OtherTab; 149 | //ShowKeyboard(OtherEdit); 150 | end; 151 | 152 | procedure TSelectorForm.SaveValue(const S: String); 153 | begin 154 | if BindSourceDBCBRemote.DataSet<>nil then 155 | begin 156 | if BindSourceDBCBRemote.DataSet.Active = False then 157 | begin 158 | BindSourceDBCBRemote.DataSet.Open; 159 | end; 160 | 161 | BindSourceDBCBRemote.DataSet.DisableControls; 162 | if not (BindSourceDBCBRemote.DataSet.State in [dsEdit, dsInsert]) then BindSourceDBCBRemote.DataSet.Edit; 163 | BindSourceDBCBRemote.DataSet.FieldByName(ResultField).AsString := S; 164 | BindSourceDBCBRemote.DataSet.Post; 165 | BindSourceDBCBRemote.DataSet.EnableControls; 166 | 167 | end; 168 | 169 | OtherEdit.Text := ''; 170 | OtherBTN.Visible := True; 171 | ClearSearchBox(PickerLB); 172 | TabControl1.ActiveTab := SelectTab; 173 | SelectorForm.Hide; 174 | MainForm.Show; 175 | end; 176 | 177 | procedure TSelectorForm.SetGroupsView; 178 | begin 179 | LinkFillControlToField.Active := False; 180 | LinkFillControlToField.FillDataSource := BindSourceDBGroups; 181 | LinkFillControlToField.FillDisplayFieldName := 'Group'; 182 | LinkFillControlToField.Active := True; 183 | HeaderText.Text := 'Select Group'; 184 | OtherBTN.Visible := True; 185 | end; 186 | 187 | 188 | end. 189 | -------------------------------------------------------------------------------- /uSelector.vlb: -------------------------------------------------------------------------------- 1 | [MainForm.EndPointTable] 2 | Visible=False 3 | Coordinates=646,245,138,33 4 | 5 | [MainForm.RequestTypeMemTable] 6 | Visible=False 7 | Coordinates=646,141,181,33 8 | 9 | [MainForm.TableNameMemTable] 10 | Visible=False 11 | Coordinates=141,500,171,33 12 | 13 | [MainForm.GroupsMemTable] 14 | Visible=False 15 | Coordinates=646,193,153,33 16 | 17 | [MainForm.FDMemTableAction] 18 | Visible=False 19 | Coordinates=320,500,162,33 20 | 21 | [MainForm.BindSourceDBEndPoints] 22 | Coordinates=0,0,190,231 23 | 24 | [Text6] 25 | Coordinates=646,1,41,51 26 | 27 | [MainForm.BindSourceDBGroups] 28 | Coordinates=12,375,175,69 29 | 30 | [OtherTab] 31 | Coordinates=646,297,60,33 32 | 33 | [BindSourceDBGroups] 34 | Coordinates=418,141,137,87 35 | 36 | [BackBTN] 37 | Coordinates=646,71,60,51 38 | 39 | [MainForm.BackendAuth] 40 | Coordinates=209,89,132,87 41 | 42 | [ClearEditButton2] 43 | Coordinates=646,349,98,33 44 | 45 | [Layout12] 46 | Coordinates=646,401,59,33 47 | 48 | [OtherEdit] 49 | Coordinates=418,71,61,51 50 | 51 | [OtherLayout] 52 | Coordinates=646,453,75,33 53 | 54 | [SelectTab] 55 | Coordinates=627,500,62,33 56 | 57 | [ToolBar1] 58 | Coordinates=568,500,58,33 59 | 60 | [BindSourceDBRequestType] 61 | Coordinates=209,195,165,87 62 | 63 | [MainForm.BindSourceDBRequestTypes] 64 | Coordinates=399,250,209,69 65 | 66 | [TabControl1] 67 | Coordinates=489,500,74,33 68 | 69 | [HeaderText] 70 | Coordinates=191,375,70,51 71 | 72 | [MainForm.BindSourceDBTables] 73 | Coordinates=209,1,171,69 74 | 75 | [BindSourceDBTableName] 76 | Coordinates=50,250,157,87 77 | 78 | [SaveBTN] 79 | Coordinates=418,338,59,51 80 | 81 | [OtherBTN] 82 | Coordinates=418,1,62,51 83 | 84 | [MainForm.BindSourceDB1] 85 | Coordinates=270,375,146,87 86 | 87 | [BindingsListCB] 88 | Coordinates=42,500,91,33 89 | 90 | [PickerLB] 91 | Coordinates=520,200,116,177 92 | Visible=True 93 | 94 | --------------------------------------------------------------------------------