%s

├── .gitignore ├── Google_Email_Example.dpr ├── Google_Email_Example.dproj ├── Google_Email_Example.skincfg ├── LICENSE ├── README.md ├── U_DCS_OAuth2.pas ├── U_emailExample.dfm └── U_emailExample.pas /.gitignore: -------------------------------------------------------------------------------- 1 | __history/ 2 | __recovery/ 3 | Win32/ 4 | Win64/ 5 | Win64x/ 6 | 7 | *.~* 8 | *.bak 9 | *.dsk 10 | *.dsv 11 | *.hpp 12 | *.identcache 13 | *.local 14 | *.res 15 | *.stat 16 | *.tds 17 | *.tvsconfig 18 | -------------------------------------------------------------------------------- /Google_Email_Example.dpr: -------------------------------------------------------------------------------- 1 | program Google_Email_Example; 2 | 3 | uses 4 | Vcl.Forms, 5 | U_emailExample in 'U_emailExample.pas' {FRM_sendMail}, 6 | U_DCS_OAuth2 in 'U_DCS_OAuth2.pas'; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.MainFormOnTaskbar := True; 13 | Application.CreateForm(TFRM_sendMail, FRM_sendMail); 14 | Application.Run; 15 | end. 16 | -------------------------------------------------------------------------------- /Google_Email_Example.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {D2CF27A5-F54E-4683-B706-7CF724622F5F} 4 | 19.1 5 | VCL 6 | True 7 | Debug 8 | Win32 9 | 1 10 | Application 11 | Google_Email_Example.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 | Google_Email_Example 61 | 62 | 63 | DBXSqliteDriver;RESTComponents;fmxase;DBXInterBaseDriver;dxSpreadSheetConditionalFormattingDialogsRS27;vclactnband;vclFireDAC;dxSpreadSheetReportDesignerRS27;dxSpreadSheetRS27;bindcompvclsmp;tethering;svnui;FireDACADSDriver;cxLibraryRS27;dxADOServerModeRS27;vcltouch;vcldb;bindcompfmx;svn;dxPScxExtCommonRS27;inetdb;cxTreeListRS27;fmx;FireDACIBDriver;fmxdae;vcledge;dbexpress;IndyCore;vclx;dsnap;FireDACCommon;DCS_Components;RESTBackendComponents;dclZipForged27;VCLRESTComponents;soapserver;dxPScxTLLnkRS27;vclie;bindengine;DBXMySQLDriver;CloudService;dxPSCoreRS27;FireDACMySQLDriver;cxExportRS27;FireDACCommonODBC;FireDACCommonDriver;inet;IndyIPCommon;bindcompdbx;vcl;IndyIPServer;dxPScxPCProdRS27;IndySystem;dxHttpIndyRequestRS27;dsnapcon;dxComnRS27;FireDACMSAccDriver;fmxFireDAC;dxmdsRS27;vclimg;FireDAC;dxCoreRS27;dxPSdxSpreadSheetLnkRS27;FireDACSqliteDriver;FireDACPgDriver;DCS_dxModernRS27;soaprtl;DbxCommonDriver;dxCloudServiceLibraryRS27;xmlrtl;soapmidas;fmxobj;vclwinx;dxPScxCommonRS27;rtl;VpevclXe2;DbxClientDriver;CustomIPTransport;vcldsnap;dxSkinsCoreRS27;dxPScxGridLnkRS27;vclZipForged27;bindcomp;appanalytics;dxSpreadSheetCoreRS27;dxGDIPlusRS27;IndyIPClient;dxFireDACServerModeRS27;bindcompvcl;dxServerModeRS27;dxPSLnksRS27;dbxcds;VclSmp;adortl;dxDBXServerModeRS27;cxGridRS27;dsnapxml;dbrtl;IndyProtocols;inetdbxpress;dxPSdxLCLnkRS27;dxSpreadSheetCoreConditionalFormattingDialogsRS27;$(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;DBXInterBaseDriver;dxSpreadSheetConditionalFormattingDialogsRS27;vclactnband;vclFireDAC;dxSpreadSheetReportDesignerRS27;dxSpreadSheetRS27;bindcompvclsmp;tethering;FireDACADSDriver;cxLibraryRS27;dxADOServerModeRS27;vcltouch;vcldb;bindcompfmx;dxPScxExtCommonRS27;inetdb;cxTreeListRS27;fmx;FireDACIBDriver;fmxdae;vcledge;dbexpress;IndyCore;vclx;dsnap;FireDACCommon;RESTBackendComponents;VCLRESTComponents;soapserver;dxPScxTLLnkRS27;vclie;bindengine;DBXMySQLDriver;CloudService;dxPSCoreRS27;FireDACMySQLDriver;cxExportRS27;FireDACCommonODBC;FireDACCommonDriver;inet;IndyIPCommon;bindcompdbx;vcl;IndyIPServer;dxPScxPCProdRS27;IndySystem;dxHttpIndyRequestRS27;dsnapcon;dxComnRS27;FireDACMSAccDriver;fmxFireDAC;dxmdsRS27;vclimg;FireDAC;dxCoreRS27;dxPSdxSpreadSheetLnkRS27;FireDACSqliteDriver;FireDACPgDriver;soaprtl;DbxCommonDriver;dxCloudServiceLibraryRS27;xmlrtl;soapmidas;fmxobj;vclwinx;dxPScxCommonRS27;rtl;DbxClientDriver;CustomIPTransport;vcldsnap;dxSkinsCoreRS27;dxPScxGridLnkRS27;vclZipForged27;bindcomp;appanalytics;dxSpreadSheetCoreRS27;dxGDIPlusRS27;IndyIPClient;dxFireDACServerModeRS27;bindcompvcl;dxServerModeRS27;dxPSLnksRS27;dbxcds;VclSmp;adortl;dxDBXServerModeRS27;cxGridRS27;dsnapxml;dbrtl;IndyProtocols;inetdbxpress;dxPSdxLCLnkRS27;dxSpreadSheetCoreConditionalFormattingDialogsRS27;$(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 | 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 | Google_Email_Example.dpr 125 | 126 | 127 | 128 | 129 | 130 | Google_Email_Example.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-ldpi 277 | 1 278 | 279 | 280 | res\drawable-ldpi 281 | 1 282 | 283 | 284 | 285 | 286 | res\drawable-mdpi 287 | 1 288 | 289 | 290 | res\drawable-mdpi 291 | 1 292 | 293 | 294 | 295 | 296 | res\drawable-hdpi 297 | 1 298 | 299 | 300 | res\drawable-hdpi 301 | 1 302 | 303 | 304 | 305 | 306 | res\drawable-xhdpi 307 | 1 308 | 309 | 310 | res\drawable-xhdpi 311 | 1 312 | 313 | 314 | 315 | 316 | res\drawable-mdpi 317 | 1 318 | 319 | 320 | res\drawable-mdpi 321 | 1 322 | 323 | 324 | 325 | 326 | res\drawable-hdpi 327 | 1 328 | 329 | 330 | res\drawable-hdpi 331 | 1 332 | 333 | 334 | 335 | 336 | res\drawable-xhdpi 337 | 1 338 | 339 | 340 | res\drawable-xhdpi 341 | 1 342 | 343 | 344 | 345 | 346 | res\drawable-xxhdpi 347 | 1 348 | 349 | 350 | res\drawable-xxhdpi 351 | 1 352 | 353 | 354 | 355 | 356 | res\drawable-xxxhdpi 357 | 1 358 | 359 | 360 | res\drawable-xxxhdpi 361 | 1 362 | 363 | 364 | 365 | 366 | res\drawable-small 367 | 1 368 | 369 | 370 | res\drawable-small 371 | 1 372 | 373 | 374 | 375 | 376 | res\drawable-normal 377 | 1 378 | 379 | 380 | res\drawable-normal 381 | 1 382 | 383 | 384 | 385 | 386 | res\drawable-large 387 | 1 388 | 389 | 390 | res\drawable-large 391 | 1 392 | 393 | 394 | 395 | 396 | res\drawable-xlarge 397 | 1 398 | 399 | 400 | res\drawable-xlarge 401 | 1 402 | 403 | 404 | 405 | 406 | res\values 407 | 1 408 | 409 | 410 | res\values 411 | 1 412 | 413 | 414 | 415 | 416 | 1 417 | 418 | 419 | Contents\MacOS 420 | 1 421 | 422 | 423 | 0 424 | 425 | 426 | 427 | 428 | Contents\MacOS 429 | 1 430 | .framework 431 | 432 | 433 | Contents\MacOS 434 | 1 435 | .framework 436 | 437 | 438 | 0 439 | 440 | 441 | 442 | 443 | 1 444 | .dylib 445 | 446 | 447 | 1 448 | .dylib 449 | 450 | 451 | 1 452 | .dylib 453 | 454 | 455 | Contents\MacOS 456 | 1 457 | .dylib 458 | 459 | 460 | Contents\MacOS 461 | 1 462 | .dylib 463 | 464 | 465 | 0 466 | .dll;.bpl 467 | 468 | 469 | 470 | 471 | 1 472 | .dylib 473 | 474 | 475 | 1 476 | .dylib 477 | 478 | 479 | 1 480 | .dylib 481 | 482 | 483 | Contents\MacOS 484 | 1 485 | .dylib 486 | 487 | 488 | Contents\MacOS 489 | 1 490 | .dylib 491 | 492 | 493 | 0 494 | .bpl 495 | 496 | 497 | 498 | 499 | 0 500 | 501 | 502 | 0 503 | 504 | 505 | 0 506 | 507 | 508 | 0 509 | 510 | 511 | 0 512 | 513 | 514 | Contents\Resources\StartUp\ 515 | 0 516 | 517 | 518 | Contents\Resources\StartUp\ 519 | 0 520 | 521 | 522 | 0 523 | 524 | 525 | 526 | 527 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 528 | 1 529 | 530 | 531 | 532 | 533 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 534 | 1 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\LaunchScreenImage.imageset 554 | 1 555 | 556 | 557 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 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\AppIcon.appiconset 574 | 1 575 | 576 | 577 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 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\LaunchScreenImage.imageset 624 | 1 625 | 626 | 627 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 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\AppIcon.appiconset 664 | 1 665 | 666 | 667 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 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 | 1 724 | 725 | 726 | 1 727 | 728 | 729 | 730 | 731 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 732 | 1 733 | 734 | 735 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 736 | 1 737 | 738 | 739 | 740 | 741 | ..\ 742 | 1 743 | 744 | 745 | ..\ 746 | 1 747 | 748 | 749 | 750 | 751 | 1 752 | 753 | 754 | 1 755 | 756 | 757 | 1 758 | 759 | 760 | 761 | 762 | ..\$(PROJECTNAME).launchscreen 763 | 64 764 | 765 | 766 | ..\$(PROJECTNAME).launchscreen 767 | 64 768 | 769 | 770 | 771 | 772 | 1 773 | 774 | 775 | 1 776 | 777 | 778 | 1 779 | 780 | 781 | 782 | 783 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 784 | 1 785 | 786 | 787 | 788 | 789 | ..\ 790 | 1 791 | 792 | 793 | ..\ 794 | 1 795 | 796 | 797 | 798 | 799 | Contents 800 | 1 801 | 802 | 803 | Contents 804 | 1 805 | 806 | 807 | 808 | 809 | Contents\Resources 810 | 1 811 | 812 | 813 | Contents\Resources 814 | 1 815 | 816 | 817 | 818 | 819 | library\lib\armeabi-v7a 820 | 1 821 | 822 | 823 | library\lib\arm64-v8a 824 | 1 825 | 826 | 827 | 1 828 | 829 | 830 | 1 831 | 832 | 833 | 1 834 | 835 | 836 | 1 837 | 838 | 839 | Contents\MacOS 840 | 1 841 | 842 | 843 | Contents\MacOS 844 | 1 845 | 846 | 847 | 0 848 | 849 | 850 | 851 | 852 | library\lib\armeabi-v7a 853 | 1 854 | 855 | 856 | 857 | 858 | 1 859 | 860 | 861 | 1 862 | 863 | 864 | 865 | 866 | Assets 867 | 1 868 | 869 | 870 | Assets 871 | 1 872 | 873 | 874 | 875 | 876 | Assets 877 | 1 878 | 879 | 880 | Assets 881 | 1 882 | 883 | 884 | 885 | 886 | 887 | 888 | 889 | 890 | 891 | 892 | 893 | 894 | 895 | 896 | True 897 | False 898 | 899 | 900 | 12 901 | 902 | 903 | 904 | 905 | 906 | -------------------------------------------------------------------------------- /Google_Email_Example.skincfg: -------------------------------------------------------------------------------- 1 | [ExpressSkins] 2 | Default=0 3 | ShowNotifications=1 4 | Enabled=1 5 | dxSkinBasic=1 6 | dxSkinBlack=1 7 | dxSkinBlue=0 8 | dxSkinBlueprint=0 9 | dxSkinCaramel=0 10 | dxSkinCoffee=0 11 | dxSkinDarkroom=0 12 | dxSkinDarkSide=0 13 | DCS_dxModern=1 14 | dxSkinDevExpressDarkStyle=0 15 | dxSkinDevExpressStyle=0 16 | dxSkinFoggy=0 17 | dxSkinGlassOceans=0 18 | dxSkinHighContrast=0 19 | dxSkiniMaginary=0 20 | dxSkinLilian=0 21 | dxSkinLiquidSky=0 22 | dxSkinLondonLiquidSky=0 23 | dxSkinMcSkin=0 24 | dxSkinMetropolis=0 25 | dxSkinMetropolisDark=0 26 | dxSkinMoneyTwins=0 27 | dxSkinOffice2007Black=0 28 | dxSkinOffice2007Blue=0 29 | dxSkinOffice2007Green=0 30 | dxSkinOffice2007Pink=0 31 | dxSkinOffice2007Silver=0 32 | dxSkinOffice2010Black=0 33 | dxSkinOffice2010Blue=0 34 | dxSkinOffice2010Silver=0 35 | dxSkinOffice2013DarkGray=0 36 | dxSkinOffice2013LightGray=0 37 | dxSkinOffice2013White=0 38 | dxSkinOffice2016Colorful=1 39 | dxSkinOffice2016Dark=1 40 | dxSkinOffice2019Black=1 41 | dxSkinOffice2019Colorful=1 42 | dxSkinOffice2019DarkGray=1 43 | dxSkinOffice2019White=1 44 | dxSkinPumpkin=0 45 | dxSkinSeven=0 46 | dxSkinSevenClassic=0 47 | dxSkinSharp=0 48 | dxSkinSharpPlus=0 49 | dxSkinSilver=0 50 | dxSkinSpringtime=0 51 | dxSkinStardust=0 52 | dxSkinSummer2008=0 53 | dxSkinTheAsphaltWorld=0 54 | dxSkinTheBezier=1 55 | dxSkinsDefaultPainters=0 56 | dxSkinValentine=0 57 | dxSkinVisualStudio2013Blue=1 58 | dxSkinVisualStudio2013Dark=1 59 | dxSkinVisualStudio2013Light=1 60 | dxSkinVS2010=0 61 | dxSkinWhiteprint=0 62 | dxSkinXmas2008Blue=0 63 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "[]" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright [yyyy] [name of copyright owner] 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # delphi-google-oauth2 2 | Browser enabled TCustomAuthenticator for Delphi TRestClient 3 | 4 | This unit is inspired on Delphi's OAuth2 code but: 5 | - Allows authorization via externel browser 6 | - Uses PKCE flow for added security 7 | - Allows gereration of new tokens when they expire (using the refresh token) 8 | 9 | # Dependencies 10 | - You will need libeay32.dll and ssleay32.dll in the same folder of your applications's .exe file for the Authenticator to work (becouse PKCE uses SHA256). 11 | - You will need Indy 12 | 13 | # Test authenticator using the demo application (Google_Email_Example) 14 | Open the project and fill in your Application's ClientID and ClientSecret on procedure googleAPI_prepare: 15 | 16 | ```pascal 17 | // Application specific options (created on Google's console) 18 | DCSOAuth2Authenticator.ClientID := 'your ClientID goes here'; // ClientID created on console.developers.google.com 19 | DCSOAuth2Authenticator.ClientSecret := 'your ClientSecret goes here'; // ClientSecret for the application registered on console.developers.google.com 20 | ``` 21 | -------------------------------------------------------------------------------- /U_DCS_OAuth2.pas: -------------------------------------------------------------------------------- 1 | // =========================================================================== 2 | // Copyright 2020 DCS, Lda 3 | // 4 | // Licensed under the Apache License, Version 2.0 (the "License"); 5 | // you may not use this file except in compliance with the License. 6 | // You may obtain a copy of the License at 7 | // 8 | // http://www.apache.org/licenses/LICENSE-2.0 9 | // 10 | // Unless required by applicable law or agreed to in writing, software 11 | // distributed under the License is distributed on an "AS IS" BASIS, 12 | // WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | // See the License for the specific language governing permissions and 14 | // limitations under the License. 15 | 16 | // ============ IMPORTANT ==================================================== 17 | // This unit is inspired on Delphi's OAuth2 code but: 18 | // - Allows authorization via externel browser 19 | // - Uses PKCE flow for added security 20 | // - Allows gereration of new tokens when they expire (using the refresh token) 21 | // =========================================================================== 22 | 23 | {$HPPEMIT LINKUNIT} 24 | unit U_DCS_OAuth2; 25 | 26 | interface 27 | 28 | uses 29 | System.Classes, 30 | System.SysUtils, 31 | Data.Bind.ObjectScope, 32 | Data.Bind.Components, 33 | REST.Client, 34 | REST.Types, 35 | REST.Consts, 36 | REST.Utils, 37 | REST.BindSource, 38 | IdCustomHTTPServer, 39 | IdHTTPServer, 40 | IdContext; 41 | 42 | {$SCOPEDENUMS ON} 43 | 44 | const 45 | K_invalidAuth = 'invalidAuth'; 46 | 47 | type 48 | TDCSOAuth2ResponseType = (rtCODE, rtTOKEN); // rtCODE Default workflow including the authentication of the client - rtTOKEN Implicit workflow for direct requesting an accesstoken 49 | TDCSOAuth2TokenType = (ttNONE, ttBEARER); 50 | TDCSTokenRequestType = (trtAuthGetTokens, trtRefreshTokens); 51 | 52 | TDCSOAuth2Authenticator = class; 53 | TDCSSubOAuth2AuthBindSource = class; 54 | EOAuth2Exception = class(ERESTException); 55 | 56 | TDCSOAuth2Authenticator = class(TCustomAuthenticator) 57 | private 58 | { Private declarations } 59 | FBindSource: TDCSSubOAuth2AuthBindSource; 60 | FAccessToken: string; 61 | FAccessTokenEndpoint: string; 62 | FAccessTokenExpiry: TDateTime; 63 | FAccessTokenParamName: string; 64 | FAuthCode: string; 65 | FAuthorizationEndpoint: string; 66 | FClientID: string; 67 | FClientSecret: string; 68 | FLocalState: string; 69 | FCodeVerifier: string; 70 | FCodeChallenge: string; 71 | FRedirectionEndpoint: string; 72 | FRefreshToken: string; 73 | FResponseType: TDCSOAuth2ResponseType; 74 | FScope: string; 75 | FTokenType: TDCSOAuth2TokenType; 76 | FLoginHint: string; 77 | 78 | privLS: TIdHTTPServer; // LS: Local server (Used to get the Auth code from the localhost redirect by the service provider) 79 | privLS_port: integer; 80 | privTempAuthCode: string; 81 | 82 | procedure SetAccessTokenEndpoint(const AValue: string); 83 | procedure SetAccessTokenParamName(const AValue: string); 84 | procedure SetAuthCode(const AValue: string); 85 | procedure SetAuthorizationEndpoint(const AValue: string); 86 | procedure SetClientID(const AValue: string); 87 | procedure SetClientSecret(const AValue: string); 88 | procedure SetLocalState(const AValue: string); 89 | procedure SetRedirectionEndpoint(const AValue: string); 90 | procedure SetRefreshToken(const AValue: string); 91 | procedure SetResponseType(const AValue: TDCSOAuth2ResponseType); 92 | procedure SetScope(const AValue: string); 93 | function ResponseTypeIsStored: Boolean; 94 | function TokenTypeIsStored: Boolean; 95 | function AccessTokenParamNameIsStored: Boolean; 96 | procedure ReadAccessTokenExpiryData(AReader: TReader); 97 | procedure SetAccessToken(const AValue: string); 98 | procedure SetAccessTokenExpiry(const AExpiry: TDateTime); 99 | procedure SetTokenType(const AType: TDCSOAuth2TokenType); 100 | procedure WriteAccessTokenExpiryData(AWriter: TWriter); 101 | 102 | procedure LS_start; 103 | procedure LS_stop; 104 | procedure LS_onCommandGet (AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); 105 | procedure LS_onCommandError(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo; AException: Exception); 106 | function LS_getMsgPage_html(errorStr: string = ''): string; 107 | function LS_getFreePort: integer; 108 | 109 | function generate_randomString(strLength: integer): string; 110 | function encode_SHA256_base64URL(str_toEncode: string): string; 111 | protected 112 | { Protected declarations } 113 | procedure DefineProperties(Filer: TFiler); override; 114 | procedure DoAuthenticate(ARequest: TCustomRESTRequest); override; 115 | function CreateBindSource: TBaseObjectBindSource; override; 116 | public 117 | { Public declarations } 118 | constructor Create(AOwner: TComponent); override; 119 | 120 | procedure Assign(ASource: TDCSOAuth2Authenticator); reintroduce; 121 | procedure ResetToDefaults; override; 122 | 123 | function getLocalRedirectionURL_andSetPort: string; 124 | function AuthorizationRequestURI: string; 125 | 126 | procedure AquireAccessToken_browser; 127 | procedure GetTokens_fromAuthCode; 128 | procedure GetTokens_fromRefreshToken; 129 | procedure GetTokens(requestType: TDCSTokenRequestType); 130 | published 131 | { Published properties } 132 | property AccessToken: string read FAccessToken write SetAccessToken; 133 | property AccessTokenEndpoint: string read FAccessTokenEndpoint write SetAccessTokenEndpoint; 134 | property AccessTokenExpiry: TDateTime read FAccessTokenExpiry write SetAccessTokenExpiry; 135 | property AccessTokenParamName: string read FAccessTokenParamName write SetAccessTokenParamName stored AccessTokenParamNameIsStored; 136 | property AuthCode: string read FAuthCode write SetAuthCode; 137 | property AuthorizationEndpoint: string read FAuthorizationEndpoint write SetAuthorizationEndpoint; 138 | property ClientID: string read FClientID write SetClientID; 139 | property ClientSecret: string read FClientSecret write SetClientSecret; 140 | property LocalState: string read FLocalState write SetLocalState; 141 | property CodeVerifier: string read FCodeVerifier write FCodeVerifier; 142 | property CodeChallenge: string read FCodeChallenge write FCodeChallenge; 143 | property RedirectionEndpoint: string read FRedirectionEndpoint write SetRedirectionEndpoint; 144 | property RefreshToken: string read FRefreshToken write SetRefreshToken; 145 | property ResponseType: TDCSOAuth2ResponseType read FResponseType write SetResponseType stored ResponseTypeIsStored; 146 | property Scope: string read FScope write SetScope; 147 | property TokenType: TDCSOAuth2TokenType read FTokenType write SetTokenType stored TokenTypeIsStored; 148 | property LoginHint: string read FLoginHint write FLoginHint; 149 | property BindSource: TDCSSubOAuth2AuthBindSource read FBindSource; 150 | end; 151 | 152 | // *************************************************************************************** 153 | // LiveBindings bindsource for TDCSOAuth2Authenticator. Publishes subcomponent properties 154 | TDCSSubOAuth2AuthBindSource = class(TRESTAuthenticatorBindSource) 155 | protected 156 | function CreateAdapterT: TRESTAuthenticatorAdapter; override; 157 | end; 158 | 159 | // *********************************************************************** 160 | /// LiveBindings adapter for TOAuth2Authenticator. Create bindable members 161 | TDCSOAuth2AuthAdapter = class(TRESTAuthenticatorAdapter) 162 | protected 163 | procedure AddFields; override; 164 | end; 165 | 166 | 167 | function DCSOAuth2ResponseTypeToString (const AType: TDCSOAuth2ResponseType): string; 168 | function DCSOAuth2ResponseTypeFromString(const ATypeString: string): TDCSOAuth2ResponseType; 169 | 170 | function DCSOAuth2TokenTypeToString (const AType: TDCSOAuth2TokenType): string; 171 | function DCSOAuth2TokenTypeFromString(const ATypeString: string): TDCSOAuth2TokenType; 172 | 173 | var 174 | DefaultOAuth2ResponseType: TDCSOAuth2ResponseType = TDCSOAuth2ResponseType.rtCODE; 175 | DefaultOAuth2TokenType: TDCSOAuth2TokenType = TDCSOAuth2TokenType.ttNONE; 176 | DefaultOAuth2AccessTokenParamName: string = 'access_token'; // do not localize 177 | 178 | 179 | implementation 180 | 181 | uses 182 | System.DateUtils, System.NetEncoding, 183 | Winapi.Windows, Winapi.ShellAPI, Win.ScktComp, 184 | IdHashSHA, IdSSLOpenSSL, IdGlobal; 185 | 186 | 187 | 188 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 189 | { ******* // // ******* } 190 | { ******* // TDCSOAuth2Authenticator // ******* } 191 | { ******* // // ******* } 192 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 193 | constructor TDCSOAuth2Authenticator.Create(AOwner: TComponent); 194 | begin 195 | inherited Create(AOwner); 196 | self.ResetToDefaults; 197 | end; 198 | 199 | 200 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 201 | function TDCSOAuth2Authenticator.CreateBindSource: TBaseObjectBindSource; 202 | begin 203 | self.FBindSource := TDCSSubOAuth2AuthBindSource.Create(self); 204 | self.FBindSource.Name := 'BindSource'; { Do not localize } 205 | self.FBindSource.SetSubComponent(True); 206 | self.FBindSource.Authenticator := self; 207 | 208 | result := self.FBindSource; 209 | end; 210 | 211 | 212 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 213 | function TDCSOAuth2Authenticator.AccessTokenParamNameIsStored: Boolean; 214 | begin 215 | result := self.AccessTokenParamName <> DefaultOAuth2AccessTokenParamName; 216 | end; 217 | 218 | 219 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 220 | procedure TDCSOAuth2Authenticator.Assign(ASource: TDCSOAuth2Authenticator); 221 | begin 222 | self.ResetToDefaults; 223 | 224 | self.ClientID := ASource.ClientID; 225 | self.ClientSecret := ASource.ClientSecret; 226 | self.AuthCode := ASource.AuthCode; 227 | self.AccessToken := ASource.AccessToken; 228 | self.AccessTokenParamName := ASource.AccessTokenParamName; 229 | 230 | self.AccessTokenExpiry := ASource.AccessTokenExpiry; 231 | 232 | self.Scope := ASource.Scope; 233 | self.RefreshToken := ASource.RefreshToken; 234 | self.LocalState := ASource.LocalState; 235 | 236 | self.TokenType := ASource.TokenType; 237 | 238 | self.ResponseType := ASource.ResponseType; 239 | self.AuthorizationEndpoint := ASource.AuthorizationEndpoint; 240 | self.AccessTokenEndpoint := ASource.AccessTokenEndpoint; 241 | self.RedirectionEndpoint := ASource.RedirectionEndpoint; 242 | end; 243 | 244 | 245 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 246 | function TDCSOAuth2Authenticator.AuthorizationRequestURI: string; 247 | var 248 | respTypeStr: string; 249 | begin 250 | respTypeStr := DCSOAuth2ResponseTypeToString(self.FResponseType); 251 | 252 | result := self.FAuthorizationEndpoint; 253 | if true then result := result + '?response_type=' + URIEncode(respTypeStr); 254 | if self.FClientID <> '' then result := result + '&client_id=' + URIEncode(self.FClientID); 255 | if self.FRedirectionEndpoint <> '' then result := result + '&redirect_uri=' + URIEncode(self.FRedirectionEndpoint); 256 | if self.FScope <> '' then result := result + '&scope=' + URIEncode(self.FScope); 257 | if self.FLocalState <> '' then result := result + '&state=' + URIEncode(self.FLocalState); 258 | if self.FLoginHint <> '' then result := result + '&login_hint=' + URIEncode(self.FLoginHint); 259 | 260 | if self.FCodeChallenge <> '' then 261 | begin 262 | result := result + '&code_challenge_method=' + URIEncode('S256'); 263 | result := result + '&code_challenge=' + URIEncode(self.FCodeChallenge); 264 | end; 265 | end; 266 | 267 | 268 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 269 | // Get the tokens using the authorization code 270 | procedure TDCSOAuth2Authenticator.GetTokens_fromAuthCode; 271 | begin 272 | self.GetTokens(TDCSTokenRequestType.trtAuthGetTokens); 273 | end; 274 | 275 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 276 | // Get new tokens using the refresh token 277 | // - Call if the access token is expired 278 | procedure TDCSOAuth2Authenticator.GetTokens_fromRefreshToken; 279 | begin 280 | self.GetTokens(TDCSTokenRequestType.trtRefreshTokens); 281 | end; 282 | 283 | 284 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 285 | procedure TDCSOAuth2Authenticator.GetTokens(requestType: TDCSTokenRequestType); 286 | var 287 | restClient: TRestClient; 288 | restRequest: TRESTRequest; 289 | get_fromAuth: boolean; 290 | get_fremRefresh: boolean; 291 | respValueStr: string; 292 | expireSecs: int64; 293 | begin 294 | get_fromAuth := (requestType = TDCSTokenRequestType.trtAuthGetTokens); 295 | get_fremRefresh := (requestType = TDCSTokenRequestType.trtRefreshTokens); 296 | 297 | if get_fromAuth and (FAuthCode = '') then raise EOAuth2Exception.Create(SAuthorizationCodeNeeded); // AuthCode is needed to send it to the servce and exchange the code into an access-token 298 | if get_fremRefresh and (FRefreshToken = '') then raise EOAuth2Exception.Create('Empty RefreshToken'); // RefreshToken is needed to refresh the access-token 299 | 300 | restClient := TRestClient.Create(FAccessTokenEndpoint); 301 | try 302 | restRequest := TRESTRequest.Create(restClient); // The restClient now "owns" the Request and will free it. 303 | restRequest.Method := TRESTRequestMethod.rmPOST; 304 | 305 | // Add parameters to the request 306 | restRequest.AddAuthParameter('client_id', self.FClientID, TRESTRequestParameterKind.pkGETorPOST); 307 | restRequest.AddAuthParameter('client_secret', self.FClientSecret, TRESTRequestParameterKind.pkGETorPOST); 308 | restRequest.AddAuthParameter('redirect_uri', self.FRedirectionEndpoint, TRESTRequestParameterKind.pkGETorPOST); 309 | 310 | if get_fromAuth then 311 | begin 312 | restRequest.AddAuthParameter('code', self.FAuthCode, TRESTRequestParameterKind.pkGETorPOST); 313 | restRequest.AddAuthParameter('code_verifier', self.FCodeVerifier, TRESTRequestParameterKind.pkGETorPOST); // Added for PKCE 314 | restRequest.AddAuthParameter('grant_type', 'authorization_code', TRESTRequestParameterKind.pkGETorPOST); 315 | end else 316 | if get_fremRefresh then 317 | begin 318 | restRequest.AddAuthParameter('refresh_token', self.FRefreshToken, TRESTRequestParameterKind.pkGETorPOST); 319 | restRequest.AddAuthParameter('grant_type', 'refresh_token', TRESTRequestParameterKind.pkGETorPOST); 320 | end; 321 | 322 | // Make the request 323 | restRequest.Execute; 324 | 325 | // Get Tokens from response 326 | if restRequest.Response.GetSimpleValue('access_token', respValueStr) then self.FAccessToken := respValueStr; 327 | if restRequest.Response.GetSimpleValue('refresh_token', respValueStr) then self.FRefreshToken := respValueStr; 328 | if restRequest.Response.GetSimpleValue('token_type', respValueStr) then self.FTokenType := DCSOAuth2TokenTypeFromString(respValueStr); // token-type is important for how using it later on the normal requests to the API 329 | 330 | // Get token exipancy if provided by the service (value in secounds) 331 | if restRequest.Response.GetSimpleValue('expires_in', respValueStr) then 332 | begin 333 | expireSecs := StrToIntdef(respValueStr, -1); 334 | if (expireSecs > -1) 335 | then self.FAccessTokenExpiry := IncSecond(Now, expireSecs) 336 | else self.FAccessTokenExpiry := 0.0; 337 | end; 338 | 339 | // Clear AuthCode (can only be used once) 340 | if get_fromAuth and (self.FAccessToken <> '') then 341 | self.FAuthCode := ''; 342 | 343 | finally 344 | restClient.Free; 345 | end; 346 | end; 347 | 348 | 349 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 350 | // Request user authorization (using the browser) to get an authCode 351 | // Use the authCode to get the AccessToken and RefreshToken 352 | procedure TDCSOAuth2Authenticator.AquireAccessToken_browser; 353 | var 354 | i: integer; 355 | url: string; 356 | begin 357 | if (self.FClientID = '') then raise Exception.Create('ClientID required'); 358 | if (self.FClientSecret = '') then raise Exception.Create('ClientSecret required'); 359 | 360 | // Generate verification codes 361 | self.FLocalState := self.generate_randomString(10); // LocalState 362 | self.FCodeVerifier := self.generate_randomString(60); // PKCE 363 | self.FCodeChallenge := self.encode_SHA256_base64URL(FCodeVerifier); // PKCE 364 | 365 | // Get URL with queryString to open in the browser 366 | url := self.AuthorizationRequestURI; 367 | 368 | //******************* 369 | // Start Local Server 370 | // - the http server waits for the user to authorize 371 | // - then google redirects the browser to the local RedirectionEndpoint provided adding the AuthCode on its queryParams 372 | privTempAuthCode := ''; // Clear 373 | self.LS_start; 374 | 375 | //******************************* 376 | // Open link to get authorization 377 | ShellExecute(0, 'open', PChar(url), nil, nil, SW_SHOWNORMAL); 378 | 379 | //**************************************** 380 | // User will have 60 seconds to authorize 381 | for i := 0 to 60 do 382 | begin 383 | sleep(1000); 384 | 385 | if privTempAuthCode <> '' then // When this becomes set we have the auth code 386 | break; 387 | end; 388 | 389 | //****************** 390 | // Stop Local Server 391 | self.LS_stop; 392 | 393 | if privTempAuthCode <> K_invalidAuth then 394 | self.FAuthCode := privTempAuthCode; 395 | 396 | if (self.FAuthCode = '') 397 | then raise EOAuth2Exception.Create('Authentication failed'); 398 | 399 | //****************************** 400 | // Get Tokens using the AuthCode 401 | self.GetTokens_fromAuthCode(); 402 | 403 | if (self.FAccessToken = '') then 404 | raise EOAuth2Exception.Create('Failed to aquire access token'); 405 | end; 406 | 407 | 408 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 409 | function TDCSOAuth2Authenticator.getLocalRedirectionURL_andSetPort: string; 410 | begin 411 | self.privLS_port := self.LS_getFreePort; 412 | result := 'http://127.0.0.1:' + intToStr(self.privLS_port); 413 | end; 414 | 415 | 416 | 417 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 418 | function TDCSOAuth2Authenticator.LS_getFreePort: integer; 419 | begin 420 | with TServerSocket.Create(self) do 421 | begin 422 | Port := 0; 423 | Active := true; 424 | result := Socket.LocalPort; 425 | Active := false; 426 | 427 | Free; 428 | end; 429 | end; 430 | 431 | 432 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 433 | procedure TDCSOAuth2Authenticator.LS_start; 434 | begin 435 | if privLS <> nil then raise Exception.Create('Error on LS_start'); 436 | 437 | privLS := TIdHTTPServer.Create(nil); 438 | 439 | privLS.Active := false; 440 | privLS.DefaultPort := self.privLS_port; 441 | privLS.OnCommandGet := LS_onCommandGet; 442 | privLS.OnCommandError := LS_onCommandError; 443 | privLS.Active := true; 444 | end; 445 | 446 | 447 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 448 | procedure TDCSOAuth2Authenticator.LS_stop; 449 | begin 450 | privLS.Active := false; 451 | FreeAndNil(privLS); 452 | end; 453 | 454 | 455 | 456 | 457 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 458 | // This event runs when the Local Server processes a GET request 459 | // - When the user accepts (or not) the request for authorization in the browser 460 | // the service (Google) calls the redirect URL provided earlier 461 | // - In this case we the localhost URL 462 | // - The service adds the AuthCode to the URL with a query string named "code" 463 | procedure TDCSOAuth2Authenticator.LS_onCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); 464 | var 465 | getCode: boolean; 466 | errorHtml: string; 467 | codeStr: string; 468 | stateStr: string; 469 | begin 470 | 471 | if ARequestInfo.QueryParams = '' then exit; // The request has to have query strings 472 | if privTempAuthCode <> '' then exit; // Exit if the AuthCode was already captured 473 | 474 | // Obter erro caso exista 475 | errorHtml := ARequestInfo.Params.Values['error']; 476 | getCode := (errorHtml = ''); 477 | 478 | //*************** 479 | // Obter AuthCode 480 | if getCode then 481 | begin 482 | codeStr := ARequestInfo.Params.Values['code']; 483 | stateStr := ARequestInfo.Params.Values['state']; 484 | 485 | if stateStr = self.FLocalState then // Value LocalState was sent to the browser and have to return unchanged 486 | privTempAuthCode := codeStr; 487 | end; 488 | 489 | 490 | if privTempAuthCode = '' then 491 | privTempAuthCode := K_invalidAuth; 492 | 493 | //*********************************** 494 | // Set HTML response (to the browser) 495 | if (privTempAuthCode = K_invalidAuth) and (errorHtml = '') then 496 | errorHtml := 'Auth code not found'; 497 | 498 | if privTempAuthCode = K_invalidAuth then AResponseInfo.ContentText := self.LS_getMsgPage_html(errorHtml) 499 | else AResponseInfo.ContentText := self.LS_getMsgPage_html(''); 500 | end; 501 | 502 | 503 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 504 | procedure TDCSOAuth2Authenticator.LS_onCommandError(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo; AException: Exception); 505 | begin 506 | privTempAuthCode := K_invalidAuth; 507 | raise EOAuth2Exception.Create('LS_onCommandError: ' + AException.Message); 508 | end; 509 | 510 | 511 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 512 | function TDCSOAuth2Authenticator.LS_getMsgPage_html(errorStr: string = ''): string; 513 | resourcestring 514 | RS_LS_page_ok = 'Authorization OK'; 515 | RS_LS_page_error = 'Authorization Fail'; 516 | RS_LS_ok_tit = 'The authorization has succeeded'; 517 | RS_LS_ok_msg = 'You can close this page and return to the application.'; 518 | RS_LS_error_tit = 'Something went wrong...'; 519 | RS_LS_error_msg = 'You can close this page and return to the application to try again.'; 520 | const 521 | K_HTML_doc = '%s' + 522 | '

' + 523 | '

' + 524 | '%s' + 525 | '

' + 526 | '

'; 527 | K_HTML_h3_green = '

%s

'; 528 | K_HTML_h3_red = '

%s

'; 529 | K_HTML_P = '

'; 530 | var 531 | errorPage: boolean; 532 | h3_html: string; 533 | p1_html: string; 534 | p2_html: string; 535 | page_title: string; 536 | page_content: string; 537 | begin 538 | errorPage := errorStr <> ''; 539 | 540 | if errorPage 541 | then begin 542 | h3_html := THTMLEncoding.HTML.Encode(RS_LS_error_tit); 543 | p1_html := THTMLEncoding.HTML.Encode(RS_LS_error_msg); 544 | p2_html := THTMLEncoding.HTML.Encode(errorStr); 545 | 546 | h3_html := format(K_HTML_h3_red, [h3_html]); 547 | p1_html := format(K_HTML_p, [p1_html]); 548 | p2_html := format(K_HTML_p, [p2_html]); 549 | 550 | page_title := RS_LS_page_error; 551 | page_content := h3_html + p1_html + p2_html; 552 | end 553 | else begin 554 | h3_html := THTMLEncoding.HTML.Encode(RS_LS_ok_tit); 555 | p1_html := THTMLEncoding.HTML.Encode(RS_LS_ok_msg); 556 | 557 | h3_html := format(K_HTML_h3_green, [h3_html]); 558 | p1_html := format(K_HTML_p, [p1_html]); 559 | 560 | page_title := RS_LS_page_ok; 561 | page_content := h3_html + p1_html; 562 | end; 563 | 564 | result := format(K_HTML_doc, [page_title, page_content]); 565 | end; 566 | 567 | 568 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 569 | function TDCSOAuth2Authenticator.generate_randomString(strLength: integer): string; 570 | const 571 | K_charsToUse = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890-._~'; 572 | var 573 | i: integer; 574 | allChars_count: integer; 575 | curCharPos: byte; 576 | begin 577 | allChars_count := Length(K_charsToUse); 578 | 579 | SetLength(result, strLength); 580 | Randomize; 581 | 582 | for i := 1 to strLength do 583 | begin 584 | curCharPos := Random(allChars_count) + 1; // +1 becouse strings start in 1 and Random generates values of 0 <= X < Range 585 | result[i] := K_charsToUse[curCharPos]; 586 | end; 587 | end; 588 | 589 | 590 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 591 | function TDCSOAuth2Authenticator.encode_SHA256_base64URL(str_toEncode: string): string; 592 | var 593 | hash_sha256: TIdHashSHA256; 594 | enc_base64: TBase64Encoding; 595 | arr_sha256: TIdBytes; 596 | str_b64: string; 597 | str_b64URL: string; 598 | begin 599 | result := ''; 600 | 601 | LoadOpenSSLLibrary; 602 | if not TIdHashSHA256.IsAvailable then raise Exception.Create('Error encode_SHA256_base64URL: TIdHashSHA256 not available.'); 603 | 604 | hash_sha256 := TIdHashSHA256.Create; 605 | enc_base64 := TBase64Encoding.Create(0); 606 | 607 | try 608 | arr_sha256 := hash_sha256.HashString(str_toEncode, IndyTextEncoding_ASCII); // Hash SHA256 609 | str_b64 := enc_base64.EncodeBytesToString(arr_sha256); // Convert SHA256 hash to Base64 610 | 611 | // Convert Base64 to Base64URL 612 | str_b64URL := str_b64; 613 | str_b64URL := StringReplace(str_b64URL, '+', '-', [rfReplaceAll]); // Replace + with - 614 | str_b64URL := StringReplace(str_b64URL, '/', '_', [rfReplaceAll]); // Replace / with _ 615 | str_b64URL := StringReplace(str_b64URL, '=', '', [rfReplaceAll]); // Remove padding, character = 616 | 617 | result := str_b64URL; 618 | finally 619 | enc_base64.Free; 620 | hash_sha256.Free; 621 | end; 622 | end; 623 | 624 | 625 | 626 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 627 | procedure TDCSOAuth2Authenticator.DefineProperties(Filer: TFiler); 628 | begin 629 | inherited; 630 | 631 | Filer.DefineProperty('AccessTokenExpiryDate', 632 | self.ReadAccessTokenExpiryData, 633 | self.WriteAccessTokenExpiryData, 634 | (self.FAccessTokenExpiry > 0.1)); 635 | end; 636 | 637 | 638 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 639 | // The procedure runs on every API request 640 | // Flow: 641 | // 1. If no access_token is defined, the browser auth process is started 642 | // 2. If tokens are expired, get new ones using the RefreshToken 643 | // 3. Add the access_token to the request 644 | procedure TDCSOAuth2Authenticator.DoAuthenticate(ARequest: TCustomRESTRequest); 645 | var 646 | accessParamName: string; 647 | begin 648 | inherited; 649 | 650 | // Get or refresh the tokens if needed 651 | if self.FAccessToken = '' then self.AquireAccessToken_browser; 652 | if self.FAccessTokenExpiry < now then self.GetTokens_fromRefreshToken; 653 | 654 | // Use another parameter name for the access_token if necessary 655 | // - Only used when the token type is not Bearer 656 | accessParamName := self.FAccessTokenParamName; 657 | if (Trim(accessParamName) = '') then 658 | accessParamName := DefaultOAuth2AccessTokenParamName; 659 | 660 | // Add AccessToken to the request 661 | if self.FTokenType = TDCSOAuth2TokenType.ttBEARER 662 | then ARequest.AddAuthParameter(HTTP_HEADERFIELD_AUTH, 'Bearer ' + self.FAccessToken, TRESTRequestParameterKind.pkHTTPHEADER, [TRESTRequestParameterOption.poDoNotEncode]) 663 | else ARequest.AddAuthParameter(accessParamName, self.FAccessToken, TRESTRequestParameterKind.pkGETorPOST, [TRESTRequestParameterOption.poDoNotEncode]); 664 | end; 665 | 666 | 667 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 668 | procedure TDCSOAuth2Authenticator.ReadAccessTokenExpiryData(AReader: TReader); 669 | begin 670 | self.FAccessTokenExpiry := AReader.ReadDate; 671 | end; 672 | 673 | 674 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 675 | procedure TDCSOAuth2Authenticator.ResetToDefaults; 676 | begin 677 | inherited; 678 | 679 | self.AuthorizationEndpoint := ''; 680 | self.AccessTokenEndpoint := ''; 681 | self.RedirectionEndpoint := ''; 682 | 683 | self.ClientID := ''; 684 | self.ClientSecret := ''; 685 | self.AuthCode := ''; 686 | self.AccessToken := ''; 687 | self.FAccessTokenExpiry := 0.0; 688 | self.Scope := ''; 689 | self.RefreshToken := ''; 690 | self.LocalState := ''; 691 | self.LoginHint := ''; 692 | self.CodeVerifier := ''; 693 | self.CodeChallenge := ''; 694 | 695 | self.FTokenType := DefaultOAuth2TokenType; 696 | self.ResponseType := DefaultOAuth2ResponseType; 697 | self.AccessTokenParamName := DefaultOAuth2AccessTokenParamName; 698 | end; 699 | 700 | 701 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 702 | function TDCSOAuth2Authenticator.ResponseTypeIsStored: Boolean; 703 | begin 704 | Result := self.ResponseType <> DefaultOAuth2ResponseType; 705 | end; 706 | 707 | 708 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 709 | procedure TDCSOAuth2Authenticator.SetAccessToken(const AValue: string); 710 | begin 711 | if AValue <> FAccessToken then 712 | begin 713 | FAccessToken := AValue; 714 | PropertyValueChanged; 715 | end; 716 | end; 717 | 718 | 719 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 720 | procedure TDCSOAuth2Authenticator.SetAccessTokenEndpoint(const AValue: string); 721 | begin 722 | if AValue <> FAccessTokenEndpoint then 723 | begin 724 | FAccessTokenEndpoint := AValue; 725 | PropertyValueChanged; 726 | end; 727 | end; 728 | 729 | 730 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 731 | procedure TDCSOAuth2Authenticator.SetAccessTokenExpiry(const AExpiry: TDateTime); 732 | begin 733 | if AExpiry <> FAccessTokenExpiry then 734 | begin 735 | FAccessTokenExpiry := AExpiry; 736 | PropertyValueChanged; 737 | end; 738 | end; 739 | 740 | 741 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 742 | procedure TDCSOAuth2Authenticator.SetAccessTokenParamName(const AValue: string); 743 | begin 744 | if AValue <> FAccessTokenParamName then 745 | begin 746 | FAccessTokenParamName := AValue; 747 | PropertyValueChanged; 748 | end; 749 | end; 750 | 751 | 752 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 753 | procedure TDCSOAuth2Authenticator.SetAuthCode(const AValue: string); 754 | begin 755 | if AValue <> FAuthCode then 756 | begin 757 | FAuthCode := AValue; 758 | PropertyValueChanged; 759 | end; 760 | end; 761 | 762 | 763 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 764 | procedure TDCSOAuth2Authenticator.SetAuthorizationEndpoint(const AValue: string); 765 | begin 766 | if AValue <> FAuthorizationEndpoint then 767 | begin 768 | FAuthorizationEndpoint := AValue; 769 | PropertyValueChanged; 770 | end; 771 | end; 772 | 773 | 774 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 775 | procedure TDCSOAuth2Authenticator.SetClientID(const AValue: string); 776 | begin 777 | if AValue <> FClientID then 778 | begin 779 | FClientID := AValue; 780 | PropertyValueChanged; 781 | end; 782 | end; 783 | 784 | 785 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 786 | procedure TDCSOAuth2Authenticator.SetClientSecret(const AValue: string); 787 | begin 788 | if AValue <> FClientSecret then 789 | begin 790 | FClientSecret := AValue; 791 | PropertyValueChanged; 792 | end; 793 | end; 794 | 795 | 796 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 797 | procedure TDCSOAuth2Authenticator.SetLocalState(const AValue: string); 798 | begin 799 | if AValue <> FLocalState then 800 | begin 801 | FLocalState := AValue; 802 | PropertyValueChanged; 803 | end; 804 | end; 805 | 806 | 807 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 808 | procedure TDCSOAuth2Authenticator.SetRedirectionEndpoint(const AValue: string); 809 | begin 810 | if AValue <> FRedirectionEndpoint then 811 | begin 812 | FRedirectionEndpoint := AValue; 813 | PropertyValueChanged; 814 | end; 815 | end; 816 | 817 | 818 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 819 | procedure TDCSOAuth2Authenticator.SetRefreshToken(const AValue: string); 820 | begin 821 | if AValue <> FRefreshToken then 822 | begin 823 | FRefreshToken := AValue; 824 | PropertyValueChanged; 825 | end; 826 | end; 827 | 828 | 829 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 830 | procedure TDCSOAuth2Authenticator.SetResponseType(const AValue: TDCSOAuth2ResponseType); 831 | begin 832 | if AValue <> FResponseType then 833 | begin 834 | FResponseType := AValue; 835 | PropertyValueChanged; 836 | end; 837 | end; 838 | 839 | 840 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 841 | procedure TDCSOAuth2Authenticator.SetScope(const AValue: string); 842 | begin 843 | if AValue <> FScope then 844 | begin 845 | FScope := AValue; 846 | PropertyValueChanged; 847 | end; 848 | end; 849 | 850 | 851 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 852 | procedure TDCSOAuth2Authenticator.SetTokenType(const AType: TDCSOAuth2TokenType); 853 | begin 854 | if AType <> FTokenType then 855 | begin 856 | FTokenType := AType; 857 | PropertyValueChanged; 858 | end; 859 | end; 860 | 861 | 862 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 863 | function TDCSOAuth2Authenticator.TokenTypeIsStored: Boolean; 864 | begin 865 | Result := TokenType <> DefaultOAuth2TokenType; 866 | end; 867 | 868 | 869 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 870 | procedure TDCSOAuth2Authenticator.WriteAccessTokenExpiryData(AWriter: TWriter); 871 | begin 872 | AWriter.WriteDate(FAccessTokenExpiry); 873 | end; 874 | 875 | 876 | 877 | 878 | 879 | 880 | 881 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 882 | { ******* // // ******* } 883 | { ******* // TDCSSubOAuth2AuthBindSource // ******* } 884 | { ******* // // ******* } 885 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 886 | function TDCSSubOAuth2AuthBindSource.CreateAdapterT: TRESTAuthenticatorAdapter; 887 | begin 888 | result := TDCSOAuth2AuthAdapter.Create(self); 889 | end; 890 | 891 | 892 | 893 | 894 | 895 | 896 | 897 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 898 | { ******* // // ******* } 899 | { ******* // TDCSOAuth2AuthAdapter // ******* } 900 | { ******* // // ******* } 901 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 902 | procedure TDCSOAuth2AuthAdapter.AddFields; 903 | const 904 | sAccessToken = 'AccessToken'; 905 | sAccessTokenEndpoint = 'AccessTokenEndpoint'; 906 | sRefreshToken = 'RefreshToken'; 907 | sAuthCode = 'AuthCode'; 908 | sClientID = 'ClientID'; 909 | sClientSecret = 'ClientSecret'; 910 | sAuthorizationEndpoint = 'AuthorizationEndpoint'; 911 | sRedirectionEndpoint = 'RedirectionEndpoint'; 912 | sScope = 'Scope'; 913 | sLocalState = 'LocalState'; 914 | sCodeVerifier = 'CodeVerifier'; 915 | sCodeChallenge = 'CodeChallenge'; 916 | sLoginHint = 'LoginHint'; 917 | var 918 | LGetMemberObject: IGetMemberObject; 919 | begin 920 | CheckInactive; 921 | ClearFields; 922 | if Authenticator <> nil then 923 | begin 924 | LGetMemberObject := TBindSourceAdapterGetMemberObject.Create(self); 925 | 926 | CreateReadWriteField(sAccessToken, LGetMemberObject, TScopeMemberType.mtText, 927 | function: string 928 | begin 929 | result := Authenticator.AccessToken; 930 | end, 931 | procedure(AValue: string) 932 | begin 933 | Authenticator.AccessToken := AValue; 934 | end); 935 | 936 | CreateReadWriteField(sAccessTokenEndpoint, LGetMemberObject, TScopeMemberType.mtText, 937 | function: string 938 | begin 939 | result := Authenticator.AccessTokenEndpoint; 940 | end, 941 | procedure(AValue: string) 942 | begin 943 | Authenticator.AccessTokenEndpoint := AValue; 944 | end); 945 | 946 | CreateReadWriteField(sRefreshToken, LGetMemberObject, TScopeMemberType.mtText, 947 | function: string 948 | begin 949 | result := Authenticator.RefreshToken; 950 | end, 951 | procedure(AValue: string) 952 | begin 953 | Authenticator.RefreshToken := AValue; 954 | end); 955 | 956 | CreateReadWriteField(sAuthCode, LGetMemberObject, TScopeMemberType.mtText, 957 | function: string 958 | begin 959 | result := Authenticator.AuthCode; 960 | end, 961 | procedure(AValue: string) 962 | begin 963 | Authenticator.AuthCode := AValue; 964 | end); 965 | 966 | CreateReadWriteField(sClientID, LGetMemberObject, TScopeMemberType.mtText, 967 | function: string 968 | begin 969 | result := Authenticator.ClientID; 970 | end, 971 | procedure(AValue: string) 972 | begin 973 | Authenticator.ClientID := AValue; 974 | end); 975 | 976 | CreateReadWriteField(sClientSecret, LGetMemberObject, TScopeMemberType.mtText, 977 | function: string 978 | begin 979 | result := Authenticator.ClientSecret; 980 | end, 981 | procedure(AValue: string) 982 | begin 983 | Authenticator.ClientSecret := AValue; 984 | end); 985 | 986 | CreateReadWriteField(sAuthorizationEndpoint, LGetMemberObject, TScopeMemberType.mtText, 987 | function: string 988 | begin 989 | result := Authenticator.AuthorizationEndpoint; 990 | end, 991 | procedure(AValue: string) 992 | begin 993 | Authenticator.AuthorizationEndpoint := AValue; 994 | end); 995 | 996 | CreateReadWriteField(sRedirectionEndpoint, LGetMemberObject, TScopeMemberType.mtText, 997 | function: string 998 | begin 999 | result := Authenticator.RedirectionEndpoint; 1000 | end, 1001 | procedure(AValue: string) 1002 | begin 1003 | Authenticator.RedirectionEndpoint := AValue; 1004 | end); 1005 | 1006 | CreateReadWriteField(sScope, LGetMemberObject, TScopeMemberType.mtText, 1007 | function: string 1008 | begin 1009 | result := Authenticator.Scope; 1010 | end, 1011 | procedure(AValue: string) 1012 | begin 1013 | Authenticator.Scope := AValue; 1014 | end); 1015 | 1016 | CreateReadWriteField(sLocalState, LGetMemberObject, TScopeMemberType.mtText, 1017 | function: string 1018 | begin 1019 | result := Authenticator.LocalState; 1020 | end, 1021 | procedure(AValue: string) 1022 | begin 1023 | Authenticator.LocalState := AValue; 1024 | end); 1025 | 1026 | CreateReadWriteField(sCodeVerifier, LGetMemberObject, TScopeMemberType.mtText, 1027 | function: string 1028 | begin 1029 | result := Authenticator.CodeVerifier; 1030 | end, 1031 | procedure(AValue: string) 1032 | begin 1033 | Authenticator.CodeVerifier := AValue; 1034 | end); 1035 | 1036 | CreateReadWriteField(sCodeChallenge, LGetMemberObject, TScopeMemberType.mtText, 1037 | function: string 1038 | begin 1039 | result := Authenticator.CodeChallenge; 1040 | end, 1041 | procedure(AValue: string) 1042 | begin 1043 | Authenticator.CodeChallenge := AValue; 1044 | end); 1045 | 1046 | CreateReadWriteField(sLoginHint, LGetMemberObject, TScopeMemberType.mtText, 1047 | function: string 1048 | begin 1049 | result := Authenticator.LoginHint; 1050 | end, 1051 | procedure(AValue: string) 1052 | begin 1053 | Authenticator.LoginHint := AValue; 1054 | end); 1055 | end; 1056 | end; 1057 | 1058 | 1059 | 1060 | 1061 | 1062 | 1063 | 1064 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 1065 | { ******* // // ******* } 1066 | { ******* // Unit functions // ******* } 1067 | { ******* // // ******* } 1068 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 1069 | 1070 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 1071 | function DCSOAuth2ResponseTypeToString(const AType: TDCSOAuth2ResponseType): string; 1072 | begin 1073 | case AType of 1074 | TDCSOAuth2ResponseType.rtCODE: result := 'code'; // do not localize 1075 | TDCSOAuth2ResponseType.rtTOKEN: result := 'token'; // do not localize 1076 | else 1077 | result := ''; 1078 | end; 1079 | end; 1080 | 1081 | 1082 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 1083 | function DCSOAuth2ResponseTypeFromString(const ATypeString: string): TDCSOAuth2ResponseType; 1084 | var 1085 | LType: TDCSOAuth2ResponseType; 1086 | begin 1087 | result := DefaultOAuth2ResponseType; 1088 | 1089 | for LType IN [Low(TDCSOAuth2ResponseType)..High(TDCSOAuth2ResponseType)] do 1090 | if SameText(ATypeString, DCSOAuth2ResponseTypeToString(LType)) then 1091 | begin 1092 | result := LType; 1093 | BREAK; 1094 | end; 1095 | end; 1096 | 1097 | 1098 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 1099 | function DCSOAuth2TokenTypeToString(const AType: TDCSOAuth2TokenType): string; 1100 | begin 1101 | case AType of 1102 | TDCSOAuth2TokenType.ttBEARER: result := 'bearer'; // do not localize 1103 | else 1104 | result := ''; 1105 | end; 1106 | end; 1107 | 1108 | 1109 | { ******* // ******* // ******* // ******* // ******* // ******* // ******* } 1110 | function DCSOAuth2TokenTypeFromString(const ATypeString: string): TDCSOAuth2TokenType; 1111 | var 1112 | LType: TDCSOAuth2TokenType; 1113 | begin 1114 | result := DefaultOAuth2TokenType; 1115 | 1116 | for LType IN [Low(TDCSOAuth2TokenType) .. High(TDCSOAuth2TokenType)] do 1117 | if SameText(ATypeString, DCSOAuth2TokenTypeToString(LType)) then 1118 | begin 1119 | result := LType; 1120 | BREAK; 1121 | end; 1122 | end; 1123 | 1124 | 1125 | initialization 1126 | 1127 | end. 1128 | -------------------------------------------------------------------------------- /U_emailExample.dfm: -------------------------------------------------------------------------------- 1 | object FRM_sendMail: TFRM_sendMail 2 | Left = 0 3 | Top = 0 4 | Caption = 'FRM_sendMail' 5 | ClientHeight = 291 6 | ClientWidth = 352 7 | Color = clBtnFace 8 | Constraints.MinHeight = 300 9 | Constraints.MinWidth = 360 10 | Font.Charset = DEFAULT_CHARSET 11 | Font.Color = clWindowText 12 | Font.Height = -11 13 | Font.Name = 'Tahoma' 14 | Font.Style = [] 15 | OldCreateOrder = False 16 | Position = poScreenCenter 17 | OnCreate = FormCreate 18 | OnDestroy = FormDestroy 19 | DesignSize = ( 20 | 352 21 | 291) 22 | PixelsPerInch = 96 23 | TextHeight = 13 24 | object Label1: TLabel 25 | Left = 17 26 | Top = 27 27 | Width = 65 28 | Height = 13 29 | Alignment = taRightJustify 30 | Caption = 'Sender email:' 31 | end 32 | object Label2: TLabel 33 | Left = 88 34 | Top = 46 35 | Width = 240 36 | Height = 13 37 | Anchors = [akLeft, akTop, akRight] 38 | Caption = '(email that will use Google API to send email)' 39 | ExplicitWidth = 214 40 | end 41 | object Label3: TLabel 42 | Left = 14 43 | Top = 75 44 | Width = 68 45 | Height = 13 46 | Alignment = taRightJustify 47 | Caption = 'Send email to:' 48 | end 49 | object Label4: TLabel 50 | Left = 42 51 | Top = 102 52 | Width = 40 53 | Height = 13 54 | Alignment = taRightJustify 55 | Caption = 'Subject:' 56 | end 57 | object Label5: TLabel 58 | Left = 36 59 | Top = 126 60 | Width = 46 61 | Height = 13 62 | Alignment = taRightJustify 63 | Caption = 'Message:' 64 | end 65 | object EDT_email_google: TEdit 66 | Left = 88 67 | Top = 24 68 | Width = 243 69 | Height = 21 70 | Anchors = [akLeft, akTop, akRight] 71 | TabOrder = 0 72 | Text = '@gmail.com' 73 | ExplicitWidth = 217 74 | end 75 | object EDT_toEmail: TEdit 76 | Left = 88 77 | Top = 72 78 | Width = 243 79 | Height = 21 80 | Anchors = [akLeft, akTop, akRight] 81 | TabOrder = 1 82 | ExplicitWidth = 217 83 | end 84 | object EDT_toSubject: TEdit 85 | Left = 88 86 | Top = 99 87 | Width = 243 88 | Height = 21 89 | Anchors = [akLeft, akTop, akRight] 90 | TabOrder = 2 91 | Text = 'Email subject' 92 | ExplicitWidth = 217 93 | end 94 | object MEM_toMessage: TMemo 95 | Left = 88 96 | Top = 126 97 | Width = 243 98 | Height = 114 99 | Anchors = [akLeft, akTop, akRight, akBottom] 100 | Lines.Strings = ( 101 | 'Email message.') 102 | TabOrder = 3 103 | ExplicitWidth = 217 104 | ExplicitHeight = 89 105 | end 106 | object BUT_send: TButton 107 | Left = 256 108 | Top = 246 109 | Width = 75 110 | Height = 25 111 | Anchors = [akRight, akBottom] 112 | Caption = 'Send' 113 | TabOrder = 4 114 | OnClick = BUT_sendClick 115 | ExplicitLeft = 230 116 | ExplicitTop = 221 117 | end 118 | end 119 | -------------------------------------------------------------------------------- /U_emailExample.pas: -------------------------------------------------------------------------------- 1 | unit U_emailExample; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, 8 | U_DCS_OAuth2, IdBaseComponent, IdMessage; 9 | 10 | const 11 | K_tokens_file = 'tokens.txt'; 12 | K_token_expirancy = 'token_expirancy'; 13 | K_token_access = 'token_access'; 14 | K_token_refresh = 'token_refresh'; 15 | 16 | type 17 | TFRM_sendMail = class(TForm) 18 | EDT_email_google: TEdit; 19 | Label1: TLabel; 20 | Label2: TLabel; 21 | Label3: TLabel; 22 | EDT_toEmail: TEdit; 23 | Label4: TLabel; 24 | EDT_toSubject: TEdit; 25 | MEM_toMessage: TMemo; 26 | Label5: TLabel; 27 | BUT_send: TButton; 28 | procedure FormCreate(Sender: TObject); 29 | procedure BUT_sendClick(Sender: TObject); 30 | procedure FormDestroy(Sender: TObject); 31 | private 32 | { Private declarations } 33 | TSL_tokens: tStringList; 34 | 35 | privAppPath: string; 36 | DCSOAuth2Authenticator: TDCSOAuth2Authenticator; 37 | 38 | procedure prepareAuthenticator(senderEmail: string; clearTokens: boolean = false); 39 | procedure emailSender_send_viaGmail; 40 | function getEmailMessage_fromForm: tIdMessage; 41 | 42 | procedure loadOptions; 43 | procedure saveOptions; 44 | public 45 | { Public declarations } 46 | end; 47 | 48 | var 49 | FRM_sendMail: TFRM_sendMail; 50 | 51 | implementation 52 | 53 | {$R *.dfm} 54 | 55 | uses 56 | REST.Client, REST.Types, System.JSON, Web.HTTPApp, IdText, dateUtils; 57 | 58 | 59 | { ***** / / ***** / / ****** / / ***** } 60 | procedure TFRM_sendMail.FormCreate(Sender: TObject); 61 | begin 62 | TSL_tokens := tStringList.Create; 63 | DCSOAuth2Authenticator := TDCSOAuth2Authenticator.Create(nil); 64 | 65 | privAppPath := Application.ExeName; 66 | privAppPath := ExtractFilePath(privAppPath); 67 | 68 | self.loadOptions; 69 | end; 70 | 71 | 72 | { ***** / / ***** / / ****** / / ***** } 73 | procedure TFRM_sendMail.FormDestroy(Sender: TObject); 74 | begin 75 | self.saveOptions; 76 | 77 | DCSOAuth2Authenticator.Free; 78 | TSL_tokens.Free; 79 | end; 80 | 81 | 82 | { ***** / / ***** / / ****** / / ***** } 83 | procedure TFRM_sendMail.BUT_sendClick(Sender: TObject); 84 | begin 85 | self.emailSender_send_viaGmail; 86 | 87 | ShowMessage('The email was sent.'); 88 | end; 89 | 90 | 91 | { ***** / / ***** / / ****** / / ***** } 92 | procedure TFRM_sendMail.loadOptions; 93 | var 94 | unix_exp: Int64; 95 | unix_onFile: string; 96 | begin 97 | if FileExists(privAppPath + K_tokens_file) then 98 | begin 99 | // Open tokens file 100 | TSL_tokens.LoadFromFile(privAppPath + K_tokens_file); 101 | 102 | // Load previousely obtained tokens 103 | unix_onFile := TSL_tokens.Values[K_token_expirancy]; 104 | if unix_onFile = '' 105 | then unix_exp := DateTimeToUnix(now, false) 106 | else unix_exp := StrToInt64(unix_onFile); 107 | 108 | DCSOAuth2Authenticator.AccessToken := TSL_tokens.Values[K_token_access]; 109 | DCSOAuth2Authenticator.RefreshToken := TSL_tokens.Values[K_token_refresh]; 110 | DCSOAuth2Authenticator.AccessTokenExpiry := UnixToDateTime(unix_exp, false); 111 | 112 | // Load other options 113 | EDT_email_google.Text := TSL_tokens.Values[EDT_email_google.Name]; 114 | EDT_toEmail.Text := TSL_tokens.Values[EDT_toEmail.Name]; 115 | EDT_toSubject.Text := TSL_tokens.Values[EDT_toSubject.Name]; 116 | end; 117 | end; 118 | 119 | 120 | { ***** / / ***** / / ****** / / ***** } 121 | procedure TFRM_sendMail.saveOptions; 122 | var 123 | unix_exp: Int64; 124 | unix_expStr: string; 125 | begin 126 | // Save corrent tokens 127 | unix_exp := DateTimeToUnix(DCSOAuth2Authenticator.AccessTokenExpiry, false); 128 | unix_expStr := IntToStr(unix_exp); 129 | TSL_tokens.Values[K_token_access] := DCSOAuth2Authenticator.AccessToken; 130 | TSL_tokens.Values[K_token_refresh] := DCSOAuth2Authenticator.RefreshToken; 131 | TSL_tokens.Values[K_token_expirancy] := unix_expStr; 132 | 133 | // Save other options 134 | TSL_tokens.Values[EDT_email_google.Name] := EDT_email_google.Text; 135 | TSL_tokens.Values[EDT_toEmail.Name] := EDT_toEmail.Text; 136 | TSL_tokens.Values[EDT_toSubject.Name] := EDT_toSubject.Text; 137 | 138 | // Save to tokens file 139 | TSL_tokens.SaveToFile(privAppPath + K_tokens_file); 140 | end; 141 | 142 | 143 | { ***** / / ***** / / ****** / / ***** } 144 | procedure TFRM_sendMail.prepareAuthenticator(senderEmail: string; clearTokens: boolean = false); 145 | begin 146 | if clearTokens then 147 | DCSOAuth2Authenticator.ResetToDefaults; // Reset tokens 148 | 149 | // General options 150 | DCSOAuth2Authenticator.AccessTokenEndpoint := 'https://www.googleapis.com/oauth2/v4/token'; 151 | DCSOAuth2Authenticator.AuthorizationEndpoint := 'https://accounts.google.com/o/oauth2/v2/auth'; 152 | DCSOAuth2Authenticator.ResponseType := TDCSOAuth2ResponseType.rtCODE; 153 | DCSOAuth2Authenticator.Scope := 'https://www.googleapis.com/auth/gmail.send'; 154 | DCSOAuth2Authenticator.RedirectionEndpoint := DCSOAuth2Authenticator.getLocalRedirectionURL_andSetPort; 155 | 156 | // Application specific options (created on Google's console) 157 | DCSOAuth2Authenticator.ClientID := 'your ClientID goes here'; // ClientID created on console.developers.google.com 158 | DCSOAuth2Authenticator.ClientSecret := 'your ClientSecret goes here'; // ClientSecret for the application registered on console.developers.google.com 159 | 160 | // Email hint 161 | DCSOAuth2Authenticator.LoginHint := senderEmail; 162 | end; 163 | 164 | 165 | { ***** / / ***** / / ****** / / ***** } 166 | procedure TFRM_sendMail.emailSender_send_viaGmail; 167 | var 168 | restClient: TRestClient; 169 | restRequest: TRESTRequest; 170 | fromChanged: boolean; 171 | endPoint: string; 172 | fromEmail: string; 173 | MSG_email: TIdMessage; 174 | msgStream: tMemoryStream; 175 | errJSON_Obj: TJSonObject; 176 | errJSONValue: TJSonValue; 177 | errorStr: string; 178 | begin 179 | MSG_email := self.getEmailMessage_fromForm; 180 | fromChanged := TSL_tokens.Values[EDT_email_google.Name] <> EDT_email_google.Text; 181 | fromEmail := MSG_email.From.Address; 182 | msgStream := tMemoryStream.Create; 183 | 184 | // IMPORTANT: sender email in the URL 185 | endPoint := format('https://gmail.googleapis.com/upload/gmail/v1/users/%s/messages/send', [fromEmail]); 186 | 187 | restClient := TRestClient.Create(endPoint); 188 | restRequest := TRESTRequest.Create(restClient); 189 | 190 | errJSON_Obj := TJSonObject.Create; 191 | errJSONValue := nil; 192 | 193 | self.prepareAuthenticator(fromEmail, fromChanged); // Clear tokens if From email changed 194 | restClient.Authenticator := DCSOAuth2Authenticator; 195 | 196 | try 197 | if MSG_email.BccList.Count <= 0 198 | then MSG_email.SaveToStream(msgStream, false) 199 | else begin 200 | MSG_email.SaveToFile (privAppPath + 'tmp.eml'); // Limitation of Indy, when bcc is set TIdMessage.SaveToStream loses that field. We use TIdMessage.SaveToFile and then stream.LoadFromFile to get arround that problem 201 | msgStream.LoadFromFile(privAppPath + 'tmp.eml'); 202 | end; 203 | 204 | // Add email headers 205 | restRequest.Method := TRESTRequestMethod.rmPOST; 206 | restRequest.Params.AddHeader('Content-Type', htmlEncode('message/rfc822')); 207 | restRequest.Params.ParameterByName('Content-Type').Options := [poDoNotEncode]; 208 | restRequest.AddParameter('uploadType', 'media', pkQUERY); 209 | 210 | restRequest.Body.Add(msgStream, ctMESSAGE_RFC822); // If email with metadata only, use: //restRequest.Body.Add(format('{"raw": "%s"}', [MEM_base64.Lines.Text]), ctMESSAGE_RFC822); 211 | 212 | //************* 213 | // Send request 214 | restRequest.Execute; 215 | 216 | if fromChanged then 217 | self.saveOptions; 218 | 219 | // If Error response 220 | if restRequest.Response.GetSimpleValue('error', errorStr) then // Check if an error was returned 221 | begin 222 | errorStr := 'Error sending Email (generic).'; // Default error 223 | errJSONValue := errJSON_Obj.ParseJSONValue(restRequest.Response.Content, false, true); 224 | 225 | if errJSONValue <> nil then errJSONValue := (errJSONValue as TJSONObject).Get('error').JSONValue; 226 | if errJSONValue <> nil then errorStr := (errJSONValue as TJSONObject).GetValue('message').Value; 227 | 228 | raise Exception.Create('Google: ' + errorStr); 229 | end; 230 | 231 | finally 232 | restClient.Free; 233 | msgStream.Free; 234 | errJSON_Obj.Free; 235 | errJSONValue.Free; 236 | end; 237 | end; 238 | 239 | 240 | { ***** / / ***** / / ****** / / ***** } 241 | function TFRM_sendMail.getEmailMessage_fromForm: tIdMessage; 242 | var 243 | i: integer; 244 | myIndyMsg: TIdMessage; 245 | textPart: TIdText; 246 | htmlPart: TIdText; 247 | htmlStr: string; 248 | begin 249 | myIndyMsg := TIdMessage.Create; 250 | 251 | //************ 252 | // Message cfg 253 | myIndyMsg.clear; 254 | myIndyMsg.Encoding := meMIME; 255 | myIndyMsg.BccList.EMailAddresses := EDT_toEmail.Text; 256 | myIndyMsg.from.Name := 'Delphi Application'; 257 | myIndyMsg.from.Address := EDT_email_google.Text; 258 | myIndyMsg.CharSet := 'UTF-8'; 259 | myIndyMsg.Subject := EDT_toSubject.Text; 260 | 261 | // Only 1 recipient, use To field instead of Bcc 262 | if myIndyMsg.BccList.Count = 1 then 263 | begin 264 | myIndyMsg.Recipients.Add.Assign(myIndyMsg.BccList.Items[0]); 265 | myIndyMsg.BccList.Delete(0); 266 | end; 267 | 268 | myIndyMsg.Body.Clear; 269 | myIndyMsg.ContentType := 'multipart/alternative'; 270 | 271 | // Plain version 272 | textPart := TIdText.Create(myIndyMsg.MessageParts); 273 | textPart.Body.Text := MEM_toMessage.Lines.Text; 274 | textPart.ContentType := 'text/plain'; 275 | textPart.CharSet := 'UTF-8'; 276 | textPart.ParentPart := -1; 277 | 278 | // HTML version 279 | htmlStr := ''; 280 | for i := 0 to MEM_toMessage.Lines.Count - 1 do 281 | htmlStr := htmlStr + MEM_toMessage.Lines[i] + '
'; 282 | htmlStr := '

' + htmlStr + '

'; 283 | 284 | htmlPart := TIdText.Create(myIndyMsg.MessageParts); 285 | htmlPart.ContentType := 'text/html'; 286 | htmlPart.CharSet := 'UTF-8'; 287 | htmlPart.ParentPart := -1; 288 | htmlPart.Body.Text := htmlStr; 289 | 290 | result := myIndyMsg; 291 | end; 292 | 293 | end. 294 | --------------------------------------------------------------------------------