├── .gitignore ├── LICENSE ├── README.md ├── doc ├── generator-app-guide.md └── resources │ ├── datasetproxy-01.png │ ├── datasetproxy-diagram.png │ ├── generator-app.png │ ├── proxy-tool-01.png │ └── proxy-tool-02.png ├── samples ├── 01-books │ ├── BooksDataProxy.dpr │ ├── Data.Mock.Book.pas │ ├── Data.Proxy.Book.pas │ ├── Form.Main.dfm │ ├── Form.Main.pas │ └── clear_project.bat ├── 02-code-evolution │ ├── CodeEvolutionDemo.dpr │ ├── Form.Main.dfm │ ├── Form.Main.pas │ ├── Model.Books.pas │ ├── Procesor.Currency.Intf.pas │ ├── Procesor.Currency.pas │ ├── Proxy.Books.pas │ └── books.sdb ├── README.md └── books.sql ├── src ├── Comp.Generator.DataProxy.pas └── Data.DataProxy.pas ├── tests ├── Helper.DUnitAssert.pas ├── Test.DataSetProxy.pas ├── Test.GeneratorClassMethods.pas ├── Test.ProxyGenerator.pas ├── Test.SqlDataSetProxy.pas ├── TestDataSetProxy.dpr ├── Wrapper.TProxyGenerator.pas └── clear_project.bat └── tools ├── app-config.json ├── bumper_source ├── AppConfiguration.pas ├── Main.pas ├── Processor.PascalUnit.pas ├── Processor.ReadmeMarkdown.pas ├── Processor.Utils.pas ├── clear_project.bat └── version_bumper.dpr └── generator-app ├── App.AppInfo.pas ├── Base.ProxyGenerator.pas ├── Comp.Generator.DataSetCode.pas ├── DataModule.Main.dfm ├── DataModule.Main.pas ├── Dialog.QueryBuilder.dfm ├── Dialog.QueryBuilder.pas ├── Dialog.SelectDefinition.dfm ├── Dialog.SelectDefinition.pas ├── Form.Main.dfm ├── Form.Main.pas ├── ProxyGenerator.dpr ├── clear_project.bat ├── helpers ├── Helper.TApplication.pas ├── Helper.TDBGrid.pas ├── Helper.TFDConnection.pas ├── Helper.TFDCustomManager.pas ├── Helper.TField.pas └── Helper.TStrings.pas └── utils └── Utils.Timer.Interval.pas /.gitignore: -------------------------------------------------------------------------------- 1 | # ########## Open Console File 2 | 3 | /OpenConsole.bat 4 | secure-data.json 5 | .vscode/** 6 | 7 | # ########## OS X hidden file index data 8 | 9 | .DS_Store 10 | 11 | # ########## Delphi project file 12 | # (*.dproj) Delphi Project file 13 | # (*.cbproj) C++Builder Project file 14 | 15 | *.dproj 16 | 17 | # ########## Resource file 18 | # (*.rc, *.res) Compiled and uncompiled resource files 19 | # *.rc 20 | 21 | *.res 22 | 23 | # ########## Delphi binary files 24 | # (*.dll) A dynamically linked library file 25 | # (*.exe) Windows executable file 26 | # (*.bpl) Package shared library file 27 | # (*.bpi) Package import library file 28 | # (*.dcp) Delphi Compiled Package file 29 | # (*.drc) Delphi resource string file 30 | # (*.map) Map debug file 31 | # (*.dres) Delphi compiled resource file. (Used when you add to a project RESOURCE such as an icon or image.) 32 | # (*.dcu) Delphi Compiled Unit file 33 | # (*.lib) static library file OR import library for the Win32/Win64 34 | # (*.ocx) OLE Control eXtension 35 | # (*.rsm) Used for remote debugging. (Include remote debug symbols option.) 36 | # (*.dylib) Dynamic library (.dll) or package (.bpl) compiled for the OS X 37 | # (*.tds) Remote debugger TDS debug file. 38 | # (*.tlb) Type library 39 | 40 | *.exe 41 | *.dll 42 | *.bpl 43 | *.bpi 44 | *.dcp 45 | *.drc 46 | *.map 47 | *.dres 48 | *.tds 49 | *.dcu 50 | *.lib 51 | *.ocx 52 | *.rsm 53 | *.tds 54 | *.tlb 55 | 56 | # ########## Android / iOS / OS X binary files 57 | # (*.apk) Android application package file. 58 | # (*.so) Unix-like systems shared libraries (OS X and Linux) 59 | # (*.a) Static library file (ELF-format) produced by Clang 60 | 61 | *.so 62 | *.apk 63 | *.a 64 | 65 | # ########## IDE files 66 | # (*.cfg) Project configuration file used for command-line compiles 67 | # (*.ddp): Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 68 | # (*.vlb): Visual LiveBindings file. Added in Delphi XE2. 69 | # (*.deployproj): Deployment Manager configuration file for your project. Added in Delphi XE2. 70 | 71 | *.cfg 72 | *.ddp 73 | *.vlb 74 | *.deployproj 75 | 76 | 77 | # ########## Other IDE files 78 | # Delphi local files (user-specific info) 79 | 80 | *.local 81 | *.identcache 82 | *.projdata 83 | *.tvsconfig 84 | *.dsk 85 | *.otares 86 | 87 | # ########## Delphi history and backups 88 | # (__history) History folder 89 | # (__recovery) Recovery folder 90 | # (*.~*) Local versions history file 91 | 92 | __history/ 93 | __recovery/ 94 | *.~* 95 | 96 | # ########## Castalia statistics file. Castalia add in Delphi XE7 97 | 98 | *.stat 99 | 100 | # ########## C++Builder 101 | # (*.obj) C++ Object File 102 | # (*.pch) C++ Precompiled Header File 103 | # (*.o) C++ object file or compiled translation unit. 104 | # (*.pch) C++ precompiled header file. 105 | 106 | 107 | TestInsightSettings.ini 108 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2019 Bogdan Polak 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # DataProxy Pattern for Delphi 2 | 3 | ![ Delphi Support ](https://img.shields.io/badge/Delphi%20Support-%20XE8%20..%2010.3%20Rio-blue.svg) 4 | ![ version ](https://img.shields.io/badge/version-%201.1-yellow.svg) 5 | 6 | ## Overview 7 | 8 | TDataSetProxy is a wrapper component for the classic Delphi dataset component. It allows to replace any dataset with a fake dataset (in-memory table). Proxy can be used to separate a business class from datasets, this separation is helpful when the business code needs to be putted into automated test harness (unit tests). 9 | 10 | ![](./doc/resources/datasetproxy-diagram.png) 11 | 12 | **Inspiration**. Idea is based on Proxy GoF pattern and Active Record pattern, defined by Martin Fowler in book **Patterns of Enterprise Application Architecture** 13 | 14 | ## Why using proxy? 15 | 16 | DataSet Proxy pattern is helpful during the business logic extraction. This could be especially useful for improving legacy, highly coupled projects. When production code is dependent on a SQL data and SQL connection, it's really difficult to write unit tests for such code. 17 | 18 | Replacing dataset with proxies introduce new abstraction level which can facilitate both: SQL datasets in production code and memory datasets in test project. Proxy has very similar interface (methods list) to classic dataset, which help in easy migration. Fake datasets will allow to verify (assert) production code without connecting to database. 19 | 20 | DataSet Proxy together with two companion projects (DataSet Generator, Delphi Command Pattern) gives developers opportunity to introduce unit tests with with safe refactorings. 21 | 22 | Dataset proxy is a temporary solution and after covering code with the tests engineers can apply more advanced refactorings: decoupling code or make it more composable and reusable. As one of these refactorings proxy can be safely replaced by the DAO object or by the model data structures. 23 | 24 | Together with code and quality improvement developers will learn how to write cleaner code or how to use test first approach and work better. 25 | 26 | Supportive project: 27 | 28 | | Project | GitHub Repo | 29 | | --- | --- | 30 | | DataSet Generator | https://github.com/bogdanpolak/dataset-generator | 31 | 32 | ## Proxy generation 33 | 34 | Project includes source code of base class `TDataSetProxy` and two different types of proxy generators: 35 | 36 | 1) Component: **TDataProxyGenerator** 37 | - unit `src/Comp.Generator.DataProxy.pas` 38 | - As an input receives dataset and as an output generates source code: unit containing proxy class inherited from `TDataSetProxy` 39 | 2) Tool: **Generator App for FireDAC** 40 | - tool source: `tools/generator-app` 41 | - VCL Forms application written in Delphi which is able to connect to SQL server via FireDAC, then prepare SQL command, fetch result dataset and generate proxy class together with dataset fake 42 | 43 | ### Component 44 | 45 | Component `TDataProxyGenerator` is useful when engineer wants to generate proxy for exiting dataset in production code. This is two steps easy task: (1) add component unit to uses section, (2) find code using dataset and call generator method: 46 | 47 | Current production code: 48 | 49 | ```pas 50 | aBooksDataSet := fDBConnection.ConstructSQLDataSet( 51 | aOwner, APPSQL_SelectBooks); 52 | dbgridBooks.DataSource.Dataset := aBooksDataSet; 53 | ``` 54 | 55 | Injected generator code: 56 | 57 | ```pas 58 | TDataProxyGenerator.SaveToFile('../../src/Proxy.Books', 59 | aBooksDataSet, 'TBookProxy'); 60 | ``` 61 | 62 | ### Tool 63 | 64 | **Generator App for FireDAC** is alternative tool created mostly for demo purposes. In practice using this tool can be less useful then using directly the component generator. Generator App is dedicated for coaching and training purposes. For more information check: [Generator App for FireDAC - User Guide](doc/generator-app-guide.md). 65 | 66 | ## Sample proxy class 67 | 68 | ```pas 69 | type 70 | TBookProxy = class(TDatasetProxy) 71 | private 72 | fISBN :TWideStringField; 73 | fTitle :TWideStringField; 74 | fReleseDate :TDateField; 75 | fPages :TIntegerField; 76 | fPrice :TBCDField; 77 | protected 78 | procedure ConnectFields; override; 79 | public 80 | property ISBN :TWideStringField read fISBN; 81 | property Title :TWideStringField read fTitle; 82 | property ReleseDate :TDateField read fReleseDate; 83 | property Pages :TIntegerField read fPages; 84 | property Price :TBCDField read fPrice; 85 | end; 86 | 87 | procedure TBookProxy.ConnectFields; 88 | begin 89 | Assert(fDataSet.Fields.Count = 5); 90 | fISBN := fDataSet.FieldByName('ISBN'); 91 | fTitle := fDataSet.FieldByName('Title'); 92 | fReleseDate := fDataSet.FieldByName('ReleseDate'); 93 | fPages := fDataSet.FieldByName('Pages'); 94 | fPrice := fDataSet.FieldByName('Price'); 95 | end; 96 | ``` 97 | 98 | ## TDataSetProxy class 99 | 100 | DataSetProxy component is a proxy class, which has almost identical methods to classic TDataSet component. Developer can easily replace any DataSet component with this proxy applying only few and low risk changes to the production code. From the production code point o view change is small small and not much important but from the testing perspective this is fundamental change, because developer is able to reconfigure proxy to use lightweight memory dataset. 101 | 102 | Most of the `TDataSetProxy` methods are just clones of TDataSet once. You can easily expand set of this methods adding missing once or build new unique ones. This proxy methods are: `Append`, `Edit`, `Cancel`, `Delete`, `Close`, `Post`, `RecordCount`, `First`, `Last`, `Eof`, `Next`, `Prior`, `EnableControls`, `DisableControls`, `Locate`, `Lookup`, `Refresh` and others. Documentation and this methods usage is the same like standard Delphi documentation for `TDataSet` class. 103 | 104 | Rest of `TDataSetProxy` methods can be divided into two groups: proxy setup methods (configuration) and proxy helper methods (expanding classic dataset functionality). 105 | 106 | ### TDataSetProxy setup 107 | 108 | ```pas 109 | procedure TDataModule1.OnCreate(Sender: TObject); 110 | begin 111 | fOrdersProxy := TOrdersProxy.Create(fOwner); 112 | fOrdersDataSource := fOrdersProxy.ConstructDataSource; 113 | end; 114 | 115 | procedure TDataModule1.InitOrders(aYear, aMonth: word); 116 | begin 117 | fOrdersProxy.WithFiredacSQL( FDConnection1, 118 | 'SELECT OrderID, CustomerID, OrderDate, Freight' + 119 | ' FROM {id Orders} WHERE OrderDate between' + 120 | ' :StartDate and :EndDate', 121 | [ GetMonthStart(aYear, aMonth), 122 | GetMonthEnd(aYear, aMonth) ], 123 | [ftDate, ftDate]) 124 | .Open; 125 | fOrdersInitialized := True; 126 | end; 127 | 128 | procedure TDataModule1.InitOrders(aDataSet: TDataSet); 129 | begin 130 | fOrdersProxy.WithDataSet(aDataSet).Open; 131 | fOrdersInitialized := True; 132 | end; 133 | ``` 134 | 135 | ### DataSetProxy helpers 136 | 137 | Current release of `TDataSetProxy` component is containing only one helper methods which was implemented as an example. Developers are able to expand this collection according to the team coding practices. Suggested of expanding proxy class is using the inheritance. Sample usage of existing `ForEach` helper method: 138 | 139 | ```pas 140 | function TDataModule.CalculateTotalOrders (const aCustomerID: string): Currency; 141 | begin 142 | Result := 0; 143 | fOrdersProxy.ForEach(procedure 144 | begin 145 | if fOrdersProxy.CustomerID.Value = aCustomerID then 146 | Result := Result + fOrdersProxy.GetTotalOrderValue; 147 | end; 148 | end; 149 | ``` 150 | 151 | ## TDataProxyGenerator 152 | 153 | - Unit: `Comp.Generator.DataProxy.pas` 154 | - Class methods: 155 | - `SaveToFile` 156 | - `SaveToClipboard` 157 | - Methods: 158 | - `Execute` 159 | - Properties: 160 | - `Code` 161 | - `DataSet` 162 | - `GeneratorMode` 163 | - `DataSetAccess` 164 | - `FieldNamingStyle` 165 | - `NameOfUnit` 166 | - `NameOfClass` 167 | - `IndentationText` 168 | 169 | ### Generator options 170 | 171 | | Option | Values | Description | 172 | | --- | --- | --- | 173 | | `GeneratorMode` | (`pgmClass`, `pgmUnit`) | Generates only class header and implementation or whole unit with a class | 174 | | `NameOfUnit` | `String` | Name of the generated unit uses to create unit header | 175 | | `NameOfClass` | `String` | Name of a generated proxy class | 176 | | `FieldNamingStyle` | (`fnsUpperCaseF`, `fnsLowerCaseF`) | Decides how class fields are named: using upper case F suffix or lower-case | 177 | | `IndentationText` | `String` | Text uses for each code indentation, default value is two spaces | 178 | | `DataSetAccess` | (`dsaNoAccess`, `dsaGenComment`, `dsaFullAccess`) | Defines access to internal proxy dataset: full access = read-only property is generated to have an access. No access option is default and recommended | 179 | 180 | ### Generating using Execute 181 | 182 | To generate poxy class you can use Execute method, but before calling it you should setup all options and `DataSet` properties. After calling `Execute` generated code will be stored in the internal `TStringList` accessible through `Code` property. See sample code bellow: 183 | 184 | ```pas 185 | aProxyGenerator:= TDataProxyGenerator.Create(Self); 186 | try 187 | aProxyGenerator.DataSet := fdqEmployees; 188 | aProxyGenerator.NameOfUnit := 'Proxy.Employee'; 189 | aProxyGenerator.NameOfClass := 'TEmployeeProxy'; 190 | aProxyGenerator.IndentationText := ' '; 191 | aProxyGenerator.Execute; 192 | Memo1.Lines := aProxyGenerator.Code; 193 | finally 194 | aProxyGenerator.Free; 195 | end; 196 | ``` 197 | 198 | ### Generating using class methods 199 | 200 | Much easier and compact way of generating proxy classes is to use generator class methods: `SaveToFile` or `SaveToClipboard`. Its names are enough meaningful to understand their functionality. SaveToFile generates whole unit and writes it into file and SaveToClipboard generates only a class and writes to Windows Clipboard. See samples bellow: 201 | 202 | ```pas 203 | TDataProxyGenerator.SaveToFile( 204 | 'src/Proxy.Employee', 205 | fdqEmployees, 206 | 'TEmployeeProxy', 207 | ' ' 208 | fnsLowerCaseF); 209 | ``` 210 | 211 | ```pas 212 | TDataProxyGenerator.SaveToClipboard( 213 | fdqEmployees, 214 | 'TEmployeeProxy', 215 | ' ' 216 | fnsLowerCaseF); 217 | ``` 218 | 219 | 220 | ## Why engineers need to change? 221 | 222 | This project is effect of many years and multiple teams experience. This teams found that classic event based Delphi approach is not only less productive, but even dangerous for the developers, the managers and for the customers. 223 | 224 | Working with RDBMS (SQL servers) in Delphi looks to be very productive and simple. Developer drops a `Query` component, enters SQL command, sets Active property, connects all DB-aware controls to query and you are done ... almost done, almost but actually far from being ready to deliver application. 225 | 226 | Using this simple visual pattern developer can expose and modify SQL server data extremely quickly. In reality what looks simple at the begging, latter becomes challenging. Within time engineers create more and more datasets and events, defragmenting business flow and mixing presentation, configuration and domain code. Project becomes more and more messy and coupled. After some years managers and developers lose control over such project: plans and deadlines are not possible to quantify, customers are struggling with unexpected and strange bugs, simple changes require many hours of work. 227 | 228 | - **Pros of classic even approach**: 229 | - Intuitive 230 | - Easy to learn 231 | - Productive (in initial phases) 232 | - Easy prototyping 233 | - Easy to debug 234 | - **Cons of classic approach**: 235 | - Messy code 236 | - Almost no architectural design 237 | - Massive copy-paste development - difficult to reuse code 238 | - Mixing layers - manipulation of user controls along with business logic and data in a single class or even in a single method 239 | - High technical debt 240 | - Stagnation and team demotivation - developers aren’t motivated to learn, improve and change 241 | - No or minimalistic unit test coverage 242 | 243 | ## Modernizing VCL projects in action 244 | 245 | Replacing classic dataset with proxy requires some time to learn and validate in action. This approach could looks a little strange for Delphi developers, but is easy to adopt and learn. With management motivation and senior engineer coaching team will faster adopt code extraction and replacing datasets with proxies technique. 246 | 247 | Defined here proxy approach is a simple and safe refactoring technique dedicated for classic VCL application builded in EDP (Event Driven Programming) way. Using this solution in evolution way small, but important parts of business code can be extracted and covered with unit tests. After some time, with a better safety net (unit tests coverage), engineers can swap proxies with OOP DAOs and improve code more using advanced refactorings and architectural patterns. 248 | 249 | The modernization process includes following steps: 250 | 1. Business code extraction 251 | 1. Proxy generation 252 | 1. Dataset replacement with the proxy 253 | 1. Unit test introduction 254 | 1. Decomposition (big methods into smaller once) with unit test coverage 255 | 1. New composable classes creation (unit tests) 256 | 1. Proxy retirement (to replace with DAO) 257 | 258 | ## Code evolution with proxy 259 | 260 | Look at example showing the migration path of a legacy VCL project using a TDataSetProxy. We'll start with the classic method defined in the form: 261 | 262 | ```pas 263 | procedure TFormMain.LoadBooksToListBox(); 264 | var 265 | aIndex: integer; 266 | aBookmark: TBookmark; 267 | aBook: TBook; 268 | isDatePrecise: boolean; 269 | begin 270 | ListBox1.ItemIndex := -1; 271 | for aIndex := 0 to ListBox1.Items.Count - 1 do 272 | ListBox1.Items.Objects[aIndex].Free; 273 | ListBox1.Clear; 274 | aBookmark := fdqBook.GetBookmark; 275 | try 276 | fdqBook.DisableControls; 277 | try 278 | while not fdqBook.Eof do 279 | begin 280 | aBook := TBook.Create; 281 | ListBox1.AddItem(fdqBook.FieldByName('ISBN').AsString + ' - ' + 282 | fdqBook.FieldByName('Title').AsString, aBook); 283 | aBook.ISBN := fdqBook.FieldByName('ISBN').AsString; 284 | aBook.Authors.AddRange(BuildAuhtorsList( 285 | fdqBook.FieldByName('Authors').AsString)); 286 | aBook.Title := fdqBook.FieldByName('Title').AsString; 287 | aBook.ReleaseDate := ConvertReleaseDate( 288 | fdqBook.FieldByName('ReleaseDate').AsString); 289 | aBook.Price := fdqBook.FieldByName('Price').AsCurrency; 290 | aBook.PriceCurrency := fdqBook.FieldByName('Currency').AsString; 291 | ValidateCurrency(aBook.PriceCurrency); 292 | fdqBook.Next; 293 | end; 294 | finally 295 | fdqBook.EnableControls; 296 | end 297 | finally 298 | fdqBook.FreeBookmark(aBookmark); 299 | end; 300 | end; 301 | ``` 302 | 303 | > **Notice!** Presented above solution is a bad practice, but unfortunately is often used by Delphi developers. Goal of using TDataProxy is to improve this state and separate business logic from visualization. 304 | 305 | This method is loading data from SQL database, using `fdqBook` TFDQuery. An object of class `TBook` is created for each row, its fields are filled with data set values and validated. Because `TBook` objects are stored in the `TListBox` control, which also owns them, this method must release them first. 306 | 307 | ### Stage 1. DataSet Replacement 308 | 309 | We replace the data set with the proxy object. In addition, we are modernizing the code by changing the classic `while-not-eof` loop with a functional `ForEach` method. At the same time, we are introducing a safer variant of accessing field values. It is possible to separate this phase in 3 separate phases, but for this article we need to keep content compact. 310 | 311 | ```pas 312 | procedure TFormMain.LoadBooksToListBox(); 313 | var 314 | aIndex: integer; 315 | aBook: TBook; 316 | begin 317 | ListBox1.ItemIndex := -1; 318 | for aIndex := 0 to ListBox1.Items.Count - 1 do 319 | ListBox1.Items.Objects[aIndex].Free; 320 | ListBox1.Clear; 321 | fProxyBooks.ForEach( 322 | procedure 323 | begin 324 | aBook := TBook.Create; 325 | ListBox1.AddItem(fProxyBooks.ISBN.Value + ' - ' + 326 | fProxyBooks.Title.Value, aBook); 327 | aBook.ISBN := fProxyBooks.ISBN.Value; 328 | aBook.Authors.AddRange( 329 | BuildAuhtorsList(fProxyBooks.Authors.Value)); 330 | aBook.Title := fProxyBooks.Title.Value; 331 | aBook.ReleaseDate := ConvertReleaseDate( 332 | fProxyBooks.ReleaseDate.Value); 333 | aBook.Price := fProxyBooks.Price.AsCurrency; 334 | aBook.PriceCurrency := fProxyBooks.Currency.Value; 335 | ValidateCurrency(aBook.PriceCurrency); 336 | end); 337 | end; 338 | ``` 339 | 340 | The code is more readable and safer, but is still in the form. It's time to remove it and separate from all dependencies to enable testing. 341 | 342 | ### Stage 2. Code Decouple 343 | 344 | We must start with an important architectural decision. Currently in the code we have two similar classes: `TBook` storing data and `TBookProxy` processing them. It is important to decide which of these classes depends on the other. `TBook` is part of the model layer and should be not aware about about data access object. 345 | 346 | ```pas 347 | procedure TForm1.LoadBooksToListBox(); 348 | begin 349 | ListBox1.Clear; 350 | fProxyBooks.LoadAndValidate; 351 | fProxyBooks.FillStringsWithBooks(ListBox1.Items); 352 | end; 353 | ``` 354 | 355 | Finally, the form method looks nice and clear. This is a good sign that we are going in the right direction. Code extracted and moved to a dataset proxy looks almost like previous: 356 | 357 | ```pas 358 | procedure TBooksProxy.LoadAndValidate; 359 | var 360 | aBook: TBook; 361 | isDatePrecise: boolean; 362 | begin 363 | fBooksList.Clear; 364 | ForEach( 365 | procedure 366 | begin 367 | aBook := TBook.Create; 368 | fBooksList.Add(aBook); 369 | aBook.ISBN := ISBN.Value; 370 | aBook.Authors.AddRange( 371 | BuildAuhtorsList(Authors.Value)); 372 | aBook.Title := Title.Value; 373 | aBook.ReleaseDate := ConvertReleaseDate( 374 | ReleaseDate.Value, isDatePrecise); 375 | aBook.IsPreciseReleaseDate := isDatePrecise; 376 | aBook.Price := Price.AsCurrency; 377 | aBook.PriceCurrency := Currency.Value; 378 | ValidateCurrency(aBook.PriceCurrency); 379 | end); 380 | end; 381 | ``` 382 | 383 | Together with this code we had to move all dependent methods responsible for converting and validating data: `BuildAuhtorsList`, `ConvertReleaseDate` and `ValidateCurrency`. 384 | 385 | This proxy contains internal collection of book `fBookList` which is used to fill ListBox. At that moment we moved this code to dataset proxy class to reduce number of changes, but letter it should be moved into proper class: 386 | 387 | ```pas 388 | procedure TBooksProxy.FillStringsWithBooks( 389 | aStrings: TStrings); 390 | var 391 | aBook: TBook; 392 | begin 393 | aStrings.Clear; 394 | for aBook in fBooksList do 395 | aStrings.AddObject( 396 | aBook.ISBN + ' - ' + aBook.Title, aBook); 397 | end; 398 | ``` 399 | 400 | ## More proxy samples 401 | 402 | 1) Books sample demo application 403 | 1) see the setup documentation: [Samples README](./samples/README.md) 404 | 1) Generated proxy = `TBookProxy` in (`Data.Proxy.Book.pas` unit) 405 | 1) Generated mock factory = `function CreateMockTableBook` in (`Data.Mock.Book.pas` unit) 406 | 407 | ## Additional documentation 408 | 409 | 1. [Generator App for FireDAC - User Guide](doc/generator-app-guide.md) 410 | -------------------------------------------------------------------------------- /doc/generator-app-guide.md: -------------------------------------------------------------------------------- 1 | # User Guide: Proxy Generator 2 | 3 | ## Overview 4 | 5 | The **Proxy Generator for FireDAC** application is a supportive tool included in TProxyDataSet project. It allows to create Delphi source code for proxy class together with code of fake dataset code. Generator is using a provided SQL command (SELECT statement) and an internal dataset to output results. 6 | 7 | ![](resources/generator-app.png) 8 | 9 | The project is stored in a folder `tools/generator-app`. Generator App is using FireDAC connection definitions to connect to the RDBMS server and execute query. Potentially it is possible to support to other Delphi DAC components, different then FireDAC, but this functionality in not available in current release. 10 | 11 | Generator App goals are: 12 | * Provide / build a SQL statement 13 | * Connects to RDBMS database with `FireDAC`, paste, enter or edit a SQL statement 14 | * Checks a structure and data in the result data set 15 | * Generate a proxy and fake dataset 16 | * Using a SQL statement and internal TDataSet component application is generating code of: 17 | - **proxy** - class derived from `TProxyDataSet` containing all data fields from query 18 | - **fake** - code generating in memory dataset (TClientDataSet or TFDMemTable) with the same structure and with code appending the live data fetched from SQL command. 19 | 20 | ## Build notes 21 | 22 | To compile `Generator App` this tool developer requires any modern Delphi IDE (XE8 or newer) with FireDAC. FireDAC components are avaliable in all Delphi tiers including Professional and Community edition, check the Embarcadero documentation for version limitations. Project should be able to compile in older versions without any or with some minor changes - please register any problems or inform about success. 23 | 24 | ## Setup 25 | 26 | 1) Clone this repository 27 | 1) Load GeneratorApp project (`/tools/generator-app/ProxyGenerator.dpr`) 28 | 1) Build the generator project 29 | 1) Check you FireDAC Connection Definitions and add new definition if it is required. Definition management are available through: 30 | - `FireDAC Explorer` - external tool distributed with IDE 31 | - Directly in Delphi IDE using `Data Explorer` tool window 32 | 33 | ## First steps 34 | 35 | ### 1) Run Proxy Generator for FireDAC 36 | 37 | - Select FireDAC connection definition 38 | - FireDAC Connection Definition has to be defined before using proxy generator tool. 39 | - Connection can be defined using RAD Studio IDE or FireDAC Manager 40 | - Connect to the database (server) 41 | - Copy or type a SQL command or use the query builder (early preview) 42 | - Execute SQL statement 43 | 44 | ![](resources/proxy-tool-01.png) 45 | 46 | 47 | ### 2. Generate and setup proxy 48 | 49 | - Execute code generation **[Generate Data Proxy]** 50 | - Automatically view will be switched to tab "Generated code: DataSetProxy" 51 | - Review generated code display in right memo control 52 | - Setup proxy parameters display on left panel 53 | 54 | ![](resources/proxy-tool-02.png) 55 | 56 | ### 3. Setup Fake DataSet 57 | 58 | - Switch tab to "Generated code: Fake DataSet" 59 | - Review generated code 60 | - Setup generator parameters 61 | -------------------------------------------------------------------------------- /doc/resources/datasetproxy-01.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bogdanpolak/delphi-dataproxy/fef7a3a3c5256788ae9f52f105b7a1c1b841f466/doc/resources/datasetproxy-01.png -------------------------------------------------------------------------------- /doc/resources/datasetproxy-diagram.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bogdanpolak/delphi-dataproxy/fef7a3a3c5256788ae9f52f105b7a1c1b841f466/doc/resources/datasetproxy-diagram.png -------------------------------------------------------------------------------- /doc/resources/generator-app.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bogdanpolak/delphi-dataproxy/fef7a3a3c5256788ae9f52f105b7a1c1b841f466/doc/resources/generator-app.png -------------------------------------------------------------------------------- /doc/resources/proxy-tool-01.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bogdanpolak/delphi-dataproxy/fef7a3a3c5256788ae9f52f105b7a1c1b841f466/doc/resources/proxy-tool-01.png -------------------------------------------------------------------------------- /doc/resources/proxy-tool-02.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bogdanpolak/delphi-dataproxy/fef7a3a3c5256788ae9f52f105b7a1c1b841f466/doc/resources/proxy-tool-02.png -------------------------------------------------------------------------------- /samples/01-books/BooksDataProxy.dpr: -------------------------------------------------------------------------------- 1 | program BooksDataProxy; 2 | 3 | uses 4 | Vcl.Forms, 5 | Form.Main in 'Form.Main.pas' {Form1}, 6 | Data.Proxy.Book in 'Data.Proxy.Book.pas', 7 | Data.Mock.Book in 'Data.Mock.Book.pas', 8 | Data.DataProxy in '..\..\src\Data.DataProxy.pas'; 9 | 10 | {$R *.res} 11 | 12 | begin 13 | Application.Initialize; 14 | Application.MainFormOnTaskbar := True; 15 | Application.CreateForm(TForm1, Form1); 16 | Application.Run; 17 | end. 18 | -------------------------------------------------------------------------------- /samples/01-books/Data.Mock.Book.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bogdanpolak/delphi-dataproxy/fef7a3a3c5256788ae9f52f105b7a1c1b841f466/samples/01-books/Data.Mock.Book.pas -------------------------------------------------------------------------------- /samples/01-books/Data.Proxy.Book.pas: -------------------------------------------------------------------------------- 1 | unit Data.Proxy.Book; 2 | 3 | interface 4 | 5 | uses 6 | Data.DB, 7 | Data.DataProxy; 8 | 9 | type 10 | TBookProxy = class(TDatasetProxy) 11 | private 12 | FISBN: TWideStringField; 13 | FTitle: TWideStringField; 14 | FAuthors: TWideStringField; 15 | FStatus: TWideStringField; 16 | FReleseDate: TDateField; 17 | FPages: TIntegerField; 18 | FPrice: TBCDField; 19 | FCurrency: TWideStringField; 20 | FImported: TDateTimeField; 21 | FDescription: TWideStringField; 22 | protected 23 | procedure ConnectFields; override; 24 | public 25 | function ToString: String; override; 26 | function CountMoreExpensiveBooks: integer; 27 | function LocateISBN(const ISBN: string): boolean; 28 | property ISBN: TWideStringField read FISBN; 29 | property Title: TWideStringField read FTitle; 30 | property Authors: TWideStringField read FAuthors; 31 | property Status: TWideStringField read FStatus; 32 | property ReleseDate: TDateField read FReleseDate; 33 | property Pages: TIntegerField read FPages; 34 | property Price: TBCDField read FPrice; 35 | property Currency: TWideStringField read FCurrency; 36 | property Imported: TDateTimeField read FImported; 37 | property Description: TWideStringField read FDescription; 38 | // this property should be hidden, but during migration can be usefull 39 | // property DataSet: TDataSet read FDataSet; 40 | end; 41 | 42 | implementation 43 | 44 | uses 45 | System.SysUtils; 46 | 47 | procedure TBookProxy.ConnectFields; 48 | const 49 | ExpectedFieldCount = 10; 50 | begin 51 | FISBN := fDataSet.FieldByName('ISBN') as TWideStringField; 52 | FTitle := fDataSet.FieldByName('Title') as TWideStringField; 53 | FAuthors := fDataSet.FieldByName('Authors') as TWideStringField; 54 | FStatus := fDataSet.FieldByName('Status') as TWideStringField; 55 | FReleseDate := fDataSet.FieldByName('ReleseDate') as TDateField; 56 | FPages := fDataSet.FieldByName('Pages') as TIntegerField; 57 | FPrice := fDataSet.FieldByName('Price') as TBCDField; 58 | FCurrency := fDataSet.FieldByName('Currency') as TWideStringField; 59 | FImported := fDataSet.FieldByName('Imported') as TDateTimeField; 60 | FDescription := fDataSet.FieldByName('Description') as TWideStringField; 61 | Assert(fDataSet.Fields.Count = ExpectedFieldCount); 62 | end; 63 | 64 | function TBookProxy.CountMoreExpensiveBooks: integer; 65 | var 66 | CurrentPrice: Extended; 67 | Count: integer; 68 | begin 69 | Count := 0; 70 | CurrentPrice := Price.Value; 71 | self.ForEach( 72 | procedure 73 | begin 74 | if self.Price.Value > CurrentPrice then 75 | Count := Count + 1; 76 | end); 77 | Result := Count; 78 | end; 79 | 80 | function TBookProxy.LocateISBN(const ISBN: string): boolean; 81 | begin 82 | Result := fDataSet.Locate('ISBN', ISBN, []); 83 | end; 84 | 85 | function TBookProxy.ToString: String; 86 | begin 87 | Result := Format('%s (%.2f %s)', [Title.Value, Price.Value, Currency.Value]); 88 | end; 89 | 90 | end. 91 | -------------------------------------------------------------------------------- /samples/01-books/Form.Main.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form1' 5 | ClientHeight = 345 6 | ClientWidth = 695 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnCreate = FormCreate 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object Splitter1: TSplitter 18 | Left = 180 19 | Top = 0 20 | Width = 5 21 | Height = 345 22 | ExplicitLeft = 191 23 | ExplicitHeight = 318 24 | end 25 | object GroupBox1: TGroupBox 26 | AlignWithMargins = True 27 | Left = 3 28 | Top = 3 29 | Width = 174 30 | Height = 339 31 | Align = alLeft 32 | Caption = 'GroupBox1' 33 | TabOrder = 0 34 | object Button1: TButton 35 | AlignWithMargins = True 36 | Left = 5 37 | Top = 103 38 | Width = 164 39 | Height = 39 40 | Align = alTop 41 | Caption = 'Read Books -> ListBox' 42 | TabOrder = 1 43 | OnClick = Button1Click 44 | ExplicitTop = 18 45 | end 46 | object Button2: TButton 47 | AlignWithMargins = True 48 | Left = 5 49 | Top = 148 50 | Width = 164 51 | Height = 40 52 | Align = alTop 53 | Caption = 'Button2' 54 | TabOrder = 2 55 | WordWrap = True 56 | OnClick = Button2Click 57 | ExplicitTop = 63 58 | end 59 | object GroupBox2: TGroupBox 60 | AlignWithMargins = True 61 | Left = 5 62 | Top = 27 63 | Width = 164 64 | Height = 70 65 | Margins.Top = 12 66 | Align = alTop 67 | Caption = 'GroupBox2' 68 | TabOrder = 0 69 | object rbtnSqlDataset: TRadioButton 70 | Tag = 2 71 | AlignWithMargins = True 72 | Left = 17 73 | Top = 41 74 | Width = 142 75 | Height = 17 76 | Margins.Left = 15 77 | Align = alTop 78 | Caption = 'SQL DataSet (SQLite)' 79 | TabOrder = 0 80 | OnClick = rbtnSqlDatasetClick 81 | ExplicitLeft = 24 82 | ExplicitTop = 48 83 | ExplicitWidth = 113 84 | end 85 | object rbtnMemoryDataset: TRadioButton 86 | Tag = 1 87 | AlignWithMargins = True 88 | Left = 17 89 | Top = 18 90 | Width = 142 91 | Height = 17 92 | Margins.Left = 15 93 | Align = alTop 94 | Caption = 'Memory DataSet' 95 | Checked = True 96 | TabOrder = 1 97 | TabStop = True 98 | OnClick = rbtnMemoryDatasetClick 99 | ExplicitLeft = 19 100 | end 101 | end 102 | end 103 | object ListBox1: TListBox 104 | AlignWithMargins = True 105 | Left = 188 106 | Top = 3 107 | Width = 504 108 | Height = 339 109 | Align = alClient 110 | ItemHeight = 13 111 | TabOrder = 1 112 | OnClick = ListBox1Click 113 | end 114 | object FDConnection1: TFDConnection 115 | Params.Strings = ( 116 | 'ConnectionDef=SQLite_Books') 117 | LoginPrompt = False 118 | Left = 392 119 | Top = 24 120 | end 121 | object FDPhysSQLiteDriverLink1: TFDPhysSQLiteDriverLink 122 | Left = 392 123 | Top = 80 124 | end 125 | end 126 | -------------------------------------------------------------------------------- /samples/01-books/Form.Main.pas: -------------------------------------------------------------------------------- 1 | unit Form.Main; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, 7 | System.Variants, 8 | System.Classes, 9 | Winapi.Windows, 10 | Winapi.Messages, 11 | Vcl.Graphics, 12 | Vcl.Controls, 13 | Vcl.Forms, 14 | Vcl.Dialogs, 15 | Vcl.StdCtrls, 16 | Vcl.ExtCtrls, 17 | Data.DB, 18 | FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf, 19 | FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Stan.Async, 20 | FireDAC.Phys, FireDAC.Phys.SQLite, FireDAC.Phys.SQLiteDef, 21 | FireDAC.Stan.ExprFuncs, FireDAC.VCLUI.Wait, FireDAC.Stan.Param, FireDAC.DatS, 22 | FireDAC.DApt.Intf, FireDAC.DApt, FireDAC.Comp.DataSet, FireDAC.Comp.Client, 23 | 24 | {Project uses} 25 | Data.Proxy.Book, 26 | Data.Mock.Book; 27 | 28 | type 29 | TDatasetKind = (dskMemory, dskSQL); 30 | 31 | TForm1 = class(TForm) 32 | FDConnection1: TFDConnection; 33 | FDPhysSQLiteDriverLink1: TFDPhysSQLiteDriverLink; 34 | Button1: TButton; 35 | ListBox1: TListBox; 36 | GroupBox1: TGroupBox; 37 | Splitter1: TSplitter; 38 | Button2: TButton; 39 | GroupBox2: TGroupBox; 40 | rbtnSqlDataset: TRadioButton; 41 | rbtnMemoryDataset: TRadioButton; 42 | procedure FormCreate(Sender: TObject); 43 | procedure Button1Click(Sender: TObject); 44 | procedure Button2Click(Sender: TObject); 45 | procedure ListBox1Click(Sender: TObject); 46 | procedure rbtnMemoryDatasetClick(Sender: TObject); 47 | procedure rbtnSqlDatasetClick(Sender: TObject); 48 | private 49 | fDatasetKind: TDatasetKind; 50 | fBookProxy: TBookProxy; 51 | procedure InitializeButtonCaptions; 52 | procedure CreateBookProxy; 53 | procedure ResetDemo; 54 | public 55 | end; 56 | 57 | var 58 | Form1: TForm1; 59 | 60 | implementation 61 | 62 | {$R *.dfm} 63 | 64 | uses 65 | Data.DataProxy; 66 | 67 | function CreateSQLDataSet_Book(AOwner: TComponent; AConnection: TFDConnection) 68 | : TDataSet; 69 | var 70 | fdq: TFDQuery; 71 | begin 72 | fdq := TFDQuery.Create(AOwner); 73 | with fdq do 74 | begin 75 | Connection := AConnection; 76 | SQL.Text := 'SELECT ISBN, Title, Authors, Status, ReleseDate,' + 77 | ' Pages, Price, Currency, Imported, Description FROM Books'; 78 | Open; 79 | end; 80 | Result := fdq; 81 | end; 82 | 83 | procedure TForm1.FormCreate(Sender: TObject); 84 | begin 85 | fDatasetKind := dskMemory; 86 | fBookProxy := nil; 87 | InitializeButtonCaptions; 88 | end; 89 | 90 | procedure TForm1.CreateBookProxy; 91 | begin 92 | fBookProxy := TBookProxy.Create(Self); 93 | case fDatasetKind of 94 | dskMemory: 95 | fBookProxy.WithDataSet(CreateMockTableBook(fBookProxy)); 96 | dskSQL: 97 | fBookProxy.WithDataSet(CreateSQLDataSet_Book(fBookProxy, FDConnection1)); 98 | end; 99 | end; 100 | 101 | procedure TForm1.Button1Click(Sender: TObject); 102 | begin 103 | if fBookProxy = nil then 104 | CreateBookProxy; 105 | ListBox1.ItemIndex := -1; 106 | InitializeButtonCaptions; 107 | ListBox1.Clear; 108 | fBookProxy.ForEach( 109 | procedure 110 | begin 111 | ListBox1.Items.Add(fBookProxy.ISBN.Value + ' ' + fBookProxy.ToString); 112 | end); 113 | end; 114 | 115 | procedure TForm1.Button2Click(Sender: TObject); 116 | begin 117 | Button2.Caption := Format('More expensive books = %d', 118 | [fBookProxy.CountMoreExpensiveBooks]); 119 | end; 120 | 121 | procedure TForm1.ListBox1Click(Sender: TObject); 122 | var 123 | s: string; 124 | ISBN: string; 125 | begin 126 | if (ListBox1.ItemIndex >= 0) then 127 | begin 128 | s := ListBox1.Items[ListBox1.ItemIndex]; 129 | ISBN := s.Substring(0, 14); 130 | fBookProxy.LocateISBN(ISBN); 131 | Self.Caption := fBookProxy.Title.Value; 132 | InitializeButtonCaptions; 133 | end; 134 | end; 135 | 136 | procedure TForm1.rbtnMemoryDatasetClick(Sender: TObject); 137 | begin 138 | fDatasetKind := dskMemory; 139 | ResetDemo; 140 | end; 141 | 142 | procedure TForm1.rbtnSqlDatasetClick(Sender: TObject); 143 | begin 144 | fDatasetKind := dskSQL; 145 | ResetDemo; 146 | end; 147 | 148 | procedure TForm1.ResetDemo; 149 | begin 150 | FreeAndNil(fBookProxy); 151 | InitializeButtonCaptions; 152 | ListBox1.Clear; 153 | end; 154 | 155 | procedure TForm1.InitializeButtonCaptions; 156 | begin 157 | Button2.Enabled := (fBookProxy <> nil); 158 | if fBookProxy = nil then 159 | begin 160 | Button2.Caption := 'Load books and select one of them' 161 | end 162 | else 163 | begin 164 | Button2.Caption := 'Count more expensive books then: ' + 165 | fBookProxy.Price.AsString + ' ' + fBookProxy.Currency.Value; 166 | end; 167 | end; 168 | 169 | end. 170 | -------------------------------------------------------------------------------- /samples/01-books/clear_project.bat: -------------------------------------------------------------------------------- 1 | rmdir /Q /S __history 2 | rmdir /Q /S Win32 3 | rmdir /Q /S .svn 4 | rmdir /Q /S __recovery 5 | 6 | del *.identcache 7 | del *.dproj.local 8 | del desktop.ini 9 | del *.stat 10 | 11 | del *.dcu 12 | del *.exe 13 | del *.dll 14 | -------------------------------------------------------------------------------- /samples/02-code-evolution/CodeEvolutionDemo.dpr: -------------------------------------------------------------------------------- 1 | program CodeEvolutionDemo; 2 | 3 | uses 4 | Vcl.Forms, 5 | Form.Main in 'Form.Main.pas' {FormMain}, 6 | Comp.Generator.DataProxy in '..\..\src\Comp.Generator.DataProxy.pas', 7 | Data.DataProxy in '..\..\src\Data.DataProxy.pas', 8 | Proxy.Books in 'Proxy.Books.pas', 9 | Model.Books in 'Model.Books.pas', 10 | Procesor.Currency in 'Procesor.Currency.pas', 11 | Procesor.Currency.Intf in 'Procesor.Currency.Intf.pas'; 12 | 13 | {$R *.res} 14 | 15 | begin 16 | Application.Initialize; 17 | Application.MainFormOnTaskbar := True; 18 | Application.CreateForm(TFormMain, FormMain); 19 | Application.Run; 20 | end. 21 | -------------------------------------------------------------------------------- /samples/02-code-evolution/Form.Main.dfm: -------------------------------------------------------------------------------- 1 | object FormMain: TFormMain 2 | Left = 0 3 | Top = 0 4 | Caption = 'Code Evolution Demo' 5 | ClientHeight = 455 6 | ClientWidth = 781 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnCreate = FormCreate 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object Splitter1: TSplitter 18 | Left = 374 19 | Top = 44 20 | Width = 5 21 | Height = 411 22 | ExplicitLeft = 345 23 | ExplicitTop = 0 24 | ExplicitHeight = 362 25 | end 26 | object ListBox1: TListBox 27 | AlignWithMargins = True 28 | Left = 3 29 | Top = 47 30 | Width = 371 31 | Height = 405 32 | Margins.Right = 0 33 | Style = lbOwnerDrawFixed 34 | Align = alLeft 35 | ItemHeight = 24 36 | TabOrder = 0 37 | ExplicitTop = 3 38 | ExplicitHeight = 449 39 | OnClick = ListBox1Click 40 | end 41 | object Memo1: TMemo 42 | AlignWithMargins = True 43 | Left = 379 44 | Top = 47 45 | Width = 399 46 | Height = 405 47 | Margins.Left = 0 48 | Align = alClient 49 | Lines.Strings = ( 50 | 'Book details (select book)') 51 | ScrollBars = ssVertical 52 | TabOrder = 1 53 | ExplicitLeft = 339 54 | end 55 | object FlowPanel1: TFlowPanel 56 | AlignWithMargins = True 57 | Left = 3 58 | Top = 3 59 | Width = 775 60 | Height = 38 61 | Align = alTop 62 | AutoSize = True 63 | Caption = ' ' 64 | TabOrder = 2 65 | object btnBeforeModernization: TButton 66 | AlignWithMargins = True 67 | Left = 4 68 | Top = 4 69 | Width = 165 70 | Height = 30 71 | Align = alLeft 72 | Caption = 'Before Modernization' 73 | TabOrder = 0 74 | OnClick = btnBeforeModernizationClick 75 | end 76 | object btnPhase1: TButton 77 | AlignWithMargins = True 78 | Left = 175 79 | Top = 4 80 | Width = 90 81 | Height = 30 82 | HelpType = htKeyword 83 | Caption = 'Phase 1' 84 | TabOrder = 1 85 | OnClick = btnPhase1Click 86 | end 87 | object btnPhase2: TButton 88 | AlignWithMargins = True 89 | Left = 271 90 | Top = 4 91 | Width = 90 92 | Height = 30 93 | HelpType = htKeyword 94 | Caption = 'Phase 2' 95 | TabOrder = 2 96 | OnClick = btnPhase2Click 97 | end 98 | end 99 | object FDConnection1: TFDConnection 100 | Params.Strings = ( 101 | 'Database=./books.sdb' 102 | 'DriverID=SQLite') 103 | Left = 232 104 | Top = 96 105 | end 106 | end 107 | -------------------------------------------------------------------------------- /samples/02-code-evolution/Form.Main.pas: -------------------------------------------------------------------------------- 1 | unit Form.Main; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, 7 | System.Variants, 8 | System.Classes, 9 | System.JSON, 10 | System.Generics.Collections, 11 | System.Net.HttpClient, 12 | 13 | Winapi.Windows, Winapi.Messages, 14 | 15 | FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf, 16 | FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Stan.Async, 17 | FireDAC.Phys, FireDAC.Phys.SQLite, FireDAC.Phys.SQLiteDef, 18 | FireDAC.Stan.ExprFuncs, FireDAC.VCLUI.Wait, Data.DB, FireDAC.Comp.Client, 19 | FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt, 20 | FireDAC.Comp.DataSet, 21 | 22 | Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, 23 | Vcl.ExtCtrls, 24 | 25 | Model.Books, 26 | Proxy.Books, 27 | Data.DataProxy, 28 | Procesor.Currency.Intf; 29 | 30 | type 31 | TFormMain = class(TForm) 32 | ListBox1: TListBox; 33 | FDConnection1: TFDConnection; 34 | Splitter1: TSplitter; 35 | Memo1: TMemo; 36 | FlowPanel1: TFlowPanel; 37 | btnBeforeModernization: TButton; 38 | btnPhase1: TButton; 39 | btnPhase2: TButton; 40 | procedure FormCreate(Sender: TObject); 41 | procedure btnBeforeModernizationClick(Sender: TObject); 42 | procedure btnPhase1Click(Sender: TObject); 43 | procedure btnPhase2Click(Sender: TObject); 44 | procedure ListBox1Click(Sender: TObject); 45 | private 46 | fdqBook: TFDQuery; 47 | fProxyBooks: TBooksProxy; 48 | fCurrencyProcessor: ICurrencyProcessor; 49 | 50 | function BuildAuhtorsList(const aAuthorList: string): TArray; 51 | function ConvertReleaseDate(const aReleseDate: string; 52 | out isDatePrecise: boolean): TDateTime; 53 | procedure ValidateCurrency(const aPriceCurrency: string); 54 | { 55 | procedure DownloadCurrencyRates; 56 | function LocateRate(aCurrencyCode: string): integer; 57 | } 58 | public 59 | end; 60 | 61 | var 62 | FormMain: TFormMain; 63 | 64 | implementation 65 | 66 | {$R *.dfm} 67 | 68 | uses 69 | System.StrUtils, 70 | System.DateUtils, 71 | 72 | Procesor.Currency; 73 | 74 | procedure TFormMain.FormCreate(Sender: TObject); 75 | begin 76 | // OLD: fCurrencyRates := nil; 77 | fCurrencyProcessor := TCurrencyProcessor.Create; 78 | 79 | ListBox1.Clear; 80 | fdqBook := TFDQuery.Create(Self); 81 | fdqBook.Connection := FDConnection1; 82 | fdqBook.Open('SELECT ISBN, Title, Authors, Status, ReleaseDate,' + 83 | ' Pages, Price, Currency FROM {id Books}'); 84 | fProxyBooks := TBooksProxy.Create(Self); 85 | fProxyBooks.WithDataSet(fdqBook); 86 | fProxyBooks.SetCurrencyProcessor(fCurrencyProcessor); 87 | end; 88 | 89 | procedure TFormMain.ListBox1Click(Sender: TObject); 90 | var 91 | aBook: TBook; 92 | begin 93 | aBook := ListBox1.Items.Objects[ListBox1.ItemIndex] as TBook; 94 | Memo1.Lines.Clear; 95 | Memo1.Lines.Add('ISBN: ' + aBook.ISBN); 96 | Memo1.Lines.Add('Title: ' + aBook.Title); 97 | Memo1.Lines.Add('Authors: ' + aBook.GetAuthorsList); 98 | Memo1.Lines.Add('ReleaseDate: ' + aBook.GetReleaseDate); 99 | Memo1.Lines.Add('Local Price: ' + FormatFloat('###,###,###.00', 100 | // OLD: aBook.GetPrice('PLN', fCurrencyRates)) + ' PLN zloty'); 101 | aBook.GetPrice('PLN', fCurrencyProcessor)) + ' PLN zloty'); 102 | Memo1.Lines.Add('Original Price: ' + FormatFloat('###,###,###.00', 103 | aBook.Price) + ' ' + aBook.PriceCurrency); 104 | end; 105 | 106 | const 107 | MonthToRoman: array [1 .. 12] of string = ('I', 'II', 'III', 'IV', 'V', 'VI', 108 | 'VII', 'VIII', 'IX', 'X', 'XI', 'XII'); 109 | 110 | function TFormMain.BuildAuhtorsList(const aAuthorList: string): TArray; 111 | var 112 | aAuthors: TArray; 113 | idx: integer; 114 | begin 115 | aAuthors := SplitString(aAuthorList, ','); 116 | SetLength(Result, Length(aAuthors)); 117 | for idx := 0 to High(aAuthors) do 118 | Result[idx] := aAuthors[idx].Trim; 119 | end; 120 | 121 | function TFormMain.ConvertReleaseDate(const aReleseDate: string; 122 | out isDatePrecise: boolean): TDateTime; 123 | var 124 | idxSeparator: integer; 125 | yy: word; 126 | i: integer; 127 | sMonth: string; 128 | mm: word; 129 | begin 130 | isDatePrecise := false; 131 | if aReleseDate = '' then 132 | Exit(0); 133 | idxSeparator := aReleseDate.IndexOf(' '); 134 | if idxSeparator = -1 then 135 | begin 136 | Result := ISO8601ToDate(aReleseDate); 137 | isDatePrecise := true; 138 | end 139 | else 140 | begin 141 | yy := StrToInt(aReleseDate.Substring(idxSeparator + 1)); 142 | sMonth := aReleseDate.Substring(0, idxSeparator); 143 | mm := 0; 144 | for i := 1 to 12 do 145 | if sMonth = MonthToRoman[i] then 146 | mm := i; 147 | Result := EncodeDate(yy, mm, 1); 148 | end; 149 | end; 150 | 151 | { 152 | procedure TFormMain.DownloadCurrencyRates; 153 | var 154 | aStringStream: TStringStream; 155 | aHTTPClient: THTTPClient; 156 | jsResult: TJSONObject; 157 | jsRates: TJSONObject; 158 | idx: integer; 159 | begin 160 | aStringStream := TStringStream.Create('', TEncoding.UTF8); 161 | try 162 | aHTTPClient := THTTPClient.Create; 163 | try 164 | aHTTPClient.Get('https://api.exchangeratesapi.io/latest', aStringStream); 165 | jsResult := TJSONObject.ParseJSONValue(aStringStream.DataString) 166 | as TJSONObject; 167 | try 168 | jsRates := jsResult.GetValue('rates') as TJSONObject; 169 | SetLength(fCurrencyRates, jsRates.Count + 1); 170 | fCurrencyRates[0].Code := 'EUR'; 171 | fCurrencyRates[0].Rate := 1.0000; 172 | for idx := 0 to jsRates.Count - 1 do 173 | begin 174 | fCurrencyRates[idx + 1].Code := jsRates.Pairs[idx].JsonString.Value; 175 | fCurrencyRates[idx + 1].Rate := jsRates.Pairs[idx] 176 | .JsonValue.AsType; 177 | end; 178 | finally 179 | jsResult.Free; 180 | end; 181 | finally 182 | aHTTPClient.Free; 183 | end; 184 | finally 185 | aStringStream.Free; 186 | end; 187 | end; 188 | 189 | function TFormMain.LocateRate(aCurrencyCode: string): integer; 190 | var 191 | idx: integer; 192 | begin 193 | for idx := 0 to High(fCurrencyRates) do 194 | if fCurrencyRates[idx].Code = aCurrencyCode then 195 | Exit(idx); 196 | Result := -1; 197 | end; 198 | } 199 | 200 | procedure TFormMain.ValidateCurrency(const aPriceCurrency: string); 201 | begin 202 | // OLD: 203 | { 204 | if fCurrencyRates = nil then 205 | DownloadCurrencyRates; 206 | if LocateRate(aPriceCurrency) = -1 then 207 | raise EInvalidCurrency.Create('Invalid currency in book price: ' + 208 | aPriceCurrency); 209 | } 210 | if not fCurrencyProcessor.IsInitialiased then 211 | fCurrencyProcessor.Download('https://api.exchangeratesapi.io/latest'); 212 | if not fCurrencyProcessor.IsCurrencySupported(aPriceCurrency) then 213 | raise EInvalidCurrency.Create('Invalid currency in book price: ' + 214 | aPriceCurrency); 215 | end; 216 | 217 | procedure TFormMain.btnBeforeModernizationClick(Sender: TObject); 218 | var 219 | aIndex: integer; 220 | aBookmark: TBookmark; 221 | aBook: TBook; 222 | isDatePrecise: boolean; 223 | aBookCaption: string; 224 | begin 225 | ListBox1.ItemIndex := -1; 226 | for aIndex := 0 to ListBox1.Items.Count - 1 do 227 | ListBox1.Items.Objects[aIndex].Free; 228 | ListBox1.Clear; 229 | aBookmark := fdqBook.GetBookmark; 230 | try 231 | fdqBook.DisableControls; 232 | try 233 | while not fdqBook.Eof do 234 | begin 235 | aBookCaption := fdqBook.FieldByName('ISBN').AsString + ' - ' + 236 | fdqBook.FieldByName('Title').AsString; 237 | aBook := TBook.Create; 238 | ListBox1.AddItem(aBookCaption, aBook); 239 | aBook.ISBN := fdqBook.FieldByName('ISBN').AsString; 240 | aBook.Authors.AddRange(BuildAuhtorsList(fdqBook.FieldByName('Authors') 241 | .AsString)); 242 | aBook.Title := fdqBook.FieldByName('Title').AsString; 243 | aBook.ReleaseDate := ConvertReleaseDate 244 | (fdqBook.FieldByName('ReleaseDate').AsString, isDatePrecise); 245 | aBook.IsPreciseReleaseDate := isDatePrecise; 246 | aBook.Price := fdqBook.FieldByName('Price').AsCurrency; 247 | aBook.PriceCurrency := fdqBook.FieldByName('Currency').AsString; 248 | ValidateCurrency(aBook.PriceCurrency); 249 | fdqBook.Next; 250 | end; 251 | finally 252 | fdqBook.EnableControls; 253 | end 254 | finally 255 | fdqBook.FreeBookmark(aBookmark); 256 | end; 257 | end; 258 | 259 | procedure TFormMain.btnPhase1Click(Sender: TObject); 260 | var 261 | aIndex: integer; 262 | aBook: TBook; 263 | isDatePrecise: boolean; 264 | begin 265 | ListBox1.ItemIndex := -1; 266 | for aIndex := 0 to ListBox1.Items.Count - 1 do 267 | ListBox1.Items.Objects[aIndex].Free; 268 | ListBox1.Clear; 269 | 270 | fProxyBooks.ForEach( 271 | procedure 272 | begin 273 | aBook := TBook.Create; 274 | ListBox1.AddItem(fProxyBooks.ISBN.Value + ' - ' + 275 | fProxyBooks.Title.Value, aBook); 276 | aBook.ISBN := fProxyBooks.ISBN.Value; 277 | aBook.Authors.AddRange(BuildAuhtorsList(fProxyBooks.Authors.Value)); 278 | aBook.Title := fProxyBooks.Title.Value; 279 | aBook.ReleaseDate := ConvertReleaseDate(fProxyBooks.ReleaseDate.Value, 280 | isDatePrecise); 281 | aBook.IsPreciseReleaseDate := isDatePrecise; 282 | aBook.Price := fProxyBooks.Price.AsCurrency; 283 | aBook.PriceCurrency := fProxyBooks.Currency.Value; 284 | ValidateCurrency(aBook.PriceCurrency); 285 | end); 286 | end; 287 | 288 | procedure TFormMain.btnPhase2Click(Sender: TObject); 289 | begin 290 | ListBox1.Clear; 291 | fProxyBooks.LoadAndValidate; 292 | fProxyBooks.FillStringsWithBooks(ListBox1.Items); 293 | end; 294 | 295 | end. 296 | -------------------------------------------------------------------------------- /samples/02-code-evolution/Model.Books.pas: -------------------------------------------------------------------------------- 1 | unit Model.Books; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, 7 | System.Classes, 8 | System.StrUtils, 9 | System.Generics.Collections, 10 | 11 | Procesor.Currency.Intf; 12 | 13 | type 14 | TBook = class 15 | strict private 16 | FISBN: string; 17 | FTitle: String; 18 | FAuthors: TList; 19 | FReleaseDate: TDateTime; 20 | FIsPreciseReleaseDate: boolean; 21 | FPrice: Currency; 22 | FPriceCurrency: string; 23 | FPages: integer; 24 | private 25 | public 26 | constructor Create; virtual; 27 | destructor Destroy; override; 28 | // --- 29 | function GetAuthorsList: string; 30 | function GetReleaseDate: string; 31 | function GetPrice(const aCurrencyCode: string; 32 | aCurrencyProcessor: ICurrencyProcessor): double; 33 | // --- 34 | property ISBN: string read FISBN write FISBN; 35 | property Title: String read FTitle write FTitle; 36 | property Authors: TList read FAuthors write FAuthors; 37 | property ReleaseDate: TDateTime read FReleaseDate write FReleaseDate; 38 | property IsPreciseReleaseDate: boolean read FIsPreciseReleaseDate 39 | write FIsPreciseReleaseDate; 40 | property Price: Currency read FPrice write FPrice; 41 | property PriceCurrency: string read FPriceCurrency write FPriceCurrency; 42 | property Pages: integer read FPages write FPages; 43 | end; 44 | 45 | implementation 46 | 47 | constructor TBook.Create; 48 | begin 49 | FAuthors := TList.Create; 50 | end; 51 | 52 | destructor TBook.Destroy; 53 | begin 54 | FAuthors.Free; 55 | inherited; 56 | end; 57 | 58 | function TBook.GetAuthorsList: string; 59 | var 60 | idx: integer; 61 | begin 62 | if FAuthors.Count = 0 then 63 | Exit(''); 64 | Result := FAuthors[0]; 65 | for idx := 1 to FAuthors.Count - 1 do 66 | Result := Result + ', ' + FAuthors[idx]; 67 | end; 68 | 69 | function LocateRate(const aCurrencyCode: string; 70 | const aCurrencyTable: TArray): integer; 71 | var 72 | idx: integer; 73 | begin 74 | for idx := 0 to High(aCurrencyTable) do 75 | if aCurrencyTable[idx].Code = aCurrencyCode then 76 | Exit(idx); 77 | Result := -1; 78 | end; 79 | 80 | function TBook.GetPrice(const aCurrencyCode: string; 81 | aCurrencyProcessor: ICurrencyProcessor): double; 82 | begin 83 | // OLD: 84 | { 85 | idxFrom := LocateRate(FPriceCurrency, aCurrencyTable); 86 | idxTo := LocateRate(aCurrencyCode, aCurrencyTable); 87 | Result := Round(FPrice / aCurrencyTable[idxFrom].Rate * aCurrencyTable 88 | [idxTo].Rate); 89 | } 90 | Result := Round(aCurrencyProcessor.Convert(FPrice, FPriceCurrency, 91 | aCurrencyCode)); 92 | end; 93 | 94 | function TBook.GetReleaseDate: string; 95 | begin 96 | if FReleaseDate = 0 then 97 | Result := '---' 98 | else if FIsPreciseReleaseDate then 99 | Result := DateToStr(FReleaseDate) 100 | else 101 | Result := FormatDateTime('mm yyyy', FReleaseDate); 102 | end; 103 | 104 | end. 105 | -------------------------------------------------------------------------------- /samples/02-code-evolution/Procesor.Currency.Intf.pas: -------------------------------------------------------------------------------- 1 | unit Procesor.Currency.Intf; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils; 7 | 8 | type 9 | EInvalidCurrency = class(Exception); 10 | 11 | TCurrencyRate = record 12 | Code: String; 13 | Rate: Currency; 14 | end; 15 | 16 | ICurrencyProcessor = interface(IInvokable) 17 | ['{08CE1219-BC8A-45C9-B704-9D8D3B25FDFB}'] 18 | function IsInitialiased: boolean; 19 | procedure Download(const aURL: string); 20 | function IsCurrencySupported(const aCode: string): boolean; 21 | function Convert(aValue: Currency; const aFromCurrency: string; 22 | const aToCurrency: string): Currency; 23 | end; 24 | 25 | implementation 26 | 27 | end. 28 | -------------------------------------------------------------------------------- /samples/02-code-evolution/Procesor.Currency.pas: -------------------------------------------------------------------------------- 1 | unit Procesor.Currency; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, 7 | System.Classes, 8 | System.JSON, 9 | System.Generics.Collections, 10 | System.Net.HttpClient, 11 | 12 | Procesor.Currency.Intf; 13 | 14 | type 15 | ECurrencyProcessorError = class(Exception); 16 | 17 | TCurrencyProcessor = class(TInterfacedObject, ICurrencyProcessor) 18 | private 19 | fCurrencyRates: TArray; 20 | function GetCurrencyRate(const aCode: string): Currency; 21 | public 22 | constructor Create; 23 | function IsInitialiased: boolean; 24 | procedure Download(const aURL: string); 25 | function IsCurrencySupported(const aCode: string): boolean; 26 | function Convert(aValue: Currency; const aFromCurrency: string; 27 | const aToCurrency: string): Currency; 28 | end; 29 | 30 | implementation 31 | 32 | constructor TCurrencyProcessor.Create; 33 | begin 34 | fCurrencyRates := nil; 35 | end; 36 | 37 | function TCurrencyProcessor.IsInitialiased: boolean; 38 | begin 39 | Result := (fCurrencyRates <> nil); 40 | end; 41 | 42 | procedure TCurrencyProcessor.Download(const aURL: string); 43 | var 44 | aStringStream: TStringStream; 45 | aHTTPClient: THTTPClient; 46 | jsResult: TJSONObject; 47 | jsRates: TJSONObject; 48 | idx: integer; 49 | begin 50 | aStringStream := TStringStream.Create('', TEncoding.UTF8); 51 | try 52 | aHTTPClient := THTTPClient.Create; 53 | try 54 | aHTTPClient.Get(aURL, aStringStream); 55 | jsResult := TJSONObject.ParseJSONValue(aStringStream.DataString) 56 | as TJSONObject; 57 | try 58 | jsRates := jsResult.GetValue('rates') as TJSONObject; 59 | SetLength(fCurrencyRates, jsRates.Count + 1); 60 | fCurrencyRates[0].Code := 'EUR'; 61 | fCurrencyRates[0].Rate := 1.0000; 62 | for idx := 0 to jsRates.Count - 1 do 63 | begin 64 | fCurrencyRates[idx + 1].Code := jsRates.Pairs[idx].JsonString.Value; 65 | fCurrencyRates[idx + 1].Rate := jsRates.Pairs[idx] 66 | .JsonValue.AsType; 67 | end; 68 | finally 69 | jsResult.Free; 70 | end; 71 | finally 72 | aHTTPClient.Free; 73 | end; 74 | finally 75 | aStringStream.Free; 76 | end; 77 | end; 78 | 79 | function TCurrencyProcessor.IsCurrencySupported(const aCode: string): boolean; 80 | var 81 | idx: integer; 82 | begin 83 | for idx := 0 to High(fCurrencyRates) do 84 | if fCurrencyRates[idx].Code = aCode then 85 | Exit(True); 86 | Result := False; 87 | end; 88 | 89 | function TCurrencyProcessor.GetCurrencyRate(const aCode: string): Currency; 90 | var 91 | idx: integer; 92 | begin 93 | for idx := 0 to High(fCurrencyRates) do 94 | if fCurrencyRates[idx].Code = aCode then 95 | Exit(fCurrencyRates[idx].Rate); 96 | raise ECurrencyProcessorError.Create('Unregistered currency code: ' + aCode); 97 | end; 98 | 99 | function TCurrencyProcessor.Convert(aValue: Currency; 100 | const aFromCurrency, aToCurrency: string): Currency; 101 | begin 102 | Result := aValue / GetCurrencyRate(aFromCurrency) * 103 | GetCurrencyRate(aToCurrency); 104 | end; 105 | 106 | end. 107 | -------------------------------------------------------------------------------- /samples/02-code-evolution/Proxy.Books.pas: -------------------------------------------------------------------------------- 1 | unit Proxy.Books; 2 | 3 | interface 4 | 5 | uses 6 | Data.DB, 7 | Data.DataProxy, 8 | System.SysUtils, 9 | System.Classes, 10 | // ---- Stage 2 code: 11 | System.DateUtils, 12 | System.StrUtils, 13 | System.Generics.Collections, 14 | // ---- 15 | FireDAC.Comp.Client, 16 | 17 | // ---- Stage 2 code: 18 | Procesor.Currency.Intf, 19 | Model.Books; 20 | // ---- 21 | 22 | type 23 | TBooksProxy = class(TDatasetProxy) 24 | private 25 | FISBN: TWideStringField; 26 | FTitle: TWideStringField; 27 | FAuthors: TWideStringField; 28 | FStatus: TWideStringField; 29 | FReleaseDate: TWideStringField; 30 | FPages: TIntegerField; 31 | FPrice: TBCDField; 32 | FCurrency: TWideStringField; 33 | // ---- Stage 2 code: 34 | fCurrencyProcessor: ICurrencyProcessor; 35 | fBooksList: TObjectList; 36 | procedure ValidateCurrency(const aPriceCurrency: string); 37 | function BuildAuhtorsList(const aAuthorList: string): TArray; 38 | function ConvertReleaseDate(const aReleseDate: string; 39 | out isDatePrecise: boolean): TDateTime; 40 | // ---- 41 | protected 42 | procedure ConnectFields; override; 43 | public 44 | // ---- Stage 2 code: 45 | constructor Create(Owner: TComponent); override; 46 | destructor Destroy; override; 47 | procedure SetCurrencyProcessor(aCurrencyProc: ICurrencyProcessor); 48 | procedure FillStringsWithBooks(aStrings: TStrings); 49 | procedure LoadAndValidate; 50 | // ---- 51 | property ISBN: TWideStringField read FISBN; 52 | property Title: TWideStringField read FTitle; 53 | property Authors: TWideStringField read FAuthors; 54 | property Status: TWideStringField read FStatus; 55 | property ReleaseDate: TWideStringField read FReleaseDate; 56 | property Pages: TIntegerField read FPages; 57 | property Price: TBCDField read FPrice; 58 | property Currency: TWideStringField read FCurrency; 59 | end; 60 | 61 | implementation 62 | 63 | procedure TBooksProxy.ConnectFields; 64 | const 65 | ExpectedFieldCount = 8; 66 | begin 67 | FISBN := FDataSet.FieldByName('ISBN') as TWideStringField; 68 | FTitle := FDataSet.FieldByName('Title') as TWideStringField; 69 | FAuthors := FDataSet.FieldByName('Authors') as TWideStringField; 70 | FStatus := FDataSet.FieldByName('Status') as TWideStringField; 71 | FReleaseDate := FDataSet.FieldByName('ReleaseDate') as TWideStringField; 72 | FPages := FDataSet.FieldByName('Pages') as TIntegerField; 73 | FPrice := FDataSet.FieldByName('Price') as TBCDField; 74 | FCurrency := FDataSet.FieldByName('Currency') as TWideStringField; 75 | Assert(FDataSet.Fields.Count = ExpectedFieldCount); 76 | end; 77 | 78 | 79 | // -------------------------------------------------------- 80 | // ---- Stage 2 code: 81 | 82 | const 83 | ThisIsObjectsOwner = true; 84 | 85 | constructor TBooksProxy.Create(Owner: TComponent); 86 | begin 87 | inherited; 88 | fBooksList := TObjectList.Create(ThisIsObjectsOwner); 89 | fCurrencyProcessor := nil; 90 | end; 91 | 92 | destructor TBooksProxy.Destroy; 93 | begin 94 | fBooksList.Free; 95 | inherited; 96 | end; 97 | 98 | const 99 | MonthToRoman: array [1 .. 12] of string = ('I', 'II', 'III', 'IV', 'V', 'VI', 100 | 'VII', 'VIII', 'IX', 'X', 'XI', 'XII'); 101 | 102 | function TBooksProxy.BuildAuhtorsList(const aAuthorList: string) 103 | : TArray; 104 | var 105 | aAuthors: TArray; 106 | idx: integer; 107 | begin 108 | aAuthors := SplitString(aAuthorList, ','); 109 | SetLength(Result, Length(aAuthors)); 110 | for idx := 0 to High(aAuthors) do 111 | Result[idx] := aAuthors[idx].Trim; 112 | end; 113 | 114 | function TBooksProxy.ConvertReleaseDate(const aReleseDate: string; 115 | out isDatePrecise: boolean): TDateTime; 116 | var 117 | idxSeparator: integer; 118 | yy: word; 119 | i: integer; 120 | sMonth: string; 121 | mm: word; 122 | begin 123 | isDatePrecise := false; 124 | if aReleseDate = '' then 125 | Exit(0); 126 | idxSeparator := aReleseDate.IndexOf(' '); 127 | if idxSeparator = -1 then 128 | begin 129 | Result := ISO8601ToDate(aReleseDate); 130 | isDatePrecise := true; 131 | end 132 | else 133 | begin 134 | yy := StrToInt(aReleseDate.Substring(idxSeparator + 1)); 135 | sMonth := aReleseDate.Substring(0, idxSeparator); 136 | mm := 0; 137 | for i := 1 to 12 do 138 | if sMonth = MonthToRoman[i] then 139 | mm := i; 140 | Result := EncodeDate(yy, mm, 1); 141 | end; 142 | end; 143 | 144 | procedure TBooksProxy.ValidateCurrency(const aPriceCurrency: string); 145 | begin 146 | if not fCurrencyProcessor.IsInitialiased then 147 | fCurrencyProcessor.Download('https://api.exchangeratesapi.io/latest'); 148 | if not fCurrencyProcessor.IsCurrencySupported(aPriceCurrency) then 149 | raise EInvalidCurrency.Create('Invalid currency in book price: ' + 150 | aPriceCurrency); 151 | end; 152 | 153 | procedure TBooksProxy.SetCurrencyProcessor(aCurrencyProc: ICurrencyProcessor); 154 | begin 155 | fCurrencyProcessor := aCurrencyProc; 156 | end; 157 | 158 | procedure TBooksProxy.FillStringsWithBooks(aStrings: TStrings); 159 | var 160 | aBook: TBook; 161 | begin 162 | aStrings.Clear; 163 | for aBook in fBooksList do 164 | aStrings.AddObject(aBook.ISBN + ' - ' + aBook.Title, aBook); 165 | end; 166 | 167 | procedure TBooksProxy.LoadAndValidate; 168 | var 169 | aBook: TBook; 170 | isDatePrecise: boolean; 171 | begin 172 | fBooksList.Clear; 173 | ForEach( 174 | procedure 175 | begin 176 | aBook := TBook.Create; 177 | fBooksList.Add(aBook); 178 | aBook.ISBN := ISBN.Value; 179 | aBook.Authors.AddRange(BuildAuhtorsList(Authors.Value)); 180 | aBook.Title := Title.Value; 181 | aBook.ReleaseDate := ConvertReleaseDate(ReleaseDate.Value, isDatePrecise); 182 | aBook.IsPreciseReleaseDate := isDatePrecise; 183 | aBook.Price := Price.AsCurrency; 184 | aBook.PriceCurrency := Currency.Value; 185 | ValidateCurrency(aBook.PriceCurrency); 186 | end); 187 | end; 188 | 189 | // -------------------------------------------------------- 190 | 191 | end. 192 | -------------------------------------------------------------------------------- /samples/02-code-evolution/books.sdb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bogdanpolak/delphi-dataproxy/fef7a3a3c5256788ae9f52f105b7a1c1b841f466/samples/02-code-evolution/books.sdb -------------------------------------------------------------------------------- /samples/README.md: -------------------------------------------------------------------------------- 1 | # DataProxy Samples 2 | 3 | ### (1) Books DataProxy 4 | 5 | - Requires: `SQLite` database 6 | - Step 1: Execute `books.sql` script to create a table and insert data 7 | - Step 2: Create FireDAC connection definition (name: `SQLite_Books`) 8 | - Script: [books.sql](./books.sql) 9 | -------------------------------------------------------------------------------- /src/Comp.Generator.DataProxy.pas: -------------------------------------------------------------------------------- 1 | unit Comp.Generator.DataProxy; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, 7 | System.Classes, 8 | System.StrUtils, 9 | System.Math, 10 | Data.DB, 11 | System.Generics.Collections, 12 | Vcl.Clipbrd; // required for TDataProxyGenerator.SaveToClipboard 13 | 14 | type 15 | // pgmClass - generates only class (no unit items: unit, interface, implementation 16 | // pgmUnit - generate full unt (add end.) 17 | TProxyGeneratorMode = (pgmClass, pgmUnit); 18 | TFieldNamingStyle = (fnsUpperCaseF, fnsLowerCaseF); 19 | TDataSetAccess = (dsaNoAccess, dsaGenComment, dsaFullAccess); 20 | 21 | TDataProxyGenerator = class(TComponent) 22 | private const 23 | Version = '1.1'; 24 | private 25 | fDataSet: TDataSet; 26 | fCode: TStringList; 27 | fGeneratorMode: TProxyGeneratorMode; 28 | fDataSetAccess: TDataSetAccess; 29 | fFieldNamingStyle: TFieldNamingStyle; 30 | fNameOfUnit: string; 31 | fNameOfClass: string; 32 | fIndentationText: string; 33 | procedure Guard; 34 | function GetFieldPrefix: string; 35 | protected 36 | function Gen_UnitHeader: string; 37 | function Gen_UsesSection: string; 38 | function Gen_ClassDeclaration: string; 39 | function Gen_PrivateField(fld: TField): string; 40 | function Gen_PublicProperty(fld: TField): string; 41 | function Gen_FieldAssigment(fld: TField): string; 42 | function Gen_MethodConnectFields: string; 43 | public 44 | constructor Create(Owner: TComponent); override; 45 | destructor Destroy; override; 46 | procedure Execute; 47 | class procedure SaveToFile(const aFileName: string; aDataSet: TDataSet; 48 | const aNameOfClass: string; const aIndentationText: string = ' '; 49 | aNamingStyle: TFieldNamingStyle = fnsUpperCaseF); static; 50 | class procedure SaveToClipboard(aDataSet: TDataSet; 51 | const aNameOfClass: string; const aIndentationText: string = ' '; 52 | aNamingStyle: TFieldNamingStyle = fnsUpperCaseF); static; 53 | published 54 | property Code: TStringList read fCode; 55 | property DataSet: TDataSet read fDataSet write fDataSet; 56 | // ---- options ---- 57 | property GeneratorMode: TProxyGeneratorMode read fGeneratorMode 58 | write fGeneratorMode; 59 | property DataSetAccess: TDataSetAccess read fDataSetAccess 60 | write fDataSetAccess; 61 | property FieldNamingStyle: TFieldNamingStyle read fFieldNamingStyle 62 | write fFieldNamingStyle; 63 | property NameOfUnit: string read fNameOfUnit write fNameOfUnit; 64 | property NameOfClass: string read fNameOfClass write fNameOfClass; 65 | 66 | property IndentationText: string read fIndentationText 67 | write fIndentationText; 68 | end; 69 | 70 | implementation 71 | 72 | constructor TDataProxyGenerator.Create(Owner: TComponent); 73 | begin 74 | inherited; 75 | fCode := TStringList.Create; 76 | fDataSet := nil; 77 | fNameOfUnit := 'Unit1'; 78 | fNameOfClass := 'TFoo'; 79 | fDataSetAccess := dsaNoAccess; 80 | fIndentationText := ' '; 81 | fGeneratorMode := pgmUnit; 82 | end; 83 | 84 | destructor TDataProxyGenerator.Destroy; 85 | begin 86 | fCode.Free; 87 | inherited; 88 | end; 89 | 90 | procedure TDataProxyGenerator.Guard; 91 | begin 92 | Assert(fDataSet <> nil); 93 | Assert(fDataSet.Active); 94 | end; 95 | 96 | function TDataProxyGenerator.Gen_UnitHeader: string; 97 | begin 98 | Result := 99 | {} 'unit ' + fNameOfUnit + ';' + sLineBreak + 100 | {} sLineBreak + 101 | {} 'interface' + sLineBreak + 102 | {} sLineBreak; 103 | end; 104 | 105 | function TDataProxyGenerator.Gen_UsesSection: string; 106 | begin 107 | Result := 108 | (* *) 'uses' + sLineBreak + 109 | (* *) fIndentationText + 'Data.DB,' + sLineBreak + 110 | (* *) fIndentationText + 'Data.DataProxy,' + sLineBreak + 111 | (* *) fIndentationText + 'System.SysUtils,' + sLineBreak + 112 | (* *) fIndentationText + 'System.Classes,' + sLineBreak + 113 | (* *) fIndentationText + 'FireDAC.Comp.Client;' + sLineBreak; 114 | end; 115 | 116 | function GetFieldClassName(fld: TField): string; 117 | begin 118 | Result := Data.DB.DefaultFieldClasses[fld.DataType].ClassName; 119 | end; 120 | 121 | function TDataProxyGenerator.GetFieldPrefix: string; 122 | begin 123 | case fFieldNamingStyle of 124 | fnsUpperCaseF: 125 | Result := 'F'; 126 | fnsLowerCaseF: 127 | Result := 'f'; 128 | end; 129 | end; 130 | 131 | function TDataProxyGenerator.Gen_PrivateField(fld: TField): string; 132 | begin 133 | Result := GetFieldPrefix + fld.FieldName + ' :' + 134 | GetFieldClassName(fld) + ';'; 135 | end; 136 | 137 | function TDataProxyGenerator.Gen_PublicProperty(fld: TField): string; 138 | begin 139 | Result := 'property ' + fld.FieldName + ' :' + GetFieldClassName(fld) + 140 | ' read ' + GetFieldPrefix + fld.FieldName + ';'; 141 | end; 142 | 143 | function TDataProxyGenerator.Gen_FieldAssigment(fld: TField): string; 144 | begin 145 | Result := GetFieldPrefix + fld.FieldName + ' := FDataSet.FieldByName(''' + 146 | fld.FieldName + ''') as ' + GetFieldClassName(fld) + ';'; 147 | end; 148 | 149 | function TDataProxyGenerator.Gen_ClassDeclaration: string; 150 | var 151 | fld: TField; 152 | aPrivateFields: string; 153 | aPublicProperties: string; 154 | aDatasePropertyCode: string; 155 | aIden: string; 156 | begin 157 | aPrivateFields := ''; 158 | aPublicProperties := ''; 159 | aIden := fIndentationText; 160 | if fDataSet <> nil then 161 | begin 162 | for fld in fDataSet.Fields do 163 | begin 164 | aPrivateFields := aPrivateFields + 165 | {} aIden + aIden + Gen_PrivateField(fld) + sLineBreak; 166 | aPublicProperties := aPublicProperties + 167 | {} aIden + aIden + Gen_PublicProperty(fld) + sLineBreak; 168 | end; 169 | end; 170 | // ---- 171 | case fDataSetAccess of 172 | dsaNoAccess: 173 | aDatasePropertyCode := ''; 174 | dsaGenComment: 175 | aDatasePropertyCode := 176 | {} aIden + aIden + '// the following property should be hidden ' + 177 | '(uncomment if required)' + sLineBreak + 178 | {} aIden + aIden + '// property DataSet: TDataSet read FDataSet;' + 179 | sLineBreak; 180 | dsaFullAccess: 181 | aDatasePropertyCode := 182 | {} aIden + aIden + 'property DataSet: TDataSet read FDataSet;' + 183 | sLineBreak; 184 | end; 185 | // ---- 186 | Result := 187 | {} 'type' + sLineBreak + 188 | {} aIden + fNameOfClass + ' = class(TDatasetProxy)' + sLineBreak + 189 | {} aIden + 'private' + sLineBreak + 190 | {} aPrivateFields + 191 | {} aIden + 'protected' + sLineBreak + 192 | {} aIden + aIden + 'procedure ConnectFields; override;' + sLineBreak + 193 | {} aIden + 'public' + sLineBreak + 194 | {} aPublicProperties + 195 | {} aDatasePropertyCode + 196 | {} aIden + 'end;' + sLineBreak; 197 | end; 198 | 199 | function TDataProxyGenerator.Gen_MethodConnectFields: string; 200 | var 201 | aFieldCount: Integer; 202 | fld: TField; 203 | aFieldAssigments: string; 204 | begin 205 | if fDataSet <> nil then 206 | begin 207 | aFieldCount := fDataSet.Fields.Count; 208 | for fld in fDataSet.Fields do 209 | aFieldAssigments := aFieldAssigments + fIndentationText + 210 | Gen_FieldAssigment(fld) + sLineBreak; 211 | end 212 | else 213 | begin 214 | aFieldCount := 0; 215 | aFieldAssigments := ''; 216 | end; 217 | Result := 218 | {} 'procedure ' + fNameOfClass + '.ConnectFields;' + sLineBreak + 219 | {} 'const' + sLineBreak + 220 | {} fIndentationText + 'ExpectedFieldCount = ' + aFieldCount.ToString + ';' + 221 | sLineBreak + 222 | {} 'begin' + sLineBreak + 223 | {} aFieldAssigments + 224 | {} fIndentationText + 'Assert(FDataSet.Fields.Count = ExpectedFieldCount);' + 225 | sLineBreak + 226 | {} 'end;' + sLineBreak; 227 | end; 228 | 229 | procedure TDataProxyGenerator.Execute; 230 | begin 231 | Guard; 232 | if fGeneratorMode = pgmClass then 233 | fCode.Text := 234 | {} Gen_ClassDeclaration + 235 | {} sLineBreak + 236 | {} Gen_MethodConnectFields 237 | else 238 | fCode.Text := 239 | {} Gen_UnitHeader + 240 | {} Gen_UsesSection + 241 | {} sLineBreak + 242 | {} Gen_ClassDeclaration + 243 | {} sLineBreak + 244 | {} 'implementation' + sLineBreak + 245 | {} sLineBreak + 246 | {} Gen_MethodConnectFields + 247 | {} sLineBreak + 248 | {} 'end.' + sLineBreak; 249 | end; 250 | 251 | function ExtractNameFromFullPath(const aFullPath: string): string; 252 | var 253 | sFileName: string; 254 | aExtLength: Integer; 255 | begin 256 | sFileName := ExtractFileName(aFullPath); 257 | aExtLength := Length(ExtractFileExt(aFullPath)); 258 | Result := sFileName.Substring(0, Length(sFileName) - aExtLength); 259 | end; 260 | 261 | function ExtractUnitName(const aFileName: string): string; 262 | var 263 | aName: string; 264 | aLen: Integer; 265 | begin 266 | aName := ExtractFileName(aFileName); 267 | aLen := ExtractFileExt(aFileName).Length; 268 | Result := aName.Substring(0, aName.Length - aLen); 269 | end; 270 | 271 | class procedure TDataProxyGenerator.SaveToFile(const aFileName: string; 272 | aDataSet: TDataSet; const aNameOfClass: string; 273 | const aIndentationText: string; aNamingStyle: TFieldNamingStyle); 274 | var 275 | aGenerator: TDataProxyGenerator; 276 | aUnitName: string; 277 | aStringStream: TStringStream; 278 | begin 279 | aGenerator := TDataProxyGenerator.Create(nil); 280 | try 281 | aGenerator.DataSet := aDataSet; 282 | aGenerator.NameOfUnit := ExtractUnitName(aFileName); 283 | aGenerator.NameOfClass := aNameOfClass; 284 | aGenerator.IndentationText := aIndentationText; 285 | aGenerator.FieldNamingStyle := aNamingStyle; 286 | aGenerator.Execute; 287 | aUnitName := ExtractNameFromFullPath(aFileName); 288 | aStringStream := TStringStream.Create(aGenerator.Code.Text, TEncoding.UTF8); 289 | try 290 | aStringStream.SaveToFile(aFileName); 291 | finally 292 | aStringStream.Free; 293 | end; 294 | finally 295 | aGenerator.Free; 296 | end; 297 | end; 298 | 299 | class procedure TDataProxyGenerator.SaveToClipboard(aDataSet: TDataSet; 300 | const aNameOfClass: string; const aIndentationText: string; 301 | aNamingStyle: TFieldNamingStyle); 302 | var 303 | aGenerator: TDataProxyGenerator; 304 | begin 305 | aGenerator := TDataProxyGenerator.Create(nil); 306 | try 307 | aGenerator.DataSet := aDataSet; 308 | aGenerator.NameOfClass := aNameOfClass; 309 | aGenerator.IndentationText := aIndentationText; 310 | aGenerator.FieldNamingStyle := aNamingStyle; 311 | aGenerator.GeneratorMode := pgmClass; 312 | aGenerator.Execute; 313 | // 314 | Clipboard.AsText := aGenerator.Code.Text; 315 | finally 316 | aGenerator.Free; 317 | end; 318 | end; 319 | 320 | end. 321 | -------------------------------------------------------------------------------- /src/Data.DataProxy.pas: -------------------------------------------------------------------------------- 1 | {* ------------------------------------------------------------------------ 2 | * ♥ 3 | * ♥ Delphi DataSetProxy component - wrapper for Delphi TDataSet 4 | * ♥ 5 | * Home: https://github.com/bogdanpolak/delphi-dataproxy 6 | * 7 | * Classes: 8 | * 1. TGenericDataSetProxy - base class for the wrapper 9 | * 2. TDatasetProxy - inherited from TGenericDataSetProxy adding ForEach 10 | * 3. TDataProxyFactory - TDasetProxy and derived clasess factory 11 | * ----------------------------------------------------------------------- * } 12 | unit Data.DataProxy; 13 | 14 | interface 15 | 16 | uses 17 | System.Classes, 18 | System.SysUtils, 19 | Data.DB, 20 | FireDAC.Comp.Client; 21 | 22 | type 23 | TDataSetProxy = class(TComponent) 24 | private const 25 | Version = '1.1'; 26 | protected 27 | fDataSet: TDataSet; 28 | procedure ConnectFields; virtual; abstract; 29 | procedure SetDataSet(aDataSet: TDataSet); 30 | public 31 | function WithDataSet(aDataSet: TDataSet): TDataSetProxy; 32 | function WithFiredacSQL(aConnection: TFDConnection; const aSQL: String; 33 | const aParams: TArray = []; 34 | const aParamTypes: TArray = []): TDataSetProxy; 35 | function Open: TDataSetProxy; 36 | procedure ForEach(OnElem: TProc); 37 | // ---------------- 38 | // TDataSet wrapped methods: 39 | procedure Append; 40 | procedure AppendRecord(const Values: array of const); 41 | procedure BindToDataSource(DataSource: TDataSource); 42 | procedure Cancel; 43 | function ConstructDataSource(AOwner: TComponent): TDataSource; 44 | procedure Close; 45 | function ControlsDisabled: Boolean; 46 | function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; 47 | procedure Delete; 48 | procedure DisableControls; 49 | procedure Edit; 50 | procedure EnableControls; 51 | procedure First; 52 | procedure Insert; 53 | procedure InsertRecord(const Values: array of const); 54 | function IsEmpty: Boolean; 55 | procedure Last; 56 | function Eof: Boolean; 57 | function Locate(const KeyFields: string; const KeyValues: Variant; 58 | Options: TLocateOptions): Boolean; 59 | function Lookup(const KeyFields: string; const KeyValues: Variant; 60 | const ResultFields: string): Variant; 61 | procedure Next; 62 | procedure Post; 63 | procedure Prior; 64 | function RecordCount: integer; 65 | procedure Refresh; 66 | function UpdateStatus: TUpdateStatus; 67 | end; 68 | 69 | implementation 70 | 71 | uses 72 | {FireDAC - for component TFDeuery} 73 | FireDAC.DApt, 74 | FireDAC.Stan.Async; 75 | 76 | // * -------------------------------------------------------------------- 77 | // * TGenericDataSetProxy 78 | // * -------------------------------------------------------------------- 79 | 80 | procedure TDataSetProxy.Append; 81 | begin 82 | fDataSet.Append; 83 | end; 84 | 85 | procedure TDataSetProxy.AppendRecord(const Values: array of const); 86 | begin 87 | fDataSet.AppendRecord(Values); 88 | end; 89 | 90 | procedure TDataSetProxy.BindToDataSource(DataSource: TDataSource); 91 | begin 92 | DataSource.DataSet := fDataSet; 93 | end; 94 | 95 | procedure TDataSetProxy.Cancel; 96 | begin 97 | fDataSet.Cancel; 98 | end; 99 | 100 | procedure TDataSetProxy.Close; 101 | begin 102 | fDataSet.Close; 103 | end; 104 | 105 | function TDataSetProxy.ConstructDataSource(AOwner: TComponent): TDataSource; 106 | begin 107 | Result := TDataSource.Create(AOwner); 108 | Result.DataSet := fDataSet; 109 | end; 110 | 111 | function TDataSetProxy.ControlsDisabled: Boolean; 112 | begin 113 | Result := fDataSet.ControlsDisabled; 114 | end; 115 | 116 | function TDataSetProxy.CreateBlobStream(Field: TField; 117 | Mode: TBlobStreamMode): TStream; 118 | begin 119 | Result := fDataSet.CreateBlobStream(Field, Mode); 120 | end; 121 | 122 | procedure TDataSetProxy.Delete; 123 | begin 124 | fDataSet.Delete; 125 | end; 126 | 127 | procedure TDataSetProxy.DisableControls; 128 | begin 129 | fDataSet.DisableControls; 130 | end; 131 | 132 | procedure TDataSetProxy.Edit; 133 | begin 134 | fDataSet.Edit; 135 | end; 136 | 137 | procedure TDataSetProxy.EnableControls; 138 | begin 139 | fDataSet.EnableControls; 140 | end; 141 | 142 | function TDataSetProxy.Eof: Boolean; 143 | begin 144 | Result := fDataSet.Eof; 145 | end; 146 | 147 | procedure TDataSetProxy.First; 148 | begin 149 | fDataSet.First; 150 | end; 151 | 152 | procedure TDataSetProxy.Insert; 153 | begin 154 | fDataSet.Insert; 155 | end; 156 | 157 | procedure TDataSetProxy.InsertRecord(const Values: array of const); 158 | begin 159 | fDataSet.InsertRecord(Values); 160 | end; 161 | 162 | function TDataSetProxy.IsEmpty: Boolean; 163 | begin 164 | Result := fDataSet.IsEmpty; 165 | end; 166 | 167 | procedure TDataSetProxy.Last; 168 | begin 169 | fDataSet.Last; 170 | end; 171 | 172 | function TDataSetProxy.Locate(const KeyFields: string; const KeyValues: Variant; 173 | Options: TLocateOptions): Boolean; 174 | begin 175 | Result := fDataSet.Locate(KeyFields, KeyValues, Options); 176 | end; 177 | 178 | function TDataSetProxy.Lookup(const KeyFields: string; const KeyValues: Variant; 179 | const ResultFields: string): Variant; 180 | begin 181 | Result := fDataSet.Lookup(KeyFields, KeyValues, ResultFields); 182 | end; 183 | 184 | procedure TDataSetProxy.Next; 185 | begin 186 | fDataSet.Next; 187 | end; 188 | 189 | procedure TDataSetProxy.Post; 190 | begin 191 | fDataSet.Post; 192 | end; 193 | 194 | procedure TDataSetProxy.Prior; 195 | begin 196 | fDataSet.Prior; 197 | end; 198 | 199 | function TDataSetProxy.RecordCount: integer; 200 | begin 201 | Result := fDataSet.RecordCount; 202 | end; 203 | 204 | procedure TDataSetProxy.Refresh; 205 | begin 206 | fDataSet.Refresh; 207 | end; 208 | 209 | function TDataSetProxy.UpdateStatus: TUpdateStatus; 210 | begin 211 | Result := fDataSet.UpdateStatus; 212 | end; 213 | 214 | 215 | // * -------------------------------------------------------------------- 216 | // * SQL DataSet proxy (supporting FireDAC only. Considering: ADO, IBX) 217 | // * -------------------------------------------------------------------- 218 | 219 | function TDataSetProxy.WithFiredacSQL(aConnection: TFDConnection; 220 | const aSQL: String; const aParams: TArray = []; 221 | const aParamTypes: TArray = []): TDataSetProxy; 222 | var 223 | aFDQuery: TFDQuery; 224 | begin 225 | aFDQuery := TFDQuery.Create(Self); 226 | aFDQuery.Connection := aConnection; 227 | aFDQuery.Open(aSQL,aParams,aParamTypes); 228 | fDataSet := aFDQuery; 229 | ConnectFields; 230 | Result := Self; 231 | end; 232 | 233 | // * -------------------------------------------------------------------- 234 | // * Extra methods (dedicated for Proxy) 235 | // * -------------------------------------------------------------------- 236 | 237 | procedure TDataSetProxy.SetDataSet(aDataSet: TDataSet); 238 | begin 239 | fDataSet := aDataSet; 240 | if fDataSet.Active then 241 | ConnectFields; 242 | end; 243 | 244 | function TDataSetProxy.WithDataSet(aDataSet: TDataSet): TDataSetProxy; 245 | begin 246 | SetDataSet(aDataSet); 247 | Result := Self; 248 | end; 249 | 250 | function TDataSetProxy.Open: TDataSetProxy; 251 | begin 252 | fDataSet.Open; 253 | ConnectFields; 254 | Result := Self; 255 | end; 256 | 257 | procedure TDataSetProxy.ForEach(OnElem: TProc); 258 | var 259 | Bookmark: TBookmark; 260 | begin 261 | Self.DisableControls; 262 | try 263 | Bookmark := fDataSet.GetBookmark; 264 | try 265 | Self.First; 266 | while not fDataSet.Eof do 267 | begin 268 | OnElem(); 269 | fDataSet.Next; 270 | end; 271 | finally 272 | if fDataSet.BookmarkValid(Bookmark) then 273 | fDataSet.GotoBookmark(Bookmark); 274 | fDataSet.FreeBookmark(Bookmark); 275 | end; 276 | finally 277 | fDataSet.EnableControls; 278 | end; 279 | end; 280 | 281 | end. 282 | -------------------------------------------------------------------------------- /tests/Helper.DUnitAssert.pas: -------------------------------------------------------------------------------- 1 | unit Helper.DUnitAssert; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, 7 | System.Classes, 8 | System.Math, 9 | DUnitX.TestFramework; 10 | 11 | type 12 | TAssertHelper = class helper for Assert 13 | class procedure AreMemosEqual(const expectedStrings: string; 14 | const actualStrings: string); 15 | end; 16 | 17 | implementation 18 | 19 | function FindDiffrence(const s1: string; const s2: string): integer; 20 | var 21 | j: integer; 22 | begin 23 | if s1 = s2 then 24 | Exit(0); 25 | for j := 1 to Min(s1.Length, s2.Length) do 26 | if s1[j] <> s2[j] then 27 | Exit(j); 28 | Result := Min(s1.Length, s2.Length); 29 | end; 30 | 31 | class procedure TAssertHelper.AreMemosEqual(const expectedStrings: string; 32 | const actualStrings: string); 33 | var 34 | slActual: TStringList; 35 | slExpected: TStringList; 36 | i: integer; 37 | aPos: integer; 38 | begin 39 | slActual := TStringList.Create; 40 | slExpected := TStringList.Create; 41 | try 42 | slActual.Text := actualStrings; 43 | slExpected.Text := expectedStrings; 44 | Assert.AreEqual(slExpected.Count, slActual.Count, 45 | Format('(diffrent number of lines)', [slExpected.Count, slActual.Count])); 46 | for i := 0 to slExpected.Count - 1 do 47 | if slExpected[i] <> slActual[i] then 48 | begin 49 | aPos := FindDiffrence(slExpected[i], slActual[i]); 50 | Assert.Fail 51 | (Format('in line: %d at pos: %d, expected |%s| is not equal to actual |%s|', 52 | [i + 1, aPos, slExpected[i], slActual[i]])); 53 | end; 54 | finally 55 | slActual.Free; 56 | slExpected.Free; 57 | end; 58 | end; 59 | 60 | end. 61 | -------------------------------------------------------------------------------- /tests/Test.GeneratorClassMethods.pas: -------------------------------------------------------------------------------- 1 | unit Test.GeneratorClassMethods; 2 | 3 | interface 4 | 5 | uses 6 | DUnitX.TestFramework, 7 | System.Classes, 8 | System.SysUtils, 9 | System.Variants, 10 | Data.DB, 11 | FireDAC.Comp.Client, 12 | 13 | Comp.Generator.DataProxy, 14 | Helper.DUnitAssert; 15 | 16 | {$TYPEINFO ON} 17 | 18 | type 19 | 20 | [TestFixture] 21 | TestGeneratorClassMethods = class(TObject) 22 | private 23 | fOwner: TComponent; 24 | fTemporaryFileName: string; 25 | fStringList: TStringList; 26 | public 27 | [Setup] 28 | procedure Setup; 29 | [TearDown] 30 | procedure TearDown; 31 | published 32 | // --- 33 | procedure SaveToFile_IsFileExists; 34 | procedure SaveToFile_CheckUnitName; 35 | procedure SaveToFile_CheckAllUnit; 36 | procedure SaveToFile_CheckIndetnationAndNamingStyle; 37 | procedure SaveToFile_DiffrentUnitNameAndNameOfClass; 38 | // --- 39 | procedure SaveToClipboard_ClipboardNotEmpty; 40 | procedure SaveToClipboard_CheckClipboardText; 41 | procedure SaveToClipboard_IndetationAndNamingStyle; 42 | end; 43 | 44 | {$TYPEINFO OFF} 45 | 46 | implementation 47 | 48 | uses 49 | System.IOUtils, 50 | Vcl.Clipbrd; 51 | 52 | // ----------------------------------------------------------------------- 53 | // Utulities 54 | // ----------------------------------------------------------------------- 55 | 56 | function GivenDataSet_HistoricalEvents(aOwner: TComponent): TDataSet; 57 | var 58 | memTable: TFDMemTable; 59 | begin 60 | memTable := TFDMemTable.Create(aOwner); 61 | with memTable do 62 | begin 63 | FieldDefs.Add('EventID', ftInteger); 64 | FieldDefs.Add('Event', ftWideString, 50); 65 | FieldDefs.Add('Date', ftDate); 66 | FieldDefs.Add('Expirence', ftFloat); 67 | FieldDefs.Add('Income', ftCurrency); 68 | CreateDataSet; 69 | AppendRecord([1, 'Liberation of Poland', EncodeDate(1989, 06, 04), 70 | 1.2, 120]); 71 | AppendRecord([2, 'Battle of Vienna', EncodeDate(1683, 09, 12), 72 | System.Variants.Null, Null]); 73 | First; 74 | end; 75 | Result := memTable; 76 | end; 77 | 78 | function GivenDataSet_MiniHistoricalEvents(aOwner: TComponent): TDataSet; 79 | var 80 | memTable: TFDMemTable; 81 | begin 82 | memTable := TFDMemTable.Create(aOwner); 83 | with memTable do 84 | begin 85 | FieldDefs.Add('EventID', ftInteger); 86 | FieldDefs.Add('Event', ftWideString, 50); 87 | FieldDefs.Add('Date', ftDate); 88 | CreateDataSet; 89 | AppendRecord([1, 'Liberation of Poland', EncodeDate(1989, 06, 04)]); 90 | AppendRecord([2, 'Battle of Vienna', EncodeDate(1683, 09, 12)]); 91 | First; 92 | end; 93 | Result := memTable; 94 | end; 95 | 96 | // ----------------------------------------------------------------------- 97 | // Setup and TearDown section 98 | // ----------------------------------------------------------------------- 99 | 100 | procedure TestGeneratorClassMethods.Setup; 101 | begin 102 | fOwner := TComponent.Create(nil); 103 | fStringList := TStringList.Create; 104 | fTemporaryFileName := ''; 105 | Clipboard.Clear; 106 | end; 107 | 108 | procedure TestGeneratorClassMethods.TearDown; 109 | begin 110 | fStringList.Free; 111 | fOwner.Free; 112 | if (fTemporaryFileName <> '') and FileExists(fTemporaryFileName) then 113 | DeleteFile(fTemporaryFileName); 114 | end; 115 | 116 | // ----------------------------------------------------------------------- 117 | // Tests: SaveToFile 118 | // ----------------------------------------------------------------------- 119 | 120 | procedure TestGeneratorClassMethods.SaveToFile_IsFileExists; 121 | begin 122 | fTemporaryFileName := TPath.GetTempPath + 'HistoricalEvents1.pas'; 123 | 124 | TDataProxyGenerator.SaveToFile( 125 | {} fTemporaryFileName, 126 | {} GivenDataSet_MiniHistoricalEvents(fOwner), 127 | {} 'HistoricalEvents'); 128 | 129 | Assert.IsTrue(FileExists(fTemporaryFileName), 130 | Format('Expected temporary file is not exist (%s)', [fTemporaryFileName])); 131 | end; 132 | 133 | procedure TestGeneratorClassMethods.SaveToFile_CheckUnitName; 134 | begin 135 | fTemporaryFileName := TPath.GetTempPath + 'Proxy.HistoricalEvents.pas'; 136 | 137 | TDataProxyGenerator.SaveToFile( 138 | {} fTemporaryFileName, 139 | {} GivenDataSet_MiniHistoricalEvents(fOwner), 140 | {} 'TEventsProxy'); 141 | 142 | fStringList.LoadFromFile(fTemporaryFileName); 143 | 144 | Assert.AreEqual('unit Proxy.HistoricalEvents;', fStringList[0]); 145 | end; 146 | 147 | procedure TestGeneratorClassMethods.SaveToFile_CheckAllUnit; 148 | begin 149 | fTemporaryFileName := TPath.GetTempPath + 'Proxy.HistoricalEvents.pas'; 150 | 151 | TDataProxyGenerator.SaveToFile( 152 | {} fTemporaryFileName, 153 | {} GivenDataSet_MiniHistoricalEvents(fOwner), 154 | {} 'THistoricalEventsProxy'); 155 | 156 | fStringList.LoadFromFile(fTemporaryFileName); 157 | 158 | Assert.AreMemosEqual( 159 | {} 'unit Proxy.HistoricalEvents;'#13 + 160 | {} sLineBreak + 161 | {} 'interface'#13 + 162 | {} sLineBreak + 163 | {} 'uses'#13 + 164 | {} ' Data.DB,'#13 + 165 | {} ' Data.DataProxy,'#13 + 166 | {} ' System.SysUtils,'#13 + 167 | {} ' System.Classes,'#13 + 168 | {} ' FireDAC.Comp.Client;'#13 + 169 | {} sLineBreak + 170 | {} 'type'#13 + 171 | {} ' THistoricalEventsProxy = class(TDatasetProxy)'#13 + 172 | {} ' private'#13 + 173 | {} ' FEventID :TIntegerField;'#13 + 174 | {} ' FEvent :TWideStringField;'#13 + 175 | {} ' FDate :TDateField;'#13 + 176 | {} ' protected'#13 + 177 | {} ' procedure ConnectFields; override;'#13 + 178 | {} ' public'#13 + 179 | {} ' property EventID :TIntegerField read FEventID;'#13 + 180 | {} ' property Event :TWideStringField read FEvent;'#13 + 181 | {} ' property Date :TDateField read FDate;'#13 + 182 | {} ' end;'#13 + 183 | {} sLineBreak + 184 | {} 'implementation'#13 + 185 | {} sLineBreak + 186 | {} 'procedure THistoricalEventsProxy.ConnectFields;'#13 + 187 | {} 'const'#13 + 188 | {} ' ExpectedFieldCount = 3;'#13 + 189 | {} 'begin'#13 + 190 | {} ' FEventID := FDataSet.FieldByName(''EventID'') as TIntegerField;'#13 + 191 | {} ' FEvent := FDataSet.FieldByName(''Event'') as TWideStringField;'#13 + 192 | {} ' FDate := FDataSet.FieldByName(''Date'') as TDateField;'#13 + 193 | {} ' Assert(FDataSet.Fields.Count = ExpectedFieldCount);'#13 + 194 | {} 'end;'#13 + 195 | {} sLineBreak + 196 | {} 'end.'#13, fStringList.Text); 197 | end; 198 | 199 | procedure TestGeneratorClassMethods.SaveToFile_CheckIndetnationAndNamingStyle; 200 | begin 201 | fTemporaryFileName := TPath.GetTempPath + 'Proxy.HistoricalEvents.pas'; 202 | 203 | TDataProxyGenerator.SaveToFile( 204 | {} fTemporaryFileName, 205 | {} GivenDataSet_MiniHistoricalEvents(fOwner), 206 | {} 'HistoricalEvents', 207 | {} ' ', 208 | {} fnsLowerCaseF); 209 | 210 | fStringList.LoadFromFile(fTemporaryFileName); 211 | 212 | Assert.AreEqual(' Data.DB,', fStringList[5]); 213 | Assert.AreEqual(' fEventID :TIntegerField;', fStringList[14]); 214 | Assert.AreEqual(' property EventID :TIntegerField read fEventID;', 215 | fStringList[20]); 216 | end; 217 | 218 | procedure TestGeneratorClassMethods.SaveToFile_DiffrentUnitNameAndNameOfClass; 219 | begin 220 | fTemporaryFileName := TPath.GetTempPath + 'ProxyUnit.pas'; 221 | 222 | TDataProxyGenerator.SaveToFile( 223 | {} fTemporaryFileName, 224 | {} GivenDataSet_MiniHistoricalEvents(fOwner), 225 | {} 'TFooProxy'); 226 | 227 | fStringList.LoadFromFile(fTemporaryFileName); 228 | 229 | Assert.AreEqual('unit ProxyUnit;', fStringList[0]); 230 | Assert.AreEqual(' TFooProxy = class(TDatasetProxy)', fStringList[12]); 231 | Assert.AreEqual('procedure TFooProxy.ConnectFields;', fStringList[27]); 232 | end; 233 | 234 | // ----------------------------------------------------------------------- 235 | // Tests: SaveToClipboard 236 | // ----------------------------------------------------------------------- 237 | 238 | procedure TestGeneratorClassMethods.SaveToClipboard_ClipboardNotEmpty; 239 | begin 240 | TDataProxyGenerator.SaveToClipboard( 241 | {} GivenDataSet_MiniHistoricalEvents(fOwner), 242 | {} 'TEventsProxy'); 243 | 244 | Assert.IsTrue(Clipboard.AsText.Length > 0, 245 | 'Expected proxy code, but the clipboard content is empty'); 246 | end; 247 | 248 | procedure TestGeneratorClassMethods.SaveToClipboard_CheckClipboardText; 249 | begin 250 | TDataProxyGenerator.SaveToClipboard( 251 | {} GivenDataSet_MiniHistoricalEvents(fOwner), 252 | {} 'THistoricalEventsProxy'); 253 | 254 | Assert.AreMemosEqual( 255 | {} 'type'#13 + 256 | {} ' THistoricalEventsProxy = class(TDatasetProxy)'#13 + 257 | {} ' private'#13 + 258 | {} ' FEventID :TIntegerField;'#13 + 259 | {} ' FEvent :TWideStringField;'#13 + 260 | {} ' FDate :TDateField;'#13 + 261 | {} ' protected'#13 + 262 | {} ' procedure ConnectFields; override;'#13 + 263 | {} ' public'#13 + 264 | {} ' property EventID :TIntegerField read FEventID;'#13 + 265 | {} ' property Event :TWideStringField read FEvent;'#13 + 266 | {} ' property Date :TDateField read FDate;'#13 + 267 | {} ' end;'#13 + 268 | {} sLineBreak + 269 | {} 'procedure THistoricalEventsProxy.ConnectFields;'#13 + 270 | {} 'const'#13 + 271 | {} ' ExpectedFieldCount = 3;'#13 + 272 | {} 'begin'#13 + 273 | {} ' FEventID := FDataSet.FieldByName(''EventID'') as TIntegerField;'#13 + 274 | {} ' FEvent := FDataSet.FieldByName(''Event'') as TWideStringField;'#13 + 275 | {} ' FDate := FDataSet.FieldByName(''Date'') as TDateField;'#13 + 276 | {} ' Assert(FDataSet.Fields.Count = ExpectedFieldCount);'#13 + 277 | {} 'end;'#13, Clipboard.AsText); 278 | end; 279 | 280 | procedure TestGeneratorClassMethods.SaveToClipboard_IndetationAndNamingStyle; 281 | begin 282 | TDataProxyGenerator.SaveToClipboard( 283 | {} GivenDataSet_MiniHistoricalEvents(fOwner), 284 | {} 'THistoricalEventsProxy', 285 | {} ' ', 286 | {} fnsLowerCaseF); 287 | 288 | fStringList.Text := Clipboard.AsText; 289 | 290 | Assert.AreEqual(' private', fStringList[2]); 291 | Assert.AreEqual(' FDate :TDateField;', fStringList[5]); 292 | Assert.AreEqual(' property Date :TDateField read FDate;', 293 | fStringList[11]); 294 | Assert.AreEqual(' FDate := FDataSet.FieldByName(''Date'') as TDateField;', 295 | fStringList[20]); 296 | end; 297 | 298 | end. 299 | -------------------------------------------------------------------------------- /tests/Test.ProxyGenerator.pas: -------------------------------------------------------------------------------- 1 | unit Test.ProxyGenerator; 2 | 3 | interface 4 | 5 | uses 6 | DUnitX.TestFramework, 7 | System.Classes, 8 | System.SysUtils, 9 | System.Variants, 10 | Data.DB, 11 | FireDAC.Comp.Client, 12 | 13 | Comp.Generator.DataProxy, 14 | Wrapper.TProxyGenerator, 15 | Helper.DUnitAssert; 16 | 17 | {$M+} 18 | 19 | type 20 | TMatrixOfVariants = TArray>; 21 | 22 | [TestFixture] 23 | TestGenerator = class(TObject) 24 | private 25 | fOwner: TComponent; 26 | fGenerator: TTestProxyDataGenerator; 27 | function GivenDataset(aFieldsDef: TMatrixOfVariants): TDataSet; 28 | public 29 | [Setup] 30 | procedure Setup; 31 | [TearDown] 32 | procedure TearDown; 33 | published 34 | // --- 35 | procedure GenUnitHeader_IsEmpty; 36 | procedure GenUsesSection; 37 | procedure GenUsesSection_Identation_4spaces; 38 | // --- 39 | procedure GenClassFields_Integer; 40 | procedure GenClassFields_Integer_LowerCaseStyle; 41 | procedure GenClassFields_String; 42 | procedure GenProperty_Date; 43 | procedure GenFieldAssigment_Currency; 44 | // --- 45 | procedure GenClass_DataSet_Nil; 46 | procedure GenClass_Dataset_OneInteger; 47 | procedure GenClass_With2Fields_Identation4; 48 | procedure GenClass_TwoFields_LowerCaseStyle; 49 | procedure GenClass_AccessToDataSet_InComments; 50 | procedure GenClass_AccessToDataSet_Full; 51 | // --- 52 | procedure GenMethod_ConnectFields_DataSet_Nil; 53 | procedure GenMethod_ConnectFields_DataSet_OneString; 54 | procedure GenMethod_ConnectFields_TwoFields_LowerCaseStyle; 55 | procedure GenMethod_ConnectFields_Identation4; 56 | // --- 57 | procedure Generate_BooksProxy_Unit; 58 | procedure Generate_BooksProxy_Class; 59 | end; 60 | 61 | implementation 62 | 63 | // ----------------------------------------------------------------------- 64 | // Dataset factories 65 | // ----------------------------------------------------------------------- 66 | 67 | function GivenField(aOwner: TComponent; const fieldName: string; 68 | fieldType: TFieldType; size: integer = 0): TField; 69 | var 70 | ds: TFDMemTable; 71 | begin 72 | ds := TFDMemTable.Create(aOwner); 73 | ds.FieldDefs.Add(fieldName, fieldType, size); 74 | ds.CreateDataSet; 75 | Result := ds.Fields[0]; 76 | end; 77 | 78 | function TestGenerator.GivenDataset(aFieldsDef: TMatrixOfVariants): TDataSet; 79 | var 80 | aTable: TFDMemTable; 81 | i: integer; 82 | begin 83 | aTable := TFDMemTable.Create(fOwner); 84 | for i := 0 to High(aFieldsDef) do 85 | aTable.FieldDefs.Add(aFieldsDef[i][0], aFieldsDef[i][1]); 86 | aTable.CreateDataSet; 87 | Result := aTable; 88 | end; 89 | 90 | 91 | // ----------------------------------------------------------------------- 92 | // Setup and TearDown section 93 | // ----------------------------------------------------------------------- 94 | 95 | procedure TestGenerator.Setup; 96 | begin 97 | fOwner := TComponent.Create(nil); 98 | fGenerator := TTestProxyDataGenerator.Create(fOwner); 99 | end; 100 | 101 | procedure TestGenerator.TearDown; 102 | begin 103 | fOwner.Free; 104 | end; 105 | 106 | 107 | // ----------------------------------------------------------------------- 108 | // Tests: Unit Header / Uses Section 109 | // ----------------------------------------------------------------------- 110 | 111 | procedure TestGenerator.GenUnitHeader_IsEmpty; 112 | begin 113 | fGenerator.Generate_UnitHeader; 114 | Assert.AreEqual('', fGenerator.Code.Text); 115 | end; 116 | 117 | procedure TestGenerator.GenUsesSection; 118 | var 119 | actualCode: string; 120 | begin 121 | actualCode := fGenerator.Generate_UsesSection; 122 | 123 | Assert.AreEqual( 124 | (* *) 'uses'#13#10 + 125 | (* *) ' Data.DB,'#13#10 + 126 | (* *) ' Data.DataProxy,'#13#10 + 127 | (* *) ' System.SysUtils,'#13#10 + 128 | (* *) ' System.Classes,'#13#10 + 129 | (* *) ' FireDAC.Comp.Client;'#13#10, actualCode); 130 | end; 131 | 132 | procedure TestGenerator.GenUsesSection_Identation_4spaces; 133 | var 134 | actualCode: string; 135 | begin 136 | fGenerator.IndentationText := ' '; 137 | 138 | actualCode := fGenerator.Generate_UsesSection; 139 | 140 | Assert.AreEqual( 141 | (* *) 'uses'#13#10 + 142 | (* *) ' Data.DB,'#13#10 + 143 | (* *) ' Data.DataProxy,'#13#10 + 144 | (* *) ' System.SysUtils,'#13#10 + 145 | (* *) ' System.Classes,'#13#10 + 146 | (* *) ' FireDAC.Comp.Client;'#13#10, actualCode); 147 | end; 148 | 149 | 150 | // ----------------------------------------------------------------------- 151 | // Tests: Field generation in class definition 152 | // ----------------------------------------------------------------------- 153 | 154 | procedure TestGenerator.GenClassFields_Integer; 155 | var 156 | fld: TField; 157 | actualCode: string; 158 | begin 159 | fld := GivenField(fOwner, 'Level', ftInteger); 160 | 161 | actualCode := fGenerator.Generate_PrivateField(fld); 162 | 163 | Assert.AreEqual('FLevel :TIntegerField;', actualCode); 164 | end; 165 | 166 | procedure TestGenerator.GenClassFields_Integer_LowerCaseStyle; 167 | var 168 | fld: TField; 169 | actualCode: string; 170 | begin 171 | fld := GivenField(fOwner, 'Level', ftInteger); 172 | fGenerator.FieldNamingStyle := fnsLowerCaseF; 173 | 174 | actualCode := fGenerator.Generate_PrivateField(fld); 175 | 176 | Assert.AreEqual('FLevel :TIntegerField;', actualCode); 177 | end; 178 | 179 | procedure TestGenerator.GenClassFields_String; 180 | var 181 | fld: TField; 182 | actualCode: string; 183 | begin 184 | fld := GivenField(fOwner, 'Captal', ftString, 20); 185 | 186 | actualCode := fGenerator.Generate_PrivateField(fld); 187 | 188 | Assert.AreEqual('FCaptal :TStringField;', actualCode); 189 | end; 190 | 191 | 192 | // ----------------------------------------------------------------------- 193 | // Tests: Property generation in class definition 194 | // ----------------------------------------------------------------------- 195 | 196 | procedure TestGenerator.GenProperty_Date; 197 | var 198 | fld: TField; 199 | actualCode: string; 200 | begin 201 | fld := GivenField(fOwner, 'BirthDate', ftDate); 202 | 203 | actualCode := fGenerator.Generate_PublicProperty(fld); 204 | 205 | Assert.AreEqual('property BirthDate :TDateField read FBirthDate;', 206 | actualCode); 207 | end; 208 | 209 | 210 | // ----------------------------------------------------------------------- 211 | // Tests: Generate one private field assigment 212 | // ----------------------------------------------------------------------- 213 | 214 | procedure TestGenerator.GenFieldAssigment_Currency; 215 | var 216 | fld: TField; 217 | actualCode: string; 218 | begin 219 | fld := GivenField(fOwner, 'Budget', ftCurrency); 220 | 221 | actualCode := fGenerator.Generate_FieldAssigment(fld); 222 | 223 | Assert.AreEqual 224 | ('FBudget := FDataSet.FieldByName(''Budget'') as TCurrencyField;', 225 | actualCode); 226 | end; 227 | 228 | 229 | // ----------------------------------------------------------------------- 230 | // Tests: Class Declaration 231 | // ----------------------------------------------------------------------- 232 | 233 | procedure TestGenerator.GenClass_DataSet_Nil; 234 | var 235 | actualCode: string; 236 | begin 237 | fGenerator.DataSet := nil; 238 | fGenerator.NameOfClass := 'TFoo'; 239 | 240 | actualCode := fGenerator.Generate_ClassDeclaration; 241 | 242 | Assert.AreMemosEqual( 243 | (* *) 'type'#13#10 + 244 | (* *) ' TFoo = class(TDatasetProxy)'#13#10 + 245 | (* *) ' private'#13#10 + 246 | (* *) ' protected'#13#10 + 247 | (* *) ' procedure ConnectFields; override;'#13#10 + 248 | (* *) ' public'#13#10 + 249 | (* *) ' end;'#13#10, actualCode); 250 | end; 251 | 252 | procedure TestGenerator.GenClass_Dataset_OneInteger; 253 | var 254 | actualCode: string; 255 | begin 256 | fGenerator.DataSet := GivenDataset([['FieldInteger', ftInteger]]); 257 | fGenerator.NameOfClass := 'TFooProxy'; 258 | 259 | actualCode := fGenerator.Generate_ClassDeclaration; 260 | 261 | Assert.AreMemosEqual( 262 | (* *) 'type'#13#10 + 263 | (* *) ' TFooProxy = class(TDatasetProxy)'#13#10 + 264 | (* *) ' private'#13#10 + 265 | (* *) ' FFieldInteger :TIntegerField;'#13#10 + 266 | (* *) ' protected'#13#10 + 267 | (* *) ' procedure ConnectFields; override;'#13#10 + 268 | (* *) ' public'#13#10 + 269 | (* *) ' property FieldInteger :TIntegerField read FFieldInteger;'#13#10 + 270 | (* *) ' end;'#13#10, actualCode); 271 | end; 272 | 273 | procedure TestGenerator.GenClass_With2Fields_Identation4; 274 | var 275 | actualCode: string; 276 | begin 277 | fGenerator.DataSet := GivenDataset([ 278 | {} ['CustomerID', ftInteger], 279 | {} ['CompanyName', ftString]]); 280 | fGenerator.NameOfClass := 'TProxyWith2Fields'; 281 | fGenerator.IndentationText := ' '; 282 | 283 | actualCode := fGenerator.Generate_ClassDeclaration; 284 | 285 | Assert.AreMemosEqual( 286 | {} 'type'#13#10 + 287 | {} ' TProxyWith2Fields = class(TDatasetProxy)'#13#10 + 288 | {} ' private'#13#10 + 289 | {} ' FCustomerID :TIntegerField;'#13#10 + 290 | {} ' FCompanyName :TStringField;'#13#10 + 291 | {} ' protected'#13#10 + 292 | {} ' procedure ConnectFields; override;'#13#10 + 293 | {} ' public'#13#10 + 294 | {} ' property CustomerID :TIntegerField read FCustomerID;'#13#10 + 295 | {} ' property CompanyName :TStringField read FCompanyName;'#13#10 + 296 | {} ' end;'#13#10, actualCode); 297 | end; 298 | 299 | procedure TestGenerator.GenClass_TwoFields_LowerCaseStyle; 300 | var 301 | actualCode: string; 302 | begin 303 | fGenerator.DataSet := GivenDataset([['CustomerID', ftInteger], 304 | ['CompanyName', ftString]]); 305 | fGenerator.NameOfClass := 'TFoo'; 306 | fGenerator.FieldNamingStyle := fnsLowerCaseF; 307 | 308 | actualCode := fGenerator.Generate_ClassDeclaration; 309 | 310 | Assert.AreMemosEqual( 311 | (* *) 'type'#13#10 + 312 | (* *) ' TFoo = class(TDatasetProxy)'#13#10 + 313 | (* *) ' private'#13#10 + 314 | (* *) ' fCustomerID :TIntegerField;'#13#10 + 315 | (* *) ' fCompanyName :TStringField;'#13#10 + 316 | (* *) ' protected'#13#10 + 317 | (* *) ' procedure ConnectFields; override;'#13#10 + 318 | (* *) ' public'#13#10 + 319 | (* *) ' property CustomerID :TIntegerField read fCustomerID;'#13#10 + 320 | (* *) ' property CompanyName :TStringField read fCompanyName;'#13#10 + 321 | (* *) ' end;'#13#10, actualCode); 322 | end; 323 | 324 | procedure TestGenerator.GenClass_AccessToDataSet_InComments; 325 | var 326 | actualCode: string; 327 | begin 328 | fGenerator.DataSet := GivenDataset([['FullName', ftString]]); 329 | fGenerator.NameOfClass := 'TFoo'; 330 | fGenerator.DataSetAccess := dsaGenComment; 331 | 332 | actualCode := fGenerator.Generate_ClassDeclaration; 333 | 334 | Assert.AreMemosEqual( 335 | (* *) 'type'#13#10 336 | (* *) + ' TFoo = class(TDatasetProxy)'#13#10 337 | (* *) + ' private'#13#10 338 | (* *) + ' FFullName :TStringField;'#13#10 339 | (* *) + ' protected'#13#10 340 | (* *) + ' procedure ConnectFields; override;'#13#10 341 | (* *) + ' public'#13#10 342 | (* *) + ' property FullName :TStringField read FFullName;'#13#10 343 | (* *) + ' // the following property should be hidden (uncomment if required)'#13#10 344 | (* *) + ' // property DataSet: TDataSet read FDataSet;'#13#10 345 | (* *) + ' end;'#13#10, actualCode); 346 | end; 347 | 348 | procedure TestGenerator.GenClass_AccessToDataSet_Full; 349 | var 350 | actualCode: string; 351 | begin 352 | fGenerator.DataSet := GivenDataset([['FullName', ftString]]); 353 | fGenerator.NameOfClass := 'TFoo'; 354 | fGenerator.DataSetAccess := dsaFullAccess; 355 | 356 | actualCode := fGenerator.Generate_ClassDeclaration; 357 | 358 | Assert.AreMemosEqual( 359 | (* *) 'type'#13#10 360 | (* *) + ' TFoo = class(TDatasetProxy)'#13#10 361 | (* *) + ' private'#13#10 362 | (* *) + ' FFullName :TStringField;'#13#10 363 | (* *) + ' protected'#13#10 364 | (* *) + ' procedure ConnectFields; override;'#13#10 365 | (* *) + ' public'#13#10 366 | (* *) + ' property FullName :TStringField read FFullName;'#13#10 367 | (* *) + ' property DataSet: TDataSet read FDataSet;'#13#10 368 | (* *) + ' end;'#13#10, actualCode); 369 | end; 370 | 371 | 372 | // ----------------------------------------------------------------------- 373 | // Tests: Method ConnectFields 374 | // ----------------------------------------------------------------------- 375 | 376 | procedure TestGenerator.GenMethod_ConnectFields_DataSet_Nil; 377 | var 378 | actualCode: string; 379 | begin 380 | fGenerator.DataSet := nil; 381 | fGenerator.NameOfClass := 'TFooProxy'; 382 | 383 | actualCode := fGenerator.Generate_MethodConnectFields; 384 | 385 | Assert.AreMemosEqual( 386 | (* *) 'procedure TFooProxy.ConnectFields;'#13#10 + 387 | (* *) 'const'#13#10 + 388 | (* *) ' ExpectedFieldCount = 0;'#13#10 + 389 | (* *) 'begin'#13#10 + 390 | (* *) ' Assert(FDataSet.Fields.Count = ExpectedFieldCount);'#13#10 + 391 | (* *) 'end;'#13#10, actualCode); 392 | end; 393 | 394 | procedure TestGenerator.GenMethod_ConnectFields_DataSet_OneString; 395 | var 396 | actualCode: string; 397 | begin 398 | fGenerator.DataSet := GivenDataset([['FullName', ftString]]); 399 | fGenerator.NameOfClass := 'TFooProxy'; 400 | 401 | actualCode := fGenerator.Generate_MethodConnectFields; 402 | 403 | Assert.AreMemosEqual( 404 | (* *) 'procedure TFooProxy.ConnectFields;'#13#10 + 405 | (* *) 'const'#13#10 + 406 | (* *) ' ExpectedFieldCount = 1;'#13#10 + 407 | (* *) 'begin'#13#10 + 408 | (* *) ' FFullName := FDataSet.FieldByName(''FullName'') as TStringField;'#13#10 409 | (* *) + ' Assert(FDataSet.Fields.Count = ExpectedFieldCount);'#13#10 + 410 | (* *) 'end;'#13#10, actualCode); 411 | end; 412 | 413 | procedure TestGenerator.GenMethod_ConnectFields_TwoFields_LowerCaseStyle; 414 | var 415 | actualCode: string; 416 | begin 417 | fGenerator.DataSet := GivenDataset([['CustomerID', ftInteger], 418 | ['CompanyName', ftString]]); 419 | fGenerator.NameOfClass := 'TFooProxy'; 420 | fGenerator.FieldNamingStyle := fnsLowerCaseF; 421 | 422 | actualCode := fGenerator.Generate_MethodConnectFields; 423 | 424 | Assert.AreMemosEqual( 425 | (* *) 'procedure TFooProxy.ConnectFields;'#13#10 426 | (* *) + 'const'#13#10 427 | (* *) + ' ExpectedFieldCount = 2;'#13#10 428 | (* *) + 'begin'#13#10 429 | (* *) + ' fCustomerID := FDataSet.FieldByName(''CustomerID'') as TIntegerField;'#13#10 430 | (* *) + ' fCompanyName := FDataSet.FieldByName(''CompanyName'') as TStringField;'#13#10 431 | (* *) + ' Assert(FDataSet.Fields.Count = ExpectedFieldCount);'#13#10 432 | (* *) + 'end;'#13#10, actualCode); 433 | end; 434 | 435 | procedure TestGenerator.GenMethod_ConnectFields_Identation4; 436 | var 437 | actualCode: string; 438 | begin 439 | fGenerator.DataSet := GivenDataset([ 440 | {} ['CustomerID', ftInteger], 441 | {} ['CompanyName', ftString]]); 442 | fGenerator.NameOfClass := 'TFooProxy'; 443 | fGenerator.IndentationText := ' '; 444 | 445 | actualCode := fGenerator.Generate_MethodConnectFields; 446 | 447 | Assert.AreMemosEqual( 448 | {} 'procedure TFooProxy.ConnectFields;'#13#10 449 | {} + 'const'#13#10 450 | {} + ' ExpectedFieldCount = 2;'#13#10 451 | {} + 'begin'#13#10 452 | {} + ' FCustomerID := FDataSet.FieldByName(''CustomerID'') as TIntegerField;'#13#10 453 | {} + ' FCompanyName := FDataSet.FieldByName(''CompanyName'') as TStringField;'#13#10 454 | {} + ' Assert(FDataSet.Fields.Count = ExpectedFieldCount);'#13#10 455 | {} + 'end;'#13#10, actualCode); 456 | end; 457 | 458 | // ----------------------------------------------------------------------- 459 | // Tests: Generate books proxy 460 | // ----------------------------------------------------------------------- 461 | 462 | procedure TestGenerator.Generate_BooksProxy_Unit; 463 | begin 464 | fGenerator.DataSet := GivenDataset([ 465 | {} ['ISBN', ftWideString, 20], 466 | {} ['Title', ftWideString, 100], 467 | {} ['Authors', ftWideString, 100], 468 | {} ['ReleseDate', ftDate], 469 | {} ['Pages', ftInteger], 470 | {} ['Price', ftBCD, 12, 2]]); 471 | fGenerator.UnitName := 'Proxy.Books'; 472 | fGenerator.NameOfClass := 'TBooksProxy'; 473 | 474 | fGenerator.Execute; 475 | 476 | Assert.AreMemosEqual( 477 | {} 'unit Proxy.Books;'#13#10 478 | {} + sLineBreak 479 | {} + 'interface'#13#10 480 | {} + sLineBreak 481 | {} + 'uses'#13#10 482 | {} + ' Data.DB,'#13#10 483 | {} + ' Data.DataProxy,'#13#10 484 | {} + ' System.SysUtils,'#13#10 485 | {} + ' System.Classes,'#13#10 486 | {} + ' FireDAC.Comp.Client;'#13#10 487 | {} + ''#13#10 488 | {} + 'type'#13#10 489 | {} + ' TBooksProxy = class(TDatasetProxy)'#13#10 490 | {} + ' private'#13#10 491 | {} + ' FISBN :TWideStringField;'#13#10 492 | {} + ' FTitle :TWideStringField;'#13#10 493 | {} + ' FAuthors :TWideStringField;'#13#10 494 | {} + ' FReleseDate :TDateField;'#13#10 495 | {} + ' FPages :TIntegerField;'#13#10 496 | {} + ' FPrice :TBCDField;'#13#10 497 | {} + ' protected'#13#10 498 | {} + ' procedure ConnectFields; override;'#13#10 499 | {} + ' public'#13#10 500 | {} + ' property ISBN :TWideStringField read FISBN;'#13#10 501 | {} + ' property Title :TWideStringField read FTitle;'#13#10 502 | {} + ' property Authors :TWideStringField read FAuthors;'#13#10 503 | {} + ' property ReleseDate :TDateField read FReleseDate;'#13#10 504 | {} + ' property Pages :TIntegerField read FPages;'#13#10 505 | {} + ' property Price :TBCDField read FPrice;'#13#10 506 | {} + ' end;'#13#10 507 | {} + sLineBreak 508 | {} + 'implementation'#13#10 509 | {} + sLineBreak 510 | {} + 'procedure TBooksProxy.ConnectFields;'#13#10 511 | {} + 'const'#13#10 512 | {} + ' ExpectedFieldCount = 6;'#13#10 513 | {} + 'begin'#13#10 514 | {} + ' FISBN := FDataSet.FieldByName(''ISBN'') as TWideStringField;'#13#10 515 | {} + ' FTitle := FDataSet.FieldByName(''Title'') as TWideStringField;'#13#10 516 | {} + ' FAuthors := FDataSet.FieldByName(''Authors'') as TWideStringField;'#13#10 517 | {} + ' FReleseDate := FDataSet.FieldByName(''ReleseDate'') as TDateField;'#13#10 518 | {} + ' FPages := FDataSet.FieldByName(''Pages'') as TIntegerField;'#13#10 519 | {} + ' FPrice := FDataSet.FieldByName(''Price'') as TBCDField;'#13#10 520 | {} + ' Assert(FDataSet.Fields.Count = ExpectedFieldCount);'#13#10 521 | {} + 'end;'#13#10 522 | {} + sLineBreak 523 | {} + 'end.'#13#10, fGenerator.Code.Text); 524 | end; 525 | 526 | procedure TestGenerator.Generate_BooksProxy_Class; 527 | begin 528 | fGenerator.DataSet := GivenDataset([ 529 | {} ['ISBN', ftWideString, 20], 530 | {} ['Pages', ftInteger]]); 531 | fGenerator.NameOfClass := 'TBooksProxy'; 532 | 533 | fGenerator.GeneratorMode := pgmClass; 534 | fGenerator.Execute; 535 | 536 | Assert.AreMemosEqual( 537 | {} 'type'#13#10 538 | {} + ' TBooksProxy = class(TDatasetProxy)'#13#10 539 | {} + ' private'#13#10 540 | {} + ' FISBN :TWideStringField;'#13#10 541 | {} + ' FPages :TIntegerField;'#13#10 542 | {} + ' protected'#13#10 543 | {} + ' procedure ConnectFields; override;'#13#10 544 | {} + ' public'#13#10 545 | {} + ' property ISBN :TWideStringField read FISBN;'#13#10 546 | {} + ' property Pages :TIntegerField read FPages;'#13#10 547 | {} + ' end;'#13#10 548 | {} + sLineBreak 549 | {} + 'procedure TBooksProxy.ConnectFields;'#13#10 550 | {} + 'const'#13#10 551 | {} + ' ExpectedFieldCount = 2;'#13#10 552 | {} + 'begin'#13#10 553 | {} + ' FISBN := FDataSet.FieldByName(''ISBN'') as TWideStringField;'#13#10 554 | {} + ' FPages := FDataSet.FieldByName(''Pages'') as TIntegerField;'#13#10 555 | {} + ' Assert(FDataSet.Fields.Count = ExpectedFieldCount);'#13#10 556 | {} + 'end;'#13#10, fGenerator.Code.Text); 557 | end; 558 | 559 | initialization 560 | 561 | TDUnitX.RegisterTestFixture(TestGenerator); 562 | 563 | end. 564 | -------------------------------------------------------------------------------- /tests/Test.SqlDataSetProxy.pas: -------------------------------------------------------------------------------- 1 | unit Test.SqlDataSetProxy; 2 | 3 | interface 4 | 5 | uses 6 | DUnitX.TestFramework, 7 | System.Classes, 8 | System.SysUtils, 9 | System.Variants, 10 | Data.DB, 11 | 12 | Data.DataProxy; 13 | 14 | {$M+} 15 | 16 | type 17 | 18 | [TestFixture] 19 | TestSqDemoProxy = class(TObject) 20 | private const 21 | TestUsingFireDefinitionName = 'SQLite_Demo'; 22 | private 23 | fOwner: TComponent; 24 | public 25 | [Setup] 26 | procedure Setup; 27 | [TearDown] 28 | procedure TearDown; 29 | published 30 | procedure CheckFireDAC_ConnectionDef; 31 | procedure WithSql_CustomerOrders; 32 | procedure WithSql_Orders_Year1998_Month01; 33 | procedure WithSql_Orders_Params2xDateTime; 34 | procedure WithSql_Orders_ParamCurrency; 35 | procedure WithSql_Orders_GetFieldValues; 36 | end; 37 | 38 | implementation 39 | 40 | uses 41 | FireDAC.Comp.Client, 42 | FireDAC.Stan.Def, 43 | FireDAC.Phys.Intf, FireDAC.Phys, FireDAC.Phys.SQLiteDef, FireDAC.Phys.SQLite; 44 | 45 | 46 | // ----------------------------------------------------------------------- 47 | // Proxy: CustomerOrders 48 | // ----------------------------------------------------------------------- 49 | 50 | type 51 | TCustomerOrdersProxy = class(TDatasetProxy) 52 | strict private 53 | FOrderID: TAutoIncField; 54 | FCustomerID: TStringField; 55 | FCompanyName: TStringField; 56 | FEmployeeID: TIntegerField; 57 | FEmployeeName: TWideStringField; 58 | FOrderDate: TDateTimeField; 59 | FRequiredDate: TDateTimeField; 60 | FShippedDate: TDateTimeField; 61 | FShipVia: TIntegerField; 62 | FFreight: TCurrencyField; 63 | strict protected 64 | procedure ConnectFields; override; 65 | public 66 | property OrderID: TAutoIncField read FOrderID; 67 | property CustomerID: TStringField read FCustomerID; 68 | property CompanyName: TStringField read FCompanyName; 69 | property EmployeeID: TIntegerField read FEmployeeID; 70 | property EmployeeName: TWideStringField read FEmployeeName; 71 | property OrderDate: TDateTimeField read FOrderDate; 72 | property RequiredDate: TDateTimeField read FRequiredDate; 73 | property ShippedDate: TDateTimeField read FShippedDate; 74 | property ShipVia: TIntegerField read FShipVia; 75 | property Freight: TCurrencyField read FFreight; 76 | end; 77 | 78 | procedure TCustomerOrdersProxy.ConnectFields; 79 | const 80 | ExpectedFieldCount = 10; 81 | begin 82 | FOrderID := FDataSet.FieldByName('OrderID') as TAutoIncField; 83 | FCustomerID := FDataSet.FieldByName('CustomerID') as TStringField; 84 | FCompanyName := FDataSet.FieldByName('CompanyName') as TStringField; 85 | FEmployeeID := FDataSet.FieldByName('EmployeeID') as TIntegerField; 86 | FEmployeeName := FDataSet.FieldByName('EmployeeName') as TWideStringField; 87 | FOrderDate := FDataSet.FieldByName('OrderDate') as TDateTimeField; 88 | FRequiredDate := FDataSet.FieldByName('RequiredDate') as TDateTimeField; 89 | FShippedDate := FDataSet.FieldByName('ShippedDate') as TDateTimeField; 90 | FShipVia := FDataSet.FieldByName('ShipVia') as TIntegerField; 91 | FFreight := FDataSet.FieldByName('Freight') as TCurrencyField; 92 | System.Assert(FDataSet.Fields.Count = ExpectedFieldCount); 93 | end; 94 | 95 | type 96 | TMiniOrdersProxy = class(TDatasetProxy) 97 | strict private 98 | FOrderID: TAutoIncField; 99 | FCustomerID: TStringField; 100 | FOrderDate: TDateTimeField; 101 | FFreight: TCurrencyField; 102 | strict protected 103 | procedure ConnectFields; override; 104 | public 105 | property OrderID: TAutoIncField read FOrderID; 106 | property CustomerID: TStringField read FCustomerID; 107 | property OrderDate: TDateTimeField read FOrderDate; 108 | property Freight: TCurrencyField read FFreight; 109 | end; 110 | 111 | procedure TMiniOrdersProxy.ConnectFields; 112 | const 113 | ExpectedFieldCount = 4; 114 | begin 115 | FOrderID := FDataSet.FieldByName('OrderID') as TAutoIncField; 116 | FCustomerID := FDataSet.FieldByName('CustomerID') as TStringField; 117 | FOrderDate := FDataSet.FieldByName('OrderDate') as TDateTimeField; 118 | FFreight := FDataSet.FieldByName('Freight') as TCurrencyField; 119 | System.Assert(FDataSet.Fields.Count = ExpectedFieldCount); 120 | end; 121 | 122 | 123 | // ----------------------------------------------------------------------- 124 | // Utilities 125 | // ----------------------------------------------------------------------- 126 | 127 | function GivenConnection(aOwner: TComponent): TFDConnection; 128 | begin 129 | Result := TFDConnection.Create(aOwner); 130 | Result.ConnectionName := TestSqDemoProxy.TestUsingFireDefinitionName; 131 | Result.FetchOptions.RowsetSize := 100; 132 | end; 133 | 134 | 135 | // ----------------------------------------------------------------------- 136 | // Setup and TearDown section 137 | // ----------------------------------------------------------------------- 138 | 139 | procedure TestSqDemoProxy.Setup; 140 | begin 141 | FDManager.SilentMode := True; 142 | fOwner := TComponent.Create(nil); 143 | end; 144 | 145 | procedure TestSqDemoProxy.TearDown; 146 | begin 147 | fOwner.Free; 148 | end; 149 | 150 | 151 | // ----------------------------------------------------------------------- 152 | // Tests: CheckFireDAC 153 | // ----------------------------------------------------------------------- 154 | 155 | procedure TestSqDemoProxy.CheckFireDAC_ConnectionDef; 156 | begin 157 | Assert.IsTrue(FDManager.ConnectionDefs.FindConnectionDef 158 | (TestUsingFireDefinitionName) <> nil, 'Test fixture ' + Self.ClassName + 159 | ' required FireDAC to work. ' + 'Expected connction definition "' + 160 | TestUsingFireDefinitionName + '" not found.'); 161 | end; 162 | 163 | 164 | // ----------------------------------------------------------------------- 165 | // Tests: WithSql 166 | // ----------------------------------------------------------------------- 167 | 168 | procedure TestSqDemoProxy.WithSql_CustomerOrders; 169 | var 170 | aCustOrdersProxy: TCustomerOrdersProxy; 171 | begin 172 | aCustOrdersProxy := TCustomerOrdersProxy.Create(fOwner); 173 | 174 | aCustOrdersProxy.WithFiredacSQL(GivenConnection(fOwner), 175 | {} 'SELECT Orders.OrderID,'#13#10 + 176 | {} ' Orders.CustomerID, Customers.CompanyName, Orders.EmployeeID,'#13#10 + 177 | {} ' Employees.FirstName||'' ''||Employees.LastName EmployeeName,'#13#10 + 178 | {} ' Orders.OrderDate, Orders.RequiredDate, Orders.ShippedDate,'#13#10 + 179 | {} ' Orders.ShipVia, Orders.Freight'#13#10 + 180 | {} 'FROM {id Orders} Orders'#13#10 + 181 | {} ' INNER JOIN {id Employees} Employees'#13#10 + 182 | {} ' ON Orders.EmployeeID = Employees.EmployeeID'#13#10 + 183 | {} ' INNER JOIN {id Customers} Customers'#13#10 + 184 | {} ' ON Orders.CustomerID = Customers.CustomerID'#13#10 + 185 | {} 'WHERE {year(OrderDate)} = 1997 and {month(OrderDate)} = 11 '#13#10 + 186 | {} 'ORDER BY Orders.OrderID'); 187 | 188 | Assert.AreEqual(34, aCustOrdersProxy.RecordCount); 189 | end; 190 | 191 | procedure TestSqDemoProxy.WithSql_Orders_Year1998_Month01; 192 | var 193 | aOrdersProxy: TMiniOrdersProxy; 194 | begin 195 | aOrdersProxy := TMiniOrdersProxy.Create(fOwner); 196 | 197 | aOrdersProxy.WithFiredacSQL(GivenConnection(fOwner), 198 | {} 'SELECT OrderID, CustomerID, OrderDate, Freight' + 199 | {} ' FROM {id Orders} ' + 200 | {} ' WHERE {year(OrderDate)} = :AYear and {month(OrderDate)} = :AMonth', 201 | [1998, 01]); 202 | 203 | Assert.AreEqual(55, aOrdersProxy.RecordCount); 204 | end; 205 | 206 | procedure TestSqDemoProxy.WithSql_Orders_Params2xDateTime; 207 | var 208 | aOrdersProxy: TMiniOrdersProxy; 209 | begin 210 | aOrdersProxy := TMiniOrdersProxy.Create(fOwner); 211 | 212 | aOrdersProxy.WithFiredacSQL(GivenConnection(fOwner), 213 | {} 'SELECT OrderID, CustomerID, OrderDate, Freight' + 214 | {} ' FROM {id Orders} ' + 215 | {} ' WHERE OrderDate between :StartDate and :EndDate', 216 | {} [EncodeDate(1998, 04, 01), EncodeDate(1998, 04, 07)], 217 | {} [ftDate, ftDate]); 218 | 219 | Assert.AreEqual(17, aOrdersProxy.RecordCount); 220 | end; 221 | 222 | procedure TestSqDemoProxy.WithSql_Orders_ParamCurrency; 223 | var 224 | aOrdersProxy: TMiniOrdersProxy; 225 | aFreightField: TCurrencyField; 226 | begin 227 | aOrdersProxy := TMiniOrdersProxy.Create(fOwner); 228 | 229 | aOrdersProxy.WithFiredacSQL(GivenConnection(fOwner), 230 | {} 'SELECT OrderID, CustomerID, OrderDate, Freight' + 231 | {} ' FROM {id Orders} ' + 232 | {} ' WHERE Freight > :Freight1' + 233 | {} ' ORDER BY Freight', 234 | {} [490.01], [ftCurrency]); 235 | 236 | Assert.AreEqual(13, aOrdersProxy.RecordCount); 237 | Assert.AreEqual(544.08, aOrdersProxy.Freight.Value, 0.000001); 238 | end; 239 | 240 | procedure TestSqDemoProxy.WithSql_Orders_GetFieldValues; 241 | var 242 | aOrdersProxy: TMiniOrdersProxy; 243 | begin 244 | aOrdersProxy := TMiniOrdersProxy.Create(fOwner); 245 | 246 | aOrdersProxy.WithFiredacSQL(GivenConnection(fOwner), 247 | {} 'SELECT OrderID, CustomerID, OrderDate, Freight' + 248 | {} ' FROM {id Orders} WHERE Freight>400 ORDER BY Freight'); 249 | 250 | Assert.AreEqual(10941, aOrdersProxy.OrderID.Value); 251 | Assert.AreEqual('SAVEA', aOrdersProxy.CustomerID.AsString); 252 | Assert.AreEqual(400.81, aOrdersProxy.Freight.Value, 0.00001); 253 | end; 254 | 255 | end. 256 | -------------------------------------------------------------------------------- /tests/TestDataSetProxy.dpr: -------------------------------------------------------------------------------- 1 | program TestDataSetProxy; 2 | 3 | {$IFNDEF TESTINSIGHT} 4 | {$APPTYPE CONSOLE} 5 | {$ENDIF}{$STRONGLINKTYPES ON} 6 | uses 7 | System.SysUtils, 8 | {$IFDEF TESTINSIGHT} 9 | TestInsight.DUnitX, 10 | {$ENDIF } 11 | DUnitX.Loggers.Console, 12 | DUnitX.Loggers.Xml.NUnit, 13 | DUnitX.TestFramework, 14 | Test.ProxyGenerator in 'Test.ProxyGenerator.pas', 15 | Wrapper.TProxyGenerator in 'Wrapper.TProxyGenerator.pas', 16 | Comp.Generator.DataProxy in '..\src\Comp.Generator.DataProxy.pas', 17 | Data.DataProxy in '..\src\Data.DataProxy.pas', 18 | Helper.DUnitAssert in 'Helper.DUnitAssert.pas', 19 | Test.DataSetProxy in 'Test.DataSetProxy.pas', 20 | Test.SqlDataSetProxy in 'Test.SqlDataSetProxy.pas', 21 | Test.GeneratorClassMethods in 'Test.GeneratorClassMethods.pas'; 22 | 23 | var 24 | runner : ITestRunner; 25 | results : IRunResults; 26 | logger : ITestLogger; 27 | nunitLogger : ITestLogger; 28 | begin 29 | {$IFDEF TESTINSIGHT} 30 | TestInsight.DUnitX.RunRegisteredTests; 31 | exit; 32 | {$ENDIF} 33 | try 34 | //Check command line options, will exit if invalid 35 | TDUnitX.CheckCommandLine; 36 | //Create the test runner 37 | runner := TDUnitX.CreateRunner; 38 | //Tell the runner to use RTTI to find Fixtures 39 | runner.UseRTTI := True; 40 | //tell the runner how we will log things 41 | //Log to the console window 42 | logger := TDUnitXConsoleLogger.Create(true); 43 | runner.AddLogger(logger); 44 | //Generate an NUnit compatible XML File 45 | nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile); 46 | runner.AddLogger(nunitLogger); 47 | runner.FailsOnNoAsserts := False; //When true, Assertions must be made during tests; 48 | 49 | //Run tests 50 | results := runner.Execute; 51 | if not results.AllPassed then 52 | System.ExitCode := EXIT_ERRORS; 53 | 54 | {$IFNDEF CI} 55 | //We don't want this happening when running under CI. 56 | if TDUnitX.Options.ExitBehavior = TDUnitXExitBehavior.Pause then 57 | begin 58 | System.Write('Done.. press key to quit.'); 59 | System.Readln; 60 | end; 61 | {$ENDIF} 62 | except 63 | on E: Exception do 64 | System.Writeln(E.ClassName, ': ', E.Message); 65 | end; 66 | end. 67 | -------------------------------------------------------------------------------- /tests/Wrapper.TProxyGenerator.pas: -------------------------------------------------------------------------------- 1 | unit Wrapper.TProxyGenerator; 2 | 3 | interface 4 | 5 | uses 6 | Data.DB, 7 | Comp.Generator.DataProxy; 8 | 9 | type 10 | TTestProxyDataGenerator = class(TDataProxyGenerator) 11 | public 12 | function Generate_UnitHeader: string; 13 | function Generate_UsesSection: string; 14 | function Generate_ClassDeclaration: string; 15 | function Generate_PrivateField(fld: TField): string; 16 | function Generate_PublicProperty(fld: TField): string; 17 | function Generate_FieldAssigment(fld: TField): string; 18 | function Generate_MethodConnectFields: string; 19 | end; 20 | 21 | implementation 22 | 23 | function TTestProxyDataGenerator.Generate_UnitHeader: string; 24 | begin 25 | Result := Gen_UnitHeader; 26 | end; 27 | 28 | function TTestProxyDataGenerator.Generate_UsesSection: string; 29 | begin 30 | Result := Gen_UsesSection; 31 | end; 32 | 33 | function TTestProxyDataGenerator.Generate_ClassDeclaration: string; 34 | begin 35 | Result := Gen_ClassDeclaration; 36 | end; 37 | 38 | function TTestProxyDataGenerator.Generate_PrivateField(fld: TField): string; 39 | begin 40 | Result := Gen_PrivateField(fld); 41 | end; 42 | 43 | function TTestProxyDataGenerator.Generate_PublicProperty(fld: TField): string; 44 | begin 45 | Result := Gen_PublicProperty(fld); 46 | end; 47 | 48 | function TTestProxyDataGenerator.Generate_FieldAssigment(fld: TField): string; 49 | begin 50 | Result := Gen_FieldAssigment(fld); 51 | end; 52 | 53 | function TTestProxyDataGenerator.Generate_MethodConnectFields: string; 54 | begin 55 | Result := Gen_MethodConnectFields; 56 | end; 57 | 58 | end. 59 | -------------------------------------------------------------------------------- /tests/clear_project.bat: -------------------------------------------------------------------------------- 1 | rmdir /Q /S __history 2 | rmdir /Q /S Win32 3 | rmdir /Q /S .svn 4 | rmdir /Q /S __recovery 5 | 6 | del *.identcache 7 | del *.dproj.local 8 | del desktop.ini 9 | del *.stat 10 | 11 | del *.dcu 12 | del *.exe 13 | del *.dll 14 | -------------------------------------------------------------------------------- /tools/app-config.json: -------------------------------------------------------------------------------- 1 | { 2 | "sourceUnitsSearch": "..\\src\\*.pas", 3 | "readmeIsUpdateVersion": true, 4 | "readmeFileName": "..\\README.md", 5 | "readmeSearchPattern": "https://img.shields.io/badge/version" 6 | } 7 | -------------------------------------------------------------------------------- /tools/bumper_source/AppConfiguration.pas: -------------------------------------------------------------------------------- 1 | unit AppConfiguration; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, 7 | System.Classes, 8 | System.JSON, 9 | System.IOUtils; 10 | 11 | type 12 | TAppConfiguration = class 13 | private const 14 | KeySourceUnitsSearch = 'sourceUnitsSearch'; 15 | KeyReadmeIsUpdate = 'readmeIsUpdateVersion'; 16 | KeyReadmeFilePath = 'readmeFileName'; 17 | KeyReadmeSearchPattern = 'readmeSearchPattern'; 18 | private 19 | FSourceDir: string; 20 | FSrcSearchPattern: string; 21 | FReadmeIsUpdate: boolean; 22 | FReadmeFilePath: string; 23 | FReadmeSearchPattern: string; 24 | function PosTrillingBackslash(const aText: string): integer; 25 | public 26 | procedure LoadFromFile; 27 | property SourceDir: string read FSourceDir write FSourceDir; 28 | property SrcSearchPattern: string read FSrcSearchPattern 29 | write FSrcSearchPattern; 30 | property ReadmeIsUpdate: boolean read FReadmeIsUpdate write FReadmeIsUpdate; 31 | property ReadmeFilePath: string read FReadmeFilePath write FReadmeFilePath; 32 | property ReadmeSearchPattern: string read FReadmeSearchPattern 33 | write FReadmeSearchPattern; 34 | end; 35 | 36 | implementation 37 | 38 | function TAppConfiguration.PosTrillingBackslash(const aText: string): integer; 39 | begin 40 | Result := aText.Length; 41 | while (Result > 0) and (aText[Result] <> '\') do 42 | Result := Result - 1; 43 | end; 44 | 45 | procedure TAppConfiguration.LoadFromFile; 46 | var 47 | aJsonData: string; 48 | jsObject: TJSONObject; 49 | jsTrue: TJSONTrue; 50 | aSourceUnitsSearch: string; 51 | i: integer; 52 | begin 53 | aJsonData := TFile.ReadAllText('app-config.json'); 54 | jsObject := TJSONObject.ParseJSONValue(aJsonData) as TJSONObject; 55 | jsTrue := TJSONTrue.Create; 56 | try 57 | aSourceUnitsSearch := jsObject.GetValue(KeySourceUnitsSearch).Value; 58 | i := PosTrillingBackslash(aSourceUnitsSearch); 59 | SourceDir := aSourceUnitsSearch.Substring(0, i); 60 | SrcSearchPattern := aSourceUnitsSearch.Substring(i); 61 | ReadmeIsUpdate := (jsObject.GetValue(KeyReadmeIsUpdate) 62 | .Value = jsTrue.Value); 63 | ReadmeFilePath := jsObject.GetValue(KeyReadmeFilePath).Value; 64 | ReadmeSearchPattern := jsObject.GetValue(KeyReadmeSearchPattern).Value; 65 | finally 66 | jsObject.Free; 67 | jsTrue.Free; 68 | end; 69 | end; 70 | 71 | end. 72 | -------------------------------------------------------------------------------- /tools/bumper_source/Main.pas: -------------------------------------------------------------------------------- 1 | unit Main; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, 7 | System.Classes, 8 | System.IOUtils, 9 | 10 | AppConfiguration; 11 | 12 | type 13 | TMainApplication = class 14 | private 15 | fAppConfig: TAppConfiguration; 16 | fSilentMode: boolean; 17 | procedure ValidateSourceConfiguration(); 18 | function ExtractInputParameters(): string; 19 | procedure ProcessReadmeMarkdown(const aNewVersion: string); 20 | procedure ProcessSourcePasFiles(const aNewVersion: string); 21 | procedure WriteProcessErrorAndHalt(const AErrorMsg: string); 22 | public 23 | constructor Create(); 24 | destructor Destroy; override; 25 | procedure ExecuteApplication(); 26 | class procedure Run; 27 | end; 28 | 29 | implementation 30 | 31 | uses 32 | Processor.Utils, 33 | Processor.PascalUnit, 34 | Processor.ReadmeMarkdown; 35 | 36 | constructor TMainApplication.Create(); 37 | begin 38 | fAppConfig := TAppConfiguration.Create; 39 | fAppConfig.LoadFromFile; 40 | fSilentMode := true; 41 | end; 42 | 43 | destructor TMainApplication.Destroy; 44 | begin 45 | fAppConfig.Free; 46 | inherited; 47 | end; 48 | 49 | procedure TMainApplication.ValidateSourceConfiguration(); 50 | var 51 | aSourceDir: string; 52 | begin 53 | aSourceDir := fAppConfig.SourceDir; 54 | if not DirectoryExists(aSourceDir) then 55 | begin 56 | writeln(Format 57 | ('Configured source directory [%s] didnt exists. Please update configuration!', 58 | [aSourceDir])); 59 | Halt(1); 60 | end; 61 | end; 62 | 63 | procedure TMainApplication.WriteProcessErrorAndHalt(const AErrorMsg: string); 64 | begin 65 | writeln(' [Error] Processing error!'); 66 | writeln(' ' + AErrorMsg); 67 | Halt(3); 68 | end; 69 | 70 | procedure TMainApplication.ProcessReadmeMarkdown(const aNewVersion: string); 71 | var 72 | aFilePath: string; 73 | aSourceText: string; 74 | aNewSource: string; 75 | begin 76 | aFilePath := fAppConfig.ReadmeFilePath; 77 | writeln('Updating: ' + aFilePath); 78 | aSourceText := TFile.ReadAllText(aFilePath, TEncoding.UTF8); 79 | try 80 | aNewSource := TReadmeMarkdownProcessor.ProcessReadme(aSourceText, 81 | aNewVersion, fAppConfig.ReadmeSearchPattern); 82 | except 83 | on E: Processor.Utils.EProcessError do 84 | WriteProcessErrorAndHalt(E.Message); 85 | end; 86 | TFile.WriteAllText(aFilePath, aNewSource, TEncoding.UTF8); 87 | end; 88 | 89 | procedure TMainApplication.ProcessSourcePasFiles(const aNewVersion: string); 90 | var 91 | aSourceDir: string; 92 | aFiles: TArray; 93 | aPath: string; 94 | aSourceText: string; 95 | aNewSource: string; 96 | begin 97 | aSourceDir := fAppConfig.SourceDir; 98 | aFiles := TDirectory.GetFiles(aSourceDir, fAppConfig.SrcSearchPattern); 99 | for aPath in aFiles do 100 | begin 101 | aSourceText := TFile.ReadAllText(aPath, TEncoding.UTF8); 102 | writeln('Updating: ' + aPath); 103 | try 104 | aNewSource := TPascalUnitProcessor.ProcessUnit(aSourceText, aNewVersion); 105 | except 106 | on E: Processor.Utils.EProcessError do 107 | WriteProcessErrorAndHalt(E.Message); 108 | end; 109 | if aSourceText <> aNewSource then 110 | TFile.WriteAllText(aPath, aNewSource, TEncoding.UTF8); 111 | end; 112 | end; 113 | 114 | procedure TMainApplication.ExecuteApplication(); 115 | var 116 | aNewVersion: string; 117 | aFiles: TArray; 118 | aPath: string; 119 | aSourceText: string; 120 | aNewSource: string; 121 | begin 122 | ValidateSourceConfiguration; 123 | aNewVersion := ExtractInputParameters; 124 | if fAppConfig.ReadmeIsUpdate then 125 | ProcessReadmeMarkdown(aNewVersion); 126 | ProcessSourcePasFiles(aNewVersion); 127 | if fSilentMode = false then 128 | begin 129 | writeln(''); 130 | write('All files was updated. Press [Enter] to close application ...'); 131 | readln; 132 | end; 133 | end; 134 | 135 | function TMainApplication.ExtractInputParameters: string; 136 | var 137 | version: string; 138 | begin 139 | if ParamCount = 0 then 140 | begin 141 | fSilentMode := false; 142 | writeln('+--------------------------------------------------------+'); 143 | writeln('| Class Helper Version Bumper |'); 144 | writeln('+--------------------------------------------------------+'); 145 | writeln('| Can''t execute - required version string as parameter |'); 146 | writeln('| Syntax: version_bumper.exe version |'); 147 | writeln('| Sample: version_bumper.exe "1.3" |'); 148 | writeln('+--------------------------------------------------------+'); 149 | writeln(''); 150 | writeln('New version number is required to update files!'); 151 | writeln(' Type new version ([Enter] exits application):'); 152 | Write(' New version: '); 153 | readln(version); 154 | if Trim(version) = '' then 155 | Halt(2); 156 | writeln(''); 157 | end 158 | else 159 | version := ParamStr(1); 160 | Result := version; 161 | end; 162 | 163 | class procedure TMainApplication.Run; 164 | var 165 | App: TMainApplication; 166 | begin 167 | App := TMainApplication.Create; 168 | try 169 | App.ExecuteApplication; 170 | finally 171 | App.Free; 172 | end; 173 | end; 174 | 175 | end. 176 | -------------------------------------------------------------------------------- /tools/bumper_source/Processor.PascalUnit.pas: -------------------------------------------------------------------------------- 1 | unit Processor.PascalUnit; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, 7 | System.StrUtils; 8 | 9 | type 10 | TPascalUnitProcessor = class 11 | const 12 | Aphostrophe = ''''; 13 | private 14 | class function FindSignature(const aSource, FieldName: string) 15 | : integer; static; 16 | class function TextLength(const aSource: string; aTextStartIdx: integer) 17 | : integer; static; 18 | public 19 | class function ProcessUnit(const aSource: string; const aNewVersion: string) 20 | : string; static; 21 | end; 22 | 23 | implementation 24 | 25 | uses 26 | Processor.Utils; 27 | 28 | class function TPascalUnitProcessor.FindSignature(const aSource, 29 | FieldName: string): integer; 30 | var 31 | idx1: integer; 32 | i: integer; 33 | begin 34 | idx1 := aSource.IndexOf(FieldName); 35 | if idx1 >= 0 then 36 | begin 37 | i := aSource.IndexOf(Aphostrophe, idx1); 38 | if i >= 0 then 39 | Exit(i + 1); 40 | end; 41 | Result := -1; 42 | end; 43 | 44 | class function TPascalUnitProcessor.TextLength(const aSource: string; 45 | aTextStartIdx: integer): integer; 46 | var 47 | j: integer; 48 | begin 49 | if aTextStartIdx > 0 then 50 | begin 51 | j := aSource.IndexOf(Aphostrophe, aTextStartIdx); 52 | if j > aTextStartIdx then 53 | Exit(j - aTextStartIdx); 54 | end; 55 | Result := 0; 56 | end; 57 | 58 | class function TPascalUnitProcessor.ProcessUnit(const aSource: string; 59 | const aNewVersion: string): string; 60 | var 61 | idx2: integer; 62 | len2: integer; 63 | aReleaseVersion: string; 64 | aNewSource: string; 65 | begin 66 | idx2 := FindSignature(aSource, 'Version'); 67 | len2 := TextLength(aSource, idx2); 68 | aReleaseVersion := aSource.Substring(idx2, len2); 69 | if len2 = 0 then 70 | raise EProcessError.Create('No found Version const in class helper.'); 71 | aNewSource := aSource.Substring(0, idx2) + aNewVersion + 72 | aSource.Substring(idx2 + len2, 99999); 73 | write(' '); 74 | if aSource <> aNewSource then 75 | writeln(Format('Updated. Version: %s -> %s', [aReleaseVersion, 76 | aNewVersion])) 77 | else 78 | writeln('No changes. Nothing to update'); 79 | Result := aNewSource; 80 | end; 81 | 82 | end. 83 | -------------------------------------------------------------------------------- /tools/bumper_source/Processor.ReadmeMarkdown.pas: -------------------------------------------------------------------------------- 1 | unit Processor.ReadmeMarkdown; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, 7 | System.StrUtils; 8 | 9 | type 10 | TReadmeMarkdownProcessor = class 11 | private 12 | public 13 | class function ProcessReadme(const aSource: string; 14 | const aNewVersion: string; const aSearchPattern: string): string; static; 15 | end; 16 | 17 | implementation 18 | 19 | uses 20 | Processor.Utils; 21 | 22 | class function TReadmeMarkdownProcessor.ProcessReadme(const aSource: string; 23 | const aNewVersion: string; const aSearchPattern: string): string; 24 | var 25 | idx1: Integer; 26 | len: Integer; 27 | idx2: Integer; 28 | idx3: Integer; 29 | begin 30 | // --------------------------------------------------------------------- 31 | // ![ version ](https://img.shields.io/badge/version-%201.2-yellow.svg) 32 | // ^----------- search pattern -------^ 33 | // --------------------------------------------------------------------- 34 | idx1 := aSource.IndexOf(aSearchPattern); 35 | len := length(aSearchPattern); 36 | if idx1 = -1 then 37 | raise Processor.Utils.EProcessError.Create 38 | ('No version pattern found in main README file. Please update configuration file.'); 39 | idx2 := aSource.IndexOf('-', idx1 + len); 40 | idx3 := aSource.IndexOf('-', idx2+1); 41 | if (idx2 = -1) or (idx3 = -1) then 42 | raise Processor.Utils.EProcessError.Create 43 | ('Invalid format of version stored in main README'); 44 | Result := aSource.Substring(0, idx2+1) + '%20'+aNewVersion + 45 | aSource.Substring(idx3, 9999999); 46 | writeln(' Bumped README.md version to: '+aNewVersion) 47 | end; 48 | 49 | end. 50 | -------------------------------------------------------------------------------- /tools/bumper_source/Processor.Utils.pas: -------------------------------------------------------------------------------- 1 | unit Processor.Utils; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils; 7 | 8 | type 9 | EProcessError = class(Exception); 10 | 11 | 12 | implementation 13 | 14 | end. 15 | -------------------------------------------------------------------------------- /tools/bumper_source/clear_project.bat: -------------------------------------------------------------------------------- 1 | rmdir /Q /S __history 2 | rmdir /Q /S Win32 3 | rmdir /Q /S .svn 4 | rmdir /Q /S __recovery 5 | 6 | del *.identcache 7 | del *.dproj.local 8 | del desktop.ini 9 | del *.stat 10 | 11 | del *.dcu 12 | del *.exe 13 | del *.dll 14 | -------------------------------------------------------------------------------- /tools/bumper_source/version_bumper.dpr: -------------------------------------------------------------------------------- 1 | program version_bumper; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | {$R *.res} 6 | 7 | uses 8 | System.SysUtils, 9 | Main in 'Main.pas', 10 | AppConfiguration in 'AppConfiguration.pas', 11 | Processor.PascalUnit in 'Processor.PascalUnit.pas', 12 | Processor.ReadmeMarkdown in 'Processor.ReadmeMarkdown.pas', 13 | Processor.Utils in 'Processor.Utils.pas'; 14 | 15 | begin 16 | try 17 | TMainApplication.Run(); 18 | except 19 | on E: Exception do 20 | Writeln(E.ClassName, ': ', E.Message); 21 | end; 22 | end. 23 | -------------------------------------------------------------------------------- /tools/generator-app/App.AppInfo.pas: -------------------------------------------------------------------------------- 1 | unit App.AppInfo; 2 | 3 | interface 4 | 5 | type 6 | TAppInfo = class 7 | const 8 | AppName = 'Proxy Generator for FireDAC'; 9 | Version = '1.1'; 10 | ReleaseDate = '2020-03-09'; 11 | end; 12 | 13 | // ----------------------------------------------------- 14 | // Release History: 15 | // ----------------------------------------------------- 16 | (* 17 | [ 18 | {"releaseDate": "2020-03-09", "version": "1.1"}, 19 | {"releaseDate": "2020-01-29", "version": "1.0"}, 20 | {"releaseDate": "2020-01-18", "version": "0.9"}, 21 | {"releaseDate": "2019-10-02", "version": "0.8"}, 22 | {"releaseDate": "2019-09-12", "version": "0.7"}, 23 | {"releaseDate": "2019-08-26", "version": "0.6"}, 24 | {"releaseDate": "2019-08-06", "version": "0.5.1"}, 25 | {"releaseDate": "2019-08-05", "version": "0.5"}, 26 | {"releaseDate": "2019-08-01", "version": "0.4"}, 27 | {"releaseDate": "2019-07-25", "version": "0.3"}, 28 | {"releaseDate": "2019-01-17", "version": "0.2"} 29 | ] 30 | *) 31 | 32 | type 33 | TAplicationAutomation = class 34 | public 35 | // ------------ 36 | // Automation for quicker application testing (avaliable only in Developer Mode) 37 | class function IsActive: boolean; 38 | class function IsLevelSupported(level: integer): boolean; 39 | class procedure SpeedSlowDown; 40 | private const 41 | AutomationActive = False; 42 | AutomationLevel = 5; 43 | // 1: Select Connection 44 | // 2: Connect 45 | // 3: QueryBuilder & demo query 46 | // 4: Execute sql command 47 | // 5: Generate proxy 48 | AutomationSpeed = 3; 49 | // 0: max speed (no delay) otherwise: AutomationSpeed x 100 ms delay 50 | end; 51 | 52 | implementation 53 | 54 | uses 55 | System.SysUtils, 56 | Vcl.Forms, 57 | Helper.TApplication; 58 | 59 | // Automation for faster application testing (active only in Developer Mode) 60 | class function TAplicationAutomation.IsActive: boolean; 61 | begin 62 | Result := AutomationActive and Application.InDeveloperMode; 63 | end; 64 | 65 | class function TAplicationAutomation.IsLevelSupported(level: integer): boolean; 66 | begin 67 | SpeedSlowDown; 68 | Result := (level <= AutomationLevel); 69 | end; 70 | 71 | class procedure TAplicationAutomation.SpeedSlowDown; 72 | var 73 | i: integer; 74 | begin 75 | for i := 1 to AutomationSpeed do 76 | begin 77 | Application.ProcessMessages; 78 | Sleep(100); 79 | end; 80 | end; 81 | 82 | 83 | end. 84 | -------------------------------------------------------------------------------- /tools/generator-app/Base.ProxyGenerator.pas: -------------------------------------------------------------------------------- 1 | unit Base.ProxyGenerator; 2 | 3 | interface 4 | 5 | uses 6 | Data.DB, 7 | System.Classes, 8 | System.SysUtils; 9 | 10 | type 11 | EProxyGenError = class(Exception); 12 | 13 | type 14 | TProxyGenerator = class (TComponent) 15 | private 16 | FDataSet: TDataSet; 17 | FCode: String; 18 | function FieldToClass (aField: TField): TClass; 19 | procedure SetDataSet(const aDataSet: TDataSet); 20 | procedure SetCode(const aCode: String); 21 | protected 22 | function DoGenerateProxy (ds: TDataSet): String; 23 | public 24 | property Code: String read FCode write SetCode; 25 | property DataSet: TDataSet read FDataSet write SetDataSet; 26 | procedure Generate; 27 | end; 28 | 29 | implementation 30 | 31 | resourcestring 32 | ErrDataSetIsRequired = 'DataSet is required to generate new proxy'; 33 | ErrDataSetNotActive = 'DataSet have to be active!'; 34 | 35 | { TProxyGenerator } 36 | 37 | function TProxyGenerator.FieldToClass (aField: TField): TClass; 38 | begin 39 | Result := Data.DB.DefaultFieldClasses[aField.DataType]; 40 | end; 41 | 42 | function TProxyGenerator.DoGenerateProxy(ds: TDataSet): String; 43 | var 44 | code: TStringList; 45 | aField: TField; 46 | i: Integer; 47 | DataClass: TClass; 48 | begin 49 | code := TStringList.Create; 50 | try 51 | for i := 0 to ds.Fields.Count-1 do 52 | begin 53 | aField := ds.Fields[i]; 54 | DataClass := FieldToClass( aField ); 55 | code.Add(' property '+aField.FieldName+' :'+DataClass.ClassName); 56 | end; 57 | Result := code.Text; 58 | finally 59 | code.Free; 60 | end; 61 | end; 62 | 63 | procedure TProxyGenerator.Generate; 64 | begin 65 | if DataSet=nil then 66 | raise EProxyGenError.Create(ErrDataSetIsRequired); 67 | if not DataSet.Active then 68 | raise EProxyGenError.Create(ErrDataSetNotActive); 69 | Code := DoGenerateProxy(DataSet); 70 | end; 71 | 72 | procedure TProxyGenerator.SetCode(const aCode: String); 73 | begin 74 | FCode := aCode; 75 | end; 76 | 77 | procedure TProxyGenerator.SetDataSet(const aDataSet: TDataSet); 78 | begin 79 | FDataSet := aDataSet; 80 | end; 81 | 82 | end. 83 | -------------------------------------------------------------------------------- /tools/generator-app/Comp.Generator.DataSetCode.pas: -------------------------------------------------------------------------------- 1 | {* ------------------------------------------------------------------------ 2 | * ♥ 3 | * ♥ DataSet to Delphi Code (create TFDMemTable with the data) 4 | * ♥ 5 | * Component: TDSGenerator 6 | * Project: https://github.com/bogdanpolak/datasetToDelphiCode 7 | * ------------------------------------------------------------------------ } 8 | 9 | unit Comp.Generator.DataSetCode; 10 | 11 | interface 12 | 13 | uses 14 | System.Classes, System.Types, System.SysUtils, 15 | Data.DB, 16 | FireDAC.Comp.Client; 17 | 18 | type 19 | TGeneratorMode = (genStructure, genAppend, genFunction, genUnit); 20 | TDataSetType = (dstFDMemTable, dstClientDataSet); 21 | TAppendMode = (amMultilineAppends, amSinglelineAppends); 22 | 23 | TDSGenerator = class(TComponent) 24 | public const 25 | Version = '1.4'; 26 | private const 27 | MaxLiteralLenght = 70; 28 | private 29 | fCode: TStrings; 30 | fDataSet: TDataSet; 31 | fIndentationText: String; 32 | fGeneratorMode: TGeneratorMode; 33 | fDataSetType: TDataSetType; 34 | fAppendMode: TAppendMode; 35 | fUnitName: string; 36 | fMaxRows: integer; 37 | function GetDataFieldPrecision(fld: TField): integer; 38 | function GenerateOneAppend_Multiline: string; 39 | function GenerateOneAppend_Singleline: string; 40 | protected 41 | function GenerateLine_FieldDefAdd(fld: TField): string; 42 | function GenerateLine_SetFieldValue(fld: TField): string; 43 | function GenerateStructure: string; 44 | function GenerateOneAppend: string; 45 | function GenerateAppendsBlock: string; 46 | function FormatLongStringLiterals(const Literal: string): string; 47 | function GenerateUnitHeader: string; 48 | function GenerateUnitFooter: string; 49 | function GenerateFunction: string; 50 | function GenerateAll(aMode: TGeneratorMode): string; 51 | class function GenetateUnit(ds: TDataSet; const aUnitName: string): string; 52 | public 53 | constructor Create(AOwner: TComponent); override; 54 | destructor Destroy; override; 55 | procedure Execute; 56 | class function GenerateAsString(ds: TDataSet): string; 57 | class function GenerateAsArray(ds: TDataSet): TArray; 58 | class procedure GenerateAndSaveToStream(ds: TDataSet; aStream: TStream); 59 | class procedure GenerateAndSaveToFile(ds: TDataSet; 60 | const aFileName: string); 61 | class procedure GenerateAndSaveClipboard(ds: TDataSet); 62 | published 63 | property DataSet: TDataSet read fDataSet write fDataSet; 64 | property Code: TStrings read fCode; 65 | property IndentationText: String read fIndentationText 66 | write fIndentationText; 67 | property GeneratorMode: TGeneratorMode read fGeneratorMode 68 | write fGeneratorMode; 69 | property DataSetType: TDataSetType read fDataSetType write fDataSetType; 70 | property AppendMode: TAppendMode read fAppendMode write fAppendMode; 71 | property NameOfUnit: string read fUnitName write fUnitName; 72 | property MaxRows: integer read fMaxRows write fMaxRows; 73 | end; 74 | 75 | implementation 76 | 77 | uses 78 | System.Rtti, 79 | Vcl.Clipbrd; 80 | 81 | constructor TDSGenerator.Create(AOwner: TComponent); 82 | begin 83 | inherited; 84 | // -------------------------------- 85 | // Default options 86 | fGeneratorMode := genFunction; 87 | fDataSetType := dstFDMemTable; 88 | fAppendMode := amMultilineAppends; 89 | fIndentationText := ' '; 90 | fUnitName := 'uSampleDataSet'; 91 | fMaxRows := 100; 92 | // -------------------------------- 93 | fCode := TStringList.Create; 94 | end; 95 | 96 | destructor TDSGenerator.Destroy; 97 | begin 98 | fCode.Free; 99 | inherited; 100 | end; 101 | 102 | function FieldTypeToString(ft: TFieldType): string; 103 | begin 104 | Result := System.Rtti.TRttiEnumerationType.GetName(ft); 105 | end; 106 | 107 | function TDSGenerator.GetDataFieldPrecision(fld: TField): integer; 108 | begin 109 | System.Assert((fld is TBCDField) or (fld is TFMTBCDField) or 110 | (fld is TFloatField)); 111 | if fld is TBCDField then 112 | Result := (fld as TBCDField).Precision 113 | else if fld is TFMTBCDField then 114 | Result := (fld as TFMTBCDField).Precision 115 | else 116 | Result := (fld as TFloatField).Precision 117 | end; 118 | 119 | function TDSGenerator.GenerateLine_FieldDefAdd(fld: TField): string; 120 | begin 121 | (* ----------------------------------------------------------------------- 122 | [Doc] 123 | TFieldType = ( ftUnknown, ftString, ftSmallint, ftInteger, ftWord, 124 | ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime, 125 | ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo, 126 | ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar, ftWideString, 127 | ftLargeint, ftADT, ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob, 128 | ftVariant, ftInterface, ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd, 129 | ftFixedWideChar, ftWideMemo, ftOraTimeStamp, ftOraInterval, 130 | ftLongWord, ftShortint, ftByte, ftExtended, ftConnection, ftParams, ftStream, 131 | ftTimeStampOffset, ftObject, ftSingle); 132 | ------------------------------------------------------------------------- *) 133 | if fld.DataType in [ftAutoInc, ftInteger, ftWord, ftSmallint, ftLargeint, 134 | ftBoolean, ftFloat, ftCurrency, ftDate, ftTime, ftDateTime] then 135 | Result := 'FieldDefs.Add(' + QuotedStr(fld.FieldName) + ', ' + 136 | FieldTypeToString(fld.DataType) + ');' 137 | else if (fld.DataType in [ftBCD, ftFMTBcd]) then 138 | Result := 'with FieldDefs.AddFieldDef do begin' + sLineBreak + 139 | fIndentationText + ' ' + 140 | Format('Name := ''%s''; DataType := %s; Precision := %d; Size := %d;', 141 | [fld.FieldName, FieldTypeToString(fld.DataType), 142 | GetDataFieldPrecision(fld), fld.Size]) + sLineBreak + fIndentationText 143 | + ' end;' 144 | else if (fld.DataType in [ftString, ftWideString]) and (fld.Size > 9999) then 145 | Result := 'FieldDefs.Add(' + QuotedStr(fld.FieldName) + ', ' + 146 | FieldTypeToString(fld.DataType) + ', 100);' 147 | else if (fld.DataType in [ftString, ftWideString]) then 148 | Result := 'FieldDefs.Add(' + QuotedStr(fld.FieldName) + ', ' + 149 | FieldTypeToString(fld.DataType) + ', ' + fld.Size.ToString + ');' 150 | else 151 | Result := 'FieldDefs.Add(' + QuotedStr(fld.FieldName) + ', ' + 152 | FieldTypeToString(fld.DataType) + ', ' + fld.Size.ToString + ');'; 153 | end; 154 | 155 | function FloatToCode(val: Extended): string; 156 | begin 157 | Result := FloatToStr(val); 158 | Result := StringReplace(Result, ',', '.', []); 159 | end; 160 | 161 | function DateToCode(dt: TDateTime): string; 162 | var 163 | y, m, d: word; 164 | begin 165 | DecodeDate(dt, y, m, d); 166 | Result := Format('EncodeDate(%d,%d,%d)', [y, m, d]); 167 | end; 168 | 169 | function TimeToCode(dt: TDateTime): string; 170 | var 171 | h, min, s, ms: word; 172 | begin 173 | DecodeTime(dt, h, min, s, ms); 174 | Result := Format('EncodeTime(%d,%d,%d,%d)', [h, min, s, ms]); 175 | end; 176 | 177 | function DateTimeToCode(dt: TDateTime): string; 178 | begin 179 | Result := DateToCode(dt); 180 | if Frac(dt) > 0 then 181 | Result := Result + '+' + TimeToCode(dt); 182 | end; 183 | 184 | function TDSGenerator.FormatLongStringLiterals(const Literal: string): string; 185 | var 186 | s1: string; 187 | s2: string; 188 | begin 189 | if Length(Literal) <= MaxLiteralLenght then 190 | begin 191 | Result := Literal 192 | end 193 | else 194 | begin 195 | s1 := Literal; 196 | s2 := sLineBreak; 197 | while s1 <> '' do 198 | begin 199 | if Length(s1) < MaxLiteralLenght then 200 | begin 201 | s2 := s2 + fIndentationText + fIndentationText + s1; 202 | s1 := ''; 203 | end 204 | else 205 | begin 206 | s2 := s2 + fIndentationText + fIndentationText + 207 | s1.Substring(0, MaxLiteralLenght - 1) + '''+' + sLineBreak; 208 | s1 := '''' + s1.Substring(MaxLiteralLenght - 1); 209 | end; 210 | end; 211 | Result := s2; 212 | end; 213 | end; 214 | 215 | function TDSGenerator.GenerateLine_SetFieldValue(fld: TField): string; 216 | var 217 | sByNameValue: string; 218 | begin 219 | Result := ''; 220 | if not(fld.IsNull) then 221 | begin 222 | sByNameValue := 'FieldByName(' + QuotedStr(fld.FieldName) + ').Value'; 223 | case fld.DataType of 224 | ftAutoInc, ftInteger, ftWord, ftSmallint, ftLargeint: 225 | Result := sByNameValue + ' := ' + fld.AsString + ';'; 226 | ftBoolean: 227 | Result := sByNameValue + ' := ' + BoolToStr(fld.AsBoolean, true) + ';'; 228 | ftFloat, ftCurrency, ftBCD, ftFMTBcd: 229 | Result := sByNameValue + ' := ' + FloatToCode(fld.AsExtended) + ';'; 230 | ftDate: 231 | Result := sByNameValue + ' := ' + DateToCode(fld.AsDateTime) + ';'; 232 | ftTime: 233 | Result := sByNameValue + ' := ' + TimeToCode(fld.AsDateTime) + ';'; 234 | ftDateTime: 235 | Result := sByNameValue + ' := ' + DateTimeToCode(fld.AsDateTime) + ';'; 236 | ftString, ftWideString: 237 | Result := sByNameValue + ' := ' + FormatLongStringLiterals 238 | (QuotedStr(fld.Value)) + ';'; 239 | end; 240 | end; 241 | end; 242 | 243 | function TDSGenerator.GenerateStructure: string; 244 | var 245 | fld: TField; 246 | sDataSetCreate: string; 247 | sFieldDefinitions: string; 248 | begin 249 | case fDataSetType of 250 | dstFDMemTable: 251 | sDataSetCreate := 'TFDMemTable.Create(AOwner)'; 252 | dstClientDataSet: 253 | sDataSetCreate := 'TClientDataSet.Create(AOwner)'; 254 | end; 255 | sFieldDefinitions := ''; 256 | if fDataSet <> nil then 257 | for fld in fDataSet.Fields do 258 | sFieldDefinitions := sFieldDefinitions + 259 | {} fIndentationText + fIndentationText + GenerateLine_FieldDefAdd(fld) + 260 | sLineBreak; 261 | Result := 262 | {} fIndentationText + 'ds := ' + sDataSetCreate + ';' + sLineBreak + 263 | {} fIndentationText + 'with ds do' + sLineBreak + 264 | {} fIndentationText + 'begin' + sLineBreak + 265 | {} sFieldDefinitions + 266 | {} fIndentationText + fIndentationText + 'CreateDataSet;' + sLineBreak + 267 | {} fIndentationText + 'end;' + sLineBreak 268 | end; 269 | 270 | function TDSGenerator.GenerateOneAppend_Multiline: string; 271 | var 272 | fld: TField; 273 | s1: string; 274 | sl: TStringList; 275 | begin 276 | if (fDataSet = nil) or (fDataSet.Fields.Count = 0) then 277 | Exit(''); 278 | sl := TStringList.Create; 279 | try 280 | sl.Add(fIndentationText + 'ds.Append;'); 281 | for fld in fDataSet.Fields do 282 | begin 283 | s1 := GenerateLine_SetFieldValue(fld); 284 | if s1 <> '' then 285 | sl.Add(fIndentationText + 'ds.' + s1); 286 | end; 287 | sl.Add(fIndentationText + 'ds.Post;'); 288 | Result := sl.Text; 289 | finally 290 | sl.Free; 291 | end; 292 | end; 293 | 294 | function TDSGenerator.GenerateOneAppend_Singleline: string; 295 | var 296 | sFieldsValues: string; 297 | fld: TField; 298 | s1: string; 299 | begin 300 | if (fDataSet = nil) or (fDataSet.Fields.Count = 0) then 301 | Exit(''); 302 | sFieldsValues := ''; 303 | for fld in fDataSet.Fields do 304 | begin 305 | if fld.IsNull then 306 | s1 := 'Null' 307 | else 308 | case fld.DataType of 309 | ftAutoInc, ftInteger, ftWord, ftSmallint, ftLargeint: 310 | s1 := fld.AsString; 311 | ftBoolean: 312 | s1 := BoolToStr(fld.AsBoolean, true); 313 | ftFloat, ftCurrency, ftBCD, ftFMTBcd: 314 | s1 := FloatToCode(fld.AsExtended); 315 | ftDate: 316 | s1 := DateToCode(fld.AsDateTime); 317 | ftTime: 318 | s1 := TimeToCode(fld.AsDateTime); 319 | ftDateTime: 320 | s1 := DateTimeToCode(fld.AsDateTime); 321 | ftString, ftWideString: 322 | s1 := FormatLongStringLiterals(QuotedStr(fld.Value)); 323 | end; 324 | if sFieldsValues = '' then 325 | sFieldsValues := s1 326 | else 327 | sFieldsValues := sFieldsValues + ', ' + s1; 328 | end; 329 | Result := fIndentationText + 'ds.AppendRecord([' + sFieldsValues + ']);' + 330 | sLineBreak; 331 | end; 332 | 333 | function TDSGenerator.GenerateOneAppend: string; 334 | begin 335 | case fAppendMode of 336 | amMultilineAppends: 337 | Result := GenerateOneAppend_Multiline; 338 | amSinglelineAppends: 339 | Result := GenerateOneAppend_Singleline; 340 | else 341 | Result := ''; 342 | end; 343 | end; 344 | 345 | function TDSGenerator.GenerateAppendsBlock: string; 346 | var 347 | sDataAppend: string; 348 | aBookmark: TBookmark; 349 | aRowCounter: integer; 350 | begin 351 | if (fDataSet = nil) or (fDataSet.Fields.Count = 0) then 352 | Exit(''); 353 | if fMaxRows = 0 then 354 | aRowCounter := MaxInt 355 | else 356 | aRowCounter := fMaxRows; 357 | sDataAppend := ''; 358 | if DataSet <> nil then 359 | begin 360 | DataSet.DisableControls; 361 | try 362 | DataSet.Active := true; 363 | aBookmark := DataSet.GetBookmark; 364 | try 365 | DataSet.First; 366 | while not DataSet.Eof and (aRowCounter > 0) do 367 | begin 368 | sDataAppend := sDataAppend + GenerateOneAppend; 369 | dec(aRowCounter); 370 | DataSet.Next; 371 | end; 372 | finally 373 | DataSet.GotoBookmark(aBookmark); 374 | DataSet.FreeBookmark(aBookmark); 375 | end; 376 | finally 377 | DataSet.EnableControls; 378 | end; 379 | end; 380 | 381 | Result := 382 | {} sDataAppend + 383 | {} fIndentationText + 'ds.First;' + sLineBreak; 384 | end; 385 | 386 | function TDSGenerator.GenerateUnitHeader: string; 387 | var 388 | sDataSetUnits: string; 389 | begin 390 | case fDataSetType of 391 | dstFDMemTable: 392 | sDataSetUnits := fIndentationText + 'FireDAC.Comp.Client;'; 393 | dstClientDataSet: 394 | sDataSetUnits := 395 | {} fIndentationText + 'Datasnap.DBClient;'#13#10 + 396 | {} fIndentationText + 'MidasLib;'; 397 | end; 398 | Result := 399 | {} 'unit ' + fUnitName + ';' + sLineBreak + 400 | {} sLineBreak + 401 | {} 'interface' + sLineBreak + 402 | {} sLineBreak + 403 | {} 'uses' + sLineBreak + 404 | {} fIndentationText + 'System.Classes,' + sLineBreak + 405 | {} fIndentationText + 'System.SysUtils,' + sLineBreak + 406 | {} fIndentationText + 'System.Variants,' + sLineBreak + 407 | {} fIndentationText + 'Data.DB,' + sLineBreak + 408 | {} sDataSetUnits + sLineBreak + 409 | {} sLineBreak + 410 | {} 'function GivenDataSet (aOwner: TComponent): TDataSet;' + sLineBreak + 411 | {} sLineBreak + 412 | {} 'implementation' + sLineBreak + 413 | {} sLineBreak; 414 | end; 415 | 416 | function TDSGenerator.GenerateFunction: string; 417 | var 418 | aClassName: string; 419 | begin 420 | case fDataSetType of 421 | dstFDMemTable: 422 | aClassName := 'TFDMemTable'; 423 | dstClientDataSet: 424 | aClassName := 'TClientDataSet'; 425 | end; 426 | Result := 427 | {} 'function GivenDataSet (aOwner: TComponent): TDataSet;' + sLineBreak + 428 | {} 'var' + sLineBreak + 429 | {} ' ds: ' + aClassName + ';' + sLineBreak + 430 | {} 'begin' + sLineBreak + 431 | {} GenerateStructure() + 432 | {} GenerateAppendsBlock() + 433 | {} ' Result := ds;' + sLineBreak + 434 | {} 'end;' + sLineBreak; 435 | end; 436 | 437 | function TDSGenerator.GenerateUnitFooter(): string; 438 | begin 439 | Result := sLineBreak + 'end.' + sLineBreak; 440 | end; 441 | 442 | function TDSGenerator.GenerateAll(aMode: TGeneratorMode): string; 443 | begin 444 | case aMode of 445 | genStructure: 446 | Result := GenerateStructure(); 447 | genAppend: 448 | Result := GenerateAppendsBlock(); 449 | genUnit: 450 | Result := GenerateUnitHeader + GenerateFunction + GenerateUnitFooter; 451 | genFunction: 452 | Result := GenerateFunction; 453 | else 454 | Result := '// Unsupported generator mode'; 455 | end; 456 | end; 457 | 458 | procedure TDSGenerator.Execute; 459 | begin 460 | fCode.Text := GenerateAll(fGeneratorMode); 461 | end; 462 | 463 | class function TDSGenerator.GenerateAsString(ds: TDataSet): string; 464 | var 465 | gen: TDSGenerator; 466 | begin 467 | gen := TDSGenerator.Create(nil); 468 | try 469 | gen.DataSet := ds; 470 | gen.Execute; 471 | Result := gen.Code.Text; 472 | finally 473 | gen.Free; 474 | end; 475 | end; 476 | 477 | function TStringsToArray(sl: TStrings): TArray; 478 | var 479 | i: integer; 480 | begin 481 | SetLength(Result, sl.Count); 482 | for i := 0 to sl.Count - 1 do 483 | Result[i] := sl[i]; 484 | end; 485 | 486 | class function TDSGenerator.GenerateAsArray(ds: TDataSet): TArray; 487 | var 488 | gen: TDSGenerator; 489 | begin 490 | gen := TDSGenerator.Create(nil); 491 | try 492 | gen.DataSet := ds; 493 | gen.Execute; 494 | Result := TStringsToArray(gen.Code); 495 | finally 496 | gen.Free; 497 | end; 498 | end; 499 | 500 | class function TDSGenerator.GenetateUnit(ds: TDataSet; 501 | const aUnitName: string): string; 502 | var 503 | aGenerator: TDSGenerator; 504 | begin 505 | aGenerator := TDSGenerator.Create(nil); 506 | try 507 | aGenerator.DataSet := ds; 508 | aGenerator.fUnitName := aUnitName; 509 | Result := aGenerator.GenerateAll(genUnit); 510 | finally 511 | aGenerator.Free; 512 | end; 513 | end; 514 | 515 | class procedure TDSGenerator.GenerateAndSaveToStream(ds: TDataSet; 516 | aStream: TStream); 517 | var 518 | sCode: Utf8String; 519 | begin 520 | sCode := Utf8String(GenetateUnit(ds, 'uSampleDataSet')); 521 | aStream.Write(sCode[1], Length(sCode)); 522 | end; 523 | 524 | function GetUnitName_FromFilePath(aFilePath: string): string; 525 | var 526 | aUnitName: string; 527 | aExtentionLen: integer; 528 | begin 529 | aUnitName := ExtractFileName(aFilePath); 530 | aExtentionLen := Length(ExtractFileExt(aFilePath)); 531 | if aExtentionLen > 0 then 532 | Result := aUnitName.Substring(0, aUnitName.Length - aExtentionLen) 533 | else 534 | Result := aUnitName; 535 | end; 536 | 537 | class procedure TDSGenerator.GenerateAndSaveToFile(ds: TDataSet; 538 | const aFileName: string); 539 | var 540 | fs: TFileStream; 541 | sCode: Utf8String; 542 | aUnitName: string; 543 | begin 544 | aUnitName := GetUnitName_FromFilePath(aFileName); 545 | sCode := Utf8String(GenetateUnit(ds, aUnitName)); 546 | fs := TFileStream.Create(aFileName, fmCreate); 547 | try 548 | { 549 | aFilePreamble := TEncoding.UTF8.GetPreamble; 550 | aStream.Write(aFilePreamble[0], Length(aFilePreamble)); 551 | } 552 | fs.Write(sCode[1], Length(sCode)); 553 | finally 554 | fs.Free; 555 | end; 556 | end; 557 | 558 | class procedure TDSGenerator.GenerateAndSaveClipboard(ds: TDataSet); 559 | var 560 | aGenerator: TDSGenerator; 561 | begin 562 | aGenerator := TDSGenerator.Create(nil); 563 | try 564 | aGenerator.DataSet := ds; 565 | Clipboard.AsText := aGenerator.GenerateFunction; 566 | finally 567 | aGenerator.Free; 568 | end; 569 | end; 570 | 571 | end. 572 | -------------------------------------------------------------------------------- /tools/generator-app/DataModule.Main.dfm: -------------------------------------------------------------------------------- 1 | object DataModule1: TDataModule1 2 | OldCreateOrder = False 3 | Height = 360 4 | Width = 330 5 | object FDConnection1: TFDConnection 6 | Params.Strings = ( 7 | 'ConnectionDef=IB_Demo') 8 | LoginPrompt = False 9 | Left = 40 10 | Top = 24 11 | end 12 | object FDQuery1: TFDQuery 13 | Connection = FDConnection1 14 | SQL.Strings = ( 15 | 16 | 'SELECT OrderID,CustomerID,EmployeeID,OrderDate,RequiredDate,Ship' + 17 | 'pedDate,ShipVia,Freight FROM {id Orders}') 18 | Left = 40 19 | Top = 80 20 | end 21 | end 22 | -------------------------------------------------------------------------------- /tools/generator-app/DataModule.Main.pas: -------------------------------------------------------------------------------- 1 | unit DataModule.Main; 2 | 3 | interface 4 | 5 | {--$Define FULL_FIREDAC_ACCESS} // avaliable only in Delphi Entrprise version 6 | 7 | uses 8 | System.SysUtils, 9 | System.Classes, 10 | System.Types, 11 | Data.DB, 12 | FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error, 13 | FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Stan.Def, 14 | FireDAC.Stan.ExprFuncs, 15 | FireDAC.Stan.Param, 16 | FireDAC.Comp.DataSet, FireDAC.Comp.Client, 17 | FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt, 18 | FireDAC.UI.Intf, FireDAC.VCLUI.Wait, 19 | FireDAC.Phys.Intf, FireDAC.Phys, 20 | FireDAC.Phys.MySQLDef, FireDAC.Phys.MySQL, 21 | FireDAC.Phys.IBBase, 22 | FireDAC.Phys.IBDef, FireDAC.Phys.IB, 23 | FireDAC.Phys.FBDef, FireDAC.Phys.FB, 24 | FireDAC.Phys.PGDef, FireDAC.Phys.PG, 25 | FireDAC.Phys.SQLiteDef, FireDAC.Phys.SQLite, 26 | {$IFDEF FULL_FIREDAC_ACCESS} 27 | FireDAC.Phys.OracleDef, FireDAC.Phys.Oracle, 28 | FireDAC.Phys.DB2Def, FireDAC.Phys.DB2, 29 | FireDAC.Phys.MSSQLDef, FireDAC.Phys.MSSQL, 30 | {$ENDIF} 31 | FireDAC.Phys.ODBCBase; 32 | 33 | type 34 | // ----------------------------- 35 | // TODO: Convert to class accesed by singleton factory method 36 | // class: TDatabaseModule 37 | // interface: GetDatabaseModule: IDatabaseModule; 38 | // ----------------------------- 39 | TDataModule1 = class(TDataModule) 40 | FDConnection1: TFDConnection; 41 | FDQuery1: TFDQuery; 42 | private 43 | public 44 | function GetMainDataQuery : TDataSet; 45 | procedure ExecuteSQL (const TextSQL: String); 46 | function GetConnection: TFDConnection; 47 | end; 48 | 49 | var 50 | DataModule1: TDataModule1; 51 | 52 | implementation 53 | 54 | {%CLASSGROUP 'Vcl.Controls.TControl'} 55 | 56 | {$R *.dfm} 57 | 58 | function TDataModule1.GetConnection: TFDConnection; 59 | begin 60 | Result := FDConnection1; 61 | end; 62 | 63 | function TDataModule1.GetMainDataQuery: TDataSet; 64 | begin 65 | Result := FDQuery1; 66 | end; 67 | 68 | procedure TDataModule1.ExecuteSQL(const TextSQL: String); 69 | begin 70 | FDQuery1.SQL.Text := ''; 71 | FDQuery1.Open(TextSQL); 72 | end; 73 | 74 | end. 75 | -------------------------------------------------------------------------------- /tools/generator-app/Dialog.QueryBuilder.dfm: -------------------------------------------------------------------------------- 1 | object DialogQueryBuilder: TDialogQueryBuilder 2 | Left = 0 3 | Top = 0 4 | Caption = 'SQL Query Builder' 5 | ClientHeight = 424 6 | ClientWidth = 666 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnCreate = FormCreate 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object pnTables: TPanel 18 | Left = 0 19 | Top = 0 20 | Width = 193 21 | Height = 391 22 | Align = alLeft 23 | BevelOuter = bvNone 24 | Caption = ' ' 25 | TabOrder = 0 26 | object Label1: TLabel 27 | AlignWithMargins = True 28 | Left = 3 29 | Top = 3 30 | Width = 187 31 | Height = 13 32 | Margins.Bottom = 0 33 | Align = alTop 34 | Caption = 'Main table / view:' 35 | ExplicitWidth = 85 36 | end 37 | object Label2: TLabel 38 | AlignWithMargins = True 39 | Left = 3 40 | Top = 46 41 | Width = 187 42 | Height = 13 43 | Margins.Bottom = 0 44 | Align = alTop 45 | Caption = 'Join table / view (multi-select):' 46 | ExplicitWidth = 147 47 | end 48 | object cbxMainTables: TComboBox 49 | AlignWithMargins = True 50 | Left = 3 51 | Top = 19 52 | Width = 187 53 | Height = 21 54 | Align = alTop 55 | TabOrder = 0 56 | Text = 'cbxMainTables' 57 | end 58 | object lbxJoinTables: TListBox 59 | AlignWithMargins = True 60 | Left = 3 61 | Top = 62 62 | Width = 187 63 | Height = 326 64 | Align = alClient 65 | ItemHeight = 13 66 | TabOrder = 1 67 | end 68 | end 69 | object pnCommands: TPanel 70 | Left = 0 71 | Top = 391 72 | Width = 666 73 | Height = 33 74 | Align = alBottom 75 | BevelOuter = bvNone 76 | Caption = ' ' 77 | TabOrder = 1 78 | object Button1: TButton 79 | AlignWithMargins = True 80 | Left = 484 81 | Top = 3 82 | Width = 86 83 | Height = 27 84 | Action = actUseSQL 85 | Align = alRight 86 | TabOrder = 0 87 | end 88 | object Button2: TButton 89 | AlignWithMargins = True 90 | Left = 576 91 | Top = 3 92 | Width = 87 93 | Height = 27 94 | Action = actCancel 95 | Align = alRight 96 | TabOrder = 1 97 | end 98 | object Button3: TButton 99 | AlignWithMargins = True 100 | Left = 3 101 | Top = 3 102 | Width = 118 103 | Height = 27 104 | Action = actDemoSelect 105 | Align = alLeft 106 | TabOrder = 2 107 | end 108 | end 109 | object mmSqlPreview: TMemo 110 | AlignWithMargins = True 111 | Left = 288 112 | Top = 8 113 | Width = 194 114 | Height = 142 115 | TabStop = False 116 | BevelKind = bkFlat 117 | BorderStyle = bsNone 118 | Font.Charset = DEFAULT_CHARSET 119 | Font.Color = clWindowText 120 | Font.Height = -12 121 | Font.Name = 'Consolas' 122 | Font.Style = [] 123 | Lines.Strings = ( 124 | 'mmSqlPreview') 125 | ParentFont = False 126 | ScrollBars = ssVertical 127 | TabOrder = 2 128 | end 129 | object ActionList1: TActionList 130 | Left = 232 131 | Top = 72 132 | object actUseSQL: TAction 133 | Caption = 'actUseSQL' 134 | OnExecute = actUseSQLExecute 135 | OnUpdate = actUseSQLUpdate 136 | end 137 | object actCancel: TAction 138 | Caption = 'actCancel' 139 | OnExecute = actCancelExecute 140 | end 141 | object actDemoSelect: TAction 142 | Caption = 'actDemoSelect' 143 | OnExecute = actDemoSelectExecute 144 | end 145 | object actMainTableSelected: TAction 146 | Caption = 'actMainTableSelected' 147 | OnExecute = actMainTableSelectedExecute 148 | end 149 | object actJoinTableSelected: TAction 150 | Caption = 'actJoinTableSelected' 151 | OnExecute = actJoinTableSelectedExecute 152 | end 153 | end 154 | object tmrReady: TTimer 155 | Interval = 1 156 | OnTimer = tmrReadyTimer 157 | Left = 232 158 | Top = 8 159 | end 160 | end 161 | -------------------------------------------------------------------------------- /tools/generator-app/Dialog.QueryBuilder.pas: -------------------------------------------------------------------------------- 1 | unit Dialog.QueryBuilder; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, 7 | System.SysUtils, System.Variants, System.Classes, System.Actions, 8 | System.Types, 9 | Vcl.ActnList, Vcl.StdCtrls, Vcl.Controls, Vcl.ExtCtrls, Vcl.Graphics, 10 | Vcl.Forms, Vcl.Dialogs; 11 | 12 | type 13 | TDialogQueryBuilder = class(TForm) 14 | pnTables: TPanel; 15 | pnCommands: TPanel; 16 | Label1: TLabel; 17 | cbxMainTables: TComboBox; 18 | lbxJoinTables: TListBox; 19 | Label2: TLabel; 20 | mmSqlPreview: TMemo; 21 | // ------------------------------------------------------------------ 22 | // Actions 23 | ActionList1: TActionList; 24 | actUseSQL: TAction; 25 | actCancel: TAction; 26 | actDemoSelect: TAction; 27 | actMainTableSelected: TAction; 28 | actJoinTableSelected: TAction; 29 | // ------------------------------------------------------------------ 30 | Button1: TButton; 31 | Button2: TButton; 32 | Button3: TButton; 33 | tmrReady: TTimer; 34 | procedure FormCreate(Sender: TObject); 35 | procedure actCancelExecute(Sender: TObject); 36 | procedure actDemoSelectExecute(Sender: TObject); 37 | procedure actJoinTableSelectedExecute(Sender: TObject); 38 | procedure actMainTableSelectedExecute(Sender: TObject); 39 | procedure actUseSQLExecute(Sender: TObject); 40 | procedure actUseSQLUpdate(Sender: TObject); 41 | procedure cbxTablesMainChange(Sender: TObject); 42 | procedure tmrReadyTimer(Sender: TObject); 43 | private 44 | FTables: TArray; 45 | procedure PaintBox1Paint(Sender: TObject); 46 | procedure DrawInfoListBoxNotImplemented(APaintBox: TPaintBox); 47 | public 48 | class function Execute: string; 49 | end; 50 | 51 | implementation 52 | 53 | {$R *.dfm} 54 | 55 | uses 56 | DataModule.Main, 57 | App.AppInfo, 58 | Helper.TFDConnection; 59 | 60 | class function TDialogQueryBuilder.Execute: string; 61 | var 62 | dlg: TDialogQueryBuilder; 63 | mr: Integer; 64 | begin 65 | dlg := TDialogQueryBuilder.Create(Application); 66 | Result := ''; 67 | try 68 | mr := dlg.ShowModal; 69 | if mr = mrOK then 70 | Result := dlg.mmSqlPreview.Text; 71 | finally 72 | dlg.Free; 73 | end; 74 | end; 75 | 76 | procedure TDialogQueryBuilder.FormCreate(Sender: TObject); 77 | var 78 | s: String; 79 | begin 80 | FTables := DataModule1.GetConnection.GetTableNamesAsArray; 81 | // ------------------------------------------------------------------- 82 | // Configure dialog controls 83 | // ------------------------------------------------------------------- 84 | mmSqlPreview.Align := alClient; 85 | mmSqlPreview.Text := ''; 86 | // ------------------------------------------------------------------- 87 | // Configure cbxMainTables 88 | // ------------------------------------------------------------------- 89 | cbxMainTables.OnChange := nil; 90 | cbxMainTables.Style := csDropDownList; 91 | cbxMainTables.AddItem('