-
Notifications
You must be signed in to change notification settings - Fork 3
/
PJShellFolders.pas
1517 lines (1419 loc) · 55.2 KB
/
PJShellFolders.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
{
* This Source Code Form is subject to the terms of the Mozilla Public License,
* v. 2.0. If a copy of the MPL was not distributed with this file, You can
* obtain one at http://mozilla.org/MPL/2.0/
*
* Copyright (C) 2001-2014, Peter Johnson (www.delphidabbler.com).
*
* Run time unit that defines shell folders components, classes and routines.
}
unit PJShellFolders;
interface
// Determine compiler
{$UNDEF DELPHI5ANDUP}
{$UNDEF DELPHI6ANDUP}
{$UNDEF DELPHI7ANDUP}
{$UNDEF RTLNameSpaces} // Don't qualify RTL units names with namespaces
{$IFDEF VER130}
{$DEFINE DELPHI5ANDUP}
{$ENDIF}
{$IFDEF CONDITIONALEXPRESSIONS}
{$IF CompilerVersion >= 24.0} // Delphi XE3 and later
{$LEGACYIFEND ON} // NOTE: this must come before all $IFEND directives
{$IFEND}
{$IF CompilerVersion >= 23.0} // Delphi XE2 and later
{$DEFINE RTLNameSpaces}
{$IFEND}
{$IF CompilerVersion >= 15.0} // Delphi 7 and later
{$DEFINE DELPHI7ANDUP}
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_CAST OFF}
{$IFEND}
{$IF CompilerVersion >= 14.0} // Delphi 6 and later
{$DEFINE DELPHI5ANDUP}
{$DEFINE DELPHI6ANDUP}
{$IFEND}
{$ENDIF}
uses
{$IFNDEF RTLNameSpaces}
// Delphi
SysUtils, Windows, Classes, Controls, Messages, ShlObj
{$IFDEF DELPHI6ANDUP}
// include this unit for extra shell folder identifiers
, SHFolder
{$ENDIF}
;
{$ELSE}
System.SysUtils, Winapi.Windows, System.Classes, Vcl.Controls,
Winapi.Messages, Winapi.ShlObj, Winapi.SHFolder;
{$ENDIF}
{$IFNDEF DELPHI6ANDUP}
const
//
// CSIDL_ constants provided in SHFolder unit in Delphi 6 and later
//
// Folder ids
CSIDL_LOCAL_APPDATA = $001C;
{$EXTERNALSYM CSIDL_LOCAL_APPDATA}
CSIDL_COMMON_APPDATA = $0023;
{$EXTERNALSYM CSIDL_COMMON_APPDATA}
CSIDL_WINDOWS = $0024;
{$EXTERNALSYM CSIDL_WINDOWS}
CSIDL_SYSTEM = $0025;
{$EXTERNALSYM CSIDL_SYSTEM}
CSIDL_PROGRAM_FILES = $0026;
{$EXTERNALSYM CSIDL_PROGRAM_FILES}
CSIDL_MYPICTURES = $0027;
{$EXTERNALSYM CSIDL_MYPICTURES}
CSIDL_PROGRAM_FILES_COMMON = $002B;
{$EXTERNALSYM CSIDL_PROGRAM_FILES_COMMON}
CSIDL_COMMON_DOCUMENTS = $002E;
{$EXTERNALSYM CSIDL_COMMON_DOCUMENTS}
CSIDL_COMMON_ADMINTOOLS = $002F;
{$EXTERNALSYM CSIDL_COMMON_ADMINTOOLS}
CSIDL_ADMINTOOLS = $0030;
{$EXTERNALSYM CSIDL_ADMINTOOLS}
// Flag
CSIDL_FLAG_CREATE = $8000;
{$EXTERNALSYM CSIDL_FLAG_CREATE}
{$ENDIF}
const
//
// Further CSIDL constants from MSDN not defined in all Delphis
//
// Folder ids
CSIDL_CDBURN_AREA = $003B;
{$EXTERNALSYM CSIDL_CDBURN_AREA}
CSIDL_COMMON_MUSIC = $0035;
{$EXTERNALSYM CSIDL_COMMON_MUSIC}
CSIDL_COMMON_PICTURES = $0036;
{$EXTERNALSYM CSIDL_COMMON_PICTURES}
CSIDL_COMMON_TEMPLATES = $002D;
{$EXTERNALSYM CSIDL_COMMON_TEMPLATES}
CSIDL_COMMON_VIDEO = $0037;
{$EXTERNALSYM CSIDL_COMMON_VIDEO}
CSIDL_COMPUTERSNEARME = $003D;
{$EXTERNALSYM CSIDL_COMPUTERSNEARME}
CSIDL_CONNECTIONS = $0031;
{$EXTERNALSYM CSIDL_CONNECTIONS}
CSIDL_MYDOCUMENTS = $000C;
{$EXTERNALSYM CSIDL_MYDOCUMENTS}
CSIDL_MYMUSIC = $000D;
{$EXTERNALSYM CSIDL_MYMUSIC}
CSIDL_MYVIDEO = $000E;
{$EXTERNALSYM CSIDL_MYVIDEO}
CSIDL_PROFILE = $0028;
{$EXTERNALSYM CSIDL_PROFILE}
CSIDL_PROFILES = $003E;
{$EXTERNALSYM CSIDL_PROFILES}
CSIDL_SYSTEMX86 = $0029;
{$EXTERNALSYM CSIDL_SYSTEMX86}
CSIDL_PROGRAM_FILESX86 = $002A;
{$EXTERNALSYM CSIDL_PROGRAM_FILESX86}
CSIDL_PROGRAM_FILES_COMMONX86 = $002C;
{$EXTERNALSYM CSIDL_PROGRAM_FILES_COMMONX86}
CSIDL_RESOURCES = $0038;
{$EXTERNALSYM CSIDL_RESOURCES}
CSIDL_RESOURCES_LOCALIZED = $0039;
{$EXTERNALSYM CSIDL_RESOURCES_LOCALIZED}
CSIDL_COMMON_OEM_LINKS = $003A;
{$EXTERNALSYM CSIDL_COMMON_OEM_LINKS}
// Flags
CSIDL_FOLDER_MASK = $00FF;
{$EXTERNALSYM CSIDL_FOLDER_MASK}
CSIDL_FLAG_PER_USER_INIT = $0080;
{$EXTERNALSYM CSIDL_FLAG_PER_USER_INIT}
CSIDL_FLAG_NO_ALIAS = $1000;
{$EXTERNALSYM CSIDL_FLAG_NO_ALIAS}
CSIDL_FLAG_DONT_VERIFY = $4000;
{$EXTERNALSYM CSIDL_FLAG_DONT_VERIFY}
CSIDL_FLAG_DONT_UNEXPAND = $2000;
{$EXTERNALSYM CSIDL_FLAG_DONT_UNEXPAND}
CSIDL_FLAG_MASK = $FF00;
{$EXTERNALSYM CSIDL_FLAG_MASK}
//
// Browse dialog customisation flags
//
BIF_NEWDIALOGSTYLE = $0040;
{$EXTERNALSYM BIF_NEWDIALOGSTYLE}
BIF_UAHINT = $0100;
{$EXTERNALSYM BIF_UAHINT}
type
{
IPJSpecialFolderEnum:
Interface to enumerator of the identifiers of the Shell's special folders.
}
IPJSpecialFolderEnum = interface
['{0958B8A0-1D56-11D5-852A-EE0AA7BFE914}']
procedure Init;
{Intialises enumeration.
}
function Next: Integer;
{Gets next special folder identifier in enumeration, or -1 if at end
of enumeration.
@return Folder identifier.
}
function AtEnd: Boolean;
{Checks if at end of enumeration.
@return True if at end of enumeration and false otherwise.
}
function Count: Integer;
{Gets number of folder ids in enumeration.
@return Number of folders ids.
}
end;
{
TPJSpecialFolderEnum
Class that enumerates the indentifiers for the Shell's special folders.
}
TPJSpecialFolderEnum = class(TInterfacedObject,
IPJSpecialFolderEnum
)
private
fIndex: Integer; // Index of current folder in folder lookup table
public
constructor Create;
{Class constructor. Sets up object and intialises enumeration.
}
procedure Init;
{Intialises enumeration.
}
function Next: Integer;
{Gets next special folder identifier in enumeration, or -1 if at end of
enumeration.
@return Folder identifier.
}
function AtEnd: Boolean;
{Checks if at end of enumeration.
@return True if at end of enumeration and false otherwise.
}
function Count: Integer;
{Gets number of folder ids in enumeration.
@return Number of folders ids.
}
end;
{
TPJSpecialFolderInfo:
Component that provides information about the Shell's special folders.
}
TPJSpecialFolderInfo = class(TComponent)
private
fFolderID: Integer; // Value of FolderID property
fPath: string; // Value of Path property
fDisplayName: string; // Value of DisplayName property
fIsVirtual: Boolean; // Value of IsVirtual property
fIsSupported: Boolean; // Value of IsSupported property
procedure SetFolderID(const Value: Integer);
{Write accessor method for FolderID property. Reads information about
specified folder.
@param Value [in] New property value.
@except EPJShellFolders raised if Value is not a valid special folder
id.
}
protected
procedure GetCurrentFolderInfo; virtual;
{Retrieves information about special folder specified by FolderID property
and updates read only properties accordingly.
}
public
constructor Create(AOwner: TComponent); override;
{Class constructor. Sets up object and reads information about default
special folder.
@param AOwner [in] Component's owner.
}
property Path: string read fPath;
{The path to the special folder. This is '' if folder is virtual or not
supported}
property DisplayName: string read fDisplayName;
{Display name of special folder. This is '' if folder is not supported}
property IsVirtual: Boolean read fIsVirtual;
{True if the special folder is virtual - i.e. not part of the physical
file system. False if folder is part of virtual file system or is not
supported on this system}
property IsSupported: Boolean read fIsSupported;
{True if the current folder ID is supported on the underlying OS, false
otherwise}
published
property FolderID: Integer
read fFolderID write SetFolderID default CSIDL_DESKTOP;
{ID of the the current folder. Setting this property causes other, read
only properties to be updated to provide information about the folder}
end;
{
TPJBrowseSelChangeEvent:
Type of event triggered by TPJBrowseDialog when selected folder changes.
@param Sender [in] Reference to component triggering event.
@param FolderName [in] Name of selected folder or '' if virtual folder.
@param DisplayName [in] Display name of selected folder.
@param StatusText [in/out] Set to '' when called. May be updated to
provide status text to be displayed in old style browse dialog. Ignored
by new style dialog box.
@param OKEnabled [in/out] Set to state of browse dialog's OK button when
called. May be set true to enable OK button or false to disable it.
}
TPJBrowseSelChangeEvent = procedure(Sender: TObject;
FolderName, DisplayName: string; var StatusText: string;
var OKEnabled: Boolean) of object;
{
TPJBrowseSelChangeEventEx:
Type of event triggered by TPJBrowseDialog when selected folder changes:
gives access to folder's PIDL.
@param Sender [in] Reference to component triggering event.
@param PIDL [in] PIDL representing selected folder.
@param StatusText [in/out] Set to '' when called. May be updated to
provide status text to be displayed in old style browse dialog. Ignored
by new style dialog box.
@param OKEnabled [in/out] Set to state of browse dialog's OK button when
called. May be set true to enable OK button or false to disable it.
}
TPJBrowseSelChangeEventEx = procedure(Sender: TObject;
PIDL: PItemIDList; var StatusText: string;
var OKEnabled: Boolean) of object;
{
TPJBrowseValidationFailedEvent:
Type of event triggered by TPJBrowseDialog when an invalid folder path is
entered in the dialog's edit control and the dialog is closed.
@param Sender [in] Reference to component triggering event.
@param EditText [in] Text entered in browse dialog's edit control.
@param CanClose [in/out] True when handler called: permits dialog box to
close. Change to False to prevent dialog from closing.
}
TPJBrowseValidationFailedEvent = procedure(Sender: TObject;
const EditText: string; var CanClose: Boolean) of object;
{
TPJBrowseHelpEvent:
Type of event triggered by TPJBrowserDialg when help is requested.
@param Sender [in] Reference to component triggering event.
@param Cancel [in/out] False when handler called: permits help request to
be passed to help system via Application object. Change to True to
prevent Application object handling help request: request must be
handled in event handler.
}
TPJBrowseHelpEvent = procedure(Sender: TObject; var Cancel: Boolean)
of object;
{
TPJBrowseDlgOption:
Enumeration of options available to Options property of TPJBrowseDlg.
}
TPJBrowseDlgOption = (
boShowHelp, // show help button
// (old style dialog only)
boContextHelp, // show context help icon in title
// (not available on Vista & later)
boStatusText, // show status text in dlg box
// (old style dialog only)
boDirsOnly, // only allow selection of items in file system
boNewDlgStyle, // use new dialog style
// (requires shlobj.dll v5 or later)
boHideMakeFolderBtn, // hide Make New Folder button
// (new style dialog only)
boEditBox, // display folder edit box
boHint // display usage hint
// (new style dialog only, no boEditBox)
// (requires v6 of shlobj.dll)
);
{
TPJBrowseDlgOptions:
Set of options available to Options property of TPJBrowseDlg.
}
TPJBrowseDlgOptions = set of TPJBrowseDlgOption;
{
TPJBrowseDialog:
Displays browse dialog box.
}
TPJBrowseDialog = class(TComponent)
private
fFolderName: string; // Value of FolderName property
fHeadline: string; // Value of Headline property
fDisplayName: string; // Value of DisplayName property
fRootFolderID: Integer; // Value of RootFolderID property
fTitle: TCaption; // Value of Title property
fOptions: TPJBrowseDlgOptions; // Value of Options property
fHelpContext: THelpContext; // Value of HelpContext property
{$IFDEF DELPHI6ANDUP}
fHelpType: THelpType; // Value of HelpType property
fHelpKeyword: string; // Value of HelpKeyword property
{$ENDIF}
fOnInitialise: TNotifyEvent; // References OnInitialise event handler
fOnSelChange: // References OnSelChange event handler
TPJBrowseSelChangeEvent;
fOnSelChangeEx: // References OnSelChangeEx event handler
TPJBrowseSelChangeEventEx;
fOnClose: TNotifyEvent; // References OnClose event handler
fOnValidationFailed: // Ref to OnValidationFailed event handler
TPJBrowseValidationFailedEvent;
fOnHelp: TPJBrowseHelpEvent; // Reference to OnHelp event handler
fData: // Info passed to and from callback proc
array[1..SizeOf(HWND) + SizeOf(Pointer)] of Byte;
fOldBrowseWndProc: Pointer; // Address of dialog's original winproc
fNewBrowseWndProc: Pointer; // Address of dialog's new window procedure
function GetHandle: HWND;
{Read accessor for Handle property.
@return Handle to browse dialog box while Execute method is running or 0
otherwise.
}
procedure SetRootFolderID(const Value: Integer);
{Write accessor for RootFolderID property.
@param Value [in] New property value.
@except EPJShellFolders raised if Value is not a valid special folder
id.
}
protected
function IsNewStyle: Boolean;
{Checks if a new style dialog box being displayed.
@return True if new style dialog or False if not.
}
function IsDlgBtnEnabled(const BtnID: Integer): Boolean;
{Checks if a browse dialog button is enabled.
@return True if button enabled, False if disabled.
}
function IsHelpAvailable: Boolean;
{Checks if any help is available per component's properties.
@return True if help is available.
}
procedure DoHelp;
{Triggers a help request if help is available. OnHelp event handler is
called if assigned. Application help is called if request not cancelled in
any OnHelp event handler.
}
function GetHWND: HWND;
{Gets window handle of any TWinControl that owns this component.
@return Owner handle or 0 if owner is nil or not a TWinControl.
}
procedure BrowseWndProc(var Msg: TMessage); virtual;
{Window procedure used to subclass browse dlg box.
@param Msg [in] Message to be handled by window procedure.
}
procedure InitBrowseWindow;
{Initialises the browse dialog box. This method is called from the
dialog's callback function.
}
procedure SelectionChanged(PIDL: PItemIDList);
{Triggers OnSelChange and OnSelChangeEx events for currently selected
folder. Updates status text and OK button according to values returned
from the event handler. This method is called from the dialog's callback
function.
@param PIDL [in] PIDL representing currently selected folder.
}
function ValidationFailed(const EditText: string): Boolean;
{Triggers browse dialog's OnValidationFailed event, if assigned and
returns value indicating if dialog can close.
@param EditText [in] Text from browser's edit control that references an
invalid path.
@return True if dialog box can close, False if not.
}
procedure IncludeHelpButton;
{Creates a help button and displays it in the browse dlg box, providing
that an old style dialog box is to be displayed. Other buttons are
rearranged.
}
procedure HideMakeNewFolderButton;
{Hides the dialog's Make New Folder button, providing that a new style
dialog box is to be displayed.
}
public
constructor Create(AOwner: TComponent); override;
{Class constructor. Sets up component and creates window procedure used to
subclass then browse dialog box.
@param AOwner [in] Dialog box's owner.
}
destructor Destroy; override;
{Class destructor. Tears down object and frees browse dialog's window
procedure.
}
function Execute: Boolean;
{Initialises and displays browse dialog box. Updates properties to record
user's entry if dialog box is OKd. Some of the dialog's initialisation is
performed in the dialog box's BrowseCallbackProc callback function.
@return True if user OKs, False if dialog is cancelled.
}
property DisplayName: string read fDisplayName;
{The display name of the selected folder}
property Handle: HWND read GetHandle;
{The window handle of the browse dlg box: this returns 0 if the dlg box is
not currently displayed}
published
property Title: TCaption
read fTitle write fTitle;
{The dialog box's window title. If this property is not set (i.e. is the
empty string) the dialog box displays 'Browse for Folder')}
property FolderName: string
read fFolderName write fFolderName;
{The name of the folder chosen in the dialog box. Setting this property
before executing the dialog box causes any valid folder to be highlighted
in the dialog box}
property RootFolderID: Integer
read fRootFolderID write SetRootFolderID default CSIDL_DESKTOP;
{ID of the folder to be displayed as the root in the dialog box. This can
be any of the special shell folders. If a particular folder is not
supported on the system then an exception is raised}
property Headline: string
read fHeadline write fHeadline;
{"Headline" that appears in the body of the dialog box above the tree
view}
property Options: TPJBrowseDlgOptions
read fOptions write fOptions default [boContextHelp, boDirsOnly];
{Set of options that customise the appearance of the dialog box}
property HelpContext: THelpContext
read fHelpContext write fHelpContext default 0;
{Numeric ID for components's context-sensitive help topic. Used when
Options does not contain boContextHelp and F1 is pressed or when a help
button is displayed and pressed. On supporting compilers HelpType must
also be set to htContext}
{$IFDEF DELPHI6ANDUP}
property HelpKeyword: string
read fHelpKeyword write fHelpKeyword;
{Keyword for component's context-sensitive help topic. Used when HelpType
is htKeyword and Options does not contain boContextHelp and F1 is pressed
or when a help button is displayed and pressed}
property HelpType: THelpType
read fHelpType write fHelpType default htContext;
{Indicates whether the component's context sensitive help topic is
identified by context ID or by keyword}
{$ENDIF}
property OnInitialise: TNotifyEvent
read fOnInitialise write fOnInitialise;
{Event triggered when browse dlg box is initialised. This occurs after the
window title is set and the initial selection is made. The dialog's window
can be accessed via the Handle property}
property OnSelChange: TPJBrowseSelChangeEvent
read fOnSelChange write fOnSelChange;
{Event triggered when the selection changes in the dialog box. The
dialog's window can be accessed via the Handle property}
property OnSelChangeEx: TPJBrowseSelChangeEventEx
read fOnSelChangeEx write fOnSelChangeEx;
{Event triggered when the selection changes in the dialog box, after
OnSelChange. The dialog's window can be accessed via the Handle property}
property OnClose: TNotifyEvent
read fOnClose write fOnClose;
{Event triggered when the browse dialog closes. The dialog's window can
be accessed via the Handle property}
property OnValidationFailed: TPJBrowseValidationFailedEvent
read fOnValidationFailed write fOnValidationFailed;
{Event triggered to check if browse dialog can close after user enters an
invalid path in its edit control. Only triggered when boEditBox is
included in Options}
property OnHelp: TPJBrowseHelpEvent
read fOnHelp write fOnHelp;
{Event triggered when help is requested and is available. User can handle
help request in this handler and either prevent or permit request to be
passed to Application object}
end;
{
EPJShellFolders:
Class used for exceptions raised within this unit.
}
EPJShellFolders = class(Exception);
{ Special folder routines }
function SpecialFolderIdToStr(ID: Integer): string;
{Gets name of constant representing a special folder.
@param ID [in] Special folder id.
@return Name of special folder id.
@except EPJShellFolders raised if ID is not valid.
}
function StrToSpecialFolderID(const IDStr: string): Integer;
{Gets special folder id associated with a constant.
@param IDStr [in] Name of special folder constant.
@return Associated folder id.
@except EPJShellFolders raised if IDStr is unknown.
}
function IsValidSpecialFolderId(ID: Integer): Boolean;
{Checks if a value is a valid special folder identifier.
@param Id [in] Folder id to check.
@return True if folder ID is valid, False if not.
}
function NumSpecialFolderIds: Integer;
{Gets number of supported special folder identifiers.
@return Number of special folders.
}
{ PIDL information routines }
function PIDLToFolderPath(PIDL: PItemIDList): string;
{Gets the path of a folder from a PIDL.
@param PIDL [in] PIDL containing path.
@return Required folder path.
}
function PIDLToFolderDisplayName(PIDL: PItemIDList): string;
{Gets a display name of a folder from a PIDL.
@param PIDL [in] PIDL containing display name.
@return Required display name.
}
implementation
uses
{$IFNDEF RTLNameSpaces}
// Delphi
ActiveX, Forms, ShellAPI;
{$ELSE}
Winapi.ActiveX, Vcl.Forms, Winapi.ShellAPI;
{$ENDIF}
{ Error handling }
resourcestring
{Error messages}
sBadSpecialFolderID = 'Invalid special folder ID';
sBadSpecialFolderIDStr = '"%s" is not a valid special folder ID constant';
sNoRootFolder = 'Root folder not supported on this system';
procedure Error(const Msg: string);
{Raises exception.
@param Msg [in] Exception message.
@except EPJShellFolders exception.
}
begin
raise EPJShellFolders.Create(Msg);
end;
procedure ErrorFmt(const Msg: string; Args: array of const);
{Raises exception.
@param FmtStr [in] Message format string.
@param Args [in] Array of arguments to format string.
@except EPJShellFolder exception
}
begin
Error(Format(Msg, Args));
end;
{ PIDL information routines }
type
// Signature of SHGetFolderLocation API function.
TSHGetFolderLocation = function (hwnd: HWND; csidl: Integer; hToken: THandle;
dwFlags: DWORD; var ppidl: PItemIDList): HResult; stdcall;
var
// Handle to shell32.dll.
Shell32Handle: THandle = 0;
// Reference to SHGetFolderLocation API function if supported by OS. Nil if
// function not supported.
SHGetFolderLocation: TSHGetFolderLocation = nil;
procedure InitSHGetFolderLocation;
{Loads the SHGetFolderLocation API function if available on the underlying OS.
}
begin
{$IFDEF DELPHI5ANDUP}
Shell32Handle := SafeLoadLibrary('shell32.dll');
{$ELSE}
Shell32Handle := LoadLibrary('shell32.dll');
{$ENDIF}
if Shell32Handle = 0 then
Exit;
SHGetFolderLocation := GetProcAddress(Shell32Handle, 'SHGetFolderLocation');
end;
function GetSpecialFolderLocation(FolderID: Integer; var PIDL: PItemIDList):
HResult;
{Gets a specified special folder location as a PIDL.
NOTE: This is provided as a wrapper to SHGetFolderLocation or, if that is not
supported, to SHGetSpecialFolderLocation which is deprecated in later Windows
OSs and may be removed at some point. The code in this unit calls this
function wherever it would have previously called SHGetSpecialFolderLocation.
@param FolderID [in] A CSIDL value that identifies the folder of interest.
@param PIDL [out] A PIDL specifying the folder's location relative to the
desktop. The caller must free PIDL by using CoTaskMemFree.
@return S_OK on success or an HResult error code on failure.
}
begin
if Assigned(SHGetFolderLocation) then
Result := SHGetFolderLocation(0, FolderID, 0, 0, PIDL)
else
Result := SHGetSpecialFolderLocation(0, FolderID, PIDL);
end;
function PIDLToFolderPath(PIDL: PItemIDList): string;
{Gets the path of a folder from a PIDL.
@param PIDL [in] PIDL containing path.
@return Required folder path.
}
var
Path: PChar; // buffer to hold folder's path
begin
Path := StrAlloc(MAX_PATH);
try
SHGetPathFromIDList(PIDL, Path);
Result := Path;
finally
StrDispose(Path);
end;
end;
function PIDLToFolderDisplayName(PIDL: PItemIDList): string;
{Gets a display name of a folder from a PIDL.
@param PIDL [in] PIDL containing display name.
@return Required display name.
}
var
FileInfo: TSHFileInfo; // file info passed back from SHGetFileInfo
begin
FillChar(FileInfo, SizeOf(FileInfo), #0);
SHGetFileInfo(
PChar(PIDL),
0,
FileInfo,
SizeOf(FileInfo),
SHGFI_PIDL or SHGFI_DISPLAYNAME
);
Result := FileInfo.szDisplayName;
end;
{ Special folder identifier constants and routines }
const
// Table mapping all special folder identifiers defined by Windows to string
// representations of the constants
cFolders: array[1..58] of record // table of special folder IDs
ID: Integer; // special folder identifier value
Name: string; // constant used to represent special folder
end =
(
(ID: CSIDL_ADMINTOOLS; Name: 'CSIDL_ADMINTOOLS';),
(ID: CSIDL_ALTSTARTUP; Name: 'CSIDL_ALTSTARTUP';),
(ID: CSIDL_APPDATA; Name: 'CSIDL_APPDATA';),
(ID: CSIDL_BITBUCKET; Name: 'CSIDL_BITBUCKET';),
(ID: CSIDL_CDBURN_AREA; Name: 'CSIDL_CDBURN_AREA';),
(ID: CSIDL_COMMON_ADMINTOOLS; Name: 'CSIDL_COMMON_ADMINTOOLS';),
(ID: CSIDL_COMMON_ALTSTARTUP; Name: 'CSIDL_COMMON_ALTSTARTUP';),
(ID: CSIDL_COMMON_APPDATA; Name: 'CSIDL_COMMON_APPDATA';),
(ID: CSIDL_COMMON_DESKTOPDIRECTORY; Name: 'CSIDL_COMMON_DESKTOPDIRECTORY';),
(ID: CSIDL_COMMON_DOCUMENTS; Name: 'CSIDL_COMMON_DOCUMENTS';),
(ID: CSIDL_COMMON_FAVORITES; Name: 'CSIDL_COMMON_FAVORITES';),
(ID: CSIDL_COMMON_MUSIC; Name: 'CSIDL_COMMON_MUSIC';),
(ID: CSIDL_COMMON_OEM_LINKS; Name: 'CSIDL_COMMON_OEM_LINKS';),
(ID: CSIDL_COMMON_PICTURES; Name: 'CSIDL_COMMON_PICTURES';),
(ID: CSIDL_COMMON_PROGRAMS; Name: 'CSIDL_COMMON_PROGRAMS';),
(ID: CSIDL_COMMON_STARTMENU; Name: 'CSIDL_COMMON_STARTMENU';),
(ID: CSIDL_COMMON_STARTUP; Name: 'CSIDL_COMMON_STARTUP';),
(ID: CSIDL_COMMON_TEMPLATES; Name: 'CSIDL_COMMON_TEMPLATES';),
(ID: CSIDL_COMMON_VIDEO; Name: 'CSIDL_COMMON_VIDEO';),
(ID: CSIDL_COMPUTERSNEARME; Name: 'CSIDL_COMPUTERSNEARME';),
(ID: CSIDL_CONNECTIONS; Name: 'CSIDL_CONNECTIONS';),
(ID: CSIDL_CONTROLS; Name: 'CSIDL_CONTROLS';),
(ID: CSIDL_COOKIES; Name: 'CSIDL_COOKIES';),
(ID: CSIDL_DESKTOP; Name: 'CSIDL_DESKTOP';),
(ID: CSIDL_DESKTOPDIRECTORY; Name: 'CSIDL_DESKTOPDIRECTORY';),
(ID: CSIDL_DRIVES; Name: 'CSIDL_DRIVES';),
(ID: CSIDL_FAVORITES; Name: 'CSIDL_FAVORITES';),
(ID: CSIDL_FONTS; Name: 'CSIDL_FONTS';),
(ID: CSIDL_HISTORY; Name: 'CSIDL_HISTORY';),
(ID: CSIDL_INTERNET; Name: 'CSIDL_INTERNET';),
(ID: CSIDL_INTERNET_CACHE; Name: 'CSIDL_INTERNET_CACHE';),
(ID: CSIDL_LOCAL_APPDATA; Name: 'CSIDL_LOCAL_APPDATA';),
(ID: CSIDL_MYDOCUMENTS; Name: 'CSIDL_MYDOCUMENTS';),
(ID: CSIDL_MYMUSIC; Name: 'CSIDL_MYMUSIC';),
(ID: CSIDL_MYPICTURES; Name: 'CSIDL_MYPICTURES';),
(ID: CSIDL_MYVIDEO; Name: 'CSIDL_MYVIDEO';),
(ID: CSIDL_NETHOOD; Name: 'CSIDL_NETHOOD';),
(ID: CSIDL_NETWORK; Name: 'CSIDL_NETWORK';),
(ID: CSIDL_PERSONAL; Name: 'CSIDL_PERSONAL';),
(ID: CSIDL_PRINTERS; Name: 'CSIDL_PRINTERS';),
(ID: CSIDL_PRINTHOOD; Name: 'CSIDL_PRINTHOOD';),
(ID: CSIDL_PROFILE; Name: 'CSIDL_PROFILE';),
(ID: CSIDL_PROFILES; Name: 'CSIDL_PROFILES';),
(ID: CSIDL_PROGRAM_FILES; Name: 'CSIDL_PROGRAM_FILES';),
(ID: CSIDL_PROGRAM_FILESX86; Name: 'CSIDL_PROGRAM_FILESX86';),
(ID: CSIDL_PROGRAM_FILES_COMMON; Name: 'CSIDL_PROGRAM_FILES_COMMON';),
(ID: CSIDL_PROGRAM_FILES_COMMONX86; Name: 'CSIDL_PROGRAM_FILES_COMMONX86';),
(ID: CSIDL_PROGRAMS; Name: 'CSIDL_PROGRAMS';),
(ID: CSIDL_RECENT; Name: 'CSIDL_RECENT';),
(ID: CSIDL_RESOURCES; Name: 'CSIDL_RESOURCES';),
(ID: CSIDL_RESOURCES_LOCALIZED; Name: 'CSIDL_RESOURCES_LOCALIZED'),
(ID: CSIDL_SENDTO; Name: 'CSIDL_SENDTO';),
(ID: CSIDL_STARTMENU; Name: 'CSIDL_STARTMENU';),
(ID: CSIDL_STARTUP; Name: 'CSIDL_STARTUP';),
(ID: CSIDL_SYSTEM; Name: 'CSIDL_SYSTEM';),
(ID: CSIDL_SYSTEMX86; Name: 'CSIDL_SYSTEMX86';),
(ID: CSIDL_TEMPLATES; Name: 'CSIDL_TEMPLATES';),
(ID: CSIDL_WINDOWS; Name: 'CSIDL_WINDOWS';)
);
function NumSpecialFolderIds: Integer;
{Gets number of supported special folder identifiers.
@return Number of special folders.
}
begin
Result := High(cFolders) - Low(cFolders) + 1;
end;
function IsValidSpecialFolderId(ID: Integer): Boolean;
{Checks if a value is a valid special folder identifier.
@param Id [in] Folder id to check.
@return True if folder ID is valid, False if not.
}
var
Idx: Integer; // loops through ID table
begin
Result := False;
for Idx := Low(cFolders) to High(cFolders) do
if (cFolders[Idx].ID and not CSIDL_FLAG_CREATE) = ID then
begin
Result := True;
Break;
end;
end;
function SpecialFolderIdToStr(ID: Integer): string;
{Gets name of constant representing a special folder.
@param ID [in] Special folder id.
@return Name of special folder id.
@except EPJShellFolders raised if ID is not valid.
}
var
Idx: Integer; // loops thru ID table
begin
// Assume no match
Result := '';
// Search for match to ID and get it's constant name
for Idx := Low(cFolders) to High(cFolders) do
if cFolders[Idx].ID and CSIDL_FOLDER_MASK = ID then
begin
Result := cFolders[Idx].Name;
Break;
end;
// Raise exception if we didn't find a match
if Result = '' then
Error(sBadSpecialFolderID);
end;
function StrToSpecialFolderID(const IDStr: string): Integer;
{Gets special folder id associated with a constant.
@param IDStr [in] Name of special folder constant.
@return Associated folder id.
@except EPJShellFolders raised if IDStr is unknown.
}
var
Idx: Integer; // loops thru ID table
begin
// Assume we don't find constant
Result := -1;
// Scan lookup table looking for constant
for Idx := Low(cFolders) to High(cFolders) do
if CompareText(cFolders[Idx].Name, IDStr) = 0 then
begin
Result := cFolders[Idx].ID;
Break;
end;
// Raise exception if constant never found
if Result = -1 then
ErrorFmt(sBadSpecialFolderIDStr, [IDStr]);
end;
{ TPJSpecialFolderEnum }
function TPJSpecialFolderEnum.AtEnd: Boolean;
{Checks if at end of enumeration.
@return True if at end of enumeration and false otherwise.
}
begin
Result := fIndex > High(cFolders);
end;
function TPJSpecialFolderEnum.Count: Integer;
{Gets number of folder ids in enumeration.
@return Number of folders ids.
}
begin
Result := NumSpecialFolderIds;
end;
constructor TPJSpecialFolderEnum.Create;
{Class constructor. Sets up object and intialises enumeration.
}
begin
inherited Create;
Init;
end;
procedure TPJSpecialFolderEnum.Init;
{Intialises enumeration.
}
begin
fIndex := Low(cFolders);
end;
function TPJSpecialFolderEnum.Next: Integer;
{Gets next special folder identifier in enumeration, or -1 if at end of
enumeration.
@return Folder identifier.
}
begin
if not AtEnd then
begin
Result := cFolders[fIndex].ID;
Inc(fIndex);
end
else
Result := -1;
end;
{ TPJSpecialFolderInfo }
constructor TPJSpecialFolderInfo.Create(AOwner: TComponent);
{Class constructor. Sets up object and reads information about default special
folder.
@param AOwner [in] Component's owner.
}
begin
inherited Create(AOwner);
// Set default property values
fFolderID := CSIDL_DESKTOP;
// Now get folder info accordingly
GetCurrentFolderInfo;
end;
procedure TPJSpecialFolderInfo.GetCurrentFolderInfo;
{Retrieves information about special folder specified by FolderID property and
updates read only properties accordingly.
}
var
PIDL: PItemIDList; // PIDL to special folder
begin
// Get special folder's PIDL
fIsSupported := Succeeded(GetSpecialFolderLocation(fFolderID, PIDL));
if fIsSupported then
begin
try
// Special folder is supported on this system: set required properties
fPath := PIDLToFolderPath(PIDL);
fDisplayName := PIDLToFolderDisplayName(PIDL);
fIsVirtual := (fPath = '');
finally
CoTaskMemFree(PIDL);
end;
end
else
begin
// Special folder not supported on this system: set property values
fPath := '';
fDisplayName := '';
fIsVirtual := False;
end;
end;
procedure TPJSpecialFolderInfo.SetFolderID(const Value: Integer);
{Write accessor method for FolderID property. Reads information about
specified folder.
@param Value [in] New property value.
@except EPJShellFolders raised if Value is not a valid special folder id.
}
begin
if fFolderID <> Value then
begin
if not IsValidSpecialFolderId(Value) then
Error(sBadSpecialFolderID);
fFolderID := Value;
GetCurrentFolderInfo;
end;
end;
{ TPJBrowseDialog }
type
{
TCBData:
Record that contains information passed betwenen TPJBrowseDialog component
and the Browse dlg box's callback method. The dialog box's fData field is
cast to this type when used. This was done to avoid declaring this type with
public scope.
}
TCBData = packed record
Handle: HWND; // window handle of dlg box (0 if not active)
Obj: TPJBrowseDialog; // reference to component instance
end;
{
PCBData:
Pointer to TCBData.
}
PCBData = ^TCBData;
const
// Control identifiers for Browse dialog boc
// Not all these values are user in this class: left here for future reference
// Identifiers common to old and new style dialog box
cOKBtnID = $0001;
cCancelBtnID = $0002;
cHeadlineTextID = $3742;
// Identifiers valid only in old style dialog box
cStatusTextID = $3743; // not present in new style dialog box
cOldTreeViewID = $3741; // id different in old and new style dialog boxes
// Identifiers valid only in new style dialog box
cNewFolderBtnId = $3746; // not present in old style dialog box
cNewTreeViewID = $0064; // id different in old and new style dialog boxes
// Identifier of custom help button that may be added to Browse dlg box
// note that this button is not present in the dialog box natively - it is
// added by this component
cHelpBtnID = $1000;
function BrowseCallbackProc(HWnd: HWND; Msg: UINT; LParam, Data: LPARAM):
Integer; stdcall;
{Callback function called by browse dialog box. This function has two
purposes: (1) to initialise the dialog box - properties not definable using
BrowseInfo structure are set up here (2) special processing performed when
selection changes - including triggering events.
@param HWnd [in] Handle to browser dialog box.
@param Msg [in] Identifies event that caused the callback to be called.
@param LParam [in] Message specific value - depends on Msg.
@param Data [in] Application-defined value specified in the lParam member of
the TBrowseInfo structure in SHBrowseForFolder call.
@return Always zero.