├── .gitignore ├── LICENSE ├── README.md └── source ├── AsyncGuardDemo.dpr ├── AsyncGuardDemo.dproj ├── AsyncSearch.pas ├── Main.Form.dfm └── Main.Form.pas /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | *.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | *.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | *.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | *.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | *.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | *.obj 27 | # 28 | 29 | # Delphi compiler-generated binaries (safe to delete) 30 | *.exe 31 | *.dll 32 | *.bpl 33 | *.bpi 34 | *.dcp 35 | *.so 36 | *.apk 37 | *.drc 38 | *.map 39 | *.dres 40 | *.rsm 41 | *.tds 42 | *.dcu 43 | *.lib 44 | *.a 45 | *.o 46 | *.ocx 47 | 48 | # Delphi autogenerated files (duplicated info) 49 | *.cfg 50 | *.hpp 51 | *Resource.rc 52 | 53 | # Delphi local files (user-specific info) 54 | *.local 55 | *.identcache 56 | *.projdata 57 | *.tvsconfig 58 | *.dsk 59 | 60 | # Delphi history and backups 61 | __history/ 62 | __recovery/ 63 | *.~* 64 | 65 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 66 | *.stat 67 | 68 | # Boss dependency manager vendor folder https://github.com/HashLoad/boss 69 | modules/ 70 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2021 Uwe Raabe 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 | # AsncTasksInVclProjects 2 | 3 | This project provides the sources to th article *Async Tasks in VCL Projects*: https://www.uweraabe.de/Blog/2021/11/07/async-tasks-in-vcl-projects/ 4 | -------------------------------------------------------------------------------- /source/AsyncGuardDemo.dpr: -------------------------------------------------------------------------------- 1 | program AsyncGuardDemo; 2 | 3 | uses 4 | Vcl.Forms, 5 | Main.Form in 'Main.Form.pas' {SearchForm}, 6 | AsyncSearch in 'AsyncSearch.pas'; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.MainFormOnTaskbar := True; 13 | Application.CreateForm(TSearchForm, SearchForm); 14 | Application.Run; 15 | end. 16 | -------------------------------------------------------------------------------- /source/AsyncGuardDemo.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {9F2DE166-FF54-4BBA-9A22-5FEB86D8EB8D} 4 | 19.2 5 | VCL 6 | True 7 | Debug 8 | Win32 9 | 1 10 | Application 11 | AsyncGuardDemo.dpr 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Base 40 | true 41 | 42 | 43 | true 44 | Cfg_2 45 | true 46 | true 47 | 48 | 49 | .\$(Platform)\$(Config) 50 | .\$(Platform)\$(Config) 51 | false 52 | false 53 | false 54 | false 55 | false 56 | System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) 57 | $(BDS)\bin\delphi_PROJECTICON.ico 58 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png 59 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png 60 | AsyncGuardDemo 61 | 62 | 63 | DBXSqliteDriver;RESTComponents;fmxase;DBXDb2Driver;DBXInterBaseDriver;vclactnband;fsDB27;vclFireDAC;emsclientfiredac;bindcompvclsmp;tethering;svnui;DataSnapFireDAC;FireDACADSDriver;frx27;DBXMSSQLDriver;fsTee27;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;svn;DBXOracleDriver;ComPortDrv;inetdb;RaizeComponentsVcl;fs27;FmxTeeUI;emsedge;TMSVCLUIPackPkgWizDXE13;fmx;FireDACIBDriver;fmxdae;RaizeComponentsVclDb;vcledge;vclib;FireDACDBXDriver;dbexpress;IndyCore;TMSVCLUIPackPkgXlsDXE13;vclx;frxTee27;dsnap;emsclient;DataSnapCommon;FireDACCommon;Package16;bdertl;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;TMSVCLUIPackPkgDXE13;vclie;bindengine;DBXMySQLDriver;CloudService;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;TMSVCLUIPackPkgExDXE13;IndyIPCommon;frxDB27;bindcompdbx;vcl;IndyIPServer;DBXSybaseASEDriver;PngComponents;IndySystem;FireDACDb2Driver;bindcompvclwinx;dsnapcon;madExcept_;VirtualTreesR;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;frxIntIOIndy27;TeeDB;FireDAC;madBasic_;emshosting;frxIntIO27;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;FMXTee;soaprtl;DbxCommonDriver;CodeSiteLoggingPkg;ibxpress;CodeSiteDBToolsPkg;Tee;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;FireDACDSDriver;rtl;emsserverresource;DbxClientDriver;madDisAsm_;DBXSybaseASADriver;ibxbindings;CustomIPTransport;vcldsnap;bindcomp;appanalytics;frxADO27;DBXInformixDriver;IndyIPClient;fsADO27;bindcompvcl;vcldbx;frxe27;TeeUI;dbxcds;VclSmp;frxDBX27;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;inetdbxpress;FireDACMongoDBDriver;DataSnapServerMidas;$(DCC_UsePackage) 64 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 65 | Debug 66 | true 67 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 68 | 1033 69 | $(BDS)\bin\default_app.manifest 70 | 71 | 72 | DBXSqliteDriver;RESTComponents;fmxase;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;emsclientfiredac;bindcompvclsmp;tethering;DataSnapFireDAC;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;DBXOracleDriver;ComPortDrv;inetdb;RaizeComponentsVcl;FmxTeeUI;emsedge;fmx;FireDACIBDriver;fmxdae;RaizeComponentsVclDb;vcledge;vclib;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;emsclient;DataSnapCommon;FireDACCommon;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;TMSVCLUIPackPkgDXE13;vclie;bindengine;DBXMySQLDriver;CloudService;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;TMSVCLUIPackPkgExDXE13;IndyIPCommon;bindcompdbx;vcl;IndyIPServer;DBXSybaseASEDriver;PngComponents;IndySystem;FireDACDb2Driver;bindcompvclwinx;dsnapcon;VirtualTreesR;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;TeeDB;FireDAC;emshosting;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;FMXTee;soaprtl;DbxCommonDriver;ibxpress;Tee;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;FireDACDSDriver;rtl;emsserverresource;DbxClientDriver;DBXSybaseASADriver;ibxbindings;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;TeeUI;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;inetdbxpress;FireDACMongoDBDriver;DataSnapServerMidas;$(DCC_UsePackage) 73 | 74 | 75 | DEBUG;$(DCC_Define) 76 | true 77 | false 78 | true 79 | true 80 | true 81 | 82 | 83 | false 84 | true 85 | PerMonitorV2 86 | 87 | 88 | false 89 | RELEASE;$(DCC_Define) 90 | 0 91 | 0 92 | 93 | 94 | true 95 | PerMonitorV2 96 | 97 | 98 | 99 | MainSource 100 | 101 | 102 |
SearchForm
103 | dfm 104 | 105 | 106 | 107 | Cfg_2 108 | Base 109 | 110 | 111 | Base 112 | 113 | 114 | Cfg_1 115 | Base 116 | 117 | 118 | 119 | Delphi.Personality.12 120 | Application 121 | 122 | 123 | 124 | AsyncGuardDemo.dpr 125 | 126 | 127 | 128 | 129 | 130 | AsyncGuardDemo.exe 131 | true 132 | 133 | 134 | 135 | 136 | 1 137 | 138 | 139 | Contents\MacOS 140 | 1 141 | 142 | 143 | 0 144 | 145 | 146 | 147 | 148 | classes 149 | 1 150 | 151 | 152 | classes 153 | 1 154 | 155 | 156 | 157 | 158 | res\xml 159 | 1 160 | 161 | 162 | res\xml 163 | 1 164 | 165 | 166 | 167 | 168 | library\lib\armeabi-v7a 169 | 1 170 | 171 | 172 | 173 | 174 | library\lib\armeabi 175 | 1 176 | 177 | 178 | library\lib\armeabi 179 | 1 180 | 181 | 182 | 183 | 184 | library\lib\armeabi-v7a 185 | 1 186 | 187 | 188 | 189 | 190 | library\lib\mips 191 | 1 192 | 193 | 194 | library\lib\mips 195 | 1 196 | 197 | 198 | 199 | 200 | library\lib\armeabi-v7a 201 | 1 202 | 203 | 204 | library\lib\arm64-v8a 205 | 1 206 | 207 | 208 | 209 | 210 | library\lib\armeabi-v7a 211 | 1 212 | 213 | 214 | 215 | 216 | res\drawable 217 | 1 218 | 219 | 220 | res\drawable 221 | 1 222 | 223 | 224 | 225 | 226 | res\values 227 | 1 228 | 229 | 230 | res\values 231 | 1 232 | 233 | 234 | 235 | 236 | res\values-v21 237 | 1 238 | 239 | 240 | res\values-v21 241 | 1 242 | 243 | 244 | 245 | 246 | res\values 247 | 1 248 | 249 | 250 | res\values 251 | 1 252 | 253 | 254 | 255 | 256 | res\drawable 257 | 1 258 | 259 | 260 | res\drawable 261 | 1 262 | 263 | 264 | 265 | 266 | res\drawable-xxhdpi 267 | 1 268 | 269 | 270 | res\drawable-xxhdpi 271 | 1 272 | 273 | 274 | 275 | 276 | res\drawable-xxxhdpi 277 | 1 278 | 279 | 280 | res\drawable-xxxhdpi 281 | 1 282 | 283 | 284 | 285 | 286 | res\drawable-ldpi 287 | 1 288 | 289 | 290 | res\drawable-ldpi 291 | 1 292 | 293 | 294 | 295 | 296 | res\drawable-mdpi 297 | 1 298 | 299 | 300 | res\drawable-mdpi 301 | 1 302 | 303 | 304 | 305 | 306 | res\drawable-hdpi 307 | 1 308 | 309 | 310 | res\drawable-hdpi 311 | 1 312 | 313 | 314 | 315 | 316 | res\drawable-xhdpi 317 | 1 318 | 319 | 320 | res\drawable-xhdpi 321 | 1 322 | 323 | 324 | 325 | 326 | res\drawable-mdpi 327 | 1 328 | 329 | 330 | res\drawable-mdpi 331 | 1 332 | 333 | 334 | 335 | 336 | res\drawable-hdpi 337 | 1 338 | 339 | 340 | res\drawable-hdpi 341 | 1 342 | 343 | 344 | 345 | 346 | res\drawable-xhdpi 347 | 1 348 | 349 | 350 | res\drawable-xhdpi 351 | 1 352 | 353 | 354 | 355 | 356 | res\drawable-xxhdpi 357 | 1 358 | 359 | 360 | res\drawable-xxhdpi 361 | 1 362 | 363 | 364 | 365 | 366 | res\drawable-xxxhdpi 367 | 1 368 | 369 | 370 | res\drawable-xxxhdpi 371 | 1 372 | 373 | 374 | 375 | 376 | res\drawable-small 377 | 1 378 | 379 | 380 | res\drawable-small 381 | 1 382 | 383 | 384 | 385 | 386 | res\drawable-normal 387 | 1 388 | 389 | 390 | res\drawable-normal 391 | 1 392 | 393 | 394 | 395 | 396 | res\drawable-large 397 | 1 398 | 399 | 400 | res\drawable-large 401 | 1 402 | 403 | 404 | 405 | 406 | res\drawable-xlarge 407 | 1 408 | 409 | 410 | res\drawable-xlarge 411 | 1 412 | 413 | 414 | 415 | 416 | res\values 417 | 1 418 | 419 | 420 | res\values 421 | 1 422 | 423 | 424 | 425 | 426 | 1 427 | 428 | 429 | Contents\MacOS 430 | 1 431 | 432 | 433 | 0 434 | 435 | 436 | 437 | 438 | Contents\MacOS 439 | 1 440 | .framework 441 | 442 | 443 | Contents\MacOS 444 | 1 445 | .framework 446 | 447 | 448 | 0 449 | 450 | 451 | 452 | 453 | 1 454 | .dylib 455 | 456 | 457 | 1 458 | .dylib 459 | 460 | 461 | 1 462 | .dylib 463 | 464 | 465 | Contents\MacOS 466 | 1 467 | .dylib 468 | 469 | 470 | Contents\MacOS 471 | 1 472 | .dylib 473 | 474 | 475 | 0 476 | .dll;.bpl 477 | 478 | 479 | 480 | 481 | 1 482 | .dylib 483 | 484 | 485 | 1 486 | .dylib 487 | 488 | 489 | 1 490 | .dylib 491 | 492 | 493 | Contents\MacOS 494 | 1 495 | .dylib 496 | 497 | 498 | Contents\MacOS 499 | 1 500 | .dylib 501 | 502 | 503 | 0 504 | .bpl 505 | 506 | 507 | 508 | 509 | 0 510 | 511 | 512 | 0 513 | 514 | 515 | 0 516 | 517 | 518 | 0 519 | 520 | 521 | 0 522 | 523 | 524 | Contents\Resources\StartUp\ 525 | 0 526 | 527 | 528 | Contents\Resources\StartUp\ 529 | 0 530 | 531 | 532 | 0 533 | 534 | 535 | 536 | 537 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 538 | 1 539 | 540 | 541 | 542 | 543 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 544 | 1 545 | 546 | 547 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 548 | 1 549 | 550 | 551 | 552 | 553 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 554 | 1 555 | 556 | 557 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 558 | 1 559 | 560 | 561 | 562 | 563 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 564 | 1 565 | 566 | 567 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 568 | 1 569 | 570 | 571 | 572 | 573 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 574 | 1 575 | 576 | 577 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 578 | 1 579 | 580 | 581 | 582 | 583 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 584 | 1 585 | 586 | 587 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 588 | 1 589 | 590 | 591 | 592 | 593 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 594 | 1 595 | 596 | 597 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 598 | 1 599 | 600 | 601 | 602 | 603 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 604 | 1 605 | 606 | 607 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 608 | 1 609 | 610 | 611 | 612 | 613 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 614 | 1 615 | 616 | 617 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 618 | 1 619 | 620 | 621 | 622 | 623 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 624 | 1 625 | 626 | 627 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 628 | 1 629 | 630 | 631 | 632 | 633 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 634 | 1 635 | 636 | 637 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 638 | 1 639 | 640 | 641 | 642 | 643 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 644 | 1 645 | 646 | 647 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 648 | 1 649 | 650 | 651 | 652 | 653 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 654 | 1 655 | 656 | 657 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 658 | 1 659 | 660 | 661 | 662 | 663 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 664 | 1 665 | 666 | 667 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 668 | 1 669 | 670 | 671 | 672 | 673 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 674 | 1 675 | 676 | 677 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 678 | 1 679 | 680 | 681 | 682 | 683 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 684 | 1 685 | 686 | 687 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 688 | 1 689 | 690 | 691 | 692 | 693 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 694 | 1 695 | 696 | 697 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 698 | 1 699 | 700 | 701 | 702 | 703 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 704 | 1 705 | 706 | 707 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 708 | 1 709 | 710 | 711 | 712 | 713 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 714 | 1 715 | 716 | 717 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 718 | 1 719 | 720 | 721 | 722 | 723 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 724 | 1 725 | 726 | 727 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 728 | 1 729 | 730 | 731 | 732 | 733 | 1 734 | 735 | 736 | 1 737 | 738 | 739 | 740 | 741 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 742 | 1 743 | 744 | 745 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 746 | 1 747 | 748 | 749 | 750 | 751 | ..\ 752 | 1 753 | 754 | 755 | ..\ 756 | 1 757 | 758 | 759 | 760 | 761 | 1 762 | 763 | 764 | 1 765 | 766 | 767 | 1 768 | 769 | 770 | 771 | 772 | ..\$(PROJECTNAME).launchscreen 773 | 64 774 | 775 | 776 | ..\$(PROJECTNAME).launchscreen 777 | 64 778 | 779 | 780 | 781 | 782 | 1 783 | 784 | 785 | 1 786 | 787 | 788 | 1 789 | 790 | 791 | 792 | 793 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 794 | 1 795 | 796 | 797 | 798 | 799 | ..\ 800 | 1 801 | 802 | 803 | ..\ 804 | 1 805 | 806 | 807 | 808 | 809 | Contents 810 | 1 811 | 812 | 813 | Contents 814 | 1 815 | 816 | 817 | 818 | 819 | Contents\Resources 820 | 1 821 | 822 | 823 | Contents\Resources 824 | 1 825 | 826 | 827 | 828 | 829 | library\lib\armeabi-v7a 830 | 1 831 | 832 | 833 | library\lib\arm64-v8a 834 | 1 835 | 836 | 837 | 1 838 | 839 | 840 | 1 841 | 842 | 843 | 1 844 | 845 | 846 | 1 847 | 848 | 849 | Contents\MacOS 850 | 1 851 | 852 | 853 | Contents\MacOS 854 | 1 855 | 856 | 857 | 0 858 | 859 | 860 | 861 | 862 | library\lib\armeabi-v7a 863 | 1 864 | 865 | 866 | 867 | 868 | 1 869 | 870 | 871 | 1 872 | 873 | 874 | 875 | 876 | Assets 877 | 1 878 | 879 | 880 | Assets 881 | 1 882 | 883 | 884 | 885 | 886 | Assets 887 | 1 888 | 889 | 890 | Assets 891 | 1 892 | 893 | 894 | 895 | 896 | 897 | 898 | 899 | 900 | 901 | 902 | 903 | 904 | 905 | 906 | True 907 | False 908 | 909 | 910 | 911 | WinApi;System.Win;System;Data;Vcl 912 | 913 | 914 | 915 | 12 916 | 917 | 918 | 919 | 920 | 921 | -------------------------------------------------------------------------------- /source/AsyncSearch.pas: -------------------------------------------------------------------------------- 1 | unit AsyncSearch; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Classes; 7 | 8 | type 9 | ISearchTarget = interface 10 | procedure AddFiles(const AFiles: TArray); 11 | procedure BeginSearch; 12 | procedure EndSearch; 13 | end; 14 | 15 | type 16 | ICancel = interface 17 | procedure Cancel; 18 | function IsCancelled: Boolean; 19 | end; 20 | 21 | type 22 | TSearch = class 23 | type 24 | TCancel = class(TInterfacedObject, ICancel) 25 | private 26 | FSearch: TSearch; 27 | strict protected 28 | property Search: TSearch read FSearch implements ICancel; 29 | public 30 | constructor Create(ASearch: TSearch); 31 | destructor Destroy; override; 32 | end; 33 | private 34 | FCancelled: Boolean; 35 | FPath: string; 36 | FSearchPattern: string; 37 | FTarget: ISearchTarget; 38 | function IsCancelled: Boolean; 39 | procedure SearchFolder(const APath, ASearchPattern: string); 40 | strict protected 41 | procedure AddFiles(const AFiles: TArray); virtual; 42 | procedure BeginSearch; virtual; 43 | function CheckCancelled: Boolean; 44 | procedure EndSearch; virtual; 45 | procedure Execute(ACancel: ICancel); overload; virtual; 46 | public 47 | constructor Create(ATarget: ISearchTarget; const APath, ASearchPattern: string); 48 | procedure Cancel; 49 | procedure Execute; overload; 50 | class procedure Execute(ATarget: ISearchTarget; const APath, ASearchPattern: string; out ACancel: ICancel); overload; 51 | property Cancelled: Boolean read FCancelled; 52 | end; 53 | 54 | type 55 | TAsyncSearch = class(TSearch) 56 | strict protected 57 | procedure AddFiles(const AFiles: TArray); override; 58 | procedure BeginSearch; override; 59 | procedure EndSearch; override; 60 | procedure Execute(ACancel: ICancel); overload; override; 61 | public 62 | end; 63 | 64 | implementation 65 | 66 | uses 67 | System.IOUtils, System.Threading; 68 | 69 | constructor TSearch.Create(ATarget: ISearchTarget; const APath, ASearchPattern: string); 70 | begin 71 | inherited Create; 72 | Assert(ATarget <> nil, 'Target must not be nil!'); 73 | FTarget := ATarget; 74 | FPath := APath; 75 | FSearchPattern := ASearchPattern; 76 | end; 77 | 78 | procedure TSearch.AddFiles(const AFiles: TArray); 79 | begin 80 | if CheckCancelled then Exit; 81 | if Length(AFiles) = 0 then Exit; 82 | FTarget.AddFiles(AFiles); 83 | end; 84 | 85 | procedure TSearch.BeginSearch; 86 | begin 87 | if CheckCancelled then Exit; 88 | FTarget.BeginSearch; 89 | end; 90 | 91 | procedure TSearch.Cancel; 92 | begin 93 | FCancelled := True; 94 | end; 95 | 96 | function TSearch.CheckCancelled: Boolean; 97 | begin 98 | Result := FCancelled; 99 | if Result then 100 | FTarget := nil; 101 | end; 102 | 103 | procedure TSearch.EndSearch; 104 | begin 105 | if CheckCancelled then Exit; 106 | FTarget.EndSearch; 107 | end; 108 | 109 | procedure TSearch.Execute; 110 | begin 111 | BeginSearch; 112 | SearchFolder(FPath, FSearchPattern); 113 | EndSearch; 114 | end; 115 | 116 | class procedure TSearch.Execute(ATarget: ISearchTarget; const APath, ASearchPattern: string; out ACancel: ICancel); 117 | var 118 | instance: TSearch; 119 | begin 120 | instance := Self.Create(ATarget, APath, ASearchPattern); 121 | { TCancel is responsible for destroing instance } 122 | ACancel := TCancel.Create(instance); 123 | instance.Execute(ACancel); 124 | end; 125 | 126 | procedure TSearch.Execute(ACancel: ICancel); 127 | begin 128 | Execute; 129 | end; 130 | 131 | function TSearch.IsCancelled: Boolean; 132 | begin 133 | Result := FCancelled; 134 | end; 135 | 136 | procedure TSearch.SearchFolder(const APath, ASearchPattern: string); 137 | var 138 | arr: TArray; 139 | dir: string; 140 | begin 141 | arr := TDirectory.GetFiles(APath, ASearchPattern); 142 | AddFiles(arr); 143 | { release memory as early as possible } 144 | arr := nil; 145 | for dir in TDirectory.GetDirectories(APath) do begin 146 | if Cancelled then Exit; 147 | if not TDirectory.Exists(dir) then Continue; 148 | SearchFolder(dir, ASearchPattern); 149 | end; 150 | end; 151 | 152 | procedure TAsyncSearch.AddFiles(const AFiles: TArray); 153 | begin 154 | TThread.Synchronize(nil, procedure begin inherited; end); 155 | end; 156 | 157 | procedure TAsyncSearch.BeginSearch; 158 | begin 159 | TThread.Synchronize(nil, procedure begin inherited; end); 160 | end; 161 | 162 | procedure TAsyncSearch.EndSearch; 163 | begin 164 | TThread.Synchronize(nil, procedure begin inherited; end); 165 | end; 166 | 167 | procedure TAsyncSearch.Execute(ACancel: ICancel); 168 | begin 169 | TTask.Run( 170 | procedure 171 | begin 172 | { capture ACancel to keep the current during the lifetime of the async method } 173 | if not ACancel.IsCancelled then 174 | Execute; 175 | end); 176 | end; 177 | 178 | constructor TSearch.TCancel.Create(ASearch: TSearch); 179 | begin 180 | inherited Create; 181 | FSearch := ASearch; 182 | end; 183 | 184 | destructor TSearch.TCancel.Destroy; 185 | begin 186 | FSearch.Free; 187 | inherited Destroy; 188 | end; 189 | 190 | end. 191 | -------------------------------------------------------------------------------- /source/Main.Form.pas: -------------------------------------------------------------------------------- 1 | unit Main.Form; 2 | 3 | interface 4 | 5 | uses 6 | System.ImageList, System.Classes, System.Types, System.Diagnostics, 7 | Vcl.Forms, Vcl.ImgList, Vcl.VirtualImageList, Vcl.BaseImageCollection, Vcl.ImageCollection, Vcl.ExtCtrls, Vcl.StdCtrls, 8 | Vcl.WinXCtrls, Vcl.Controls, Vcl.ComCtrls, 9 | AsyncSearch; 10 | 11 | type 12 | TSearchForm = class(TForm, ISearchTarget) 13 | dspFiles: TListView; 14 | pnlTop: TPanel; 15 | edtSearchPattern: TSearchBox; 16 | lblSearchPattern: TLabel; 17 | lblRootFolder: TLabel; 18 | edtRootFolder: TButtonedEdit; 19 | imgCollection: TImageCollection; 20 | imgList: TVirtualImageList; 21 | btnNewSearchWindow: TButton; 22 | StatusBar: TStatusBar; 23 | procedure btnNewSearchWindowClick(Sender: TObject); 24 | procedure dspFilesData(Sender: TObject; Item: TListItem); 25 | procedure dspFilesDataFind(Sender: TObject; Find: TItemFind; const FindString: string; const FindPosition: TPoint; 26 | FindData: Pointer; StartIndex: Integer; Direction: TSearchDirection; Wrap: Boolean; var Index: Integer); 27 | procedure edtRootFolderRightButtonClick(Sender: TObject); 28 | procedure edtSearchPatternInvokeSearch(Sender: TObject); 29 | private 30 | FFiles: TStringList; 31 | FSearch: ICancel; 32 | FStopwatch: TStopwatch; 33 | class var 34 | FormIndex: Integer; 35 | function GetFiles: TStringList; 36 | procedure SelectRootFolder; 37 | procedure SetSearch(const Value: ICancel); 38 | procedure AddFiles(const AFiles: TArray); 39 | procedure BeginSearch; 40 | procedure CreateNewSearchWindow; 41 | procedure EndSearch; 42 | procedure StartSearch; 43 | protected 44 | property Files: TStringList read GetFiles; 45 | property Search: ICancel read FSearch write SetSearch; 46 | public 47 | destructor Destroy; override; 48 | end; 49 | 50 | var 51 | SearchForm: TSearchForm; 52 | 53 | implementation 54 | 55 | uses 56 | System.Threading, System.IOUtils, System.SysUtils, 57 | Vcl.FileCtrl; 58 | 59 | {$R *.dfm} 60 | 61 | destructor TSearchForm.Destroy; 62 | begin 63 | Search := nil; 64 | FFiles.Free; 65 | inherited; 66 | end; 67 | 68 | procedure TSearchForm.AddFiles(const AFiles: TArray); 69 | begin 70 | Files.AddStrings(AFiles); 71 | dspFiles.Items.Count := Files.Count; 72 | StatusBar.SimpleText := Format('%d files found', [Files.Count]); 73 | if Files.Count >= 10000 then begin 74 | EndSearch; // cancels search and releases interface 75 | end; 76 | end; 77 | 78 | procedure TSearchForm.BeginSearch; 79 | begin 80 | FStopWatch := TStopwatch.StartNew; 81 | dspFiles.Cursor := crHourGlass; 82 | end; 83 | 84 | procedure TSearchForm.btnNewSearchWindowClick(Sender: TObject); 85 | begin 86 | CreateNewSearchWindow; 87 | end; 88 | 89 | procedure TSearchForm.CreateNewSearchWindow; 90 | var 91 | form: TSearchForm; 92 | begin 93 | Inc(FormIndex); 94 | form := TSearchForm.Create(Application); 95 | form.Caption := Format('Search Window %d', [FormIndex]); 96 | form.Show; 97 | end; 98 | 99 | procedure TSearchForm.StartSearch; 100 | begin 101 | { cancel and release any active search } 102 | Search := nil; 103 | StatusBar.SimpleText := ''; 104 | dspFiles.Clear; 105 | Files.Clear; 106 | TAsyncSearch.Execute(Self, edtRootFolder.Text, edtSearchPattern.Text, FSearch); 107 | end; 108 | 109 | procedure TSearchForm.dspFilesData(Sender: TObject; Item: TListItem); 110 | begin 111 | Item.Caption := Files[Item.Index]; 112 | end; 113 | 114 | procedure TSearchForm.dspFilesDataFind(Sender: TObject; Find: TItemFind; const FindString: string; const FindPosition: TPoint; 115 | FindData: Pointer; StartIndex: Integer; Direction: TSearchDirection; Wrap: Boolean; var Index: Integer); 116 | begin 117 | Index := -1; 118 | case Find of 119 | ifData: ; 120 | ifPartialString: ; 121 | ifExactString: Index := Files.IndexOf(FindString); 122 | ifNearest: ; 123 | end; 124 | end; 125 | 126 | procedure TSearchForm.edtRootFolderRightButtonClick(Sender: TObject); 127 | begin 128 | SelectRootFolder; 129 | end; 130 | 131 | procedure TSearchForm.edtSearchPatternInvokeSearch(Sender: TObject); 132 | begin 133 | StartSearch; 134 | end; 135 | 136 | procedure TSearchForm.EndSearch; 137 | begin 138 | Search := nil; // cancel and release interface when search is complete or interrupted 139 | StatusBar.SimpleText := Format('%d files found (%d ms)', [Files.Count, FStopwatch.ElapsedMilliseconds]); 140 | dspFiles.Cursor := crDefault; 141 | end; 142 | 143 | function TSearchForm.GetFiles: TStringList; 144 | begin 145 | if FFiles = nil then begin 146 | FFiles := TStringList.Create; 147 | end; 148 | Result := FFiles; 149 | end; 150 | 151 | procedure TSearchForm.SelectRootFolder; 152 | var 153 | path: string; 154 | begin 155 | path := edtRootFolder.Text; 156 | if SelectDirectory('Select Root Folder', '', path) then 157 | edtRootFolder.Text := path; 158 | end; 159 | 160 | procedure TSearchForm.SetSearch(const Value: ICancel); 161 | begin 162 | if FSearch <> nil then 163 | FSearch.Cancel; 164 | FSearch := Value; 165 | end; 166 | 167 | end. 168 | --------------------------------------------------------------------------------