├── .gitignore ├── ExplorerCommand.dpr ├── ExplorerCommand.dproj ├── ExplorerCommand.res ├── ExplorerCommandProject.groupproj ├── ExplorerCommand_Icon.ico ├── HotkeyHook.dpr ├── HotkeyHook.dproj ├── HotkeyHook.res ├── LICENSE ├── README.md ├── main.dfm └── main.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 | Win32 69 | *.bak 70 | -------------------------------------------------------------------------------- /ExplorerCommand.dpr: -------------------------------------------------------------------------------- 1 | program ExplorerCommand; 2 | 3 | uses 4 | Vcl.Forms, 5 | Windows, 6 | SysUtils, 7 | main in 'main.pas' {Form1}, 8 | Vcl.Themes, 9 | Vcl.Styles; 10 | 11 | {$R *.res} 12 | 13 | begin 14 | if CreateMutex(nil, True, '{C97C27E2-C5FC-41BE-AF34-6C9E250FC303}') = 0 then 15 | RaiseLastOSError; 16 | if GetLastError = ERROR_ALREADY_EXISTS then 17 | Exit; 18 | 19 | Application.Initialize; 20 | Application.MainFormOnTaskbar := False; 21 | Application.ShowMainForm := False; 22 | Application.CreateForm(TForm1, Form1); 23 | Application.Run; 24 | end. 25 | -------------------------------------------------------------------------------- /ExplorerCommand.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {D22C21FB-5BAD-48E2-A372-BA38F79F80B9} 4 | 18.8 5 | VCL 6 | ExplorerCommand.dpr 7 | True 8 | Debug 9 | Win32 10 | 1 11 | Application 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | 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 | ExplorerCommand 61 | 62 | 63 | DBXSqliteDriver;bindcompdbx;IndyIPCommon;RESTComponents;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;OmniThreadLibraryRuntime;vclFireDAC;IndySystem;tethering;svnui;dsnapcon;FireDACADSDriver;madExcept_;VirtualTreesR;FireDACMSAccDriver;fmxFireDAC;METROVCL;vclimg;madBasic_;FireDAC;vcltouch;DragDropDR103R;vcldb;bindcompfmx;svn;FireDACSqliteDriver;FireDACPgDriver;inetdb;pkCindyPackD10;soaprtl;DbxCommonDriver;FireDACIBDriver;fmx;fmxdae;xmlrtl;soapmidas;fmxobj;vclwinx;rtl;madDisAsm_;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;EmbeddedWebBrowser_XE8;DOSCommandDR;vclx;bindcomp;appanalytics;dsnap;EsVclCore;FireDACCommon;IndyIPClient;DelphiUCLPackage;bindcompvcl;SynEdit_R;RESTBackendComponents;VCLRESTComponents;BCEditor.Package;soapserver;dbxcds;VclSmp;adortl;DropShadow;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;inetdbxpress;IndyProtocols;EsVclComponents;FireDACCommonODBC;FireDACCommonDriver;RKAIOXE4U1;inet;fmxase;$(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 | ExplorerCommand_Icon.ico 71 | 72 | 73 | DBXSqliteDriver;bindcompdbx;IndyIPCommon;RESTComponents;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;OmniThreadLibraryRuntime;vclFireDAC;IndySystem;tethering;dsnapcon;FireDACADSDriver;VirtualTreesR;FireDACMSAccDriver;fmxFireDAC;vclimg;FireDAC;vcltouch;DragDropDR103R;vcldb;bindcompfmx;FireDACSqliteDriver;FireDACPgDriver;inetdb;soaprtl;DbxCommonDriver;FireDACIBDriver;fmx;fmxdae;xmlrtl;soapmidas;fmxobj;vclwinx;rtl;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;DOSCommandDR;vclx;bindcomp;appanalytics;dsnap;EsVclCore;FireDACCommon;IndyIPClient;bindcompvcl;SynEdit_R;RESTBackendComponents;VCLRESTComponents;BCEditor.Package;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;inetdbxpress;IndyProtocols;EsVclComponents;FireDACCommonODBC;FireDACCommonDriver;RKAIOXE4U1;inet;fmxase;$(DCC_UsePackage) 74 | 75 | 76 | DEBUG;$(DCC_Define) 77 | true 78 | false 79 | true 80 | true 81 | true 82 | 83 | 84 | false 85 | true 86 | PerMonitorV2 87 | true 88 | 1033 89 | 90 | 91 | false 92 | RELEASE;$(DCC_Define) 93 | 0 94 | 0 95 | 96 | 97 | true 98 | PerMonitorV2 99 | 100 | 101 | 102 | MainSource 103 | 104 | 105 | 106 | 107 | 108 | Cfg_2 109 | Base 110 | 111 | 112 | Base 113 | 114 | 115 | Cfg_1 116 | Base 117 | 118 | 119 | 120 | Delphi.Personality.12 121 | Application 122 | 123 | 124 | 125 | ExplorerCommand.dpr 126 | 127 | 128 | Microsoft Office 2000 Sample Automation Server Wrapper Components 129 | Microsoft Office XP Sample Automation Server Wrapper Components 130 | 131 | 132 | 133 | 134 | 135 | ExplorerCommand.exe 136 | true 137 | 138 | 139 | 140 | 141 | 1 142 | 143 | 144 | Contents\MacOS 145 | 1 146 | 147 | 148 | 0 149 | 150 | 151 | 152 | 153 | classes 154 | 1 155 | 156 | 157 | classes 158 | 1 159 | 160 | 161 | 162 | 163 | res\xml 164 | 1 165 | 166 | 167 | res\xml 168 | 1 169 | 170 | 171 | 172 | 173 | library\lib\armeabi-v7a 174 | 1 175 | 176 | 177 | 178 | 179 | library\lib\armeabi 180 | 1 181 | 182 | 183 | library\lib\armeabi 184 | 1 185 | 186 | 187 | 188 | 189 | library\lib\armeabi-v7a 190 | 1 191 | 192 | 193 | 194 | 195 | library\lib\mips 196 | 1 197 | 198 | 199 | library\lib\mips 200 | 1 201 | 202 | 203 | 204 | 205 | library\lib\armeabi-v7a 206 | 1 207 | 208 | 209 | library\lib\arm64-v8a 210 | 1 211 | 212 | 213 | 214 | 215 | library\lib\armeabi-v7a 216 | 1 217 | 218 | 219 | 220 | 221 | res\drawable 222 | 1 223 | 224 | 225 | res\drawable 226 | 1 227 | 228 | 229 | 230 | 231 | res\values 232 | 1 233 | 234 | 235 | res\values 236 | 1 237 | 238 | 239 | 240 | 241 | res\values-v21 242 | 1 243 | 244 | 245 | res\values-v21 246 | 1 247 | 248 | 249 | 250 | 251 | res\values 252 | 1 253 | 254 | 255 | res\values 256 | 1 257 | 258 | 259 | 260 | 261 | res\drawable 262 | 1 263 | 264 | 265 | res\drawable 266 | 1 267 | 268 | 269 | 270 | 271 | res\drawable-xxhdpi 272 | 1 273 | 274 | 275 | res\drawable-xxhdpi 276 | 1 277 | 278 | 279 | 280 | 281 | res\drawable-ldpi 282 | 1 283 | 284 | 285 | res\drawable-ldpi 286 | 1 287 | 288 | 289 | 290 | 291 | res\drawable-mdpi 292 | 1 293 | 294 | 295 | res\drawable-mdpi 296 | 1 297 | 298 | 299 | 300 | 301 | res\drawable-hdpi 302 | 1 303 | 304 | 305 | res\drawable-hdpi 306 | 1 307 | 308 | 309 | 310 | 311 | res\drawable-xhdpi 312 | 1 313 | 314 | 315 | res\drawable-xhdpi 316 | 1 317 | 318 | 319 | 320 | 321 | res\drawable-mdpi 322 | 1 323 | 324 | 325 | res\drawable-mdpi 326 | 1 327 | 328 | 329 | 330 | 331 | res\drawable-hdpi 332 | 1 333 | 334 | 335 | res\drawable-hdpi 336 | 1 337 | 338 | 339 | 340 | 341 | res\drawable-xhdpi 342 | 1 343 | 344 | 345 | res\drawable-xhdpi 346 | 1 347 | 348 | 349 | 350 | 351 | res\drawable-xxhdpi 352 | 1 353 | 354 | 355 | res\drawable-xxhdpi 356 | 1 357 | 358 | 359 | 360 | 361 | res\drawable-xxxhdpi 362 | 1 363 | 364 | 365 | res\drawable-xxxhdpi 366 | 1 367 | 368 | 369 | 370 | 371 | res\drawable-small 372 | 1 373 | 374 | 375 | res\drawable-small 376 | 1 377 | 378 | 379 | 380 | 381 | res\drawable-normal 382 | 1 383 | 384 | 385 | res\drawable-normal 386 | 1 387 | 388 | 389 | 390 | 391 | res\drawable-large 392 | 1 393 | 394 | 395 | res\drawable-large 396 | 1 397 | 398 | 399 | 400 | 401 | res\drawable-xlarge 402 | 1 403 | 404 | 405 | res\drawable-xlarge 406 | 1 407 | 408 | 409 | 410 | 411 | res\values 412 | 1 413 | 414 | 415 | res\values 416 | 1 417 | 418 | 419 | 420 | 421 | 1 422 | 423 | 424 | Contents\MacOS 425 | 1 426 | 427 | 428 | 0 429 | 430 | 431 | 432 | 433 | Contents\MacOS 434 | 1 435 | .framework 436 | 437 | 438 | Contents\MacOS 439 | 1 440 | .framework 441 | 442 | 443 | 0 444 | 445 | 446 | 447 | 448 | 1 449 | .dylib 450 | 451 | 452 | 1 453 | .dylib 454 | 455 | 456 | 1 457 | .dylib 458 | 459 | 460 | Contents\MacOS 461 | 1 462 | .dylib 463 | 464 | 465 | Contents\MacOS 466 | 1 467 | .dylib 468 | 469 | 470 | 0 471 | .dll;.bpl 472 | 473 | 474 | 475 | 476 | 1 477 | .dylib 478 | 479 | 480 | 1 481 | .dylib 482 | 483 | 484 | 1 485 | .dylib 486 | 487 | 488 | Contents\MacOS 489 | 1 490 | .dylib 491 | 492 | 493 | Contents\MacOS 494 | 1 495 | .dylib 496 | 497 | 498 | 0 499 | .bpl 500 | 501 | 502 | 503 | 504 | 0 505 | 506 | 507 | 0 508 | 509 | 510 | 0 511 | 512 | 513 | 0 514 | 515 | 516 | 0 517 | 518 | 519 | Contents\Resources\StartUp\ 520 | 0 521 | 522 | 523 | Contents\Resources\StartUp\ 524 | 0 525 | 526 | 527 | 0 528 | 529 | 530 | 531 | 532 | 1 533 | 534 | 535 | 1 536 | 537 | 538 | 1 539 | 540 | 541 | 542 | 543 | 1 544 | 545 | 546 | 1 547 | 548 | 549 | 1 550 | 551 | 552 | 553 | 554 | 1 555 | 556 | 557 | 1 558 | 559 | 560 | 1 561 | 562 | 563 | 564 | 565 | 1 566 | 567 | 568 | 1 569 | 570 | 571 | 1 572 | 573 | 574 | 575 | 576 | 1 577 | 578 | 579 | 1 580 | 581 | 582 | 1 583 | 584 | 585 | 586 | 587 | 1 588 | 589 | 590 | 1 591 | 592 | 593 | 1 594 | 595 | 596 | 597 | 598 | 1 599 | 600 | 601 | 1 602 | 603 | 604 | 1 605 | 606 | 607 | 608 | 609 | 1 610 | 611 | 612 | 1 613 | 614 | 615 | 1 616 | 617 | 618 | 619 | 620 | 1 621 | 622 | 623 | 1 624 | 625 | 626 | 1 627 | 628 | 629 | 630 | 631 | 1 632 | 633 | 634 | 1 635 | 636 | 637 | 1 638 | 639 | 640 | 641 | 642 | 1 643 | 644 | 645 | 1 646 | 647 | 648 | 1 649 | 650 | 651 | 652 | 653 | 1 654 | 655 | 656 | 1 657 | 658 | 659 | 1 660 | 661 | 662 | 663 | 664 | 1 665 | 666 | 667 | 1 668 | 669 | 670 | 1 671 | 672 | 673 | 674 | 675 | 1 676 | 677 | 678 | 1 679 | 680 | 681 | 1 682 | 683 | 684 | 685 | 686 | 1 687 | 688 | 689 | 1 690 | 691 | 692 | 1 693 | 694 | 695 | 696 | 697 | 1 698 | 699 | 700 | 1 701 | 702 | 703 | 1 704 | 705 | 706 | 707 | 708 | 1 709 | 710 | 711 | 1 712 | 713 | 714 | 1 715 | 716 | 717 | 718 | 719 | 1 720 | 721 | 722 | 1 723 | 724 | 725 | 1 726 | 727 | 728 | 729 | 730 | 1 731 | 732 | 733 | 1 734 | 735 | 736 | 1 737 | 738 | 739 | 740 | 741 | 1 742 | 743 | 744 | 1 745 | 746 | 747 | 1 748 | 749 | 750 | 751 | 752 | 1 753 | 754 | 755 | 1 756 | 757 | 758 | 1 759 | 760 | 761 | 762 | 763 | 1 764 | 765 | 766 | 1 767 | 768 | 769 | 1 770 | 771 | 772 | 773 | 774 | 1 775 | 776 | 777 | 1 778 | 779 | 780 | 1 781 | 782 | 783 | 784 | 785 | 1 786 | 787 | 788 | 1 789 | 790 | 791 | 1 792 | 793 | 794 | 795 | 796 | 1 797 | 798 | 799 | 1 800 | 801 | 802 | 803 | 804 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 805 | 1 806 | 807 | 808 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 809 | 1 810 | 811 | 812 | 813 | 814 | 1 815 | 816 | 817 | 1 818 | 819 | 820 | 821 | 822 | ..\ 823 | 1 824 | 825 | 826 | ..\ 827 | 1 828 | 829 | 830 | 831 | 832 | 1 833 | 834 | 835 | 1 836 | 837 | 838 | 1 839 | 840 | 841 | 842 | 843 | 1 844 | 845 | 846 | 1 847 | 848 | 849 | 1 850 | 851 | 852 | 853 | 854 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 855 | 1 856 | 857 | 858 | 859 | 860 | ..\ 861 | 1 862 | 863 | 864 | ..\ 865 | 1 866 | 867 | 868 | 869 | 870 | Contents 871 | 1 872 | 873 | 874 | Contents 875 | 1 876 | 877 | 878 | 879 | 880 | Contents\Resources 881 | 1 882 | 883 | 884 | Contents\Resources 885 | 1 886 | 887 | 888 | 889 | 890 | library\lib\armeabi-v7a 891 | 1 892 | 893 | 894 | library\lib\arm64-v8a 895 | 1 896 | 897 | 898 | 1 899 | 900 | 901 | 1 902 | 903 | 904 | 1 905 | 906 | 907 | 1 908 | 909 | 910 | Contents\MacOS 911 | 1 912 | 913 | 914 | Contents\MacOS 915 | 1 916 | 917 | 918 | 0 919 | 920 | 921 | 922 | 923 | library\lib\armeabi-v7a 924 | 1 925 | 926 | 927 | 928 | 929 | 1 930 | 931 | 932 | 1 933 | 934 | 935 | 936 | 937 | Assets 938 | 1 939 | 940 | 941 | Assets 942 | 1 943 | 944 | 945 | 946 | 947 | Assets 948 | 1 949 | 950 | 951 | Assets 952 | 1 953 | 954 | 955 | 956 | 957 | 958 | 959 | 960 | 961 | 962 | 963 | 964 | 965 | 966 | 967 | True 968 | False 969 | 970 | 971 | 12 972 | 973 | 974 | 975 | 976 | 977 | -------------------------------------------------------------------------------- /ExplorerCommand.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/ExplorerCommand/a01852f4e8d8bb61d7add91bdb0480da99b82f5e/ExplorerCommand.res -------------------------------------------------------------------------------- /ExplorerCommandProject.groupproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {310C8440-FB7D-4877-94D7-3051EF6DF673} 4 | 5 | 6 | 7 | HotkeyHook.dproj 8 | 9 | 10 | 11 | 12 | 13 | 14 | Default.Personality.12 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | -------------------------------------------------------------------------------- /ExplorerCommand_Icon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/ExplorerCommand/a01852f4e8d8bb61d7add91bdb0480da99b82f5e/ExplorerCommand_Icon.ico -------------------------------------------------------------------------------- /HotkeyHook.dpr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/ExplorerCommand/a01852f4e8d8bb61d7add91bdb0480da99b82f5e/HotkeyHook.dpr -------------------------------------------------------------------------------- /HotkeyHook.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {0752C59F-2066-40B4-8064-724C020132A3} 4 | 18.8 5 | None 6 | HotkeyHook.dpr 7 | True 8 | Debug 9 | Win32 10 | 1 11 | Library 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 | .\$(Platform)\$(Config) 44 | .\$(Platform)\$(Config) 45 | false 46 | false 47 | false 48 | false 49 | false 50 | true 51 | System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 52 | HotkeyHook 53 | 54 | 55 | DBXSqliteDriver;bindcompdbx;IndyIPCommon;RESTComponents;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;OmniThreadLibraryRuntime;vclFireDAC;IndySystem;tethering;svnui;dsnapcon;FireDACADSDriver;madExcept_;VirtualTreesR;FireDACMSAccDriver;fmxFireDAC;METROVCL;vclimg;madBasic_;FireDAC;vcltouch;DragDropDR103R;vcldb;bindcompfmx;svn;FireDACSqliteDriver;FireDACPgDriver;inetdb;pkCindyPackD10;soaprtl;DbxCommonDriver;FireDACIBDriver;fmx;fmxdae;xmlrtl;soapmidas;fmxobj;vclwinx;rtl;madDisAsm_;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;EmbeddedWebBrowser_XE8;DOSCommandDR;vclx;bindcomp;appanalytics;dsnap;EsVclCore;FireDACCommon;IndyIPClient;DelphiUCLPackage;bindcompvcl;SynEdit_R;RESTBackendComponents;VCLRESTComponents;BCEditor.Package;soapserver;dbxcds;VclSmp;adortl;DropShadow;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;inetdbxpress;IndyProtocols;EsVclComponents;FireDACCommonODBC;FireDACCommonDriver;RKAIOXE4U1;inet;fmxase;$(DCC_UsePackage) 56 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 57 | Debug 58 | true 59 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 60 | 1033 61 | 62 | 63 | DBXSqliteDriver;bindcompdbx;IndyIPCommon;RESTComponents;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;OmniThreadLibraryRuntime;vclFireDAC;IndySystem;tethering;dsnapcon;FireDACADSDriver;VirtualTreesR;FireDACMSAccDriver;fmxFireDAC;vclimg;FireDAC;vcltouch;DragDropDR103R;vcldb;bindcompfmx;FireDACSqliteDriver;FireDACPgDriver;inetdb;soaprtl;DbxCommonDriver;FireDACIBDriver;fmx;fmxdae;xmlrtl;soapmidas;fmxobj;vclwinx;rtl;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;DOSCommandDR;vclx;bindcomp;appanalytics;dsnap;EsVclCore;FireDACCommon;IndyIPClient;bindcompvcl;SynEdit_R;RESTBackendComponents;VCLRESTComponents;BCEditor.Package;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;inetdbxpress;IndyProtocols;EsVclComponents;FireDACCommonODBC;FireDACCommonDriver;RKAIOXE4U1;inet;fmxase;$(DCC_UsePackage) 64 | 65 | 66 | DEBUG;$(DCC_Define) 67 | true 68 | false 69 | true 70 | true 71 | true 72 | 73 | 74 | false 75 | L:\Proyectos\ExplorerCommand\Win32\Debug\ExplorerCommand.exe 76 | 77 | 78 | false 79 | RELEASE;$(DCC_Define) 80 | 0 81 | 0 82 | 83 | 84 | 85 | MainSource 86 | 87 | 88 | Cfg_2 89 | Base 90 | 91 | 92 | Base 93 | 94 | 95 | Cfg_1 96 | Base 97 | 98 | 99 | 100 | Delphi.Personality.12 101 | Application 102 | 103 | 104 | 105 | HotkeyHook.dpr 106 | 107 | 108 | 109 | 110 | 111 | true 112 | 113 | 114 | 115 | 116 | true 117 | 118 | 119 | 120 | 121 | true 122 | 123 | 124 | 125 | 126 | HotkeyHook.dll 127 | true 128 | 129 | 130 | 131 | 132 | 1 133 | 134 | 135 | Contents\MacOS 136 | 1 137 | 138 | 139 | 0 140 | 141 | 142 | 143 | 144 | classes 145 | 1 146 | 147 | 148 | classes 149 | 1 150 | 151 | 152 | 153 | 154 | res\xml 155 | 1 156 | 157 | 158 | res\xml 159 | 1 160 | 161 | 162 | 163 | 164 | library\lib\armeabi-v7a 165 | 1 166 | 167 | 168 | 169 | 170 | library\lib\armeabi 171 | 1 172 | 173 | 174 | library\lib\armeabi 175 | 1 176 | 177 | 178 | 179 | 180 | library\lib\armeabi-v7a 181 | 1 182 | 183 | 184 | 185 | 186 | library\lib\mips 187 | 1 188 | 189 | 190 | library\lib\mips 191 | 1 192 | 193 | 194 | 195 | 196 | library\lib\armeabi-v7a 197 | 1 198 | 199 | 200 | library\lib\arm64-v8a 201 | 1 202 | 203 | 204 | 205 | 206 | library\lib\armeabi-v7a 207 | 1 208 | 209 | 210 | 211 | 212 | res\drawable 213 | 1 214 | 215 | 216 | res\drawable 217 | 1 218 | 219 | 220 | 221 | 222 | res\values 223 | 1 224 | 225 | 226 | res\values 227 | 1 228 | 229 | 230 | 231 | 232 | res\values-v21 233 | 1 234 | 235 | 236 | res\values-v21 237 | 1 238 | 239 | 240 | 241 | 242 | res\values 243 | 1 244 | 245 | 246 | res\values 247 | 1 248 | 249 | 250 | 251 | 252 | res\drawable 253 | 1 254 | 255 | 256 | res\drawable 257 | 1 258 | 259 | 260 | 261 | 262 | res\drawable-xxhdpi 263 | 1 264 | 265 | 266 | res\drawable-xxhdpi 267 | 1 268 | 269 | 270 | 271 | 272 | res\drawable-ldpi 273 | 1 274 | 275 | 276 | res\drawable-ldpi 277 | 1 278 | 279 | 280 | 281 | 282 | res\drawable-mdpi 283 | 1 284 | 285 | 286 | res\drawable-mdpi 287 | 1 288 | 289 | 290 | 291 | 292 | res\drawable-hdpi 293 | 1 294 | 295 | 296 | res\drawable-hdpi 297 | 1 298 | 299 | 300 | 301 | 302 | res\drawable-xhdpi 303 | 1 304 | 305 | 306 | res\drawable-xhdpi 307 | 1 308 | 309 | 310 | 311 | 312 | res\drawable-mdpi 313 | 1 314 | 315 | 316 | res\drawable-mdpi 317 | 1 318 | 319 | 320 | 321 | 322 | res\drawable-hdpi 323 | 1 324 | 325 | 326 | res\drawable-hdpi 327 | 1 328 | 329 | 330 | 331 | 332 | res\drawable-xhdpi 333 | 1 334 | 335 | 336 | res\drawable-xhdpi 337 | 1 338 | 339 | 340 | 341 | 342 | res\drawable-xxhdpi 343 | 1 344 | 345 | 346 | res\drawable-xxhdpi 347 | 1 348 | 349 | 350 | 351 | 352 | res\drawable-xxxhdpi 353 | 1 354 | 355 | 356 | res\drawable-xxxhdpi 357 | 1 358 | 359 | 360 | 361 | 362 | res\drawable-small 363 | 1 364 | 365 | 366 | res\drawable-small 367 | 1 368 | 369 | 370 | 371 | 372 | res\drawable-normal 373 | 1 374 | 375 | 376 | res\drawable-normal 377 | 1 378 | 379 | 380 | 381 | 382 | res\drawable-large 383 | 1 384 | 385 | 386 | res\drawable-large 387 | 1 388 | 389 | 390 | 391 | 392 | res\drawable-xlarge 393 | 1 394 | 395 | 396 | res\drawable-xlarge 397 | 1 398 | 399 | 400 | 401 | 402 | res\values 403 | 1 404 | 405 | 406 | res\values 407 | 1 408 | 409 | 410 | 411 | 412 | 1 413 | 414 | 415 | Contents\MacOS 416 | 1 417 | 418 | 419 | 0 420 | 421 | 422 | 423 | 424 | Contents\MacOS 425 | 1 426 | .framework 427 | 428 | 429 | Contents\MacOS 430 | 1 431 | .framework 432 | 433 | 434 | 0 435 | 436 | 437 | 438 | 439 | 1 440 | .dylib 441 | 442 | 443 | 1 444 | .dylib 445 | 446 | 447 | 1 448 | .dylib 449 | 450 | 451 | Contents\MacOS 452 | 1 453 | .dylib 454 | 455 | 456 | Contents\MacOS 457 | 1 458 | .dylib 459 | 460 | 461 | 0 462 | .dll;.bpl 463 | 464 | 465 | 466 | 467 | 1 468 | .dylib 469 | 470 | 471 | 1 472 | .dylib 473 | 474 | 475 | 1 476 | .dylib 477 | 478 | 479 | Contents\MacOS 480 | 1 481 | .dylib 482 | 483 | 484 | Contents\MacOS 485 | 1 486 | .dylib 487 | 488 | 489 | 0 490 | .bpl 491 | 492 | 493 | 494 | 495 | 0 496 | 497 | 498 | 0 499 | 500 | 501 | 0 502 | 503 | 504 | 0 505 | 506 | 507 | 0 508 | 509 | 510 | Contents\Resources\StartUp\ 511 | 0 512 | 513 | 514 | Contents\Resources\StartUp\ 515 | 0 516 | 517 | 518 | 0 519 | 520 | 521 | 522 | 523 | 1 524 | 525 | 526 | 1 527 | 528 | 529 | 1 530 | 531 | 532 | 533 | 534 | 1 535 | 536 | 537 | 1 538 | 539 | 540 | 1 541 | 542 | 543 | 544 | 545 | 1 546 | 547 | 548 | 1 549 | 550 | 551 | 1 552 | 553 | 554 | 555 | 556 | 1 557 | 558 | 559 | 1 560 | 561 | 562 | 1 563 | 564 | 565 | 566 | 567 | 1 568 | 569 | 570 | 1 571 | 572 | 573 | 1 574 | 575 | 576 | 577 | 578 | 1 579 | 580 | 581 | 1 582 | 583 | 584 | 1 585 | 586 | 587 | 588 | 589 | 1 590 | 591 | 592 | 1 593 | 594 | 595 | 1 596 | 597 | 598 | 599 | 600 | 1 601 | 602 | 603 | 1 604 | 605 | 606 | 1 607 | 608 | 609 | 610 | 611 | 1 612 | 613 | 614 | 1 615 | 616 | 617 | 1 618 | 619 | 620 | 621 | 622 | 1 623 | 624 | 625 | 1 626 | 627 | 628 | 1 629 | 630 | 631 | 632 | 633 | 1 634 | 635 | 636 | 1 637 | 638 | 639 | 1 640 | 641 | 642 | 643 | 644 | 1 645 | 646 | 647 | 1 648 | 649 | 650 | 1 651 | 652 | 653 | 654 | 655 | 1 656 | 657 | 658 | 1 659 | 660 | 661 | 1 662 | 663 | 664 | 665 | 666 | 1 667 | 668 | 669 | 1 670 | 671 | 672 | 1 673 | 674 | 675 | 676 | 677 | 1 678 | 679 | 680 | 1 681 | 682 | 683 | 1 684 | 685 | 686 | 687 | 688 | 1 689 | 690 | 691 | 1 692 | 693 | 694 | 1 695 | 696 | 697 | 698 | 699 | 1 700 | 701 | 702 | 1 703 | 704 | 705 | 1 706 | 707 | 708 | 709 | 710 | 1 711 | 712 | 713 | 1 714 | 715 | 716 | 1 717 | 718 | 719 | 720 | 721 | 1 722 | 723 | 724 | 1 725 | 726 | 727 | 1 728 | 729 | 730 | 731 | 732 | 1 733 | 734 | 735 | 1 736 | 737 | 738 | 1 739 | 740 | 741 | 742 | 743 | 1 744 | 745 | 746 | 1 747 | 748 | 749 | 1 750 | 751 | 752 | 753 | 754 | 1 755 | 756 | 757 | 1 758 | 759 | 760 | 1 761 | 762 | 763 | 764 | 765 | 1 766 | 767 | 768 | 1 769 | 770 | 771 | 1 772 | 773 | 774 | 775 | 776 | 1 777 | 778 | 779 | 1 780 | 781 | 782 | 1 783 | 784 | 785 | 786 | 787 | 1 788 | 789 | 790 | 1 791 | 792 | 793 | 794 | 795 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 796 | 1 797 | 798 | 799 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 800 | 1 801 | 802 | 803 | 804 | 805 | 1 806 | 807 | 808 | 1 809 | 810 | 811 | 812 | 813 | ..\ 814 | 1 815 | 816 | 817 | ..\ 818 | 1 819 | 820 | 821 | 822 | 823 | 1 824 | 825 | 826 | 1 827 | 828 | 829 | 1 830 | 831 | 832 | 833 | 834 | 1 835 | 836 | 837 | 1 838 | 839 | 840 | 1 841 | 842 | 843 | 844 | 845 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 846 | 1 847 | 848 | 849 | 850 | 851 | ..\ 852 | 1 853 | 854 | 855 | ..\ 856 | 1 857 | 858 | 859 | 860 | 861 | Contents 862 | 1 863 | 864 | 865 | Contents 866 | 1 867 | 868 | 869 | 870 | 871 | Contents\Resources 872 | 1 873 | 874 | 875 | Contents\Resources 876 | 1 877 | 878 | 879 | 880 | 881 | library\lib\armeabi-v7a 882 | 1 883 | 884 | 885 | library\lib\arm64-v8a 886 | 1 887 | 888 | 889 | 1 890 | 891 | 892 | 1 893 | 894 | 895 | 1 896 | 897 | 898 | 1 899 | 900 | 901 | Contents\MacOS 902 | 1 903 | 904 | 905 | Contents\MacOS 906 | 1 907 | 908 | 909 | 0 910 | 911 | 912 | 913 | 914 | library\lib\armeabi-v7a 915 | 1 916 | 917 | 918 | 919 | 920 | 1 921 | 922 | 923 | 1 924 | 925 | 926 | 927 | 928 | Assets 929 | 1 930 | 931 | 932 | Assets 933 | 1 934 | 935 | 936 | 937 | 938 | Assets 939 | 1 940 | 941 | 942 | Assets 943 | 1 944 | 945 | 946 | 947 | 948 | 949 | 950 | 951 | 952 | 953 | 954 | 955 | 956 | 957 | 958 | True 959 | False 960 | 961 | 962 | 12 963 | 964 | 965 | 966 | 967 | 968 | -------------------------------------------------------------------------------- /HotkeyHook.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vhanla/ExplorerCommand/a01852f4e8d8bb61d7add91bdb0480da99b82f5e/HotkeyHook.res -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020 Victor Alberto Gil 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 | Explorer Command 2 | ---------------- 3 | 4 | Explorer Command is a third party tool that will add command line to interact with current Directory and Selected File/Files. 5 | 6 | The purpose is to add capabilities like: 7 | 8 | - [x] Run DOS commands in current directory 9 | - [ ] Run PowerShell commands in current directory 10 | - [ ] Open With via command line 11 | - [ ] Show Git status, as well common commands 12 | - [ ] Preview files 13 | 14 | Default Hotkey [ctrl-shift-p] 15 | 16 | ### Future Plans: 17 | - [ ] Extensible via Python plugins 18 | 19 | ### Disclaimer 20 | 21 | This is a proof of concept project, it might change without advertisement. 22 | Keep in mind that it is a W.I.P. and ideas are more than welcome. 23 | -------------------------------------------------------------------------------- /main.pas: -------------------------------------------------------------------------------- 1 | unit main; 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, SynEdit, DosCommand, rkShellPath, rkEdit, 8 | Vcl.StdCtrls, Vcl.ExtCtrls, System.ImageList, Vcl.ImgList, 9 | Vcl.ComCtrls, Vcl.WinXCtrls, TlHelp32, ShellApi, ShDocVw, ActiveX, ShlObj, IniFiles, ComObj, 10 | Vcl.Menus, DzDirSeek, rkSmartPath, rkVistaProBar, Vcl.VirtualImage, 11 | uHostPreview, Winapi.Wincodec, StrUtils, ES.BaseControls, ES.Images, rkView, 12 | JPEG, Math, CommCtrl {HIMAGELIST}, rkIntegerList, SynEditHighlighter, 13 | SynHighlighterUNIXShellScript, CB.Form, madExceptVcl, scStyledForm, libgit2, 14 | rkPathViewer, IconFontsImageListBase, IconFontsImageList, Clipbrd, 15 | SynHighlighterMulti, SynEditCodeFolding, SynHighlighterPas, Vcl.Buttons, 16 | System.Actions, Vcl.ActnList, Vcl.ToolWin, MPCommonObjects, 17 | EasyListview, VirtualExplorerEasyListview, 18 | Process, CB.Autorun, System.SyncObjs, ACL.UI.Controls.Base, 19 | ACL.UI.Controls.Labels, ACL.UI.Controls.ActivityIndicator, 20 | Vcl.VirtualImageList, Vcl.BaseImageCollection, Vcl.ImageCollection, 21 | ACL.UI.Controls.CompoundControl, ACL.UI.Controls.HexView, ACL.Classes, 22 | ACL.UI.Application, ACL.UI.Controls.MagnifierGlass, 23 | ACL.UI.Controls.ColorPicker, ACL.UI.Controls.Buttons, 24 | ACL.UI.Dialogs.ColorPicker, ACL.UI.Controls.TreeList, 25 | ACL.UI.Controls.ShellTreeView; 26 | 27 | const 28 | KeyEvent = WM_USER + 11; 29 | KeyEventAll = WM_USER + 12; 30 | KeyEventUpdatePath = WM_USER + 13; 31 | KeyEventPickPaths = WM_USER + 14; 32 | CM_UpdateView = WM_USER + 2; 33 | CM_Progress = WM_USER + 3; 34 | IID_IImageList: TGUID = '{46EB5926-582E-4017-9FDF-E8998DAA0950}'; 35 | 36 | type 37 | EInvalidImageFormat = class(Exception); 38 | 39 | type 40 | 41 | PItemData = ^TItemData; 42 | TItemData = record 43 | Name: string; 44 | ThumbWidth: Word; 45 | ThumbHeight: Word; 46 | Size: Integer; 47 | Modified: TDateTime; 48 | Dir: Boolean; 49 | GotThumb: Boolean; 50 | IWidth, IHeight: Word; 51 | ImgIdx: Integer; 52 | IsIcon: Boolean; 53 | ImgState: Byte; 54 | Image: TObject; 55 | end; 56 | 57 | ThumbThread = class(TThread) 58 | private 59 | { Private Declarations } 60 | ViewLink: TrkView; 61 | ItemsLink: TList; 62 | protected 63 | procedure Execute; override; 64 | public 65 | constructor Create(View: TrkView; Items: TList); 66 | end; 67 | 68 | TFuzzyStringMatcher = class 69 | private 70 | FThreshold: Integer; 71 | function DamerauLevenshteinDistance(const S1, S2: string): Integer; 72 | public 73 | constructor Create(Threshold: Integer); 74 | function IsMatch(const Str, SubStr: string): Boolean; 75 | end; 76 | 77 | // Autocomplete https://stackoverflow.com/a/5465826 78 | TEnumString = class(TInterfacedObject, IEnumString) 79 | private 80 | type 81 | TPointerList = array[0..0] of Pointer; 82 | var 83 | FStrings: TStringList; 84 | FCurrIndex: Integer; 85 | public 86 | // IEnumString 87 | function Next(celt: Longint; out elt; 88 | pceltFetched: PLongint): HResult; stdcall; 89 | function Skip(celt: Longint): HResult; stdcall; 90 | function Reset: HResult; stdcall; 91 | function Clone(out enm: IEnumString): HResult; stdcall; 92 | // VCL 93 | constructor Create; 94 | destructor Destroy; override; 95 | end; 96 | 97 | { ACO_NONE = 0; 98 | ACO_AUTOSUGGEST = $1; 99 | ACO_AUTOAPPEND = $2; 100 | ACO_SEARCH = $4; 101 | ACO_FILTERPREFIXES = $8; 102 | ACO_USETAB = $10; 103 | ACO_UPDOWNKEYDROPSLIST = $20; 104 | ACO_RTLREADING = $40; 105 | ACO_WORD_FILTER = $80; 106 | ACO_NOPREFIXFILTERING = $100; 107 | } 108 | TACOption = (acNone, acAutoSuggest, acAutoAppend, acSearch, acFilterPrefixes, 109 | acUseTab, acUpDownKeyDropsList, acRTLReading, acWordFilter, acNoPrefixFiltering); 110 | TACOptions = set of TACOption; 111 | TACSource = (acsList, acsHistory, acsMRU, acsShell); 112 | TButtonedEdit = class(Vcl.ExtCtrls.TButtonedEdit) 113 | private 114 | FACList: TEnumString; 115 | FEnumString: IEnumString; 116 | FAutoComplete: IAutoComplete; 117 | FACEnabled: Boolean; 118 | FACOptions: TACOptions; 119 | FACSource: TACSource; 120 | function GetACStrings : TStringList; 121 | procedure SetACEnabled(const Value: Boolean); 122 | procedure SetACOptions(const Value: TACOptions); 123 | procedure SetACSource(const Value: TACSource); 124 | procedure SetACStrings(const Value: TStringList); 125 | class constructor Create; 126 | protected 127 | procedure CreateWnd; override; 128 | procedure DestroyWnd; override; 129 | public 130 | constructor Create(AOwner: TComponent); override; 131 | destructor Destroy; override; 132 | published 133 | property ACEnabled: Boolean read FACEnabled write SetACEnabled; 134 | property ACOptions: TACOptions read FACOptions write SetACOptions; 135 | property ACSource: TACSource read FACSource write SetACSource; 136 | property ACStrings: TStringList read GetACStrings write SetACStrings; 137 | end; 138 | 139 | TCommandType = (ctNormal, ctEnvironment, ctOther); 140 | 141 | TForm1 = class(TForm) 142 | DosCommand1: TDosCommand; 143 | ButtonedEdit1: TButtonedEdit; 144 | ImageList1: TImageList; 145 | BCEditor1: TSynEdit; 146 | StatusBar1: TStatusBar; 147 | SearchBox1: TSearchBox; 148 | TrayIcon1: TTrayIcon; 149 | PopupMenu1: TPopupMenu; 150 | Exit1: TMenuItem; 151 | Show1: TMenuItem; 152 | N1: TMenuItem; 153 | DzDirSeek1: TDzDirSeek; 154 | pnlPreview: TPanel; 155 | Splitter1: TSplitter; 156 | EsImage1: TEsImage; 157 | Image1: TImage; 158 | SynUNIXShellScriptSyn1: TSynUNIXShellScriptSyn; 159 | ListBox1: TListBox; 160 | ComboBox1: TComboBox; 161 | pnlTop: TPanel; 162 | IconFontsImageList1: TIconFontsImageList; 163 | rkSmartPath1: TrkSmartPath; 164 | PopupMenu2: TPopupMenu; 165 | OpenURL1: TMenuItem; 166 | CopyPathtoClipboard1: TMenuItem; 167 | SynPasSyn1: TSynPasSyn; 168 | SynMultiSyn1: TSynMultiSyn; 169 | SpeedButton1: TSpeedButton; 170 | IconFontsImageList2: TIconFontsImageList; 171 | ActionList1: TActionList; 172 | actPreview: TAction; 173 | actHide: TAction; 174 | ToolBar1: TToolBar; 175 | ToolButton1: TToolButton; 176 | Panel1: TPanel; 177 | actUnPin: TAction; 178 | actSigInt: TAction; 179 | VirtualMultiPathExplorerEasyListview1: TVirtualMultiPathExplorerEasyListview; 180 | actPath2Clip: TAction; 181 | tmrToast: TTimer; 182 | AppAutoStart1: TCBAutoStart; 183 | mnuAutoStart: TMenuItem; 184 | pnlTitle: TPanel; 185 | LinkLabel1: TLinkLabel; 186 | tmrOutput: TTimer; 187 | ActivityIndicator1: TActivityIndicator; 188 | ImageCollection1: TImageCollection; 189 | VirtualImageList1: TVirtualImageList; 190 | ACLHexView1: TACLHexView; 191 | ACLApplicationController1: TACLApplicationController; 192 | btnFileHandler: TSpeedButton; 193 | ACLShellTreeView1: TACLShellTreeView; 194 | procedure ButtonedEdit1Enter(Sender: TObject); 195 | procedure ButtonedEdit1KeyUp(Sender: TObject; var Key: Word; 196 | Shift: TShiftState); 197 | procedure DosCommand1ExecuteError(ASender: TObject; AE: Exception; 198 | var AHandled: Boolean); 199 | procedure DosCommand1NewLine(ASender: TObject; const ANewLine: string; 200 | AOutputType: TOutputType); 201 | procedure FormCreate(Sender: TObject); 202 | procedure FormDestroy(Sender: TObject); 203 | procedure FormShow(Sender: TObject); 204 | procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 205 | procedure Show1Click(Sender: TObject); 206 | procedure Exit1Click(Sender: TObject); 207 | procedure TrayIcon1DblClick(Sender: TObject); 208 | procedure DosCommand1Terminated(Sender: TObject); 209 | procedure DosCommand1TerminateProcess(ASender: TObject; 210 | var ACanTerminate: Boolean); 211 | procedure ListBox1DblClick(Sender: TObject); 212 | procedure ListBox1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 213 | procedure OpenURL1Click(Sender: TObject); 214 | procedure CopyPathtoClipboard1Click(Sender: TObject); 215 | procedure ButtonedEdit1KeyPress(Sender: TObject; var Key: Char); 216 | procedure BCEditor1DblClick(Sender: TObject); 217 | procedure SpeedButton1Click(Sender: TObject); 218 | procedure actPreviewExecute(Sender: TObject); 219 | procedure actUnPinExecute(Sender: TObject); 220 | procedure actSigIntExecute(Sender: TObject); 221 | procedure actPath2ClipExecute(Sender: TObject); 222 | procedure tmrToastTimer(Sender: TObject); 223 | procedure mnuAutoStartClick(Sender: TObject); 224 | procedure LinkLabel1LinkClick(Sender: TObject; const Link: string; 225 | LinkType: TSysLinkType); 226 | procedure tmrOutputTimer(Sender: TObject); 227 | procedure btnFileHandlerClick(Sender: TObject); 228 | procedure ACLShellTreeView1DblClick(Sender: TObject); 229 | procedure ACLShellTreeView1KeyPress(Sender: TObject; var Key: Char); 230 | private 231 | { Private declarations } 232 | FOutputBuffer: TStringList; 233 | FSyncLock: TCriticalSection; 234 | 235 | FPinned: Boolean; 236 | Items: TList; 237 | ThumbSizeW, ThumbSizeH: Integer; 238 | FhImageList48: Cardinal; 239 | FIconSize: Integer; 240 | 241 | FCommandOutput: TStringList; 242 | 243 | lastExplorerHandle: HWND; 244 | lastExplorerPath: String; 245 | lstExplorerPath: TStringList; 246 | lstExplorerWnd: TStringList; 247 | lstExplorerItem: TStringList; 248 | 249 | fPreview: THostPreviewHandler; 250 | fHexBuffer: TFileStream; 251 | 252 | function ListExplorerInstances:Integer; 253 | procedure KeyEventHandler(var Msg: TMessage); message KeyEvent; 254 | procedure KeyEventHandlerAll(var Msg: TMessage); message KeyEventAll; 255 | procedure KeyEventUpdatePath(var Msg: TMessage); message KeyEventUpdatePath; 256 | procedure KeyEventPickPaths(var Msg: TMessage); message KeyEventPickPaths; 257 | procedure OnFocusLost(Sender: TObject); 258 | 259 | function GetExplorerAddressBarRect(AHandle: HWND): TRect; 260 | function ShowPreview(const FileName: string): Boolean; 261 | procedure SwitchToWindow(AWnd: HWND); 262 | 263 | procedure ProcessDosCommand(Sender: TObject; ACommand: string; terminateCurrent: Boolean = False); 264 | 265 | procedure CMFocusChanged(var Msg: TCMFocusChanged); message CM_FOCUSCHANGED; 266 | 267 | procedure UpdateMainMenu(const ForeGroundWindow: HWND); 268 | 269 | procedure FlushIcons; 270 | 271 | procedure NoBorder(var Msg: TWMNCActivate); message WM_NCACTIVATE; 272 | protected 273 | procedure CreateParams(var Params: TCreateParams); override; 274 | procedure WndProc(var Message: TMessage); override; 275 | private 276 | FCommandType: TCommandType; 277 | FEnvExecutables: TStringList; 278 | FEnvStrings: TStringList; 279 | procedure UpdateStyle; 280 | 281 | procedure RefreshEnvironmentVariables; 282 | procedure WMSettingChange(var Msg: TMessage); message WM_SETTINGCHANGE; 283 | 284 | function ConvertImageToJpeg(const InputFileName, OutputFileName: string): Boolean; 285 | public 286 | { Public declarations } 287 | Directory: string; 288 | CurrentDir: string; 289 | CurrentFile: string; 290 | GitUrl: string; 291 | 292 | procedure Toast(aText, aTitle: string; sType: string = 'S,I,E'; ParentBase: TWinControl = nil); 293 | 294 | procedure populateCommands; 295 | procedure populateEnvironmentStrings; 296 | procedure populateMyFolders; 297 | procedure populateEnvExecutables; 298 | 299 | procedure UpdateTheme; 300 | end; 301 | 302 | var 303 | Form1: TForm1; 304 | args: TStringList; 305 | 306 | function StartHook:BOOL; stdcall; external 'HotkeyHook.dll' name 'STARTHOOK'; 307 | procedure StopHook; stdcall; external 'HotkeyHook.dll' name 'STOPHOOK'; 308 | procedure SwitchToThisWindow(h1: hWnd; x: bool); stdcall; 309 | external user32 Name 'SwitchToThisWindow'; 310 | 311 | implementation 312 | 313 | {$R *.dfm} 314 | 315 | uses 316 | frmHover, UIAutomationClient, DarkModeApi.Vcl, Vcl.Themes, 317 | DarkModeApi, Winapi.UxTheme, CB.DarkMode, Ntapi.UserEnv, Ntapi.WinNt, Ntapi.ntrtl, 318 | pngimage, GIFImg, Cod.Imaging.Heif, Cod.Imaging.WebP, Vcl.SysStyles, ACL.Utils.Common; 319 | 320 | type 321 | THostPreviewHandlerClass = class(THostPreviewHandler); 322 | 323 | { Global Functions} 324 | function RtlGetVersion(var RTL_OSVERSIONINFOEXW): LONGINT; stdcall; 325 | external 'ntdll.dll' Name 'RtlGetVersion'; 326 | function isWindows11:Boolean; 327 | var 328 | winver: RTL_OSVERSIONINFOEXW; 329 | begin 330 | Result := False; 331 | if ((RtlGetVersion(winver) = 0) and (winver.dwMajorVersion>=10) and (winver.dwBuildNumber > 22000)) then 332 | Result := True; 333 | end; 334 | 335 | procedure EnableNCShadow(Wnd: HWND); 336 | const 337 | DWMWCP_DEFAULT = 0; // Let the system decide whether or not to round window corners 338 | DWMWCP_DONOTROUND = 1; // Never round window corners 339 | DWMWCP_ROUND = 2; // Round the corners if appropriate 340 | DWMWCP_ROUNDSMALL = 3; // Round the corners if appropriate, with a small radius 341 | DWMWA_WINDOW_CORNER_PREFERENCE = 33; // [set] WINDOW_CORNER_PREFERENCE, Controls the policy that rounds top-level window corners 342 | var 343 | DWM_WINDOW_CORNER_PREFERENCE: Cardinal; 344 | begin 345 | 346 | if isWindows11 then 347 | begin 348 | 349 | DWM_WINDOW_CORNER_PREFERENCE := DWMWCP_ROUNDSMALL; 350 | DwmSetWindowAttribute(Wnd, DWMWA_WINDOW_CORNER_PREFERENCE, @DWM_WINDOW_CORNER_PREFERENCE, sizeof(DWM_WINDOW_CORNER_PREFERENCE)); 351 | end; 352 | end; 353 | 354 | 355 | procedure UseImmersiveDarkMode(Handle: HWND; Enable: Boolean); 356 | const 357 | DWMWA_USE_IMMERSIVE_DARK_MODE_BEFORE_20H1 = 19; 358 | DWMWA_USE_IMMERSIVE_DARK_MODE = 20; 359 | var 360 | DarkMode: DWORD; 361 | Attribute: DWORD; 362 | begin 363 | //https://stackoverflow.com/a/62811758 364 | DarkMode := DWORD(Enable); 365 | 366 | if Win32MajorVersion = 10 then 367 | begin 368 | if Win32BuildNumber >= 17763 then 369 | begin 370 | Attribute := DWMWA_USE_IMMERSIVE_DARK_MODE_BEFORE_20H1; 371 | if Win32BuildNumber >= 18985 then 372 | Attribute := DWMWA_USE_IMMERSIVE_DARK_MODE; 373 | DwmSetWindowAttribute(Handle, Attribute, @DarkMode, SizeOf(DWord)); 374 | SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_DRAWFRAME or SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER); 375 | end; 376 | end; 377 | end; 378 | 379 | function RunProcess(const Binary: string; const DirPath: string; args: TStrings): Boolean; 380 | const 381 | BufSize = 4096; //1024 382 | var 383 | Process: TProcess; 384 | Buf: AnsiString; 385 | Count: Integer; 386 | i: Integer; 387 | LineStart: Integer; 388 | OutputLine: AnsiString; 389 | begin 390 | Process := TProcess.Create(nil); 391 | try 392 | Process.Executable := Binary; 393 | 394 | Process.Options := [poUsePipes, poStderrToOutPut]; 395 | Process.ShowWindow := swoHIDE; 396 | 397 | Process.Parameters.Assign(args); 398 | Process.CurrentDirectory := DirPath; 399 | Process.Execute; 400 | 401 | OutputLine := ''; 402 | SetLength(Buf, BufSize); 403 | repeat 404 | if (Process.Output <> nil) then 405 | begin 406 | Count := Process.Output.Read(PChar(Buf)^, BufSize); 407 | end 408 | else 409 | Count := 0; 410 | 411 | LineStart := 1; 412 | i := 1; 413 | while i <= Count do 414 | begin 415 | if CharInSet(Buf[i], [#10, #13]) then 416 | begin 417 | OutputLine := OutputLine + Copy(Buf, LineStart, i - LineStart); 418 | Form1.BCEditor1.Lines.Add(OutputLine); 419 | OutputLine := ''; 420 | if (i < Count) and (CharInSet(Buf[i], [#10, #13])) and (Buf[i] <> Buf[i + 1]) then 421 | Inc(i); 422 | LineStart := i + 1; 423 | end; 424 | Inc(i); 425 | end; 426 | OutputLine := Copy(Buf, LineStart, Count - LineStart + 1); 427 | until Count = 0; 428 | 429 | if OutputLine <> '' then 430 | Form1.BCEditor1.Lines.Add(OutputLine); 431 | 432 | Process.WaitOnExit; 433 | Result := Process.ExitStatus = 0; 434 | if not Result then 435 | Form1.BCEditor1.Lines.Add('Command ' + Process.Executable + ' failed with exit code: ' + IntToStr(Process.ExitStatus)); 436 | 437 | finally 438 | FreeAndNil(Process); 439 | end; 440 | end; 441 | 442 | function IsGitRepository(const Dir: string): Boolean; 443 | var 444 | repo: Pgit_repository; 445 | dirPath: PAnsiChar; 446 | error: Integer; 447 | begin 448 | dirPath := PAnsiChar(AnsiString(Dir)); 449 | error := git_repository_open(@repo, dirPath); 450 | 451 | if error = 0 then 452 | begin 453 | git_repository_free(repo); 454 | Result := True; 455 | end 456 | else 457 | Result := False; 458 | end; 459 | 460 | function IsGit(const RepoDir): boolean; 461 | var 462 | repo: Pgit_repository; 463 | remote: Pgit_remote; 464 | dirPath, remoteNamePAnsi: PAnsiChar; 465 | remoteURL: PAnsiChar; 466 | error: Integer; 467 | begin 468 | Result := False; 469 | 470 | dirPath := PAnsiChar(AnsiString(RepoDir)); 471 | 472 | // Open the repository 473 | error := git_repository_open(@repo, dirPath); 474 | if error <> 0 then 475 | Exit; 476 | Result := True; 477 | // Free the repository resource 478 | git_repository_free(repo); 479 | end; 480 | 481 | 482 | function GetRemoteURL(const RepoDir, RemoteName: string): string; 483 | var 484 | repo: Pgit_repository; 485 | remote: Pgit_remote; 486 | dirPath, remoteNamePAnsi: PAnsiChar; 487 | remoteURL: PAnsiChar; 488 | error: Integer; 489 | begin 490 | Result := ''; 491 | 492 | dirPath := PAnsiChar(AnsiString(RepoDir)); 493 | remoteNamePAnsi := PAnsiChar(AnsiString(RemoteName)); 494 | 495 | // Open the repository 496 | error := git_repository_open(@repo, dirPath); 497 | if error <> 0 then 498 | Exit; 499 | 500 | // Look up the remote by its name 501 | error := git_remote_lookup(@remote, repo, remoteNamePAnsi); 502 | 503 | if error = 0 then 504 | begin 505 | // Get the remote URL 506 | remoteURL := git_remote_url(remote); 507 | Result := string(remoteURL); 508 | 509 | // Free the remote resource 510 | git_remote_free(remote); 511 | end; 512 | 513 | // Free the repository resource 514 | git_repository_free(repo); 515 | end; 516 | 517 | function ExtractThumbnail(Path: string; SizeX, SizeY: Integer; InitOle: Boolean = False): HBitmap; 518 | var 519 | ShellFolder, DesktopShellFolder: IShellFolder; 520 | XtractImage: IExtractImage; 521 | Eaten: DWord; 522 | PIDL: PItemIDList; 523 | RunnableTask: IRunnableTask; 524 | Flags: DWord; 525 | Buf: array [0 .. MAX_PATH] of Char; 526 | BmpHandle: HBITMAP; 527 | Atribute, Priority: DWord; 528 | GetLocationRes: HResult; 529 | ASize: TSize; 530 | begin 531 | Result := 0; 532 | try 533 | if InitOle then 534 | CoInitializeEx(nil, COINIT_APARTMENTTHREADED or COINIT_DISABLE_OLE1DDE); 535 | try 536 | OleCheck(SHGetDesktopFolder(DesktopShellFolder)); 537 | OleCheck(DesktopShellFolder.ParseDisplayName(0, nil, StringToOleStr(ExtractFilePath(Path)), 538 | Eaten, PIDL, Atribute)); 539 | OleCheck(DesktopShellFolder.BindToObject(PIDL, nil, IID_IShellFolder, Pointer(ShellFolder))); 540 | CoTaskMemFree(PIDL); 541 | 542 | OleCheck(ShellFolder.ParseDisplayName(0, nil, StringToOleStr(ExtractFileName(Path)), Eaten, PIDL, Atribute)); 543 | ShellFolder.GetUIObjectOf(0, 1, PIDL, IExtractImage, nil, XtractImage); 544 | CoTaskMemFree(PIDL); 545 | 546 | if Assigned(XtractImage) then // Try getting a thumbnail.. 547 | begin 548 | RunnableTask := nil; 549 | ASize.cx := SizeX; 550 | ASize.cy := SizeY; 551 | Priority := 0; 552 | Flags:= IEIFLAG_ASPECT or IEIFLAG_OFFLINE or IEIFLAG_CACHE or IEIFLAG_QUALITY; 553 | GetLocationRes := XtractImage.GetLocation(Buf, SizeOf(Buf), Priority, ASize, 32, Flags); 554 | if (GetLocationRes = NOERROR) or (GetLocationRes = E_PENDING) then 555 | begin 556 | if GetLocationRes = E_PENDING then 557 | if XtractImage.QueryInterface(IRunnableTask, RunnableTask) <> S_OK then 558 | RunnableTask := nil; 559 | try 560 | //do not call OleCheck for debug 561 | XtractImage.Extract(BmpHandle); 562 | // This could consume a long time. 563 | Result := BmpHandle; 564 | except 565 | on E: EOleSysError do 566 | OutputDebugString(PChar(string(E.ClassName) + ': ' + E.message)) 567 | end; // try/except 568 | end; 569 | end; 570 | 571 | finally 572 | if InitOle then 573 | CoUninitialize; 574 | end; 575 | except 576 | Result := 0; 577 | end; 578 | end; 579 | 580 | procedure HackAlpha(ABitmap: TBitmap; Color: TColor); 581 | type 582 | PRGB32 = ^TRGB32; 583 | TRGB32 = record 584 | B, G, R, A: Byte; 585 | end; 586 | PPixel32 = ^TPixel32; 587 | TPixel32 = array[0..0] of TRGB32; 588 | var 589 | Row: PPixel32; 590 | X, Y, slMain, slSize: Integer; 591 | R, G, B: Byte; 592 | c: Integer; 593 | begin 594 | ABitmap.PixelFormat := pf32bit; 595 | c := ColorToRGB(Color); 596 | R := Byte(c); 597 | G := Byte(c shr 8); 598 | B := Byte(c shr 16); 599 | slMain := Integer(ABitmap.ScanLine[0]); 600 | slSize := Integer(ABitmap.ScanLine[1]) - slMain; 601 | for Y := 0 to ABitmap.Height - 1 do 602 | begin 603 | Row := PPixel32(slMain); 604 | for X := 0 to ABitmap.Width - 1 do 605 | begin 606 | Row[X].R := Row[X].A * (Row[X].R - R) shr 8 + R; 607 | Row[X].G := Row[X].A * (Row[X].G - G) shr 8 + G; 608 | Row[X].B := Row[X].A * (Row[X].B - B) shr 8 + B; 609 | end; 610 | slMain := slMain + slSize; 611 | end; 612 | end; 613 | 614 | function HackIconSize(ABitmap: TBitmap): TPoint; 615 | type 616 | PPixel32 = ^TPixel32; 617 | TPixel32 = array [0..0] of Cardinal; 618 | var 619 | Row: PPixel32; 620 | X, Y, i, j, slMain, slSize: Integer; 621 | begin 622 | ABitmap.PixelFormat := pf32bit; 623 | Result.X := ABitmap.Width; 624 | Result.Y := ABitmap.Height; 625 | if (Result.X < 1) or (Result.Y < 1) then 626 | Exit; 627 | slMain := Integer(ABitmap.ScanLine[0]); 628 | slSize := Integer(ABitmap.ScanLine[1]) - slMain; 629 | Result.X := 0; 630 | Result.Y := 0; 631 | for Y := 0 to ABitmap.Height - 1 do 632 | begin 633 | Row := PPixel32(slMain); 634 | for X := 0 to ABitmap.Width - 1 do 635 | begin 636 | if (Row[X] and $FF000000) <> 0 then 637 | begin 638 | if X > Result.X then 639 | Result.X := X; 640 | if Y > Result.Y then 641 | Result.Y := Y; 642 | end; 643 | end; 644 | slMain := slMain + slSize; 645 | end; 646 | I := Math.Max(Result.X, Result.Y); 647 | j := 0; 648 | while I > j do 649 | j := j + 8; 650 | if j > 256 then 651 | j := 256; 652 | Result.X := j; 653 | Result.Y := Result.X; 654 | end; 655 | 656 | procedure GetIconFromFile(AFile: string; var AIcon: TIcon; SHIL_FLAG: Cardinal); 657 | var 658 | LImgList: HIMAGELIST; 659 | SFI: TSHFileInfo; 660 | LIndex: Integer; 661 | begin 662 | // Get the index of the imagelist 663 | SHGetFileInfo(PChar(AFile), FILE_ATTRIBUTE_NORMAL, SFI, SizeOf(TSHFileInfo), 664 | SHGFI_ICON {or SHGFI_LARGEICON} or SHGFI_SHELLICONSIZE or 665 | SHGFI_SYSICONINDEX or SHGFI_TYPENAME or SHGFI_DISPLAYNAME); 666 | if not Assigned(AIcon) then 667 | AIcon := TIcon.Create; 668 | // get image list 669 | SHGetImageList(SHIL_FLAG, IID_IImageList, Pointer(LImgList)); 670 | // its index 671 | LIndex := SFI.iIcon; 672 | // seems that ILD_NORMAL returns bad result in Windows 7, so opt for ILD_IMAGE 673 | AIcon.Handle := ImageList_GetIcon(LImgList, LIndex, ILD_IMAGE); 674 | end; 675 | 676 | procedure Graphic2Bitmap(const ASrc: TGraphic; const ADest: TBitmap; 677 | const ATransparentColor: TColor); 678 | var 679 | LCrop: TPoint; 680 | begin 681 | if not Assigned(ASrc) or not Assigned(ADest) then 682 | Exit; 683 | if (ASrc.Width = 0) or (ASrc.Height = 0) then 684 | Exit; 685 | 686 | ADest.Width := ASrc.Width; 687 | ADest.Height := ASrc.Height; 688 | if ASrc.Transparent then 689 | begin 690 | ADest.Transparent := True; 691 | if (ATransparentColor <> clNone) then 692 | begin 693 | ADest.TransparentColor := ATransparentColor; 694 | ADest.TransparentMode := tmFixed; 695 | ADest.Canvas.Brush.Color := ATransparentColor; 696 | end 697 | else 698 | ADest.TransparentMode := tmAuto; 699 | end; 700 | 701 | ADest.Canvas.FillRect(Rect(0, 0, ADest.Width, ADest.Height)); 702 | ADest.Canvas.Draw(0, 0, ASrc); 703 | LCrop := HackIconSize(ADest); 704 | ADest.Width := LCrop.X; 705 | ADest.Height := LCrop.Y; 706 | end; 707 | 708 | function Byte2Str(const i64Size: Int64): string; 709 | const 710 | i64GB = 1024 * 1024 * 1024; 711 | i64MB = 1024 * 1024; 712 | i64KB = 1024; 713 | begin 714 | if i64Size div i64GB > 0 then 715 | Result := Format('%.1f GB', [i64Size / i64GB]) 716 | else if i64Size div i64MB > 0 then 717 | Result := Format('%.2f MB', [i64Size / i64MB]) 718 | else if i64Size div i64KB > 0 then 719 | Result := Format('%.0f KB', [i64Size / i64KB]) 720 | else 721 | Result := IntToStr(i64Size) + ' bytes'; 722 | end; 723 | 724 | function CalcTHumbSize(Width, Height, ThumbWidth, ThumbHeight: Cardinal): Cardinal; 725 | begin 726 | Result := 0; 727 | if (Width = 0) or (Height = 0) then 728 | Exit; 729 | if (Width < ThumbWidth) and (Height < ThumbHeight) then 730 | Result := (Width shl 16) + Height 731 | else 732 | begin 733 | if Width > Height then 734 | begin 735 | if Width < ThumbWidth then 736 | ThumbWidth := Width; 737 | Result := (ThumbWidth shl 16) + Trunc(ThumbWidth * Height / Width); 738 | if (Result and $FFFF) >ThumbHeight then 739 | Result := (Trunc(ThumbHeight * Width / Height) shl 16) + ThumbHeight; 740 | end 741 | else 742 | begin 743 | if Height < ThumbHeight then 744 | ThumbHeight := Height; 745 | Result := (Trunc(ThumbHeight * Width / Height) shl 16) + ThumbHeight; 746 | if ((Result shr 16) and $FFFF) > ThumbWidth then 747 | Result := (ThumbWidth shl 16) + Trunc(ThumbWidth * Height / Width); 748 | end; 749 | end; 750 | end; 751 | 752 | function Blend(Color1, Color2: TColor; A: Byte): TColor; 753 | var 754 | C1, C2: LongInt; 755 | R, G, B, v1, v2: Byte; 756 | begin 757 | A := Round(2.55 * A); 758 | C1 := ColorToRGB(Color1); 759 | C2 := COlorToRGB(COlor2); 760 | v1 := Byte(C1); 761 | v2 := Byte(C2); 762 | R := A * (v1 - v2) shr 8 + v2; 763 | v1 := Byte(C1 shr 8); 764 | v2 := Byte(C2 shr 8); 765 | G := A * (v1 - v2) shr 8 + v2; 766 | v1 := Byte(C1 shr 16); 767 | v2 := Byte(C2 shr 16); 768 | B := A * (v1 - v2) shr 8 + v2; 769 | Result := (B shl 16) + (G shl 8) + R; 770 | end; 771 | 772 | procedure WinGradient(DC: HDC; ARect: TRect; AColor1, AColor2: TColor); 773 | var 774 | Vertexs: array[0..1] of TTriVertex; 775 | GRect: TGradientRect; 776 | begin 777 | Vertexs[0].x := ARect.Left; 778 | Vertexs[0].y := ARect.Top; 779 | Vertexs[0].Red := (AColor1 and $000000FF) shl 8; 780 | Vertexs[0].Green := (AColor1 and $0000FF00); 781 | Vertexs[0].Blue := (AColor1 and $00FF0000) shr 8; 782 | Vertexs[0].Alpha := 0; 783 | Vertexs[1].x := ARect.Right; 784 | Vertexs[1].y := ARect.Bottom; 785 | Vertexs[1].Red := (AColor2 and $000000FF) shl 8; 786 | Vertexs[1].Green := (AColor2 and $0000FF00); 787 | Vertexs[1].Blue := (AColor2 and $00FF0000) shr 8; 788 | Vertexs[1].Alpha := 0; 789 | GRect.UpperLeft := 0; 790 | GRect.LowerRight := 1; 791 | GradientFill(DC, @Vertexs, 2, @GRect, 1, GRADIENT_FILL_RECT_V); 792 | end; 793 | 794 | function CompareNatural(s1, s2: string): Integer; 795 | function ExtractNr(n: Integer; var Txt: string): Int64; 796 | begin 797 | while (n <= Length(Txt)) and (Txt[n] >= '0') and (Txt[n] <= '9') do 798 | n := n + 1; 799 | Result := StrToInt64Def(Copy(Txt, 1, n - 1), 0); 800 | Delete(Txt, 1, (n - 1)); 801 | end; 802 | var 803 | B: Boolean; 804 | begin 805 | Result := 0; 806 | s1 := LowerCase(s1); 807 | s2 := LowerCase(s2); 808 | if (s1 <> s2) and (s1 <> '') and (s2 <> '') then 809 | begin 810 | B := False; 811 | while (not B) do 812 | begin 813 | if ((s1[1] >= '0') and (s1[1] <= '9')) 814 | and ((s2[1] >= '0') and (s2[1] <= '9')) 815 | then 816 | Result := Sign(ExtractNr(1, s1) - ExtractNr(1, s2)) 817 | else 818 | Result := Sign(Integer(s1[1]) - Integer(s2[1])); 819 | B := (Result <> 0) or (Min(Length(s1), Length(s2)) < 2); 820 | if not B then 821 | begin 822 | Delete(s1, 1, 1); 823 | Delete(s2, 1, 1); 824 | end; 825 | end; 826 | end; 827 | if Result = 0 then 828 | begin 829 | if (Length(s1) = 1) and (Length(s2) = 1) then 830 | Result := Sign(Integer(s1[1]) - Integer(s2[1])) 831 | else 832 | Result := Sign(Length(s1) - Length(s2)); 833 | end; 834 | end; 835 | 836 | // a custom sort 837 | function SortItem(List: rkIntegerList.TIntList; Index1, Index2: Integer): Integer; 838 | var 839 | Item1, Item2: PItemData; 840 | begin 841 | Item1 := Form1.Items[List[Index1]]; 842 | Item2 := Form1.Items[List[Index2]]; 843 | if Item1.Dir and Item2.Dir then 844 | Result := CompareNatural(Item1.Name, Item2.Name) 845 | else if Item1.Dir then 846 | Result := -1 847 | else if Item2.Dir then 848 | Result := 1 849 | else 850 | Result := CompareNatural(Item1.Name, Item2.Name); 851 | end; 852 | 853 | { Form1 } 854 | 855 | procedure TForm1.ACLShellTreeView1DblClick(Sender: TObject); 856 | begin 857 | ShellExecute(0, 'OPEN', PChar(ACLShellTreeView1.GetFullPath(ACLShellTreeView1.FocusedNode)), nil, nil, SW_SHOWNORMAL); 858 | end; 859 | 860 | procedure TForm1.ACLShellTreeView1KeyPress(Sender: TObject; var Key: Char); 861 | begin 862 | if Key = #13 then 863 | ShellExecute(0, 'OPEN', PChar(ACLShellTreeView1.GetFullPath(ACLShellTreeView1.FocusedNode)), nil, nil, SW_SHOWNORMAL); 864 | end; 865 | 866 | procedure TForm1.actPath2ClipExecute(Sender: TObject); 867 | begin 868 | // Copy current path to clipboard 869 | if not CurrentDir.IsEmpty and DirectoryExists(CurrentDir) then 870 | begin 871 | Clipboard.AsText := CurrentDir; 872 | Toast('Path copied to clipboard!', 'Current Path', 'S'); 873 | end; 874 | end; 875 | 876 | procedure TForm1.actPreviewExecute(Sender: TObject); 877 | begin 878 | pnlPreview.Visible := not pnlPreview.Visible; 879 | end; 880 | 881 | procedure TForm1.actSigIntExecute(Sender: TObject); 882 | begin 883 | if DosCommand1.IsRunning then 884 | DosCommand1.SigInt; 885 | end; 886 | 887 | procedure TForm1.actUnPinExecute(Sender: TObject); 888 | begin 889 | SpeedButton1Click(Sender); 890 | end; 891 | 892 | procedure TForm1.BCEditor1DblClick(Sender: TObject); 893 | begin 894 | UpdateMainMenu(lastExplorerHandle); 895 | end; 896 | 897 | procedure TForm1.btnFileHandlerClick(Sender: TObject); 898 | begin 899 | btnFileHandler.Visible := False; 900 | Panel1.Caption := ''; 901 | if Assigned(fHexBuffer) then 902 | fHexBuffer.Free; 903 | ACLHexView1.Visible := False; 904 | try 905 | ACLHexView1.Data := nil; 906 | ACLHexView1.FullRefresh; 907 | except 908 | end; 909 | end; 910 | 911 | procedure TForm1.ButtonedEdit1Enter(Sender: TObject); 912 | begin 913 | // ButtonedEdit1.RightButton.Visible := True; 914 | end; 915 | 916 | procedure TForm1.ButtonedEdit1KeyPress(Sender: TObject; var Key: Char); 917 | begin 918 | // avoid ding sound 919 | if (Key = #13) or (Key = #27) then 920 | Key := #0; 921 | end; 922 | 923 | procedure TForm1.ButtonedEdit1KeyUp(Sender: TObject; var Key: Word; 924 | Shift: TShiftState); 925 | var 926 | I: Integer; 927 | CLI: string; 928 | begin 929 | CLI := ButtonedEdit1.Text; 930 | if key = 13 then 931 | begin 932 | // populateCommands; 933 | if CLI = 'list' then 934 | begin 935 | ListExplorerInstances; 936 | BCEditor1.Text := 'Current HWND: ' + IntToStr(lastExplorerHandle) + ''; 937 | for I := 0 to lstExplorerPath.Count - 1 do 938 | begin 939 | if lstExplorerWnd[I] = IntToStr(lastExplorerHandle) then 940 | 941 | BCEditor1.Text := BCEditor1.Text + #13#10 + lstExplorerPath[I] + ' ' + lstExplorerWnd[i]; 942 | end; 943 | end 944 | else if CLI = 'items' then 945 | begin 946 | ListExplorerInstances; 947 | BCEditor1.Text := 'Current HWND: ' + IntToStr(lastExplorerHandle) + ''; 948 | for I := 0 to lstExplorerItem.Count - 1 do 949 | begin 950 | BCEditor1.Text := BCEditor1.Text + #13#10 + lstExplorerItem[I]; 951 | end; 952 | 953 | end 954 | else if CLI = '%' then 955 | begin 956 | populateEnvironmentStrings; 957 | end 958 | else if CLI = 'hexview' then 959 | begin 960 | var curFile := StatusBar1.Panels[0].Text; 961 | if FileExists(curFile) then 962 | begin 963 | if Assigned(fHexBuffer) then 964 | fHexBuffer.Free; 965 | fHexBuffer := TFileStream.Create(curFile, fmOpenRead); 966 | try 967 | Panel1.Caption := 'Hex: ' + curFile; 968 | btnFileHandler.Visible := True; 969 | ACLHexView1.Visible := True; 970 | ACLHexView1.StyleScrollBox.Reset; 971 | ACLHexView1.SetSelection(0, 0); 972 | ACLHexView1.Data := nil; 973 | ACLHexView1.FullRefresh; 974 | ACLHexView1.Data := fHexBuffer; 975 | finally 976 | //fHexBuffer.Free; //we should keep this open so the hex viewer will read on demand 977 | end; 978 | end; 979 | end 980 | else if CLI = 'preview' then 981 | begin 982 | var curFile := StatusBar1.Panels[0].Text; 983 | if FileExists(curFile) then 984 | BCEditor1.Lines.LoadFromFile(curFile); 985 | end 986 | else if CLI = 'tojpg' then 987 | begin 988 | var curFile := StatusBar1.Panels[0].Text; 989 | if FileExists(curFile) then 990 | begin 991 | if ConvertImageToJpeg(curFile, curFile +'.jpg') then 992 | begin 993 | BCEditor1.Clear; 994 | BCEditor1.Lines.Add('Image converted to JPG %90'); 995 | BCEditor1.Lines.Add(curFile + '.jpg'); 996 | end; 997 | end; 998 | end 999 | else if CLI = 'center' then 1000 | begin 1001 | if IsZoomed(lastExplorerHandle) then Exit; 1002 | 1003 | var _R: TRect; 1004 | var _M: TMonitor; 1005 | GetWindowRect(lastExplorerHandle, _R); 1006 | _M := Screen.MonitorFromRect(_R); 1007 | if (_R.Width > 0) and (_R.Height > 0) then 1008 | begin 1009 | var NewPos: TPoint; 1010 | NewPos.X := _M.Left + (_M.Width - _R.Width) div 2; 1011 | NewPos.Y := _M.Top + (_M.Height - _R.Height) div 2; 1012 | MoveWindow(lastExplorerHandle, NewPos.X, NewPos.Y, _R.Width, _R.Height, True); 1013 | end; 1014 | end 1015 | else if CLI = 'cmd' then 1016 | begin 1017 | if DirectoryExists(lastExplorerPath) then 1018 | // ShellExecute(0, PChar('OPEN'), PChar('cmd.exe'), PChar('/k refreshenv && cd /d ' + lastExplorerPath), PChar(lastExplorerPath), SW_SHOWNORMAL); 1019 | ShellExecute(0, PChar('OPEN'), PChar('cmd.exe'), PChar('/k cd /d ' + lastExplorerPath), PChar(lastExplorerPath), SW_SHOWNORMAL) 1020 | else 1021 | ShellExecute(0, PChar('OPEN'), PChar('cmd.exe'), PChar('/k cd %USERPROFILE%'), nil, SW_SHOWNORMAL) 1022 | end 1023 | else if CLI = 'env' then 1024 | begin 1025 | BCEditor1.Lines.Clear; 1026 | BCEditor1.Lines.Add('[Environment PATH]'); 1027 | for var _env in FEnvStrings do 1028 | BCEditor1.Lines.Add(PChar(_env)); 1029 | end 1030 | else if CLI = 'flushicons' then 1031 | begin 1032 | FlushIcons; 1033 | end 1034 | // show file explorer quick access directories 1035 | else if CLI = ':' then 1036 | begin 1037 | populateMyFolders; 1038 | end 1039 | else if CLI = '>' then 1040 | begin 1041 | populateEnvExecutables; 1042 | end 1043 | else if Pos('>', CLI) = 1 then 1044 | begin 1045 | if Cli.Length > 1 then 1046 | begin 1047 | var command := Copy(CLI,2, Length(CLI) - 1); 1048 | 1049 | ShellExecute(0, PChar('OPEN'), PChar(command), nil, PChar(lastExplorerPath), SW_SHOWNORMAL); 1050 | end 1051 | end 1052 | else if Pos('find ', CLI) = 1 then 1053 | begin 1054 | if DirectoryExists(lastExplorerPath) then 1055 | begin 1056 | DzDirSeek1.Dir := lastExplorerPath; 1057 | DzDirSeek1.MaskKind := TDSMaskKind.mkInclusions; 1058 | DzDirSeek1.Masks.Clear; 1059 | DzDirSeek1.Masks.Add(Copy(CLI,6)); 1060 | DzDirSeek1.ResultKind := TDSResultKind.rkRelative; 1061 | DzDirSeek1.Seek; 1062 | BCEditor1.Lines.Clear; 1063 | BCEditor1.Text := DzDirSeek1.List.GetText; 1064 | end; 1065 | end 1066 | 1067 | else if CLI = 'listexplorers' then 1068 | begin 1069 | ListBox1.Items := lstExplorerPath; 1070 | ListBox1.Show; 1071 | if ListBox1.Visible then 1072 | ListBox1.SetFocus; 1073 | end 1074 | 1075 | else if CLI = 'exit' then 1076 | close 1077 | else 1078 | begin 1079 | 1080 | try 1081 | begin 1082 | BCEditor1.Lines.Clear; 1083 | if CLI.Contains('=') then 1084 | begin 1085 | var ls := TStringList.Create; 1086 | try 1087 | ls.Delimiter := '='; 1088 | ls.DelimitedText := CLI; 1089 | if ls.Count > 1 then 1090 | begin 1091 | if DirectoryExists(ls[1]) then 1092 | begin 1093 | ShellExecute(0, PChar('OPEN'), PChar(ls[1]), nil, nil, SW_SHOWNORMAL); 1094 | end; 1095 | end; 1096 | 1097 | finally 1098 | ls.Free; 1099 | end; 1100 | end 1101 | else 1102 | if DirectoryExists(lastExplorerPath) then 1103 | begin 1104 | var basePath := lastExplorerPath; 1105 | if DirectoryExists(CurrentFile) then 1106 | basePath := CurrentFile; 1107 | 1108 | // Temporary disabled to try DOSCommand Instead 1109 | // args := TStringList.Create; 1110 | // args.Add('/c'); 1111 | //// args.Add('chcp'); 1112 | //// args.Add('65001'); 1113 | //// args.Add('&'); 1114 | 1115 | if OpenURL1.Enabled then //git folder detected 1116 | begin 1117 | if (CLI = 'gp') or CLI.Contains('-pull') then 1118 | begin 1119 | ButtonedEdit1.Text := 'git -c fetch.parallel=0 -c submodule.fetchjobs=0 pull --progress "origin"'; 1120 | end 1121 | else if (CLI = 'gu') or CLI.Contains('-url') then 1122 | begin 1123 | ButtonedEdit1.Text := 'giturl'; 1124 | end 1125 | else if (CLI = 'gr') or Cli.Contains('-readme') then 1126 | begin 1127 | var readmePath := basePath + '\README.md'; 1128 | if FileExists(readmePath) then 1129 | ButtonedEdit1.Text := ('start ' + readmePath) 1130 | else 1131 | ButtonedEdit1.Text := ('echo NO README FOUND!'); 1132 | end; 1133 | CLI := ButtonedEdit1.Text; 1134 | end; 1135 | // args.Add(CLI); 1136 | // RunProcess('cmd.exe', PChar(basePath), args); 1137 | // Toast('Command finished!', '','S'); 1138 | // BCEditor1.GotoLineAndCenter(BCEditor1.Lines.Count); 1139 | // args.Free; 1140 | // args := nil; 1141 | 1142 | DosCommand1.CurrentDir := basePath; 1143 | // DosCommand1.CommandLine := 'cmd.exe /c ' + ButtonedEdit1.Text; 1144 | // DosCommand1.Execute; 1145 | ProcessDosCommand(Self, PChar('cmd.exe /c ' + CLI)); 1146 | end; 1147 | end 1148 | except 1149 | //on E:Exception do 1150 | 1151 | end; 1152 | 1153 | end; 1154 | ButtonedEdit1.Text := ''; 1155 | end; 1156 | end; 1157 | 1158 | procedure TForm1.CMFocusChanged(var Msg: TCMFocusChanged); 1159 | begin 1160 | ListBox1.Visible := ListBox1.Focused; 1161 | 1162 | 1163 | inherited; 1164 | end; 1165 | 1166 | function TForm1.ConvertImageToJpeg(const InputFileName, 1167 | OutputFileName: string): Boolean; 1168 | const 1169 | // Hex headers for different formats 1170 | BMPHeader: array[0..1] of Byte = ($42, $4D); // BM 1171 | PNGHeader: array[0..7] of Byte = ($89, $50, $4E, $47, $0D, $0A, $1A, $0A); // PNG signature 1172 | GIFHeader: array[0..2] of Byte = ($47, $49, $46); // GIF 1173 | JPEGHeader: array[0..1] of Byte = ($FF, $D8); // JPEG SOI marker 1174 | WebPHeader: array[0..3] of Byte = ($52, $49, $46, $46); // RIFF for WebP 1175 | HEIFHeader: array[0..3] of Byte = ($66, $74, $79, $70); // ftyp for HEIF 1176 | var 1177 | FileStream: TFileStream; 1178 | Header: TBytes; 1179 | InputImage: TGraphic; 1180 | JPEGImage: TJPEGImage; 1181 | Bitmap: TBitmap; 1182 | FormatValid: Boolean; 1183 | 1184 | function CompareHeader(const FileHeader, ValidHeader: array of Byte): Boolean; 1185 | var 1186 | I: Integer; 1187 | begin 1188 | Result := Length(FileHeader) >= Length(ValidHeader); 1189 | if Result then 1190 | for I := 0 to High(ValidHeader) do 1191 | if FileHeader[I] <> ValidHeader[I] then 1192 | Exit(False); 1193 | end; 1194 | 1195 | function ConfirmOverwrite(const FileName: string): Boolean; 1196 | begin 1197 | Result := not FileExists(FileName) or 1198 | (MessageDlg(Format('File "%s" already exists. Do you want to overwrite it?', 1199 | [FileName]), mtConfirmation, [mbYes, mbNo], 0) = mrYes); 1200 | end; 1201 | 1202 | begin 1203 | Result := False; 1204 | FormatValid := False; 1205 | Header := nil; 1206 | InputImage := nil; 1207 | JPEGImage := nil; 1208 | Bitmap := nil; 1209 | 1210 | // Check if output file exists and confirm overwrite 1211 | if not ConfirmOverwrite(OutputFileName) then 1212 | Exit; 1213 | 1214 | try 1215 | // Open file to read header 1216 | FileStream := TFileStream.Create(InputFileName, fmOpenRead or fmShareDenyWrite); 1217 | try 1218 | SetLength(Header, 8); // Longest header is 8 bytes (PNG) 1219 | FileStream.ReadBuffer(Header[0], Length(Header)); 1220 | finally 1221 | FileStream.Free; 1222 | end; 1223 | 1224 | // Validate format based on header 1225 | if CompareHeader(Header, BMPHeader) then 1226 | InputImage := TBitmap.Create 1227 | else if CompareHeader(Header, PNGHeader) then 1228 | InputImage := TPngImage.Create 1229 | else if CompareHeader(Header, GIFHeader) then 1230 | InputImage := TGIFImage.Create 1231 | else if CompareHeader(Header, JPEGHeader) then 1232 | InputImage := TJPEGImage.Create 1233 | else if CompareHeader(Header, WebPHeader) then 1234 | InputImage := TWebPImage.Create 1235 | else if CompareHeader(Header, HEIFHeader) then 1236 | InputImage := THEIFImage.Create 1237 | else 1238 | raise EInvalidImageFormat.Create('Unsupported image format.'); 1239 | 1240 | FormatValid := True; 1241 | 1242 | // Load image into InputImage 1243 | InputImage.LoadFromFile(InputFileName); 1244 | 1245 | // Create intermediate bitmap for PNG and HEIF 1246 | if (InputImage is TPngImage) or (InputImage is THEIFImage) then 1247 | begin 1248 | Bitmap := TBitmap.Create; 1249 | try 1250 | Bitmap.Width := InputImage.Width; 1251 | Bitmap.Height := InputImage.Height; 1252 | Bitmap.Canvas.Draw(0, 0, InputImage); 1253 | 1254 | // Convert to JPEG 1255 | JPEGImage := TJPEGImage.Create; 1256 | try 1257 | JPEGImage.Assign(Bitmap); // Assign from bitmap instead of direct conversion 1258 | JPEGImage.CompressionQuality := 90; 1259 | JPEGImage.SaveToFile(OutputFileName); 1260 | Result := True; 1261 | finally 1262 | JPEGImage.Free; 1263 | end; 1264 | finally 1265 | Bitmap.Free; 1266 | end; 1267 | end 1268 | else 1269 | begin 1270 | // Direct conversion for other formats 1271 | JPEGImage := TJPEGImage.Create; 1272 | try 1273 | JPEGImage.Assign(InputImage); 1274 | JPEGImage.CompressionQuality := 90; 1275 | JPEGImage.SaveToFile(OutputFileName); 1276 | Result := True; 1277 | finally 1278 | JPEGImage.Free; 1279 | end; 1280 | end; 1281 | except 1282 | on E: Exception do 1283 | raise Exception.CreateFmt('Error converting image: %s', [E.Message]); 1284 | end; 1285 | 1286 | // Clean up 1287 | if not FormatValid then 1288 | raise EInvalidImageFormat.Create('Image format validation failed.'); 1289 | if Assigned(InputImage) then 1290 | InputImage.Free; 1291 | end; 1292 | 1293 | procedure TForm1.CopyPathtoClipboard1Click(Sender: TObject); 1294 | begin 1295 | Clipboard.SetTextBuf(PChar(CurrentDir)); 1296 | end; 1297 | 1298 | procedure TForm1.CreateParams(var Params: TCreateParams); 1299 | begin 1300 | inherited; 1301 | 1302 | Params.WinClassName := 'ExplorerCommandWnd'; 1303 | end; 1304 | 1305 | procedure TForm1.DosCommand1ExecuteError(ASender: TObject; AE: Exception; 1306 | var AHandled: Boolean); 1307 | begin 1308 | if AHandled then 1309 | BCEditor1.Lines.Text := AE.ToString; 1310 | end; 1311 | 1312 | //procedure TForm1.DosCommand1NewChar(ASender: TObject; ANewChar: Char); 1313 | //begin 1314 | // BCEditor1.BeginUpdate; 1315 | // 1316 | // if ANewChar <> #13 then 1317 | // BCEditor1.Text := BCEditor1.Text + ANewChar; 1318 | // 1319 | // BCEditor1.GotoLineAndCenter(BCEditor1.Lines.Count); 1320 | // 1321 | // BCEditor1.EndUpdate; 1322 | // KHexEditor1.ExecuteCommand(ecInsertString, PChar(ANewChar)); 1323 | //end; 1324 | 1325 | procedure TForm1.DosCommand1NewLine(ASender: TObject; const ANewLine: string; 1326 | AOutputType: TOutputType); 1327 | begin 1328 | //// AOutputType := otEntireLine; 1329 | //// BCEditor1.Lines.Add(ANewLine); 1330 | //// BCEditor1.Text := BCEditor1.Text +#13#10+ ANewLine; 1331 | // FCommandOutput.Add(ANewLine); 1332 | // BCEditor1.BeginUpdate; 1333 | // BCEditor1.Lines := FCommandOutput; 1334 | //// KHexEditor1.ExecuteCommand(ecInsertString, PChar(ANewLine)); 1335 | //// BCEditor1.Perform(EM_SCROLL, SB_LINEDOWN, 0); 1336 | // BCEditor1.GotoLineAndCenter(BCEditor1.Lines.Count); 1337 | // BCEditor1.EndUpdate; 1338 | // Application.ProcessMessages; 1339 | 1340 | FSyncLock.Enter; 1341 | try 1342 | FOutputBuffer.Add(ANewLine); 1343 | finally 1344 | FSyncLock.Leave; 1345 | end; 1346 | end; 1347 | 1348 | procedure TForm1.DosCommand1Terminated(Sender: TObject); 1349 | begin 1350 | BCEditor1.Lines.Add('¡Completed process!'); 1351 | ActivityIndicator1.Animate := False; 1352 | ActivityIndicator1.Visible := False; 1353 | // BCEditor1.Lines := FCommandOutput; 1354 | BCEditor1.GotoLineAndCenter(BCEditor1.Lines.Count); 1355 | FCommandOutput.Clear; 1356 | end; 1357 | 1358 | procedure TForm1.DosCommand1TerminateProcess(ASender: TObject; 1359 | var ACanTerminate: Boolean); 1360 | begin 1361 | ACanTerminate := True; 1362 | end; 1363 | 1364 | procedure TForm1.Exit1Click(Sender: TObject); 1365 | begin 1366 | Close; 1367 | end; 1368 | 1369 | procedure TForm1.FlushIcons; 1370 | var 1371 | DesktopFolder: IShellFolder; 1372 | Pidl: PItemIDList; 1373 | begin 1374 | // Get the desktop folder 1375 | SHGetDesktopFolder(DesktopFolder); 1376 | 1377 | // Get the PIDL for the desktop folder 1378 | SHGetSpecialFolderLocation(0, CSIDL_DESKTOP, Pidl); 1379 | 1380 | try 1381 | // Notify the system of the association change 1382 | SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, Pidl, nil); 1383 | finally 1384 | // Free the PIDL 1385 | CoTaskMemFree(Pidl); 1386 | end; 1387 | end; 1388 | 1389 | procedure TForm1.FormCreate(Sender: TObject); 1390 | begin 1391 | 1392 | AllowSetForegroundWindow(GetCurrentProcessId); 1393 | 1394 | if not StartHook then 1395 | begin 1396 | MessageDlg('Couldn''t set global hotkey.',mtError, [mbOK], 0); 1397 | Application.Terminate; 1398 | end; 1399 | 1400 | KeyPreview := True; 1401 | 1402 | ActivityIndicator1.Visible := False; 1403 | 1404 | lstExplorerPath := TStringList.Create; 1405 | lstExplorerWnd := TStringList.Create; 1406 | lstExplorerItem := TStringList.Create; 1407 | 1408 | Application.OnDeactivate := OnFocusLost; 1409 | 1410 | // IShellPreview 1411 | fPreview := nil; 1412 | 1413 | // BCEditor1.Font.Name := 'Consolas'; 1414 | // BCEditor1.Font.Size := 9; 1415 | 1416 | FEnvExecutables := TStringList.Create; 1417 | FEnvStrings := TStringList.Create; 1418 | 1419 | RefreshEnvironmentVariables; 1420 | 1421 | // IAutoComplete 1422 | ButtonedEdit1.ACEnabled := True; 1423 | ButtonedEdit1.ACOptions := [acAutoAppend, acAutoSuggest, acUpDownKeyDropsList]; 1424 | ButtonedEdit1.ACSource := acsList; 1425 | populateCommands; 1426 | 1427 | FCommandOutput := TStringList.Create; 1428 | 1429 | // LibGit2 initialization 1430 | // git_libgit2_init; 1431 | InitLibgit2; 1432 | 1433 | mnuAutoStart.Checked := AppAutoStart1.IsStartupEnabled; 1434 | 1435 | // Speeding up the DOSCommand output 1436 | FOutputBuffer := TStringList.Create; 1437 | FSyncLock := TCriticalSection.Create; 1438 | 1439 | // SetWindowColorModeAsSystem; 1440 | UpdateTheme; 1441 | end; 1442 | 1443 | procedure TForm1.FormDestroy(Sender: TObject); 1444 | begin 1445 | FSyncLock.Free; 1446 | FOutputBuffer.Free; 1447 | 1448 | ShutdownLibgit2; 1449 | // git_libgit2_shutdown; 1450 | 1451 | FEnvStrings.Free; 1452 | FEnvExecutables.Free; 1453 | 1454 | 1455 | DosCommand1.Stop; 1456 | FCommandOutput.Free; 1457 | 1458 | if fPreview <> nil then 1459 | fPreview.Free; 1460 | 1461 | lstExplorerWnd.Free; 1462 | lstExplorerPath.Free; 1463 | lstExplorerItem.Free; 1464 | 1465 | StopHook; 1466 | end; 1467 | 1468 | procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 1469 | begin 1470 | if (key = VK_ESCAPE) and not FPinned then 1471 | Hide; 1472 | end; 1473 | 1474 | procedure TForm1.FormShow(Sender: TObject); 1475 | begin 1476 | ShowWindow(Application.Handle, SW_HIDE); 1477 | 1478 | // if GetForegroundWindow <> Handle then 1479 | // begin 1480 | // SwitchToThisWindow(Handle, ); 1481 | // SetForegroundWindow(Handle); 1482 | // end; 1483 | 1484 | end; 1485 | 1486 | // since Windows 11 22h2 build 22621.2506 new file explorer address bar is available 1487 | // so it should choose the new address bar 1488 | function TForm1.GetExplorerAddressBarRect(AHandle: HWND): TRect; 1489 | var 1490 | ExplorerRect: TRect; 1491 | LWND: HWND; 1492 | begin 1493 | // we assume it is a valid explorer instance before calling this function 1494 | Winapi.Windows.GetWindowRect(AHandle, ExplorerRect); 1495 | 1496 | LWND := FindWindowEx(AHandle, 0, 'WorkerW', nil); 1497 | if LWND > 0 then 1498 | LWND := FindWindowEx(LWND, 0, 'ReBarWindow32', nil); 1499 | if LWND > 0 then 1500 | LWND := FindWindowEx(LWND, 0, 'Address Band Root', nil); 1501 | if LWND > 0 then 1502 | LWND := FindWindowEx(LWND, 0, 'msctls_progress32', nil); 1503 | if LWND > 0 then 1504 | LWND := FindWindowEx(LWND, 0, 'Breadcrumb Parent', nil); 1505 | if LWND > 0 then 1506 | begin 1507 | Winapi.Windows.GetWindowRect(LWND, Result); 1508 | // Result.Width := Width; 1509 | if Result.Width < 600 then 1510 | Result.Width := 600; 1511 | Result.Height := Height; 1512 | end 1513 | else 1514 | begin 1515 | // on newer File Explorer on Windows 11 let's pick the empty area of the 1516 | // Child Class: Microsoft.UI.Content.DesktopChildSiteBridge (top area) 1517 | LWND := FindWindowEx(AHandle, 0, 'Microsoft.UI.Content.DesktopChildSiteBridge', nil); 1518 | if LWND > 0 then 1519 | begin 1520 | var nRect: TRect; 1521 | Winapi.Windows.GetWindowRect(LWND, nRect); 1522 | Result.Width := Width; 1523 | Result.Height := Height; 1524 | Result.Left := ExplorerRect.Left + (ExplorerRect.Width - Result.Width) div 2; 1525 | Result.Top := ExplorerRect.Top + nRect.Height; 1526 | end 1527 | else 1528 | begin 1529 | // it might be a different explorer version, maybe the newer on Windows 11 Insider which changed its address bar position 1530 | Result.Width := Width; 1531 | Result.Height := Height; 1532 | Result.Left := ExplorerRect.Left + (ExplorerRect.Width - Result.Width) div 2; 1533 | Result.Top := ExplorerRect.Top + (ExplorerRect.Height - Height) div 2; 1534 | end; 1535 | end; 1536 | end; 1537 | 1538 | procedure TForm1.KeyEventHandler(var Msg: TMessage); 1539 | var 1540 | I: Integer; 1541 | command: String; 1542 | Ret: Integer; 1543 | 1544 | HActiveWindow: HWND; 1545 | HForegroundThread, HAppThread: DWORD; 1546 | FClientId: DWORD; 1547 | Win11TabContainer: HWND; //TITLE_BAR_SCAFFOLDING_WINDOW_CLASS 1548 | begin 1549 | populateCommands; 1550 | // OutputDebugString(PChar('heehhehe')); 1551 | command := PChar(Msg.LParam); 1552 | lastExplorerHandle := StrToInt(command); 1553 | lastExplorerPath := ''; 1554 | 1555 | if not Visible then 1556 | begin 1557 | ACLShellTreeView1.Visible := False; 1558 | var rct: TRect; 1559 | rct := GetExplorerAddressBarRect(lastExplorerHandle); 1560 | Left := rct.Left; 1561 | Width := rct.Width; 1562 | if Width < 800 then 1563 | Width := 800; 1564 | Top := rct.Top; 1565 | 1566 | // SwitchToThisWindow(GetDesktopWindow, True); 1567 | 1568 | // BorderStyle := bsNone; 1569 | // AnimateWindow(Handle, 128, AW_SLIDE or AW_VER_POSITIVE ); 1570 | // BorderStyle := bsSizeable; 1571 | Show; 1572 | 1573 | HActiveWindow := GetForegroundWindow(); 1574 | HForegroundThread := GetWindowThreadProcessId(HActiveWindow, @FClientId); 1575 | AllowSetForegroundWindow(FClientId); 1576 | 1577 | HAppThread := GetCurrentThreadId; 1578 | 1579 | if not SetForegroundWindow(Handle) then 1580 | SwitchToThisWindow(GetDesktopWindow, True); 1581 | 1582 | // magic part to switch correctly to our window 1583 | if HForegroundThread <> HAppThread then 1584 | begin 1585 | AttachThreadInput(HForegroundThread, HAppThread, True); 1586 | BringWindowToTop(Handle); 1587 | Winapi.Windows.SetFocus(Handle); 1588 | AttachThreadInput(HForegroundThread, HAppThread, False); 1589 | end; 1590 | 1591 | // Winapi.Windows.GetWindowRect(HActiveWindow, rct); 1592 | SetWindowPos(Handle, HWND_TOP, 0, 0, 0, 0, {SWP_ASYNCWINDOWPOS or }SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW); 1593 | 1594 | // let's put out menu in the Explorer window 1595 | // Win11TabContainer := FindWindowEx(HActiveWindow, 0, 'TITLE_BAR_SCAFFOLDING_WINDOW_CLASS', nil); 1596 | // if Win11TabContainer > 0 then 1597 | // begin 1598 | // formHover.Show; 1599 | // var mr: TRect; 1600 | // Winapi.Windows.GetWindowRect(Win11TabContainer, mr); 1601 | // formHover.Left := 0; 1602 | // formHover.Top := 0; 1603 | // formHover.Width := mr.Width; 1604 | // formHover.Height := mr.Height; 1605 | // formHover.BoundsRect := mr; 1606 | // Winapi.Windows.SetParent(formHover.Handle, Win11TabContainer); 1607 | // end; 1608 | 1609 | 1610 | // ButtonedEdit1.SetFocus; 1611 | 1612 | // before listing explorer instances let's see if we are in a open save dialog 1613 | // WorkerW->ReBarWindow32->Address Band Root->msctls_progress32->ComboBoxEx32->ComboBox->Edit 1614 | 1615 | Ret := ListExplorerInstances; 1616 | 1617 | { var FirstPath := IntToStr(Ret); 1618 | StatusBar1.Panels[0].Text := FirstPath; 1619 | } 1620 | 1621 | for I := 0 to lstExplorerWnd.Count - 1 do 1622 | begin 1623 | if lstExplorerWnd[i] = IntToStr(lastExplorerHandle) then 1624 | begin 1625 | lastExplorerPath := lstExplorerPath[I]; 1626 | //rkSmartPath1.Path := lstExplorerPath[I]; 1627 | StatusBar1.Panels[0].Text := lstExplorerItem[i]; 1628 | //WIC 1629 | if FileExists(lstExplorerItem[i]) then 1630 | ShowPreview(lstExplorerItem[i]); 1631 | CurrentFile := lstExplorerItem[i]; 1632 | end; 1633 | end; 1634 | 1635 | if DirectoryExists(StatusBar1.Panels[0].Text) then 1636 | rkSmartPath1.Path := StatusBar1.Panels[0].Text 1637 | else if DirectoryExists(ExtractFilePath(StatusBar1.Panels[0].Text)) then 1638 | begin 1639 | rkSmartPath1.Path := ExtractFilePath(StatusBar1.Panels[0].Text); 1640 | end; 1641 | 1642 | if IsGitRepository(rkSmartPath1.Path) then 1643 | begin 1644 | ButtonedEdit1.LeftButton.ImageIndex := 3 1645 | end 1646 | else 1647 | ButtonedEdit1.LeftButton.ImageIndex := 0; 1648 | 1649 | CurrentDir := rkSmartPath1.Path; 1650 | GitUrl := GetRemoteURL(rkSmartPath1.Path, 'origin'); 1651 | if Pos('http', LowerCase(GitUrl)) = 1 then 1652 | begin 1653 | OpenURL1.Enabled := True; 1654 | pnlTitle.Visible := True; 1655 | LinkLabel1.Caption := 'Repository: ' + GitUrl + ''; 1656 | LinkLabel1.Left := (pnlTitle.Width - LinkLabel1.Width) div 2; 1657 | end 1658 | else 1659 | begin 1660 | OpenURL1.Enabled := False; 1661 | pnlTitle.Visible := False; 1662 | end; 1663 | 1664 | // BCEditor1.Lines.Add(gurl); 1665 | end 1666 | else 1667 | begin 1668 | // SwitchToThisWindow(Handle, True); 1669 | Hide; 1670 | end; 1671 | end; 1672 | 1673 | procedure TForm1.KeyEventHandlerAll(var Msg: TMessage); 1674 | var 1675 | I: Integer; 1676 | command: String; 1677 | Ret: Integer; 1678 | 1679 | HActiveWindow: HWND; 1680 | HForegroundThread, HAppThread: DWORD; 1681 | FClientId: DWORD; 1682 | 1683 | begin 1684 | // OutputDebugString(PChar('heehhehe')); 1685 | command := PChar(Msg.LParam); 1686 | lastExplorerHandle := StrToInt(command); 1687 | lastExplorerPath := ''; 1688 | 1689 | if not Visible then 1690 | begin 1691 | ACLShellTreeView1.Visible := False; 1692 | // SwitchToThisWindow(GetDesktopWindow, True); 1693 | Show; 1694 | HActiveWindow := GetForegroundWindow(); 1695 | // UpdateMainMenu(lastExplorerHandle); 1696 | HForegroundThread := GetWindowThreadProcessId(HActiveWindow, @FClientId); 1697 | AllowSetForegroundWindow(FClientId); 1698 | 1699 | HAppThread := GetCurrentThreadId; 1700 | 1701 | if not SetForegroundWindow(Handle) then 1702 | SwitchToThisWindow(GetDesktopWindow, True); 1703 | 1704 | 1705 | 1706 | // magic part to switch correctly to our window 1707 | if HForegroundThread <> HAppThread then 1708 | begin 1709 | AttachThreadInput(HForegroundThread, HAppThread, True); 1710 | BringWindowToTop(Handle); 1711 | Winapi.Windows.SetFocus(Handle); 1712 | AttachThreadInput(HForegroundThread, HAppThread, False); 1713 | end; 1714 | 1715 | var rct: TRect; 1716 | Winapi.Windows.GetWindowRect(HActiveWindow, rct); 1717 | SetWindowPos(Handle, HWND_TOP, 0, 0, 0, 0, {SWP_ASYNCWINDOWPOS or }SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW); 1718 | // center to current window, otherwise to monitors 1719 | var nLeft := rct.Left + (rct.Width - Width) div 2; 1720 | var nTop := rct.Top + (rct.Height - Height) div 2; 1721 | if nLeft < 0 then 1722 | Left := (Screen.Width - Width) div 2 1723 | else 1724 | Left := nLeft; 1725 | if nTop < 0 then 1726 | Top := (Screen.Height - Height) div 2 1727 | else 1728 | Top := nTop; 1729 | 1730 | // ButtonedEdit1.SetFocus; 1731 | 1732 | // before listing explorer instances let's see if we are in a open save dialog 1733 | // WorkerW->ReBarWindow32->Address Band Root->msctls_progress32->ComboBoxEx32->ComboBox->Edit 1734 | 1735 | Ret := ListExplorerInstances; 1736 | 1737 | { var FirstPath := IntToStr(Ret); 1738 | StatusBar1.Panels[0].Text := FirstPath; 1739 | } 1740 | 1741 | for I := 0 to lstExplorerWnd.Count - 1 do 1742 | begin 1743 | if lstExplorerWnd[i] = IntToStr(lastExplorerHandle) then 1744 | begin 1745 | lastExplorerPath := lstExplorerPath[I]; 1746 | //rkSmartPath1.Path := lstExplorerPath[I]; 1747 | StatusBar1.Panels[0].Text := lstExplorerItem[i]; 1748 | //WIC 1749 | if FileExists(lstExplorerItem[i]) then 1750 | ShowPreview(lstExplorerItem[i]); 1751 | CurrentFile := lstExplorerItem[i]; 1752 | end; 1753 | end; 1754 | 1755 | if DirectoryExists(StatusBar1.Panels[0].Text) then 1756 | rkSmartPath1.Path := StatusBar1.Panels[0].Text 1757 | else if DirectoryExists(ExtractFilePath(StatusBar1.Panels[0].Text)) then 1758 | begin 1759 | rkSmartPath1.Path := ExtractFilePath(StatusBar1.Panels[0].Text); 1760 | end; 1761 | 1762 | if IsGitRepository(rkSmartPath1.Path) then 1763 | begin 1764 | ButtonedEdit1.LeftButton.ImageIndex := 3 1765 | end 1766 | else 1767 | ButtonedEdit1.LeftButton.ImageIndex := 0; 1768 | 1769 | CurrentDir := rkSmartPath1.Path; 1770 | GitUrl := GetRemoteURL(rkSmartPath1.Path, 'origin'); 1771 | if Pos('http', LowerCase(GitUrl)) = 1 then 1772 | OpenURL1.Enabled := True 1773 | else 1774 | OpenURL1.Enabled := False; 1775 | 1776 | // BCEditor1.Lines.Add(gurl); 1777 | end 1778 | else 1779 | begin 1780 | // SwitchToThisWindow(Handle, True); 1781 | Hide; 1782 | end; 1783 | end; 1784 | 1785 | procedure TForm1.KeyEventPickPaths(var Msg: TMessage); 1786 | var 1787 | I: Integer; 1788 | command: String; 1789 | Ret: Integer; 1790 | 1791 | HActiveWindow: HWND; 1792 | HForegroundThread, HAppThread: DWORD; 1793 | FClientId: DWORD; 1794 | 1795 | begin 1796 | command := PChar(Msg.LParam); 1797 | lastExplorerHandle := StrToInt(command); 1798 | lastExplorerPath := ''; 1799 | 1800 | if not Visible then 1801 | begin 1802 | Show; 1803 | HActiveWindow := GetForegroundWindow(); 1804 | HForegroundThread := GetWindowThreadProcessId(HActiveWindow, @FClientId); 1805 | AllowSetForegroundWindow(FClientId); 1806 | 1807 | HAppThread := GetCurrentThreadId; 1808 | 1809 | if not SetForegroundWindow(Handle) then 1810 | SwitchToThisWindow(GetDesktopWindow, True); 1811 | 1812 | // magic part to switch correctly to our window 1813 | if HForegroundThread <> HAppThread then 1814 | begin 1815 | AttachThreadInput(HForegroundThread, HAppThread, True); 1816 | BringWindowToTop(Handle); 1817 | Winapi.Windows.SetFocus(Handle); 1818 | AttachThreadInput(HForegroundThread, HAppThread, False); 1819 | end; 1820 | 1821 | var rct: TRect; 1822 | Winapi.Windows.GetWindowRect(HActiveWindow, rct); 1823 | SetWindowPos(Handle, HWND_TOP, 0, 0, 0, 0, {SWP_ASYNCWINDOWPOS or }SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW); 1824 | // center to current window, otherwise to monitors 1825 | var nLeft := rct.Left + (rct.Width - Width) div 2; 1826 | var nTop := rct.Top + (rct.Height - Height) div 2; 1827 | if nLeft < 0 then 1828 | Left := (Screen.Width - Width) div 2 1829 | else 1830 | Left := nLeft; 1831 | if nTop < 0 then 1832 | Top := (Screen.Height - Height) div 2 1833 | else 1834 | Top := nTop; 1835 | 1836 | Ret := ListExplorerInstances; 1837 | 1838 | for I := 0 to lstExplorerWnd.Count - 1 do 1839 | begin 1840 | if lstExplorerWnd[i] = IntToStr(lastExplorerHandle) then 1841 | begin 1842 | lastExplorerPath := lstExplorerPath[I]; 1843 | StatusBar1.Panels[0].Text := lstExplorerItem[i]; 1844 | if FileExists(lstExplorerItem[i]) then 1845 | ShowPreview(lstExplorerItem[i]); 1846 | CurrentFile := lstExplorerItem[i]; 1847 | end; 1848 | end; 1849 | 1850 | if DirectoryExists(StatusBar1.Panels[0].Text) then 1851 | rkSmartPath1.Path := StatusBar1.Panels[0].Text 1852 | else if DirectoryExists(ExtractFilePath(StatusBar1.Panels[0].Text)) then 1853 | begin 1854 | rkSmartPath1.Path := ExtractFilePath(StatusBar1.Panels[0].Text); 1855 | end; 1856 | 1857 | if IsGitRepository(rkSmartPath1.Path) then 1858 | begin 1859 | ButtonedEdit1.LeftButton.ImageIndex := 3 1860 | end 1861 | else 1862 | ButtonedEdit1.LeftButton.ImageIndex := 0; 1863 | 1864 | CurrentDir := rkSmartPath1.Path; 1865 | GitUrl := GetRemoteURL(rkSmartPath1.Path, 'origin'); 1866 | if Pos('http', LowerCase(GitUrl)) = 1 then 1867 | OpenURL1.Enabled := True 1868 | else 1869 | OpenURL1.Enabled := False; 1870 | 1871 | // Show file/folder picker 1872 | ACLShellTreeView1.Visible := True; 1873 | ACLShellTreeView1.SetFocus; 1874 | 1875 | end 1876 | else 1877 | begin 1878 | Hide; 1879 | end; 1880 | end; 1881 | 1882 | 1883 | var 1884 | ChildEditHwnd: HWND = 0; 1885 | function EnumChildEditProc(ChildWnd: HWND; lParam: LPARAM): BOOL; stdcall; 1886 | var 1887 | ClassName: PChar; 1888 | Buffer: array[0..255] of Char; 1889 | LWnd: HWND; 1890 | begin 1891 | GetClassName(ChildWnd, Buffer, SizeOf(Buffer) div SizeOf(Char)); 1892 | ClassName := PChar(lParam); 1893 | 1894 | // If the class name matches, return the window handle 1895 | if CompareText(Buffer, ClassName) = 0 then 1896 | begin 1897 | // We now need to find if a 'ComboBox' classname child exists with a child with classname 'Edit', which is the Filename Edit box 1898 | LWnd := FindWindowEx(ChildWnd, 0, 'ComboBox', nil); 1899 | if LWnd <> 0 then 1900 | begin 1901 | ChildEditHwnd := LWnd; 1902 | LWnd := FindWindowEx(LWnd, 0, 'Edit', nil); 1903 | if LWnd <> 0 then 1904 | begin 1905 | Result := FALSE; // Found a matching control 1906 | Exit; 1907 | end 1908 | else 1909 | ChildEditHwnd := 0; 1910 | end; 1911 | end; 1912 | Result := TRUE; // Continue enumeration 1913 | end; 1914 | 1915 | procedure TForm1.KeyEventUpdatePath(var Msg: TMessage); 1916 | var 1917 | I: Integer; 1918 | command: String; 1919 | Ret: Integer; 1920 | 1921 | HActiveWindow: HWND; 1922 | HForegroundThread, HAppThread: DWORD; 1923 | FClientId: DWORD; 1924 | AppClassName: array[0..255] of char; 1925 | CtrlPressed, AltPressed, UpArrowPressed: Boolean; 1926 | begin 1927 | if not DirectoryExists(CurrentDir) then Exit; 1928 | 1929 | ACLShellTreeView1.Visible := False; 1930 | 1931 | command := PChar(Msg.LParam); 1932 | lastExplorerHandle := StrToInt(command); 1933 | lastExplorerPath := ''; 1934 | 1935 | HActiveWindow := GetForegroundWindow(); 1936 | GetClassName(HActiveWindow, AppClassName, 255); 1937 | // ShowMessage(AppClassName); 1938 | if AppClassName = '#32770' then 1939 | begin 1940 | //Winapi.Windows.Beep(400,1000); // annoying sound while the user release the hotkey to proceed 1941 | repeat 1942 | CtrlPressed := GetAsyncKeyState(VK_CONTROL) < 0; 1943 | AltPressed := GetAsyncKeyState(VK_MENU) < 0; 1944 | 1945 | // Sleep to prevent high CPU usage while waiting 1946 | Sleep(10); 1947 | until not CtrlPressed and not AltPressed; // Wait until both Ctrl and Alt are released 1948 | // Step 1: Press down the Ctrl key (KEYEVENTF_KEYDOWN) 1949 | keybd_event(VK_CONTROL, 0, 0, 0); 1950 | 1951 | // Step 2: Press down the L key (KEYEVENTF_KEYDOWN) 1952 | keybd_event(Ord('L'), 0, 0, 0); 1953 | 1954 | // Step 3: Release the L key (KEYEVENTF_KEYUP) 1955 | keybd_event(Ord('L'), 0, KEYEVENTF_KEYUP, 0); 1956 | 1957 | // Step 4: Release the Ctrl key (KEYEVENTF_KEYUP) 1958 | keybd_event(VK_CONTROL, 0, KEYEVENTF_KEYUP, 0); 1959 | 1960 | // Find the Directory Path Edit Box 1961 | var edFolder := FindWindowEx(HActiveWindow, 0, 'WorkerW', nil); 1962 | if edFolder <> 0 then 1963 | edFolder := FindWindowEx(edFolder, 0, 'ReBarWindow32', nil); 1964 | if edFolder <> 0 then 1965 | edFolder := FindWindowEx(edFolder, 0, 'Address Band Root', nil); 1966 | if edFolder <> 0 then 1967 | edFolder := FindWindowEx(edFolder, 0, 'msctls_progress32', nil); 1968 | if edFolder <> 0 then 1969 | edFolder := FindWindowEx(edFolder, 0, 'ComboBoxEx32', nil); 1970 | if edFolder <> 0 then 1971 | edFolder := FindWindowEx(edFolder, 0, 'ComboBox', nil); 1972 | if edFolder <> 0 then 1973 | edFolder := FindWindowEx(edFolder, 0, 'Edit', nil); 1974 | if edFolder <> 0 then 1975 | begin 1976 | SendMessage(edFolder, WM_SETTEXT, 0, LPARAM(PChar(CurrentDir))); 1977 | //Winapi.Windows.SetFocus(edFolder); 1978 | PostMessage(edFolder, WM_SETFOCUS, 0, 0); 1979 | keybd_event(VK_RETURN, 0, 0, 0); 1980 | // Step 4: Release the Ctrl key (KEYEVENTF_KEYUP) 1981 | keybd_event(VK_RETURN, 0, KEYEVENTF_KEYUP, 0); 1982 | end; 1983 | 1984 | Sleep(100); // it seems to be required as sometimes changing directory fails 1985 | // find the Filename Edit Box in Open Dialog 1986 | var edFilename := FindWindowEx(HActiveWindow, 0, 'ComboBoxEx32', nil); 1987 | if edFilename <> 0 then 1988 | begin 1989 | PostMessage(edFilename, WM_SETFOCUS, 0, 0); 1990 | edFilename := FindWindowEx(edFilename, 0, 'ComboBox', nil); 1991 | if edFilename <> 0 then 1992 | edFilename := FindWindowEx(edFilename, 0, 'Edit', nil); 1993 | if edFilename <> 0 then 1994 | begin 1995 | //SendMessage(edFilename, WM_SETTEXT, 0, LPARAM(PChar(CurrentDir))); 1996 | // these won't work directly, its parent ComboBoxEx32 is enough 1997 | //Winapi.Windows.SetFocus(edFilename); // SetFocus seems not to work 1998 | //PostMessage(edFilename, WM_SETFOCUS, 0, 0); // This might work, but as said above, its parent is the key to focus 1999 | end; 2000 | 2001 | end 2002 | // find the Filename Edit Box in Save Dialog 2003 | else 2004 | begin 2005 | edFilename := FindWindowEx(HActiveWindow, 0, 'DUIViewWndClassName', nil); 2006 | if edFilename <> 0 then 2007 | edFilename := FindWindowEx(edFilename, 0, 'DirectUIHWND', nil); 2008 | if edFilename <> 0 then 2009 | // there are other FloatNotifySink, we need to use EnumChildWindows 2010 | EnumChildWindows(edFilename, @EnumChildEditProc, LPARAM(PChar('FloatNotifySink'))); // updates global ChildEditHwnd variable if ComboBox is found inside 2011 | //edFilename := FindWindowEx(edFilename, 0, 'FloatNotifySink', nil); // this way only finds the first one that holds the Save button, which we won't want 2012 | if ChildEditHwnd <> 0 then 2013 | //edFilename := FindWindowEx(edFilename, 0, 'ComboBox', nil); 2014 | edFilename := ChildEditHwnd; 2015 | SendMessage(edFilename, WM_SETFOCUS, 0, 0); 2016 | // if edFilename <> 0 then 2017 | // edFilename := FindWindowEx(edFilename, 0, 'Edit', nil); 2018 | // if edFilename <> 0 then 2019 | // begin 2020 | // //SendMessage(edFilename, WM_SETTEXT, 0, LPARAM(PChar(CurrentDir))); 2021 | // end; 2022 | end; 2023 | end; 2024 | exit; 2025 | 2026 | HForegroundThread := GetWindowThreadProcessId(HActiveWindow, @FClientId); 2027 | AllowSetForegroundWindow(FClientId); 2028 | 2029 | HAppThread := GetCurrentThreadId; 2030 | 2031 | Ret := ListExplorerInstances; 2032 | 2033 | 2034 | for I := 0 to lstExplorerWnd.Count - 1 do 2035 | begin 2036 | if lstExplorerWnd[i] = IntToStr(lastExplorerHandle) then 2037 | begin 2038 | lastExplorerPath := lstExplorerPath[I]; 2039 | StatusBar1.Panels[0].Text := lstExplorerItem[i]; 2040 | 2041 | if FileExists(lstExplorerItem[i]) then 2042 | ShowPreview(lstExplorerItem[i]); 2043 | CurrentFile := lstExplorerItem[i]; 2044 | end; 2045 | end; 2046 | 2047 | if DirectoryExists(StatusBar1.Panels[0].Text) then 2048 | rkSmartPath1.Path := StatusBar1.Panels[0].Text 2049 | else if DirectoryExists(ExtractFilePath(StatusBar1.Panels[0].Text)) then 2050 | begin 2051 | rkSmartPath1.Path := ExtractFilePath(StatusBar1.Panels[0].Text); 2052 | end; 2053 | 2054 | CurrentDir := rkSmartPath1.Path; 2055 | end; 2056 | 2057 | // Lists explorer instances which has items visible, ignores special directories 2058 | procedure TForm1.LinkLabel1LinkClick(Sender: TObject; const Link: string; 2059 | LinkType: TSysLinkType); 2060 | begin 2061 | if LinkType = sltURL then 2062 | begin 2063 | ShellExecute(0, 'OPEN', PChar(Link), nil, nil, SW_NORMAL); 2064 | end; 2065 | end; 2066 | 2067 | procedure TForm1.ListBox1DblClick(Sender: TObject); 2068 | begin 2069 | Hide; 2070 | SwitchToThisWindow(StrToInt(lstExplorerWnd[ListBox1.ItemIndex]), True); 2071 | end; 2072 | 2073 | procedure TForm1.ListBox1KeyUp(Sender: TObject; var Key: Word; 2074 | Shift: TShiftState); 2075 | begin 2076 | if Key = 13 then 2077 | begin 2078 | Hide; 2079 | // SwitchToThisWindow(StrToInt(lstExplorerWnd[ListBox1.ItemIndex]), True); 2080 | SwitchToWindow(StrToInt(lstExplorerWnd[ListBox1.ItemIndex])); 2081 | ListBox1.Visible := False; 2082 | end; 2083 | end; 2084 | 2085 | function GetSpecialFolderPath(const FolderID: Integer): string; 2086 | var 2087 | ShellFolder: IShellFolder; 2088 | IDList: PItemIDList; 2089 | StrRet: TStrRet; 2090 | FolderPath: array [0..MAX_PATH] of Char; 2091 | begin 2092 | Result := ''; 2093 | 2094 | if Succeeded(SHGetSpecialFolderLocation(0, FolderID, IDList)) then 2095 | begin 2096 | if Succeeded(SHGetDesktopFolder(ShellFolder)) then 2097 | begin 2098 | if Succeeded(ShellFolder.GetDisplayNameOf(IDList, SHGDN_FORPARSING, StrRet)) then 2099 | begin 2100 | if StrRet.uType = STRRET_WSTR then 2101 | begin 2102 | OleStrToStrVar(StrRet.pOleStr, Result); 2103 | CoTaskMemFree(StrRet.pOleStr); 2104 | end 2105 | else 2106 | begin 2107 | // FIXLATER 2108 | // StrRetToStr(StrRet, IDList, FolderPath, SizeOf(FolderPath)); 2109 | Result := FolderPath; 2110 | end; 2111 | end; 2112 | end; 2113 | 2114 | CoTaskMemFree(IDList); 2115 | end; 2116 | end; 2117 | 2118 | function TForm1.ListExplorerInstances: Integer; 2119 | const 2120 | IID_IServiceProvider: TGUID = '{6D5140C1-7436-11CE-8034-00AA006009FA}'; 2121 | SID_STopLevelBrowser: TGUID = '{4C96BE40-915C-11CF-99D3-00AA004AE837}'; 2122 | LOOPTIME = 500; //ms i.e. half a second 2123 | var 2124 | ShellWindows: IShellWindows; 2125 | I: Integer; 2126 | ShellBrowser: IShellBrowser; 2127 | WndIface: IDispatch; 2128 | WebBrowserApp: IWebBrowserApp; 2129 | ServiceProvider: IServiceProvider; 2130 | ItemIDList, ItemIDList2: PItemIDList; 2131 | bar: HWND; 2132 | ShellView: IShellView; 2133 | FolderView: IFolderView; 2134 | PersistFolder2: IPersistFolder2; 2135 | ShellFolder: IShellFolder; 2136 | focus: Integer; 2137 | ret: _STRRET; 2138 | folderPath: PChar; 2139 | AMalloc: IMalloc; 2140 | hr: HRESULT; 2141 | CurTime: Int64; 2142 | // Thumbnail 2143 | // ItemIDList3: PItemIDList; 2144 | // Thumbnail: IExtractImage; 2145 | // ThumbBuf: array[0..MAX_PATH] of Char; 2146 | // Runnable: IRunnableTask; 2147 | // Flags, Priority: DWORD; 2148 | // BmpHandle: HBITMAP; 2149 | // ASize: TSize; 2150 | // GetLocationRes: HRESULT; 2151 | begin 2152 | Result := 0; 2153 | lstExplorerPath.BeginUpdate; 2154 | lstExplorerPath.Clear; 2155 | lstExplorerWnd.BeginUpdate; 2156 | lstExplorerWnd.Clear; 2157 | lstExplorerItem.BeginUpdate; 2158 | lstExplorerItem.Clear; 2159 | 2160 | hr := CoInitializeEx(nil, COINIT_APARTMENTTHREADED); // <-- manually call CoInitialize() 2161 | if Succeeded(hr) then 2162 | begin 2163 | 2164 | // this might fail on first try, so let's insist for LOOPTIME ms 2165 | hr := CoCreateInstance(CLASS_ShellWindows, nil, CLSCTX_ALL, 2166 | IID_IShellWindows, ShellWindows); 2167 | CurTime := GetTickCount64; 2168 | while not Succeeded(hr) do 2169 | begin 2170 | if ((GetTickCount64-CurTime)>LOOPTIME) then break; 2171 | hr := CoCreateInstance(CLASS_ShellWindows, nil, CLSCTX_ALL, 2172 | IID_IShellWindows, ShellWindows); 2173 | end; 2174 | 2175 | if Succeeded(hr) then 2176 | begin 2177 | Result := 1; 2178 | for I := 0 to ShellWindows.Count - 1 do 2179 | begin 2180 | if VarType(ShellWindows.Item(I)) = varDispatch then 2181 | begin 2182 | WndIface := ShellWindows.Item(VarAsType(I, VT_I4)); 2183 | if WndIface <> nil then 2184 | try 2185 | if Succeeded(WndIface.QueryInterface(IID_IWebBrowserApp, WebBrowserApp)) then 2186 | begin 2187 | lstExplorerWnd.Add(inttostr(WebBrowserApp.HWND)); 2188 | 2189 | begin 2190 | if Succeeded(WebBrowserApp.QueryInterface(IID_IServiceProvider, 2191 | ServiceProvider)) then 2192 | begin 2193 | if Succeeded(ServiceProvider.QueryService(SID_STopLevelBrowser, 2194 | IID_IShellBrowser, ShellBrowser)) then 2195 | begin 2196 | if Succeeded(ShellBrowser.QueryActiveShellView(ShellView)) then 2197 | begin 2198 | if Succeeded(ShellView.QueryInterface(IID_IFolderView, FolderView)) then 2199 | begin 2200 | FolderView.GetFocusedItem(focus); 2201 | FolderView.Item(focus,ItemIDList); 2202 | if Succeeded(FolderView.GetFolder(IID_IPersistFolder2, PersistFolder2)) then 2203 | begin 2204 | if succeeded(PersistFolder2.GetCurFolder(ItemIDList2)) then 2205 | begin 2206 | // mmmm 2207 | { if (ItemIDList <> nil) 2208 | and Succeeded(ShellFolder.GetDisplayNameOf(ItemIDList, SHGDN_FORPARSING, Ret)) 2209 | then 2210 | begin 2211 | case Ret.uType of 2212 | STRRET_WSTR: 2213 | begin 2214 | // FolderPath := StrPas(Ret.pOleStr); 2215 | CoTaskMemFree(Ret.pOleStr); 2216 | end; 2217 | STRRET_CSTR: 2218 | begin 2219 | // FolderPath := Ret.cStr; 2220 | end; 2221 | STRRET_OFFSET: 2222 | begin 2223 | FolderPath := PChar(Integer(ItemIDList) + Ret.uOffset); 2224 | end 2225 | else 2226 | FolderPath := ' '; 2227 | end; 2228 | end;} 2229 | 2230 | folderPath := StrAlloc(MAX_PATH); 2231 | if SHGetPathFromIDList(ItemIDList2, folderPath) then 2232 | lstExplorerPath.Add(folderPath); 2233 | SHGetMalloc(AMalloc); 2234 | AMalloc.Free(ItemIDList2); 2235 | StrDispose(folderPath); 2236 | end; 2237 | 2238 | if Succeeded(PersistFolder2.QueryInterface(IID_IShellFolder, ShellFolder)) then 2239 | begin 2240 | if (ItemIDList <> nil) and Succeeded(ShellFolder.GetDisplayNameOf(ItemIDList, SHGDN_FORPARSING, ret)) then 2241 | lstExplorerItem.Add(ret.pOleStr) 2242 | else 2243 | lstExplorerItem.Add('no name'); 2244 | end; 2245 | 2246 | // //extract thumbnail 2247 | // if Succeeded(ShellFolder.GetUIObjectOf(0, 1, ItemIDList3, IExtractImage, nil, Thumbnail)) then 2248 | // begin 2249 | // CoTaskMemFree(ItemIDList3); 2250 | // 2251 | // if Assigned(Thumbnail) then 2252 | // begin 2253 | // Runnable := nil; 2254 | // ASize.cx := 256; 2255 | // ASize.cy := 256; 2256 | // Priority := 0; 2257 | // Flags := IEIFLAG_ASPECT or IEIFLAG_OFFLINE or IEIFLAG_CACHE or IEIFLAG_QUALITY; 2258 | // GetLocationRes := Thumbnail.GetLocation(ThumbBuf, SizeOf(ThumbBuf), Priority, ASize, 32, Flags); 2259 | // if (GetLocationRes = NOERROR) or (GetLocationRes = E_PENDING) then 2260 | // begin 2261 | // if GetLocationRes = E_PENDING then 2262 | // if Thumbnail.QueryInterface(IRunnableTask, Runnable) <> S_OK then 2263 | // Runnable := nil; 2264 | // try 2265 | // Thumbnail.Extract(BmpHandle); 2266 | // Image1.Picture.Bitmap.Handle := BmpHandle; 2267 | // except 2268 | // on E: EOleSysError do 2269 | // OutputDebugString(PChar(string(E.ClassName) + ': ' + E.Message)); 2270 | // end; 2271 | // end; 2272 | // end; 2273 | // end; 2274 | end; 2275 | end; 2276 | end; 2277 | 2278 | end; 2279 | 2280 | end; 2281 | end; 2282 | // make sure the other lists are even to found explorer 2283 | if lstExplorerWnd.Count > lstExplorerPath.Count then 2284 | lstExplorerPath.Add(''); 2285 | if lstExplorerWnd.Count > lstExplorerItem.Count then 2286 | lstExplorerPath.Add(''); 2287 | end; 2288 | except 2289 | end; 2290 | end; 2291 | 2292 | end; 2293 | 2294 | end; 2295 | end; 2296 | CoUninitialize; // <-- free memory 2297 | lstExplorerItem.EndUpdate; 2298 | lstExplorerWnd.EndUpdate; 2299 | lstExplorerPath.EndUpdate; 2300 | end; 2301 | 2302 | procedure TForm1.mnuAutoStartClick(Sender: TObject); 2303 | begin 2304 | mnuAutoStart.Checked := not mnuAutoStart.Checked; 2305 | AppAutoStart1.Enabled := mnuAutoStart.Checked; 2306 | end; 2307 | 2308 | procedure TForm1.NoBorder(var Msg: TWMNCActivate); 2309 | begin 2310 | Msg.Active := False; 2311 | inherited; 2312 | end; 2313 | 2314 | procedure TForm1.OnFocusLost(Sender: TObject); 2315 | begin 2316 | EsImage1.Picture.Assign(nil); 2317 | 2318 | StatusBar1.Panels[0].Text := ''; 2319 | if not FPinned then 2320 | Hide; 2321 | end; 2322 | 2323 | procedure TForm1.OpenURL1Click(Sender: TObject); 2324 | begin 2325 | ShellExecute(0, 'OPEN', PChar(GitUrl), nil, nil, SW_SHOWNORMAL); 2326 | end; 2327 | 2328 | procedure TForm1.populateCommands; 2329 | begin 2330 | FCommandType := ctNormal; 2331 | 2332 | with ButtonedEdit1.ACStrings do 2333 | begin 2334 | BeginUpdate; 2335 | Clear; 2336 | Add('>'); 2337 | Add(':'); 2338 | Add('%'); 2339 | Add('help'); 2340 | Add('exit'); 2341 | Add('find'); 2342 | Add('open'); 2343 | Add('cmd'); 2344 | Add('env'); 2345 | Add('dir'); 2346 | if OpenURL1.Enabled then 2347 | begin 2348 | Add('git'); 2349 | Add('git-pull'); // git pull 2350 | Add('gp'); 2351 | Add('git-readme'); // git readme 2352 | Add('gr'); 2353 | Add('git-url'); // git url 2354 | Add('gu'); 2355 | end; 2356 | Add('cls'); 2357 | Add('listexplorers'); 2358 | Add('list'); 2359 | Add('center'); 2360 | Add('cmd'); 2361 | Add('hexview'); 2362 | Add('preview'); 2363 | Add('tojpg'); 2364 | EndUpdate; 2365 | end; 2366 | end; 2367 | 2368 | procedure TForm1.populateEnvExecutables; 2369 | var 2370 | Envs, Env : PChar; 2371 | PathList: TStringList; 2372 | Path: string; 2373 | SR: TSearchRec; 2374 | FilePath: string; 2375 | I: Integer; 2376 | begin 2377 | ButtonedEdit1.ACStrings.BeginUpdate; 2378 | ButtonedEdit1.ACStrings.Clear; 2379 | 2380 | if FEnvExecutables.Count < 1 then 2381 | begin 2382 | Envs := GetEnvironmentStrings; 2383 | PathList := TStringList.Create; 2384 | try 2385 | Env := Envs; 2386 | while Env^ <> #0 do 2387 | begin 2388 | if Pos('PATH=', WideCharToString(Env)) = 1 then 2389 | PathList.DelimitedText := StringReplace(WideCharToString(Env), 'PATH=', '', []); 2390 | Env := Env + StrLen(Env) + 1; 2391 | end; 2392 | 2393 | for Path in PathList do 2394 | begin 2395 | FilePath := IncludeTrailingPathDelimiter(Path); 2396 | 2397 | if not DirectoryExists(FilePath) then Continue; 2398 | 2399 | if FindFirst(FilePath + '*.cmd', faAnyFile, SR) = 0 then 2400 | begin 2401 | repeat 2402 | FEnvExecutables.Add(FilePath + SR.Name); 2403 | ButtonedEdit1.ACStrings.Add(FilePath + SR.Name); 2404 | until FindNext(SR) <> 0; 2405 | FindClose(SR); 2406 | end; 2407 | if FindFirst(FilePath + '*.bat', faAnyFile, SR) = 0 then 2408 | begin 2409 | repeat 2410 | FEnvExecutables.Add(FilePath + SR.Name); 2411 | ButtonedEdit1.ACStrings.Add(FilePath + SR.Name); 2412 | until FindNext(SR) <> 0; 2413 | FindClose(SR); 2414 | end; 2415 | if FindFirst(FilePath + '*.exe', faAnyFile, SR) = 0 then 2416 | begin 2417 | repeat 2418 | FEnvExecutables.Add(FilePath + SR.Name); 2419 | ButtonedEdit1.ACStrings.Add(FilePath + SR.Name); 2420 | until FindNext(SR) <> 0; 2421 | FindClose(SR); 2422 | end; 2423 | 2424 | end; 2425 | 2426 | finally 2427 | FreeEnvironmentStringsW(Envs); 2428 | PathList.Free; 2429 | end; 2430 | end 2431 | else 2432 | begin 2433 | for I := 0 to FEnvExecutables.Count - 1 do 2434 | begin 2435 | ButtonedEdit1.ACStrings.Add(FEnvExecutables[I]); 2436 | end; 2437 | end; 2438 | 2439 | ButtonedEdit1.ACStrings.EndUpdate; 2440 | 2441 | end; 2442 | 2443 | procedure TForm1.populateEnvironmentStrings; 2444 | var 2445 | Envs, Env : PChar; 2446 | begin 2447 | FCommandType := ctEnvironment; 2448 | 2449 | ButtonedEdit1.ACStrings.BeginUpdate; 2450 | ButtonedEdit1.ACStrings.Clear; 2451 | 2452 | Envs := GetEnvironmentStrings; 2453 | try 2454 | Env := Envs; 2455 | while Env^ <> #0 do 2456 | begin 2457 | ButtonedEdit1.ACStrings.Add(Env); 2458 | Env := Env + StrLen(Env) + 1; 2459 | end; 2460 | finally 2461 | FreeEnvironmentStrings(Envs); 2462 | end; 2463 | 2464 | ButtonedEdit1.ACStrings.EndUpdate; 2465 | end; 2466 | 2467 | procedure TForm1.populateMyFolders; 2468 | begin 2469 | with ButtonedEdit1.ACStrings do 2470 | begin 2471 | BeginUpdate; 2472 | Clear; 2473 | Add('Dir=L:\Proyectos'); 2474 | Add('Dir=F:\Components'); 2475 | Add('Dir=L:\FreepascalProjects'); 2476 | Add('Dir=F:\Projects'); 2477 | Add('Dir=O:\Projects'); 2478 | EndUpdate; 2479 | end; 2480 | end; 2481 | 2482 | procedure TForm1.ProcessDosCommand(Sender: TObject; ACommand: string; terminateCurrent: Boolean = False); 2483 | begin 2484 | if DosCommand1.IsRunning and terminateCurrent then 2485 | begin 2486 | DosCommand1.Stop; 2487 | end 2488 | else if DosCommand1.IsRunning and not terminateCurrent then 2489 | begin 2490 | if MessageDlg('A previous command is processing!'#13#10'Shoul I kill it?', TMsgDlgType.mtWarning, mbYesNo, 0) = mrYes then 2491 | begin 2492 | DosCommand1.Stop; 2493 | end; 2494 | end; 2495 | 2496 | if not DosCommand1.IsRunning then 2497 | begin 2498 | try 2499 | DosCommand1.InputToOutput := False; 2500 | 2501 | DosCommand1.CommandLine := ACommand; 2502 | DosCommand1.Execute; 2503 | ActivityIndicator1.Visible := True; 2504 | ActivityIndicator1.Animate := DosCommand1.IsRunning; 2505 | except 2506 | on e:ECreateProcessError do 2507 | begin 2508 | 2509 | end; 2510 | end; 2511 | end; 2512 | end; 2513 | 2514 | procedure TForm1.Show1Click(Sender: TObject); 2515 | begin 2516 | Show; 2517 | end; 2518 | 2519 | function TForm1.ShowPreview(const FileName: string): Boolean; 2520 | var 2521 | wicImg: TWICImage; 2522 | wicList: IWICImagingFactory; 2523 | hr: HRESULT; 2524 | list: IEnumUnknown; 2525 | vInt: IUnknown; 2526 | decoder: IWICBitmapDecoderInfo; 2527 | vBuf: array[0..255] of Char; 2528 | vLen: UINT; 2529 | friendlyName: string; 2530 | fileext: string; 2531 | begin 2532 | 2533 | {CoInitialize(nil); 2534 | 2535 | hr := CoCreateInstance(CLSID_WICImagingFactory, nil, CLSCTX_INPROC_SERVER, 2536 | IID_IWICImagingFactory, wicList); 2537 | //OleCheck(hr); 2538 | if Succeeded(hr) then 2539 | begin 2540 | hr := wicList.CreateComponentEnumerator(WICDecoder, WICComponentEnumerateDefault, list); 2541 | if Succeeded(hr) then 2542 | begin 2543 | while list.Next(1, vInt, nil) = S_OK do 2544 | begin 2545 | if Succeeded(vInt.QueryInterface(IID_IWICBitmapDecoderInfo, decoder)) then 2546 | begin 2547 | if (decoder.GetFriendlyName(High(vBuf), vBuf, vLen) = S_OK) and (vLen > 1) then 2548 | begin 2549 | SetString(friendlyName, PChar(@vBuf), vLen - 1); 2550 | BCEditor1.Lines.Add('WIC : ' + friendlyName); 2551 | end; 2552 | if (decoder.GetFileExtensions(0, nil, vLen) = S_OK) and (vLen > 1) then 2553 | begin 2554 | SetLength(fileext, vLen - 1); 2555 | decoder.GetFileExtensions(vLen, PChar(fileExt), vLen); 2556 | BCEditor1.Lines.Add('WIC extensions: ' + fileext); 2557 | end; 2558 | 2559 | end; 2560 | vInt := nil; 2561 | end; 2562 | 2563 | end; 2564 | end; 2565 | 2566 | 2567 | CoUninitialize;} 2568 | 2569 | Image1.Picture.Bitmap.Handle := ExtractThumbnail(FileName, 256, 256 ); 2570 | 2571 | Result := False; 2572 | 2573 | if fPreview <> nil then 2574 | fPreview.Free; 2575 | { DISABLE FOR NOW 2576 | fPreview := THostPreviewHandler.Create(Self); 2577 | fPreview.Top := 0; 2578 | fPreview.Left := 0; 2579 | fPreview.Width := pnlPreview.ClientWidth; 2580 | fPreview.Height := pnlPreview.ClientHeight; 2581 | fPreview.Parent := pnlPreview; 2582 | fPreview.Align := alClient; 2583 | fPreview.FileName := FileName; 2584 | 2585 | if fPreview.Previewable then 2586 | begin 2587 | fPreview.Visible := True; 2588 | THostPreviewHandlerClass(fPreview).Paint 2589 | end 2590 | else 2591 | begin 2592 | // handle by ourselves the preview 2593 | fPreview.Visible := False; 2594 | case IndexStr(ExtractFileExt(FileName).ToLower,[ 2595 | // WIC supported by default are the following according to 2596 | // https://docs.microsoft.com/es-mx/windows/win32/wic/-wic-about-windows-imaging-codec?redirectedfrom=MSDN 2597 | '.bmp', '.gif', '.ico', '.jpeg', '.jpg', 2598 | '.jfif', '.png', '.tiff', '.wdp', '.dds', 2599 | //https://docs.microsoft.com/en-us/windows/win32/wic/native-wic-codecs 2600 | '.dng', '.jxr', '.tif', '.jpe', '.dib', 2601 | // unsupported (unless you installed a wic-enabled codec) 2602 | '.webp', '.avif', '.heif', '.flif' 2603 | ]) of 2604 | 0..14: 2605 | begin 2606 | wicImg := TWICImage.Create; 2607 | try 2608 | 2609 | wicImg.LoadFromFile(FileName); 2610 | EsImage1.Picture.Assign(wicImg); 2611 | EsImage1.Repaint; 2612 | finally 2613 | wicImg.Free; 2614 | end; 2615 | end 2616 | else 2617 | begin 2618 | 2619 | end; 2620 | 2621 | end; 2622 | 2623 | end;} 2624 | end; 2625 | 2626 | procedure TForm1.SpeedButton1Click(Sender: TObject); 2627 | begin 2628 | with SpeedButton1 do 2629 | begin 2630 | if FPinned then // if not pinned 2631 | begin 2632 | FPinned := False; 2633 | Caption := ''; 2634 | end 2635 | else 2636 | begin 2637 | FPinned := True; 2638 | Caption := '' // pin 2639 | end; 2640 | end; 2641 | 2642 | end; 2643 | 2644 | procedure TForm1.SwitchToWindow(AWnd: HWND); 2645 | var 2646 | HActiveWindow: HWND; 2647 | HForegroundThread, HAppThread: DWORD; 2648 | FClientId: DWORD; 2649 | begin 2650 | HActiveWindow := AWnd; 2651 | 2652 | HForegroundThread := GetWindowThreadProcessId(HActiveWindow, @FClientId); 2653 | AllowSetForegroundWindow(FClientId); 2654 | // SwitchToThisWindow(AWnd, True); 2655 | HAppThread := GetCurrentThreadId; 2656 | 2657 | AttachThreadInput(HForegroundThread, HAppThread, True); 2658 | BringWindowToTop(AWnd); 2659 | Winapi.Windows.SetFocus(AWnd); 2660 | AttachThreadInput(HForegroundThread, HAppThread, False); 2661 | SetForegroundWindow(AWnd); 2662 | end; 2663 | 2664 | procedure TForm1.tmrOutputTimer(Sender: TObject); 2665 | var 2666 | tmpbuf: TStringList; 2667 | begin 2668 | if not Assigned(FOutputBuffer) then Exit; 2669 | 2670 | if FOutputBuffer.Count = 0 then 2671 | Exit; 2672 | 2673 | tmpbuf := TStringList.Create; 2674 | try 2675 | FSyncLock.Enter; 2676 | try 2677 | tmpbuf.Assign(FOutputBuffer); 2678 | FOutputBuffer.Clear; 2679 | finally 2680 | FSyncLock.Leave; 2681 | end; 2682 | 2683 | BCEditor1.Lines.BeginUpdate; 2684 | try 2685 | BCEditor1.Lines.AddStrings(tmpbuf); 2686 | BCEditor1.GotoLineAndCenter(BCEditor1.Lines.Count - 1); 2687 | BCEditor1.Refresh; 2688 | finally 2689 | BCEditor1.Lines.EndUpdate; 2690 | end; 2691 | finally 2692 | tmpbuf.Free; 2693 | end; 2694 | end; 2695 | 2696 | procedure TForm1.tmrToastTimer(Sender: TObject); 2697 | begin 2698 | StatusBar1.Panels[0].Text := CurrentFile; 2699 | tmrToast.Enabled := False; 2700 | end; 2701 | 2702 | procedure TForm1.Toast(aText, aTitle, sType: string; ParentBase: TWinControl); 2703 | begin 2704 | StatusBar1.Panels[0].Text := aText; 2705 | tmrToast.Enabled := True; 2706 | 2707 | end; 2708 | 2709 | procedure TForm1.TrayIcon1DblClick(Sender: TObject); 2710 | begin 2711 | Visible := not Visible; 2712 | end; 2713 | 2714 | procedure TForm1.UpdateMainMenu(const ForeGroundWindow: HWND); 2715 | var 2716 | lMenu: HMENU; 2717 | MenuItemCount, MenuItemID: Integer; 2718 | MenuItemText: array[0..255] of Char; 2719 | i: Integer; 2720 | NewMenuItem: TMenuItem; 2721 | 2722 | AU: TCUIAutomation; 2723 | WindowElement, MenuElement, MenuItemElement: IUIAutomationElement; 2724 | Collection, MenuItems: IUIAutomationElementArray; 2725 | Condition: IUIAutomationCondition; 2726 | MenuItemName: WideString; 2727 | Len: Integer; 2728 | retVal: Integer; 2729 | ExpandCollapsePattern: IUIAutomationExpandCollapsePattern; 2730 | //const 2731 | // ControlType_Menu: TGUID = '{d9077285-5a2e-4fb1-991c-ac0f69a4d9b3}'; // Menu control type GUID 2732 | 2733 | begin 2734 | // MainMenu1.Items.Clear; 2735 | 2736 | if ForeGroundWindow = Handle then 2737 | Exit; 2738 | 2739 | AU := TCUIAutomation.Create(nil); 2740 | 2741 | AU.ElementFromHandle(Pointer(ForeGroundWindow), WindowElement); 2742 | 2743 | // AU.CreatePropertyCondition(UIA_ControlTypePropertyId, ControlType_Menu, Condition); 2744 | AU.CreateTrueCondition(Condition); 2745 | 2746 | // WindowElement.FindFirst(TreeScope_Descendants, Condition, MenuElement); 2747 | WindowElement.FindAll(TreeScope_Descendants, Condition, Collection); 2748 | 2749 | Collection.Get_Length(Len); 2750 | 2751 | for I := 0 to Len - 1 do 2752 | begin 2753 | Collection.GetElement(I, MenuItemElement); 2754 | MenuItemElement.Get_CurrentControlType(retVal); 2755 | 2756 | if (retVal = UIA_MenuItemControlTypeId) then 2757 | begin 2758 | MenuItemElement.Get_CurrentName(MenuItemName); 2759 | 2760 | // NewMenuItem := TMenuItem.Create(MainMenu1); 2761 | // NewMenuItem.Caption := MenuItemName; 2762 | // NewMenuItem.Tag := I; 2763 | BCEditor1.Lines.Add(MenuItemName); 2764 | // MainMenu1.Items.Add(NewMenuItem); 2765 | 2766 | // MenuItemElement.GetCurrentPattern(UIA_ExpandCollapsePatternId, IInterface(ExpandCollapsePattern)); 2767 | // if Assigned(ExpandCollapsePattern) then 2768 | // begin 2769 | // ExpandCollapsePattern.Expand; 2770 | // if Recurse = True then 2771 | // 2772 | // 2773 | // end; 2774 | 2775 | end; 2776 | 2777 | end; 2778 | 2779 | // if Assigned(MenuElement) then 2780 | // begin 2781 | // MenuElement.FindAll(TreeScope_Children, Condition, MenuItems); 2782 | // if Assigned(MenuItems) then 2783 | // begin 2784 | // MenuItems.Get_Length(Len); 2785 | // for I := 0 to Len - 1 do 2786 | // begin 2787 | // MenuItems.GetElement(I, MenuItemElement); 2788 | // MenuItemElement.GetCurrentPropertyValue(UIA_NamePropertyId, MenuItemName); 2789 | // 2790 | // NewMenuItem := TMenuItem.Create(MainMenu1); 2791 | // NewMenuItem.Caption := MenuItemName; 2792 | // NewMenuItem.Tag := I; 2793 | // BCEditor1.Lines.Add(MenuItemName); 2794 | // 2795 | // MainMenu1.Items.Add(NewMenuItem); 2796 | // end; 2797 | // 2798 | // end; 2799 | // end; 2800 | 2801 | AU.Free; 2802 | 2803 | // lMenu := GetMenu(FindWindow('TAppBuilder', 'ExplorerCommand - RAD Studio 11 - main [Built]')); 2804 | // if lMenu <> 0 then 2805 | // begin 2806 | // MenuItemCount := GetMenuItemCount(lMenu); 2807 | // for I := 0 to MenuItemCount - 1 do 2808 | // begin 2809 | // MenuItemID := GetMenuItemID(lMenu, I); 2810 | // if MenuItemID <> -1 then 2811 | // begin 2812 | // GetMenuString(lMenu, MenuItemID, MenuItemText, SizeOf(MenuItemText), MF_BYCOMMAND); 2813 | // NewMenuItem := TMenuItem.Create(MainMenu1); 2814 | // NewMenuItem.Caption := MenuItemText; 2815 | // NewMenuItem.Tag := MenuItemID; 2816 | // MainMenu1.Items.Add(NewMenuItem); 2817 | // end; 2818 | // end; 2819 | // end; 2820 | end; 2821 | 2822 | procedure TForm1.UpdateStyle; 2823 | const 2824 | BGCOLOR = $00191919;//$00362A28; 2825 | begin 2826 | //on light 2827 | if IsWindowsDarkMode then 2828 | begin 2829 | AllowDarkModeForApp(True); 2830 | Form1.Color := RGB(38, 40, 4); 2831 | Form1.AlphaBlend := True; 2832 | Form1.AlphaBlendValue := 253; 2833 | with SynPasSyn1 do 2834 | begin 2835 | CommentAttri.Foreground := $00A47262; 2836 | CommentAttri.Background := BGCOLOR; 2837 | 2838 | // EventAttri.Foreground := $00FDE98B; 2839 | // EventAttri.Background := $00362A28; 2840 | // EventAttri.Style := [fsBold]; 2841 | 2842 | IdentifierAttri.Foreground := $00F2F8F8; 2843 | IdentifierAttri.Background := BGCOLOR; 2844 | 2845 | KeyAttri.Foreground := $0054B91D;//FDE98B; 2846 | KeyAttri.Background := BGCOLOR; 2847 | KeyAttri.Style := [fsBold]; 2848 | 2849 | // NonReservedKeyAttri.Foreground := $0054B91D;//$00FDE98B; 2850 | // NonReservedKeyAttri.Background := $00362A28; 2851 | // NonReservedKeyAttri.Style := [fsBold]; 2852 | 2853 | NumberAttri.Foreground := $00F993BD; 2854 | NumberAttri.Background := BGCOLOR; 2855 | 2856 | SpaceAttri.Foreground := clWindowText; 2857 | SpaceAttri.Background := BGCOLOR;//MOST PART 2858 | 2859 | // SpecVarAttri.Foreground := $00C679FF; 2860 | // SpecVarAttri.Background := $00362A28; 2861 | // SpecVarAttri.Style := [fsBold]; 2862 | 2863 | StringAttri.Foreground := $008BE9FC; 2864 | StringAttri.Background := clNone; 2865 | 2866 | SymbolAttri.Foreground := $00C679FF; 2867 | SymbolAttri.Background := BGCOLOR; 2868 | 2869 | // TemplateAttri.Foreground := $008BE9FC; 2870 | // TemplateAttri.Background := clNone; 2871 | end; 2872 | 2873 | rkSmartPath1.Font.Color := clWhite; 2874 | TStyleManager.TrySetStyle('Windows11 Modern Dark'); 2875 | end 2876 | else 2877 | begin 2878 | Form1.Color := RGB(248, 249, 253); //dark: 38, 40 44 2879 | Form1.AlphaBlend := True; 2880 | Form1.AlphaBlendValue := 250; // 253 2881 | TStyleManager.TrySetStyle('Windows'); 2882 | end; 2883 | 2884 | end; 2885 | 2886 | procedure TForm1.UpdateTheme; 2887 | begin 2888 | UpdateStyle; 2889 | 2890 | // EnableImmersiveDarkMode(True); 2891 | // UseImmersiveDarkMode(Handle, True); //my function to dark mode titlebar win11+ 2892 | // EnableNCShadow(Handle); 2893 | 2894 | if IsWindowsDarkMode then 2895 | begin 2896 | ACLApplicationController1.DarkMode := TACLBoolean.True; 2897 | SetDarkMode(Handle, True); 2898 | end 2899 | else 2900 | begin 2901 | ACLApplicationController1.DarkMode := TACLBoolean.False; 2902 | SetDarkMode(Handle, False); 2903 | end; 2904 | end; 2905 | 2906 | procedure TForm1.RefreshEnvironmentVariables; 2907 | var 2908 | TokenHandle: THandle; 2909 | EnvironmentStrings: PEnvironment; // LPTSTR; 2910 | Current: PChar; 2911 | begin 2912 | TokenHandle := 0; 2913 | try 2914 | if not OpenProcessToken(GetCurrentProcess, TOKEN_QUERY or TOKEN_DUPLICATE, TokenHandle) then 2915 | RaiseLastOSError; 2916 | 2917 | // Get the environment strings block 2918 | //EnvironmentStrings := GetEnvironmentStrings; 2919 | if CreateEnvironmentBlock(EnvironmentStrings, TokenHandle, False) then 2920 | try 2921 | if EnvironmentStrings = nil then 2922 | Exit; 2923 | 2924 | FEnvStrings.Clear; 2925 | FEnvStrings.Delimiter := ';'; 2926 | FEnvStrings.StrictDelimiter := True; 2927 | // Loop through the environment strings and reload them 2928 | Current := PChar(EnvironmentStrings); 2929 | while Current^ <> #0 do 2930 | begin 2931 | var EnvEntry := String(Current); 2932 | var Pos := EnvEntry.IndexOf('='); 2933 | if Pos > 0 then 2934 | begin 2935 | var Name := Copy(EnvEntry, 1, Pos); 2936 | var Value := Copy(EnvEntry, Pos + 2, Length(EnvEntry) - Pos - 1); 2937 | Winapi.Windows.SetEnvironmentVariable(PChar(Name), PChar(Value)); 2938 | if LowerCase(Name) = 'path' then 2939 | FEnvStrings.DelimitedText := PChar(Value); 2940 | end; 2941 | 2942 | // Move to the next environment string 2943 | Inc(Current, StrLen(Current) + 1); 2944 | end; 2945 | finally 2946 | //FreeEnvironmentStrings(EnvironmentStrings); 2947 | RtlDestroyEnvironment(EnvironmentStrings); 2948 | end 2949 | else 2950 | RaiseLastOSError; 2951 | finally 2952 | if TokenHandle <> 0 then 2953 | CloseHandle(TokenHandle); 2954 | end; 2955 | end; 2956 | 2957 | procedure TForm1.WMSettingChange(var Msg: TMessage); 2958 | begin 2959 | if PChar(Msg.LParam) = 'Environment' then 2960 | begin 2961 | RefreshEnvironmentVariables; 2962 | // ShowMessage('Environment refreshed!'); 2963 | end; 2964 | inherited; 2965 | end; 2966 | 2967 | procedure TForm1.WndProc(var Message: TMessage); 2968 | begin 2969 | inherited; 2970 | 2971 | if Message.Msg = WM_SETTINGCHANGE then 2972 | begin 2973 | UpdateTheme; 2974 | end; 2975 | end; 2976 | 2977 | { ThumbThread } 2978 | 2979 | constructor ThumbThread.Create(View: TrkView; Items: TList); 2980 | begin 2981 | ViewLink := View; 2982 | ItemsLink := Items; 2983 | FreeOnTerminate := False; 2984 | inherited Create(False); 2985 | Priority := tpLower; 2986 | end; 2987 | 2988 | procedure ThumbThread.Execute; 2989 | var 2990 | Cnt, I: Integer; 2991 | PThumb: PItemData; 2992 | Old: Integer; 2993 | InView: Integer; 2994 | ShellFolder, DesktopShellFolder: IShellFolder; 2995 | XtractImage: IExtractImage; 2996 | XtractImage2: IExtractImage2; 2997 | XtractIcon: IExtractIcon; 2998 | fileShellItemImage: IShellItemImageFactory; 2999 | ImageFactory: IShellItemImageFactory; 3000 | Bmp: TBitmap; 3001 | Path: string; 3002 | Eaten: DWORD; 3003 | PIDL: PItemIDList; 3004 | RunnableTask: IRunnableTask; 3005 | Flags: DWORD; 3006 | Buf: array[0..MAX_PATH * 4] of WideChar; 3007 | BmpHandle: HBITMAP; 3008 | Attribute, Priority: DWORD; 3009 | GetLocationRes: HRESULT; 3010 | ThumbJPEG: TJPEGImage; 3011 | MS: TMemoryStream; 3012 | ASize: TSize; 3013 | FName: string; 3014 | p, pro: Integer; 3015 | PV: Single; 3016 | IIdx: Integer; 3017 | IFlags: Cardinal; 3018 | SIcon, LIcon: HICON; 3019 | IconS, IconL: TIcon; 3020 | Done: Boolean; 3021 | Res: HRESULT; 3022 | ColorDepth: Cardinal; 3023 | IsVistaOrLater: Boolean; 3024 | begin 3025 | inherited; 3026 | if (ViewLink.Items.Count = 0) then 3027 | Exit; 3028 | 3029 | IsVistaOrLater := CheckWin32Version(6); 3030 | 3031 | CoInitializeEx(nil, COINIT_APARTMENTTHREADED or COINIT_DISABLE_OLE1DDE); 3032 | try 3033 | ThumbJPEG := TJPEGImage.Create; 3034 | ThumbJPEG.CompressionQuality := 80; 3035 | ThumbJPEG.Performance := jpBestSpeed; 3036 | Path := form1.Directory; 3037 | 3038 | OleCheck(SHGetDesktopFolder(DesktopShellFolder)); 3039 | OleCheck(DesktopShellFolder.ParseDisplayName(0, nil, StringToOleStr(Path), 3040 | Eaten, PIDL, Attribute)); 3041 | OleCheck(DesktopShellFolder.BindToObject(PIDL, nil, IID_IShellFolder, 3042 | Pointer(ShellFolder))); 3043 | CoTaskMemFree(PIDL); 3044 | 3045 | Cnt := 0; 3046 | Old := ViewLink.ViewIdx; 3047 | pro := 0; 3048 | PV := 100 / ViewLink.Items.Count; 3049 | repeat 3050 | while (not Terminated) and (Cnt < ViewLink.Items.Count) do 3051 | begin 3052 | if Old <> ViewLink.ViewIdx then 3053 | begin 3054 | Cnt := ViewLink.ViewIdx - 1; 3055 | if Cnt = -1 then 3056 | Cnt := 0; 3057 | Old := ViewLink.ViewIdx; 3058 | end; 3059 | 3060 | PThumb := PItemData(ItemsLink.Items[ViewLink.Items[Cnt]]); 3061 | Done := PThumb.GotThumb; 3062 | PThumb.ImgState := 0; 3063 | 3064 | if IsVistaOrLater then 3065 | begin 3066 | if not Done then 3067 | begin 3068 | Bmp := TBitmap.Create; 3069 | Bmp.Canvas.Lock; 3070 | FName := Path + PThumb.Name; 3071 | Res := SHCreateItemFromParsingName(PChar(FName), nil, 3072 | IShellItemImageFactory, fileShellItemImage); 3073 | if Succeeded(Res) then 3074 | begin 3075 | ASize.cx := 256; 3076 | ASize.cy := 256; 3077 | Res := fileShellItemImage.GetImage(ASize, SIIGBF_THUMBNAILONLY or SIIGBF_BIGGERSIZEOK, 3078 | BmpHandle); 3079 | if Succeeded(Res) then 3080 | begin 3081 | Bmp.Canvas.Unlock; 3082 | Bmp.Handle := BmpHandle; 3083 | Bmp.Canvas.Lock; 3084 | HackAlpha(Bmp, clWhite); 3085 | PThumb.IsIcon := False; 3086 | Done := True; 3087 | end; 3088 | end; 3089 | end; 3090 | end 3091 | else 3092 | begin 3093 | if not Done then 3094 | begin 3095 | Bmp := TBitmap.Create; 3096 | Bmp.Canvas.Lock; 3097 | OleCheck(ShellFolder.ParseDisplayName(0, nil, 3098 | StringToOleStr(PThumb.Name), Eaten, PIDL, Attribute)); 3099 | ShellFolder.GetUIObjectOf(0, 1, PIDL, IExtractImage, nil, 3100 | XtractImage); 3101 | CoTaskMemFree(PIDL); 3102 | if Assigned(XtractImage) then 3103 | begin 3104 | if XtractImage.QueryInterface(IID_IExtractImage2, 3105 | Pointer(XtractImage2)) <> E_NOINTERFACE then 3106 | else 3107 | XtractImage2 := nil; 3108 | RunnableTask := nil; 3109 | ASize.cx := 256; 3110 | ASize.cy := 256; 3111 | Priority := 0; 3112 | Flags := 3113 | IEIFLAG_SCREEN or IEIFLAG_OFFLINE or IEIFLAG_ORIGSIZE 3114 | or IEIFLAG_QUALITY; 3115 | ColorDepth := 32; 3116 | GetLocationRes := XtractImage.GetLocation(Buf, MAX_PATH, 3117 | Priority, ASize, ColorDepth, Flags); 3118 | if (GetLocationRes = NOERROR) or (GetLocationRes = E_PENDING) then 3119 | begin 3120 | if GetLocationRes = E_PENDING then 3121 | if XtractImage.QueryInterface(IRunnableTask, RunnableTask) 3122 | <> S_OK then 3123 | RunnableTask := nil; 3124 | try 3125 | if Succeeded(XtractImage.Extract(BmpHandle)) then 3126 | begin 3127 | Bmp.Canvas.Unlock; 3128 | Bmp.Handle := BmpHandle; 3129 | Bmp.Canvas.Lock; 3130 | HackAlpha(Bmp, clWhite); 3131 | PThumb.IsIcon := False; 3132 | Done := True; 3133 | end; 3134 | except 3135 | on E: EOleSysError do 3136 | OutputDebugString( 3137 | PChar(string(E.ClassName) + ': ' + E.Message) 3138 | ) 3139 | else 3140 | raise; 3141 | end; 3142 | end; 3143 | end; 3144 | end; 3145 | end; 3146 | 3147 | end; 3148 | until (Cnt = 0) or (Terminated); 3149 | 3150 | if not Terminated then 3151 | PostMessage(Form1.Handle, CM_UpdateView, 0, 0); 3152 | PostMessage(Form1.Handle, CM_Progress, 0, 100); 3153 | ThumbJPEG.Free; 3154 | finally 3155 | CoUninitialize; 3156 | end; 3157 | 3158 | end; 3159 | 3160 | { TEnumString } 3161 | 3162 | function TEnumString.Clone(out enm: IEnumString): HResult; 3163 | begin 3164 | Result := E_NOTIMPL; 3165 | Pointer(enm) := nil; 3166 | end; 3167 | 3168 | constructor TEnumString.Create; 3169 | begin 3170 | inherited Create; 3171 | FStrings := TStringList.Create; 3172 | FCurrIndex := 0; 3173 | end; 3174 | 3175 | destructor TEnumString.Destroy; 3176 | begin 3177 | FStrings.Free; 3178 | inherited; 3179 | end; 3180 | 3181 | function TEnumString.Next(celt: Longint; out elt; 3182 | pceltFetched: PLongint): HResult; 3183 | var 3184 | I: Integer; 3185 | wStr: WideString; 3186 | begin 3187 | I := 0; 3188 | while (I < celt) and (FCurrIndex < FStrings.Count) do 3189 | begin 3190 | wStr := FStrings[FCurrIndex]; 3191 | TPointerList(elt)[I] := CoTaskMemAlloc(2 * (Length(wStr) + 1)); 3192 | StringToWideChar(wStr, TPointerList(elt)[I], 2 * (Length(wStr) + 1)); 3193 | Inc(I); 3194 | Inc(FCurrIndex); 3195 | end; 3196 | if pceltFetched <> nil then 3197 | pceltFetched^ := I; 3198 | if I = celt then 3199 | Result := S_OK 3200 | else 3201 | Result := S_FALSE; 3202 | end; 3203 | 3204 | function TEnumString.Reset: HResult; 3205 | begin 3206 | FCurrIndex := 0; 3207 | Result := S_OK; 3208 | end; 3209 | 3210 | function TEnumString.Skip(celt: Longint): HResult; 3211 | begin 3212 | if (FCurrIndex + celt) <= FStrings.Count then 3213 | begin 3214 | Inc(FCurrIndex, celt); 3215 | Result := S_OK; 3216 | end 3217 | else 3218 | begin 3219 | FCurrIndex := FStrings.Count; 3220 | Result := S_FALSE; 3221 | end; 3222 | end; 3223 | 3224 | { TButtonedEdit } 3225 | 3226 | constructor TButtonedEdit.Create(AOwner: TComponent); 3227 | begin 3228 | inherited; 3229 | FACList := TEnumString.Create; 3230 | FEnumString := FACList; 3231 | FACEnabled := True; 3232 | FACOptions := [acAutoSuggest, acUpDownKeyDropsList]; 3233 | end; 3234 | 3235 | class constructor TButtonedEdit.Create; 3236 | begin 3237 | if not TStyleManager.IsCustomStyleActive then 3238 | begin 3239 | Winapi.Windows.Beep(400, 1000); 3240 | TCustomStyleEngine.UnRegisterSysStyleHook('SysListView32', TSysListViewStyleHook); 3241 | TCustomStyleEngine.RegisterSysStyleHook('SysListView32', TSysListViewStyleHook); 3242 | end; 3243 | end; 3244 | 3245 | procedure TButtonedEdit.CreateWnd; 3246 | var 3247 | Dummy: IUnknown; 3248 | Strings: IEnumString; 3249 | FuzzyMatchList: TStringList; 3250 | FuzzyMatcher: TFuzzyStringMatcher; 3251 | AutocompleteEx: IAutoComplete2; 3252 | begin 3253 | inherited; 3254 | // SetWindowTheme(Handle, PChar('DarkMode_Explorer'), nil); 3255 | if HandleAllocated then 3256 | begin 3257 | try 3258 | Dummy := CreateComObject(CLSID_AutoComplete); 3259 | if (Dummy <> nil) and 3260 | (Dummy.QueryInterface(IID_IAutoComplete, FAutoComplete) = S_OK) then 3261 | begin 3262 | //https://learn.microsoft.com/en-us/windows/win32/api/shldisp/ne-shldisp-autocompleteoptions 3263 | // set auto completion options 3264 | if Dummy.QueryInterface(IID_IAutoComplete2, AutoCompleteEx) = S_OK then 3265 | AutoCompleteEx.SetOptions(ACO_AUTOSUGGEST or ACO_AUTOAPPEND or ACO_UPDOWNKEYDROPSLIST); 3266 | 3267 | case FACSource of 3268 | // acsList: ; 3269 | //It is used to manage the history of autocomplete entries. 3270 | acsHistory: Strings := CreateComObject(CLSID_ACLHistory) as IEnumString; 3271 | //It is used to manage the MRU autocomplete entries. 3272 | acsMRU: Strings := CreateComObject(CLSID_ACLMRU) as IEnumString; 3273 | //It is used to manage autocomplete entries specific to shell folders. 3274 | acsShell: 3275 | begin 3276 | Strings := CreateComObject(CLSID_ACListISF) as IEnumString; 3277 | end 3278 | else 3279 | begin 3280 | // Use FuzzyStringMatch to perform fuzzy string matching 3281 | FuzzyMatchList := TStringList.Create; 3282 | try 3283 | FuzzyMatcher := TFuzzyStringMatcher.Create(8); 3284 | finally 3285 | 3286 | end; 3287 | Strings := FACList as IEnumString; // original 3288 | end; 3289 | end; 3290 | if S_OK = FAutoComplete.Init(Handle, Strings, nil, nil) then 3291 | begin 3292 | SetACEnabled(FACEnabled); 3293 | SetACOptions(FACOptions); 3294 | // TCustomStyleEngine.RegisterSysStyleHook('SysListView32', TSysListViewStyleHook); 3295 | // TCustomStyleEngine.RegisterSysStyleHook('SysListView32', TSysListViewStyleHook); 3296 | end; 3297 | end; 3298 | except 3299 | // CLSID_IAutoComplete is not available 3300 | end; 3301 | end; 3302 | 3303 | end; 3304 | 3305 | destructor TButtonedEdit.Destroy; 3306 | begin 3307 | FACList := nil; 3308 | inherited; 3309 | end; 3310 | 3311 | procedure TButtonedEdit.DestroyWnd; 3312 | begin 3313 | if (FAutoComplete <> nil) then 3314 | begin 3315 | FAutoComplete.Enable(False); 3316 | FAutoComplete := nil; 3317 | end; 3318 | 3319 | inherited; 3320 | 3321 | end; 3322 | 3323 | function TButtonedEdit.GetACStrings: TStringList; 3324 | begin 3325 | Result := FACList.FStrings; 3326 | end; 3327 | 3328 | procedure TButtonedEdit.SetACEnabled(const Value: Boolean); 3329 | begin 3330 | if (FAutoComplete <> nil) then 3331 | begin 3332 | FAutoComplete.Enable(FACEnabled); 3333 | end; 3334 | FACEnabled := Value; 3335 | end; 3336 | 3337 | procedure TButtonedEdit.SetACOptions(const Value: TACOptions); 3338 | const 3339 | Options : array[TACOption] 3340 | of Integer = ( 3341 | ACO_NONE, 3342 | ACO_AUTOSUGGEST, 3343 | ACO_AUTOAPPEND, 3344 | ACO_SEARCH, 3345 | ACO_FILTERPREFIXES, 3346 | ACO_USETAB, 3347 | ACO_UPDOWNKEYDROPSLIST, 3348 | ACO_RTLREADING, 3349 | ACO_WORD_FILTER, 3350 | ACO_NOPREFIXFILTERING 3351 | ); 3352 | var 3353 | Option: TACOption; 3354 | Opt: DWORD; 3355 | AC2: IAutoComplete2; 3356 | begin 3357 | if (FAutoComplete <> nil) then 3358 | begin 3359 | if S_OK = FAutoComplete.QueryInterface(IID_IAutoComplete2, AC2) then 3360 | begin 3361 | Opt := ACO_NONE; 3362 | for Option := Low(Options) to High(Options) do 3363 | begin 3364 | if (Option in FACOptions) then 3365 | Opt := Opt or DWORD(Options[Option]); 3366 | end; 3367 | AC2.SetOptions(Opt); 3368 | end; 3369 | end; 3370 | FACOptions := Value; 3371 | end; 3372 | 3373 | procedure TButtonedEdit.SetACSource(const Value: TACSource); 3374 | begin 3375 | if FACSource <> Value then 3376 | begin 3377 | FACSource := Value; 3378 | RecreateWnd; 3379 | end; 3380 | end; 3381 | 3382 | procedure TButtonedEdit.SetACStrings(const Value: TStringList); 3383 | begin 3384 | if Value <> FACList.FStrings then 3385 | FACList.FStrings.Assign(Value); 3386 | end; 3387 | 3388 | { TFuzzyStringMatcher } 3389 | 3390 | constructor TFuzzyStringMatcher.Create(Threshold: Integer); 3391 | begin 3392 | FThreshold := Threshold; 3393 | end; 3394 | 3395 | function TFuzzyStringMatcher.DamerauLevenshteinDistance(const S1, 3396 | S2: string): Integer; 3397 | var 3398 | Len1, Len2, I, J, Cost, PrevCost: Integer; 3399 | D: array of array of Integer; 3400 | begin 3401 | Len1 := Length(S1); 3402 | Len2 := Length(S2); 3403 | SetLength(D, Len1 + 1, Len2 + 1);; 3404 | 3405 | for I := 0 to Len1 do 3406 | D[I, 0] := I; 3407 | 3408 | for J := 0 to Len2 do 3409 | D[0, J] := J; 3410 | 3411 | for I := 1 to Len1 do 3412 | begin 3413 | for J := 1 to Len2 do 3414 | begin 3415 | if S1[I] = S2[J] then 3416 | Cost := 0 3417 | else 3418 | Cost := 1; 3419 | 3420 | PrevCost := D[I - 1, J - 1]; 3421 | 3422 | if (I > 1) and (J > 1) and (S1[I - 1] = S2[J]) and (S1[I] = S2[J - 1]) then 3423 | PrevCost := Min(PrevCost, D[I - 2, J - 2]); 3424 | 3425 | D[I, J] := Min(Min(D[I - 1, J] + 1, D[I, J - 1] + 1), PrevCost + Cost); 3426 | end; 3427 | end; 3428 | 3429 | Result := D[Len1, Len2]; 3430 | end; 3431 | 3432 | function TFuzzyStringMatcher.IsMatch(const Str, SubStr: string): Boolean; 3433 | begin 3434 | Result := DamerauLevenshteinDistance(Str, SubStr) <= FThreshold; 3435 | end; 3436 | 3437 | end. 3438 | --------------------------------------------------------------------------------