home *** CD-ROM | disk | FTP | other *** search
/ Kompuutteri K-CD 2002 #1 / K-CD_2002-01.iso / Delphi / INSTALL / program files / Borland / Delphi6 / Demos / ShellControls / ShellCtrls.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-05-22  |  95.7 KB  |  3,491 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {                                                       }
  6. {       Copyright (c) 1995,2001 Inprise Corporation     }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit ShellCtrls platform;
  11.  
  12. interface
  13.  
  14. uses
  15.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  16.   ComCtrls, CommCtrl, ShlObj, ActiveX, StdCtrls, ImgList;
  17.  
  18. type
  19.   TRoot = type string;
  20.  
  21.   TRootFolder = (rfDesktop, rfMyComputer, rfNetwork, rfRecycleBin, rfAppData,
  22.     rfCommonDesktopDirectory, rfCommonPrograms, rfCommonStartMenu, rfCommonStartup,
  23.     rfControlPanel, rfDesktopDirectory, rfFavorites, rfFonts, rfInternet, rfPersonal,
  24.     rfPrinters, rfPrintHood, rfPrograms, rfRecent, rfSendTo, rfStartMenu, rfStartup,
  25.     rfTemplates);
  26.  
  27.   TShellFolderCapability = (fcCanCopy, fcCanDelete, fcCanLink, fcCanMove, fcCanRename,
  28.                    fcDropTarget, fcHasPropSheet);
  29.   TShellFolderCapabilities = set of TShellFolderCapability;
  30.  
  31.   TShellFolderProperty = (fpCut, fpIsLink, fpReadOnly, fpShared, fpFileSystem,
  32.                      fpFileSystemAncestor, fpRemovable, fpValidate);
  33.   TShellFolderProperties = set of TShellFolderProperty;
  34.  
  35.   TShellObjectType = (otFolders, otNonFolders, otHidden);
  36.   TShellObjectTypes = set of TShellObjectType;
  37.  
  38.   EInvalidPath = class(Exception);
  39.  
  40.   IShellCommandVerb = interface
  41.     ['{7D2A7245-2376-4D33-8008-A130935A2E8B}']
  42.     procedure ExecuteCommand(Verb: string; var Handled: boolean);
  43.     procedure CommandCompleted(Verb: string; Succeeded: boolean);
  44.   end;
  45.  
  46.   TShellFolder = class
  47.   private
  48.     FPIDL,
  49.     FFullPIDL: PItemIDList;
  50.     FParent: TShellFolder;
  51.     FIShellFolder: IShellFolder;
  52.     FIShellFolder2: IShellFolder2;
  53.     FIShellDetails: IShellDetails;
  54.     FDetailInterface: IInterface;
  55.     FLevel: Integer;
  56.     FViewHandle: THandle;
  57.     FDetails: TStrings;
  58.     function GetDetailInterface: IInterface;
  59.     function GetShellDetails: IShellDetails;
  60.     function GetShellFolder2: IShellFolder2;
  61.     function GetDetails(Index: integer): string;
  62.     procedure SetDetails(Index: integer; const Value: string);
  63.     procedure LoadColumnDetails(RootFolder: TShellFolder; Handle: THandle; ColumnCount: integer);
  64.   public
  65.     constructor Create(AParent: TShellFolder; ID: PItemIDList; SF: IShellFolder); virtual;
  66.     destructor Destroy; override;
  67.     function Capabilities: TShellFolderCapabilities;
  68.     function DisplayName: string;
  69.     function ExecuteDefault: Integer;
  70.     function ImageIndex(LargeIcon: Boolean): Integer;
  71.     function IsFolder: Boolean;
  72.     function ParentShellFolder: IShellFolder;
  73.     function PathName: string;
  74.     function Properties: TShellFolderProperties;
  75.     function Rename(const NewName: WideString): boolean;
  76.     function SubFolders: Boolean;
  77.     property AbsoluteID: PItemIDLIst read FFullPIDL;
  78.     property Details[Index: integer] : string read GetDetails write SetDetails;
  79.     property Level: Integer read FLevel;
  80.     property Parent: TShellFolder read FParent;
  81.     property RelativeID: PItemIDList read FPIDL;
  82.     property ShellFolder: IShellFolder read FIShellFolder;
  83.     property ShellFolder2: IShellFolder2 read GetShellFolder2;
  84.     property ShellDetails: IShellDetails read GetShellDetails;
  85.     property ViewHandle: THandle read FViewHandle write FViewHandle;
  86.   end;
  87.  
  88.   TNotifyFilter = (nfFileNameChange, nfDirNameChange, nfAttributeChange,
  89.     nfSizeChange, nfWriteChange, nfSecurityChange);
  90.   TNotifyFilters = set of TNotifyFilter;
  91.  
  92.   TShellChangeThread = class(TThread)
  93.   private
  94.     FMutex,
  95.     FWaitHandle: Integer;
  96.     FChangeEvent: TThreadMethod;
  97.     FDirectory: string;
  98.     FWatchSubTree: Boolean;
  99.     FWaitChanged : Boolean;
  100.     FNotifyOptionFlags: DWORD;
  101.   protected
  102.     procedure Execute; override;
  103.   public
  104.     constructor Create(ChangeEvent: TThreadMethod); virtual;
  105.     destructor Destroy; override;
  106.     procedure SetDirectoryOptions( Directory : String; WatchSubTree : Boolean;
  107.       NotifyOptionFlags : DWORD);
  108.     property ChangeEvent : TThreadMethod read FChangeEvent write FChangeEvent;
  109.   end;
  110.  
  111.   TCustomShellChangeNotifier = class(TComponent)
  112.   private
  113.     FFilters: TNotifyFilters;
  114.     FWatchSubTree: Boolean;
  115.     FRoot : TRoot;
  116.     FThread: TShellChangeThread;
  117.     FOnChange: TThreadMethod;
  118.     procedure SetRoot(const Value: TRoot);
  119.     procedure SetWatchSubTree(const Value: Boolean);
  120.     procedure SetFilters(const Value: TNotifyFilters);
  121.     procedure SetOnChange(const Value: TThreadMethod);
  122.   protected
  123.     procedure Change;
  124.     procedure Start;
  125.   public
  126.     constructor Create(AOwner : TComponent); override;
  127.     destructor Destroy; override;
  128.     property NotifyFilters: TNotifyFilters read FFilters write SetFilters;
  129.     property Root: TRoot read FRoot write SetRoot;
  130.     property WatchSubTree: Boolean read FWatchSubTree write SetWatchSubTree;
  131.     property OnChange: TThreadMethod read FOnChange write SetOnChange;
  132.   end;
  133.  
  134.   TShellChangeNotifier = class(TCustomShellChangeNotifier)
  135.   published
  136.     property NotifyFilters;
  137.     property Root;
  138.     property WatchSubTree;
  139.     property OnChange;
  140.   end;
  141.  
  142.   TCustomShellComboBox = class;
  143.   TCustomShellListView = class;
  144.  
  145.   TAddFolderEvent = procedure(Sender: TObject; AFolder: TShellFolder;
  146.     var CanAdd: Boolean) of object;
  147.   TGetImageIndexEvent = procedure(Sender: TObject; Index: Integer;
  148.      var ImageIndex: Integer) of object;
  149.  
  150. { TCustomShellTreeView }
  151.  
  152.   TCustomShellTreeView = class(TCustomTreeView, IShellCommandVerb)
  153.   private
  154.     FRoot,
  155.     FOldRoot : TRoot;
  156.     FRootFolder: TShellFolder;
  157.     FObjectTypes: TShellObjectTypes;
  158.     FImages: Integer;
  159.     FLoadingRoot,
  160.     FAutoContext,
  161.     FUpdating: Boolean;
  162.     FComboBox: TCustomShellComboBox;
  163.     FListView: TCustomShellListView;
  164.     FAutoRefresh,
  165.     FImageListChanging,
  166.     FUseShellImages: Boolean;
  167.     FNotifier: TShellChangeNotifier;
  168.     FOnAddFolder: TAddFolderEvent;
  169.     FSavePath: string;
  170.     FNodeToMonitor: TTreeNode;
  171.     function FolderExists(FindID: PItemIDList; InNode: TTreeNode): TTreeNode;
  172.     function GetFolder(Index: Integer): TShellFolder;
  173.     function GetPath: string;
  174.     procedure SetComboBox(Value: TCustomShellComboBox);
  175.     procedure SetListView(const Value: TCustomShellListView);
  176.     procedure SetPath(const Value: string);
  177.     procedure SetPathFromID(ID: PItemIDList);
  178.     procedure SetRoot(const Value: TRoot);
  179.     procedure SetUseShellImages(const Value: Boolean);
  180.     procedure SetAutoRefresh(const Value: boolean);
  181.   protected
  182.     function CanChange(Node: TTreeNode): Boolean; override;
  183.     function CanExpand(Node: TTreeNode): Boolean; override;
  184.     procedure CreateRoot;
  185.     procedure CreateWnd; override;
  186.     procedure DestroyWnd; override;
  187.     procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); override;
  188.     procedure Edit(const Item: TTVItem); override;
  189.     procedure GetImageIndex(Node: TTreeNode); override;
  190.     procedure GetSelectedIndex(Node: TTreeNode); override;
  191.     procedure InitNode(NewNode: TTreeNode; ID: PItemIDList; ParentNode: TTreeNode);
  192.     procedure Loaded; override;
  193.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  194.     procedure Delete(Node: TTreeNode); override;
  195.     //! procedure NodeDeleted(Sender: TObject; Node: TTreeNode);
  196.     function NodeFromAbsoluteID(StartNode: TTreeNode; ID: PItemIDList): TTreeNode;
  197.     function NodeFromRelativeID(ParentNode: TTreeNode; ID: PItemIDList): TTreeNode;
  198.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  199.     procedure PopulateNode(Node: TTreeNode);
  200.     procedure RootChanged;
  201.     procedure SetObjectTypes(Value: TShellObjectTypes); virtual;
  202.     procedure WMDestroy(var Message: TWMDestroy); virtual;
  203.     procedure WndProc(var Message: TMessage); override;
  204.     procedure ClearItems;
  205.     procedure RefreshEvent;
  206.   public
  207.     constructor Create(AOwner: TComponent); override;
  208.     procedure Refresh(Node: TTreeNode);
  209.     function SelectedFolder: TShellFolder;
  210.     property AutoRefresh: boolean read FAutoRefresh write SetAutoRefresh;
  211.     property Folders[Index: Integer]: TShellFolder read GetFolder; default;
  212.     property Items;
  213.     property Path: string read GetPath write SetPath;
  214.     property AutoContextMenus: Boolean read FAutoContext write FAutoContext default True;
  215.     property ObjectTypes: TShellObjectTypes read FObjectTypes write SetObjectTypes;
  216.     property Root: TRoot read FRoot write SetRoot;
  217.     property ShellComboBox: TCustomShellComboBox read FComboBox write SetComboBox;
  218.     property ShellListView: TCustomShellListView read FListView write SetListView;
  219.     property UseShellImages: Boolean read FUseShellImages write SetUseShellImages;
  220.     property OnAddFolder: TAddFolderEvent read FOnAddFolder write FOnAddFolder;
  221.     procedure CommandCompleted(Verb: String; Succeeded: Boolean);
  222.     procedure ExecuteCommand(Verb: String; var Handled: Boolean);
  223.   end;
  224.  
  225. { TShellTreeView }
  226.  
  227.   TShellTreeView = class(TCustomShellTreeView)
  228.   published
  229.     property AutoContextMenus;
  230.     property ObjectTypes;
  231.     property Root;
  232.     property ShellComboBox;
  233.     property ShellListView;
  234.     property UseShellImages;
  235.     property OnAddFolder;
  236.     property Align;
  237.     property Anchors;
  238.     property AutoRefresh;
  239.     property BorderStyle;
  240.     property ChangeDelay;
  241.     property Color;
  242.     property Ctl3d;
  243.     property Cursor;
  244.     property DragCursor;
  245.     property DragMode;
  246.     property Enabled;
  247.     property Font;
  248.     property HideSelection;
  249.     property Images;
  250.     property Indent;
  251.     property ParentColor;
  252.     property ParentCtl3d;
  253.     property ParentFont;
  254.     property ParentShowHint;
  255.     property PopupMenu;
  256.     property RightClickSelect;
  257.     property ShowButtons;
  258.     property ShowHint;
  259.     property ShowLines;
  260.     property ShowRoot;
  261.     property StateImages;
  262.     property TabOrder;
  263.     property TabStop default True;
  264.     property Visible;
  265.     property OnClick;
  266.     property OnEnter;
  267.     property OnExit;
  268.     property OnDragDrop;
  269.     property OnDragOver;
  270.     property OnStartDrag;
  271.     property OnEndDrag;
  272.     property OnMouseDown;
  273.     property OnMouseMove;
  274.     property OnMouseUp;
  275.     property OnDblClick;
  276.     property OnKeyDown;
  277.     property OnKeyPress;
  278.     property OnKeyUp;
  279.     property OnChanging;
  280.     property OnChange;
  281.     property OnExpanding;
  282.     property OnCollapsing;
  283.     property OnCollapsed;
  284.     property OnExpanded;
  285.     property OnEditing;
  286.     property OnEdited;
  287.     property OnGetImageIndex;
  288.     property OnGetSelectedIndex;
  289.   end;
  290.  
  291. { TCustomShellComboBox }
  292.  
  293.   TCustomShellComboBox = class(TCustomComboBoxEx)
  294.   private
  295.     FImages,
  296.     FImageHeight,
  297.     FImageWidth: Integer;
  298.     FImageList: TCustomImageList;
  299.     FOldRoot : TRoot;
  300.     FRoot: TRoot;
  301.     FRootFolder: TShellFolder;
  302.     FTreeView: TCustomShellTreeView;
  303.     FListView: TCustomShellListView;
  304.     FObjectTypes: TShellObjectTypes;
  305.     FUseShellImages,
  306.     FUpdating: Boolean;
  307.     FOnGetImageIndex: TGetImageIndexEvent;
  308.     procedure ClearItems;
  309.     function GetFolder(Index: Integer): TShellFolder;
  310.     function GetPath: string;
  311.     procedure SetPath(const Value: string);
  312.     procedure SetPathFromID(ID: PItemIDList);
  313.     procedure SetRoot(const Value: TRoot);
  314.     procedure SetTreeView(Value: TCustomShellTreeView);
  315.     procedure SetListView(Value: TCustomShellListView);
  316.     procedure SetUseShellImages(const Value: Boolean);
  317.     function GetShellImageIndex(AFolder: TShellFolder): integer;
  318.   protected
  319.     procedure AddItems(Index: Integer; ParentFolder: TShellFolder);
  320.     procedure Change; override;
  321.     procedure Click; override;
  322.     procedure CreateRoot;
  323.     procedure CreateWnd; override;
  324.     procedure DestroyWnd; override;
  325.     function IndexFromID(AbsoluteID: PItemIDList): Integer;
  326.     procedure Init; virtual;
  327.     function InitItem(ParentFolder: TShellFolder; ID: PItemIDList): TShellFolder;
  328.     procedure Loaded; override;
  329.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  330.     procedure RootChanged;
  331.     procedure TreeUpdate(NewPath: PItemIDList);
  332.     procedure SetObjectTypes(Value: TShellObjectTypes); virtual;
  333.     //!procedure WMDestroy(var Message: TWMDestroy); message WM_DESTROY;
  334.   public
  335.     constructor Create(AOwner: TComponent); override;
  336.     destructor Destroy; override;
  337.     property Items;
  338.     property Path: string read GetPath write SetPath;
  339.     property Folders[Index: Integer]: TShellFolder read GetFolder;
  340.     property Root: TRoot read FRoot write SetRoot;
  341.     property ObjectTypes: TShellObjectTypes read FObjectTypes write SetObjectTypes;
  342.     property ShellTreeView: TCustomShellTreeView read FTreeView write SetTreeView;
  343.     property ShellListView: TCustomShellListView read FListView write SetListView;
  344.     property UseShellImages: Boolean read FUseShellImages write SetUseShellImages;
  345.     property OnGetImageIndex: TGetImageIndexEvent read FOnGetImageIndex write FOnGetImageIndex;
  346.   end;
  347.  
  348. { TShellComboBox }
  349.  
  350.   TShellComboBox = class(TCustomShellComboBox)
  351.   published
  352.     property Images;
  353.     property Root;
  354.     property ShellTreeView;
  355.     property ShellListView;
  356.     property UseShellImages;
  357.     property OnGetImageIndex;
  358.     property Anchors;
  359.     property BiDiMode;
  360.     property Color;
  361.     property Constraints;
  362.     property Ctl3D;
  363.     property DragCursor;
  364.     property DragKind;
  365.     property DragMode;
  366.     property DropDownCount;
  367.     property Enabled;
  368.     property Font;
  369.     property ImeMode;
  370.     property ImeName;
  371.     property MaxLength;
  372.     property ParentBiDiMode;
  373.     property ParentColor;
  374.     property ParentCtl3D;
  375.     property ParentFont;
  376.     property ParentShowHint;
  377.     property PopupMenu;
  378.     property ShowHint;
  379.     property TabOrder;
  380.     property TabStop;
  381.     property Visible;
  382.     property OnChange;
  383.     property OnClick;
  384.     property OnDblClick;
  385.     property OnDragDrop;
  386.     property OnDragOver;
  387.     property OnDropDown;
  388.     property OnEndDock;
  389.     property OnEndDrag;
  390.     property OnEnter;
  391.     property OnExit;
  392.     property OnKeyDown;
  393.     property OnKeyPress;
  394.     property OnKeyUp;
  395.     property OnStartDock;
  396.     property OnStartDrag;
  397.   end;
  398.  
  399. { TCustomShellListView }
  400.  
  401.   TCustomShellListView = class(TCustomListView, IShellCommandVerb)
  402.   private
  403.     FOldRoot: TRoot;
  404.     FRoot: TRoot;
  405.     FRootFolder: TShellFolder;
  406.     FAutoContext,
  407.     FAutoRefresh,
  408.     FAutoNavigate,
  409.     FSorted,
  410.     FUpdating: Boolean;
  411.     FObjectTypes: TShellObjectTypes;
  412.     FLargeImages,
  413.     FSmallImages: Integer;
  414.     FOnAddFolder: TAddFolderEvent;
  415.     FFolders: TList;
  416.     FTreeView: TCustomShellTreeView;
  417.     FComboBox: TCustomShelLComboBox;
  418.     FNotifier: TShellChangeNotifier;
  419.     FOnEditing: TLVEditingEvent;
  420.     FSettingRoot: boolean;
  421.     FSavePath: string;
  422.     procedure EnumColumns;
  423.     function GetFolder(Index: Integer): TShellFolder;
  424.     procedure SetAutoRefresh(const Value: Boolean);
  425.     procedure SetSorted(const Value: Boolean);
  426.     procedure SetTreeView(Value: TCustomShellTreeView);
  427.     procedure SetComboBox(Value: TCustomShellComboBox);
  428.     procedure TreeUpdate(NewRoot: PItemIDList);
  429.     procedure SetPathFromID(ID: PItemIDList);
  430.     procedure SynchPaths;
  431.   protected
  432.     procedure ClearItems;
  433.     procedure CreateRoot;
  434.     procedure CreateWnd; override;
  435.     procedure DestroyWnd; override;
  436.     procedure DblClick; override;
  437.     procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); override;
  438.     procedure EditText;
  439.     procedure Edit(const Item: TLVItem); override;
  440.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  441.     procedure Loaded; override;
  442.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  443.     function OwnerDataFetch(Item: TListItem; Request: TItemRequest): Boolean; override;
  444.     function OwnerDataFind(Find: TItemFind; const FindString: string;
  445.       const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer;
  446.       Direction: TSearchDirection; Wrap: Boolean): Integer; override;
  447.     procedure Populate; virtual;
  448.     procedure RootChanged;
  449.     procedure SetObjectTypes(Value: TShellObjectTypes);
  450.     procedure SetRoot(const Value: TRoot);
  451.     procedure SetViewStyle(Value: TViewStyle); override;
  452.     procedure WndProc(var Message: TMessage); override;
  453.   public
  454.     constructor Create(AOwner: TComponent); override;
  455.     destructor Destroy; override;
  456.     procedure Back;
  457.     procedure Refresh;
  458.     function SelectedFolder: TShellFolder;
  459.     property Folders[Index: Integer]: TShellFolder read GetFolder;
  460.     property RootFolder: TShellFolder read FRootFolder;
  461.     property Items;
  462.     property Columns;
  463.     property AutoContextMenus: Boolean read FAutoContext write FAutoContext default True;
  464.     property AutoRefresh: Boolean read FAutoRefresh write SetAutoRefresh default False;
  465.     property AutoNavigate: Boolean read FAutoNavigate write FAutoNavigate default True;
  466.     property ObjectTypes: TShellObjectTypes read FObjectTypes write SetObjectTypes;
  467.     property Root: TRoot read FRoot write SetRoot;
  468.     property ShellTreeView: TCustomShellTreeView read FTreeView write SetTreeView;
  469.     property ShellComboBox: TCustomShellComboBox read FComboBox write SetComboBox;
  470.     property Sorted: Boolean read FSorted write SetSorted;
  471.     property OnAddFolder: TAddFolderEvent read FOnAddFolder write FOnAddFolder;
  472.     property OnEditing: TLVEditingEvent read FOnEditing write FOnEditing;
  473.     procedure CommandCompleted(Verb: String; Succeeded: Boolean);
  474.     procedure ExecuteCommand(Verb: String; var Handled: Boolean);
  475.   end;
  476.  
  477. { TShellListView }
  478.  
  479.   TShellListView = class(TCustomShellListView)
  480.   published
  481.     property AutoContextMenus;
  482.     property AutoRefresh;
  483.     property AutoNavigate;
  484.     property ObjectTypes;
  485.     property Root;
  486.     property ShellTreeView;
  487.     property ShellComboBox;
  488.     property Sorted;
  489.     property OnAddFolder;
  490.     property Align;
  491.     property Anchors;
  492.     property BorderStyle;
  493.     property Color;
  494.     property ColumnClick;
  495.     property OnClick;
  496.     property OnDblClick;
  497.     property Ctl3D;
  498.     property DragMode;
  499.     property ReadOnly default True;
  500.     property Enabled;
  501.     property Font;
  502.     property GridLines;
  503.     property HideSelection;
  504.     property HotTrack;
  505.     property IconOptions;
  506.     property AllocBy;
  507.     property MultiSelect;
  508.     property RowSelect;
  509.     property OnChange;
  510.     property OnChanging;
  511.     property OnColumnClick;
  512.     property OnContextPopup;
  513.     property OnEnter;
  514.     property OnExit;
  515.     property OnInsert;
  516.     property OnDragDrop;
  517.     property OnDragOver;
  518.     property DragCursor;
  519.     property OnStartDrag;
  520.     property OnEndDrag;
  521.     property OnMouseDown;
  522.     property OnMouseMove;
  523.     property OnMouseUp;
  524.     property ParentColor default False;
  525.     property ParentFont;
  526.     property ParentShowHint;
  527.     property ShowHint;
  528.     property PopupMenu;
  529.     property ShowColumnHeaders;
  530.     property TabOrder;
  531.     property TabStop default True;
  532.     property Visible;
  533.     property ViewStyle;
  534.     property OnKeyDown;
  535.     property OnKeyPress;
  536.     property OnKeyUp;
  537.     property OnEditing;
  538.   end;
  539.  
  540. procedure InvokeContextMenu(Owner: TWinControl; AFolder: TShellFolder; X, Y: Integer);
  541.  
  542. implementation
  543.  
  544. uses ShellConsts, ShellAPI, ComObj, TypInfo, Menus, Consts, Math;
  545.  
  546. const
  547.   nFolder: array[TRootFolder] of Integer =
  548.     (CSIDL_DESKTOP, CSIDL_DRIVES, CSIDL_NETWORK, CSIDL_BITBUCKET, CSIDL_APPDATA,
  549.     CSIDL_COMMON_DESKTOPDIRECTORY, CSIDL_COMMON_PROGRAMS, CSIDL_COMMON_STARTMENU,
  550.     CSIDL_COMMON_STARTUP, CSIDL_CONTROLS, CSIDL_DESKTOPDIRECTORY, CSIDL_FAVORITES,
  551.     CSIDL_FONTS, CSIDL_INTERNET, CSIDL_PERSONAL, CSIDL_PRINTERS, CSIDL_PRINTHOOD,
  552.     CSIDL_PROGRAMS, CSIDL_RECENT, CSIDL_SENDTO, CSIDL_STARTMENU, CSIDL_STARTUP,
  553.     CSIDL_TEMPLATES);
  554.  
  555.  
  556. var
  557.   cmvProperties: PChar = 'properties';  { Do not localize }
  558.   ICM: IContextMenu = nil;
  559.   ICM2: IContextMenu2 = nil;
  560.   DesktopFolder: TShellFolder = nil;
  561.   CS : TRTLCriticalSection;
  562.  
  563. { PIDL manipulation }
  564.  
  565. procedure debug(Comp:TComponent; msg:string);
  566. begin
  567.   ShowMessage(Comp.Name + ':' + msg);
  568. end;
  569.  
  570. function CreatePIDL(Size: Integer): PItemIDList;
  571. var
  572.   Malloc: IMalloc;
  573. begin
  574.   OleCheck(SHGetMalloc(Malloc));
  575.  
  576.   Result := Malloc.Alloc(Size);
  577.   if Assigned(Result) then
  578.     FillChar(Result^, Size, 0);
  579. end;
  580.  
  581. function NextPIDL(IDList: PItemIDList): PItemIDList;
  582. begin
  583.   Result := IDList;
  584.   Inc(PChar(Result), IDList^.mkid.cb);
  585. end;
  586.  
  587. procedure StripLastID(IDList: PItemIDList);
  588. var
  589.   MarkerID: PItemIDList;
  590. begin
  591.   MarkerID := IDList;
  592.   if Assigned(IDList) then
  593.   begin
  594.     while IDList.mkid.cb <> 0 do
  595.     begin
  596.       MarkerID := IDList;
  597.       IDList := NextPIDL(IDList);
  598.     end;
  599.     MarkerID.mkid.cb := 0;
  600.   end;
  601. end;
  602.  
  603. function GetItemCount(IDList: PItemIDList): Integer;
  604. begin
  605.   Result := 0;
  606.   while IDList^.mkid.cb <> 0 do
  607.   begin
  608.     Inc(Result);
  609.     IDList := NextPIDL(IDList);
  610.   end;
  611. end;
  612.  
  613. function GetPIDLSize(IDList: PItemIDList): Integer;
  614. begin
  615.   Result := 0;
  616.   if Assigned(IDList) then
  617.   begin
  618.     Result := SizeOf(IDList^.mkid.cb);
  619.     while IDList^.mkid.cb <> 0 do
  620.     begin
  621.       Result := Result + IDList^.mkid.cb;
  622.       IDList := NextPIDL(IDList);
  623.     end;
  624.   end;
  625. end;
  626.  
  627. function CopyPIDL(IDList: PItemIDList): PItemIDList;
  628. var
  629.   Size: Integer;
  630. begin
  631.   Size := GetPIDLSize(IDList);
  632.   Result := CreatePIDL(Size);
  633.   if Assigned(Result) then
  634.     CopyMemory(Result, IDList, Size);
  635. end;
  636.  
  637. function ConcatPIDLs(IDList1, IDList2: PItemIDList): PItemIDList;
  638. var
  639.   cb1, cb2: Integer;
  640. begin
  641.   if Assigned(IDList1) then
  642.     cb1 := GetPIDLSize(IDList1) - SizeOf(IDList1^.mkid.cb)
  643.   else
  644.     cb1 := 0;
  645.  
  646.   cb2 := GetPIDLSize(IDList2);
  647.  
  648.   Result := CreatePIDL(cb1 + cb2);
  649.   if Assigned(Result) then
  650.   begin
  651.     if Assigned(IDList1) then
  652.       CopyMemory(Result, IDList1, cb1);
  653.     CopyMemory(PChar(Result) + cb1, IDList2, cb2);
  654.   end;
  655. end;
  656.  
  657. procedure DisposePIDL(PIDL: PItemIDList);
  658. var
  659.   MAlloc: IMAlloc;
  660. begin
  661.   OLECheck(SHGetMAlloc(MAlloc));
  662.   MAlloc.Free(PIDL);
  663. end;
  664.  
  665. function RelativeFromAbsolute(AbsoluteID: PItemIDList): PItemIDList;
  666. begin
  667.   Result := AbsoluteID;
  668.   while GetItemCount(Result) > 1 do
  669.      Result := NextPIDL(Result);
  670.   Result := CopyPIDL(Result);
  671. end;
  672.  
  673. function CreatePIDLList(ID: PItemIDList): TList;
  674. var
  675.   TempID: PItemIDList;
  676. begin
  677.   Result := TList.Create;
  678.   TempID := ID;
  679.   while TempID.mkid.cb <> 0 do
  680.   begin
  681.     TempID := CopyPIDL(TempID);
  682.     Result.Insert(0, TempID); //0 = lowest level PIDL.
  683.     StripLastID(TempID);
  684.   end;
  685. end;
  686.  
  687. procedure DestroyPIDLList(List: TList);
  688. var
  689.   I: Integer;
  690. begin
  691.   If List = nil then Exit;
  692.   for I := 0 to List.Count-1 do
  693.     DisposePIDL(List[I]);
  694.   List.Free;
  695. end;
  696.  
  697. { Miscellaneous }
  698.  
  699. procedure NoFolderDetails(AFolder: TShellFolder; HR: HResult);
  700. begin
  701.   Raise EInvalidPath.CreateFmt(SShellNoDetails, [AFolder.DisplayName, HR]);
  702. end;
  703.  
  704. function DesktopShellFolder: IShellFolder;
  705. begin
  706.   OleCheck(SHGetDesktopFolder(Result));
  707. end;
  708.  
  709. procedure CreateDesktopFolder;
  710. var
  711.   DesktopPIDL: PItemIDList;
  712. begin
  713.   SHGetSpecialFolderLocation(0, nFolder[rfDesktop], DesktopPIDL);
  714.   if DesktopPIDL <> nil then
  715.     DesktopFolder := TShellFolder.Create(nil, DesktopPIDL, DesktopShellFolder);
  716. end;
  717.  
  718. function SamePIDL(ID1, ID2: PItemIDList): boolean;
  719. begin
  720.   Result := DesktopShellFolder.CompareIDs(0, ID1, ID2) = 0;
  721. end;
  722.  
  723. function DesktopPIDL: PItemIDList;
  724. begin
  725.   OleCheck(SHGetSpecialFolderLocation(0, nFolder[rfDesktop], Result));
  726. end;
  727.  
  728. function GetCSIDLType(const Value: string): TRootFolder;
  729. begin
  730. {$R+}
  731.   Result := TRootFolder(GetEnumValue(TypeInfo(TRootFolder), Value))
  732. {$R-}
  733. end;
  734.  
  735. function IsElement(Element, Flag: Integer): Boolean;
  736. begin
  737.   Result := Element and Flag <> 0;
  738. end;
  739.  
  740. function GetShellImage(PIDL: PItemIDList; Large, Open: Boolean): Integer;
  741. var
  742.   FileInfo: TSHFileInfo;
  743.   Flags: Integer;
  744. begin
  745.   Flags := SHGFI_PIDL or SHGFI_SYSICONINDEX;
  746.   if Open then Flags := Flags or SHGFI_OPENICON;
  747.   if Large then Flags := Flags or SHGFI_LARGEICON
  748.   else Flags := Flags or SHGFI_SMALLICON;
  749.   SHGetFileInfo(PChar(PIDL),
  750.                 0,
  751.                 FileInfo,
  752.                 SizeOf(FileInfo),
  753.                 Flags);
  754.   Result := FileInfo.iIcon;
  755. end;
  756.  
  757. function GetCaps(ParentFolder: IShellFolder; PIDL: PItemIDList): TShellFolderCapabilities;
  758. var
  759.   Flags: LongWord;
  760. begin
  761.   Result := [];
  762.   Flags := SFGAO_CAPABILITYMASK;
  763.   ParentFolder.GetAttributesOf(1, PIDL, Flags);
  764.   if IsElement(SFGAO_CANCOPY, Flags) then Include(Result, fcCanCopy);
  765.   if IsElement(SFGAO_CANDELETE, Flags) then Include(Result, fcCanDelete);
  766.   if IsElement(SFGAO_CANLINK, Flags) then Include(Result, fcCanLink);
  767.   if IsElement(SFGAO_CANMOVE, Flags) then Include(Result, fcCanMove);
  768.   if IsElement(SFGAO_CANRENAME, Flags) then Include(Result, fcCanRename);
  769.   if IsElement(SFGAO_DROPTARGET, Flags) then Include(Result, fcDropTarget);
  770.   if IsElement(SFGAO_HASPROPSHEET, Flags) then Include(Result, fcHasPropSheet);
  771. end;
  772.  
  773. function GetProperties(ParentFolder: IShellFolder; PIDL: PItemIDList): TShellFolderProperties;
  774. var
  775.   Flags: LongWord;
  776. begin
  777.   Result := [];
  778.   if ParentFolder = nil then Exit;
  779.   Flags := SFGAO_DISPLAYATTRMASK;
  780.   ParentFolder.GetAttributesOf(1, PIDL, Flags);
  781.   if IsElement(SFGAO_GHOSTED, Flags) then Include(Result, fpCut);
  782.   if IsElement(SFGAO_LINK, Flags) then Include(Result, fpIsLink);
  783.   if IsElement(SFGAO_READONLY, Flags) then Include(Result, fpReadOnly);
  784.   if IsElement(SFGAO_SHARE, Flags) then Include(Result, fpShared);
  785.  
  786.   Flags := 0;
  787.   ParentFolder.GetAttributesOf(1, PIDL, Flags);
  788.   if IsElement(SFGAO_FILESYSTEM, Flags) then Include(Result, fpFileSystem);
  789.   if IsElement(SFGAO_FILESYSANCESTOR, Flags) then Include(Result, fpFileSystemAncestor);
  790.   if IsElement(SFGAO_REMOVABLE, Flags) then Include(Result, fpRemovable);
  791.   if IsElement(SFGAO_VALIDATE, Flags) then Include(Result, fpValidate);
  792. end;
  793.  
  794. function GetIsFolder(Parentfolder: IShellFolder; PIDL: PItemIDList): Boolean;
  795. var
  796.   Flags: LongWord;
  797. begin
  798.   Flags := SFGAO_FOLDER;
  799.   ParentFolder.GetAttributesOf(1, PIDL, Flags);
  800.   Result := SFGAO_FOLDER and Flags <> 0;
  801. end;
  802.  
  803. function GetHasSubFolders(Parentfolder: IShellFolder; PIDL: PItemIDList): Boolean;
  804. var
  805.   Flags: LongWord;
  806. begin
  807.   Flags := SFGAO_CONTENTSMASK;
  808.   ParentFolder.GetAttributesOf(1, PIDL, Flags);
  809.   Result := SFGAO_HASSUBFOLDER and Flags <> 0;
  810. end;
  811.  
  812. function GetHasSubItems(ShellFolder: IShellFolder; Flags: Integer): Boolean;
  813. var
  814.   ID: PItemIDList;
  815.   EnumList: IEnumIDList;
  816.   NumIDs: LongWord;
  817.   HR: HResult;
  818.   ErrMode: Integer;
  819. begin
  820.   Result := False;
  821.   if ShellFolder = nil then Exit;
  822.   ErrMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  823.   try
  824.     HR := ShellFolder.EnumObjects(0,
  825.                                 Flags,
  826.                                 EnumList);
  827.     if HR <> S_OK then Exit;
  828.     Result := EnumList.Next(1, ID, NumIDs) = S_OK;
  829.   finally
  830.     SetErrorMode(ErrMode);
  831.   end;
  832. end;
  833.  
  834. function StrRetToString(PIDL: PItemIDList; StrRet: TStrRet; Flag:string=''): string;
  835. var
  836.   P: PChar;
  837. begin
  838.   case StrRet.uType of
  839.     STRRET_CSTR:
  840.       SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr));
  841.     STRRET_OFFSET:
  842.       begin
  843.         P := @PIDL.mkid.abID[StrRet.uOffset - SizeOf(PIDL.mkid.cb)];
  844.         SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset);
  845.       end;
  846.     STRRET_WSTR:
  847.       if Assigned(StrRet.pOleStr) then
  848.         Result := StrRet.pOleStr
  849.       else
  850.         Result := '';  
  851.   end;
  852.   { This is a hack bug fix to get around Windows Shell Controls returning
  853.     spurious "?"s in date/time detail fields } 
  854.   if (Length(Result) > 1) and (Result[1] = '?') and (Result[2] in ['0'..'9']) then
  855.     Result := StringReplace(Result,'?','',[rfReplaceAll]);
  856. end;
  857.  
  858. function GetDisplayName(Parentfolder: IShellFolder; PIDL: PItemIDList;
  859.                         Flags: DWORD): string;
  860. var
  861.   StrRet: TStrRet;
  862. begin
  863.   Result := '';
  864.   if ParentFolder = nil then
  865.   begin
  866.     Result := 'parentfolder = nil';  { Do not localize }
  867.     exit;
  868.   end;
  869.   FillChar(StrRet, SizeOf(StrRet), 0);
  870.   ParentFolder.GetDisplayNameOf(PIDL, Flags, StrRet);
  871.   Result := StrRetToString(PIDL, StrRet);
  872.   { TODO 2 -oMGD -cShell Controls : Remove this hack (on Win2k, GUIDs are returned for the
  873. PathName of standard folders)}
  874.   if (Pos('::{', Result) = 1) then
  875.     Result := GetDisplayName(ParentFolder, PIDL, SHGDN_NORMAL);
  876. end;
  877.  
  878. function ObjectFlags(ObjectTypes: TShellObjectTypes): Integer;
  879. begin
  880.   Result := 0;
  881.   if otFolders in ObjectTypes then Inc(Result, SHCONTF_FOLDERS);
  882.   if otNonFolders in ObjectTypes then Inc(Result, SHCONTF_NONFOLDERS);
  883.   if otHidden in ObjectTypes then Inc(Result, SHCONTF_INCLUDEHIDDEN);
  884. end;
  885.  
  886. procedure InvokeContextMenu(Owner: TWinControl; AFolder: TShellFolder; X, Y: Integer);
  887. var
  888.   PIDL: PItemIDList;
  889.   CM: IContextMenu;
  890.   Menu: HMenu;
  891.   ICI: TCMInvokeCommandInfo;
  892.   P: TPoint;
  893.   Command: LongBool;
  894.   ICmd: integer;
  895.   ZVerb: array[0..255] of char;
  896.   Verb: string;
  897.   Handled: boolean;
  898.   SCV: IShellCommandVerb;
  899.   HR: HResult;
  900. begin
  901.   if AFolder = nil then Exit;
  902.   PIDL := AFolder.RelativeID;
  903.   AFolder.ParentShellFolder.GetUIObjectOf(Owner.Handle, 1, PIDL, IID_IContextMenu, nil, CM);
  904.   if CM = nil then Exit;
  905.   P.X := X;
  906.   P.Y := Y;
  907.  
  908.   Windows.ClientToScreen(Owner.Handle, P);
  909.   Menu := CreatePopupMenu;
  910.   try
  911.     CM.QueryContextMenu(Menu, 0, 1, $7FFF, CMF_EXPLORE or CMF_CANRENAME);
  912.     CM.QueryInterface(IID_IContextMenu2, ICM2); //To handle submenus.
  913.     try
  914.       Command := TrackPopupMenu(Menu, TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON or
  915.         TPM_RETURNCMD, P.X, P.Y, 0, Owner.Handle, nil);
  916.     finally
  917.       ICM2 := nil;
  918.     end;
  919.  
  920.     if Command then
  921.     begin
  922.       ICmd := LongInt(Command) - 1;
  923.       HR := CM.GetCommandString(ICmd, GCS_VERBA, nil, ZVerb, SizeOf(ZVerb));
  924.       Verb := StrPas(ZVerb);
  925.       Handled := False;
  926.       if Supports(Owner, IShellCommandVerb, SCV) then
  927.       begin
  928.         HR := 0;
  929.         SCV.ExecuteCommand(Verb, Handled);
  930.       end;
  931.  
  932.       if not Handled then
  933.       begin
  934.         FillChar(ICI, SizeOf(ICI), #0);
  935.         with ICI do
  936.         begin
  937.           cbSize := SizeOf(ICI);
  938.           hWND := Owner.Handle;
  939.           lpVerb := MakeIntResource(ICmd);
  940.           nShow := SW_SHOWNORMAL;
  941.         end;
  942.         HR := CM.InvokeCommand(ICI);
  943.       end;
  944.  
  945.       if Assigned(SCV) then
  946.         SCV.CommandCompleted(Verb, HR = S_OK);
  947.     end;
  948.   finally
  949.     DestroyMenu(Menu);
  950.   end;
  951. end;
  952.  
  953. procedure DoContextMenuVerb(AFolder: TShellFolder; Verb: PChar);
  954. var
  955.   ICI: TCMInvokeCommandInfo;
  956.   CM: IContextMenu;
  957.   PIDL: PItemIDList;
  958. begin
  959.   if AFolder = nil then Exit;
  960.   FillChar(ICI, SizeOf(ICI), #0);
  961.   with ICI do
  962.   begin
  963.     cbSize := SizeOf(ICI);
  964.     fMask := CMIC_MASK_ASYNCOK;
  965.     hWND := 0;
  966.     lpVerb := Verb;
  967.     nShow := SW_SHOWNORMAL;
  968.   end;
  969.   PIDL := AFolder.RelativeID;
  970.   AFolder.ParentShellFolder.GetUIObjectOf(0, 1, PIDL, IID_IContextMenu, nil, CM);
  971.   CM.InvokeCommand(ICI);
  972. end;
  973.  
  974. function GetIShellFolder(IFolder: IShellFolder; PIDL: PItemIDList;
  975.   Handle: THandle = 0): IShellFolder;
  976. var
  977.   HR : HResult;
  978. begin
  979.   if Assigned(IFolder) then
  980.   begin
  981.     HR := IFolder.BindToObject(PIDL, nil, IID_IShellFolder, Pointer(Result));
  982.     if HR <> S_OK then
  983.       IFolder.GetUIObjectOf(Handle, 1, PIDL, IID_IShellFolder, nil, Pointer(Result));
  984.     if HR <> S_OK then
  985.       IFolder.CreateViewObject(Handle, IID_IShellFolder, Pointer(Result));
  986.   end;
  987.   if not Assigned(Result) then
  988.     DesktopShellFolder.BindToObject(PIDL, nil, IID_IShellFolder, Pointer(Result));
  989. end;
  990.  
  991. function GetIShellDetails(IFolder: IShellFolder; PIDL: PItemIDList;
  992.   Handle: THandle = 0): IShellDetails;
  993. var
  994.   HR : HResult;
  995. begin
  996.   if Assigned(IFolder) then
  997.   begin
  998.     HR := IFolder.BindToObject(PIDL, nil, IID_IShellDetails, Pointer(Result));
  999.     if HR <> S_OK then
  1000.       IFolder.GetUIObjectOf(Handle, 1, PIDL, IID_IShellDetails, nil, Pointer(Result));
  1001.     if HR <> S_OK then
  1002.       IFolder.CreateViewObject(Handle, IID_IShellDetails, Pointer(Result));
  1003.   end;
  1004.   if not Assigned(Result) then
  1005.     DesktopShellFolder.BindToObject(PIDL, nil, IID_IShellDetails, Pointer(Result));
  1006. end;
  1007.  
  1008. function GetIShellFolder2(IFolder: IShellFolder; PIDL: PItemIDList;
  1009.   Handle: THandle = 0): IShellFolder2;
  1010. var
  1011.   HR : HResult;
  1012. begin
  1013.   if (Win32MajorVersion >= 5) then
  1014.   begin
  1015.     HR := DesktopShellFolder.BindToObject(PIDL, nil, IID_IShellFolder2, Pointer(Result));
  1016.     if HR <> S_OK then
  1017.       IFolder.GetUIObjectOf(Handle, 1, PIDL, IID_IShellFolder2, nil, Pointer(Result));
  1018.     if (HR <> S_OK) and (IFolder <> nil) then
  1019.       IFolder.BindToObject(PIDL, nil, IID_IShellFolder2, Pointer(Result));
  1020.   end
  1021.   else
  1022.     Result := nil;
  1023. end;
  1024.  
  1025. function CreateRootFromPIDL(Value: PItemIDList): TShellFolder;
  1026. var
  1027.   SF: IShellFolder;
  1028. begin
  1029.   SF := GetIShellFolder(DesktopShellFolder, Value);
  1030.   if SF = NIL then SF := DesktopShellFolder;
  1031.   //special case - Desktop folder can't bind to itself.
  1032.   Result := TShellFolder.Create(DesktopFolder, Value, SF);
  1033. end;
  1034.  
  1035. function CreateRootFolder(RootFolder: TShellFolder; OldRoot : TRoot;
  1036.   var NewRoot: TRoot): TShellFolder;
  1037. var
  1038.   P: PWideChar;
  1039.   NewPIDL: PItemIDList;
  1040.   NumChars,
  1041.   Flags,
  1042.   HR: LongWord;
  1043.   ErrorMsg : string;
  1044. begin
  1045.   HR := S_FALSE;
  1046.   if GetEnumValue(TypeInfo(TRootFolder), NewRoot) >= 0 then
  1047.   begin
  1048.     HR := SHGetSpecialFolderLocation(
  1049.             0,
  1050.             nFolder[GetCSIDLType(NewRoot)],
  1051.             NewPIDL);
  1052.   end
  1053.   else if Length(NewRoot) > 0 then
  1054.   begin
  1055.     if NewRoot[Length(NewRoot)] = ':' then NewRoot := NewRoot + '\';
  1056.     NumChars := Length(NewRoot);
  1057.     Flags := 0;
  1058.     P := StringToOleStr(NewRoot);
  1059.     HR := DesktopShellFolder.ParseDisplayName(0, nil, P, NumChars, NewPIDL, Flags);
  1060.   end;
  1061.  
  1062.   if HR <> S_OK then
  1063.   begin
  1064.     { TODO : Remove the next line? }
  1065.     // Result := RootFolder;
  1066.     ErrorMsg := Format( SErrorSettingPath, [ NewRoot ] );
  1067.     NewRoot := OldRoot;
  1068.     raise Exception.Create( ErrorMsg );
  1069.   end;
  1070.  
  1071.   Result := CreateRootFromPIDL(NewPIDL);
  1072.   if Assigned(RootFolder) then RootFolder.Free;
  1073. end;
  1074.  
  1075. { TShellFolder }
  1076.  
  1077. constructor TShellFolder.Create(AParent: TShellFolder; ID: PItemIDList; SF: IShellFolder);
  1078. var
  1079.   DesktopID: PItemIDList;
  1080. begin
  1081.   inherited Create;
  1082.   FLevel := 0;
  1083.   FDetails := TStringList.Create;
  1084.   FIShellFolder := SF;
  1085.   FIShellFolder2 := nil;
  1086.   FIShellDetails := nil;
  1087.   FParent := AParent;
  1088.   FPIDL := CopyPIDL(ID);
  1089.   if FParent <> nil then
  1090.     FFullPIDL := ConcatPIDLs(AParent.FFullPIDL, ID)
  1091.   else
  1092.   begin
  1093.     DesktopID := DesktopPIDL;
  1094.     try
  1095.       FFullPIDL := ConcatPIDLs(DesktopID, ID);
  1096.     finally
  1097.       DisposePIDL(DesktopID);
  1098.     end;
  1099.   end;
  1100.   if FParent = nil then
  1101.     FParent := DesktopFolder;
  1102.   while AParent <> nil do
  1103.   begin
  1104.     AParent := AParent.Parent;
  1105.     if AParent <> nil then Inc(FLevel);
  1106.   end;
  1107. end;
  1108.  
  1109. destructor TShellFolder.Destroy;
  1110. begin
  1111.   if Assigned(FDetails) then
  1112.     FDetails.Free;
  1113.   FDetails := nil;  
  1114.   if Assigned(FPIDL) then
  1115.     DisposePIDL(FPIDL);
  1116.   if Assigned(FFullPIDL) then
  1117.     DisposePIDL(FFullPIDL);
  1118.   inherited Destroy;
  1119. end;
  1120.  
  1121. function TShellFolder.GetDetailInterface: IInterface;
  1122. begin
  1123.   if (not Assigned(FDetailInterface)) and Assigned(FIShellFolder) then
  1124.   begin
  1125.     FIShellDetails := GetIShellDetails(FIShellFolder, FFullPIDL, FViewHandle);
  1126.     if (not Assigned(FIShellDetails)) and (Win32MajorVersion >= 5) then
  1127.     begin
  1128.       FIShellFolder2 := GetIShellFolder2(FIShellFolder, FFullPIDL, FViewHandle);
  1129.       if not Assigned(FIShellFolder2) then // Hack!
  1130.        { Note: Although QueryInterface will not work in this instance,
  1131.          IShellFolder2 is indeed supported for this Folder if IShellDetails
  1132.          is not. In all tested cases, hard-casting the interface to
  1133.          IShellFolder2 has worked. Hopefully, Microsoft will fix this bug in
  1134.          a future release of ShellControls }
  1135.         FIShellFolder2 := IShellFolder2(FIShellFolder);
  1136.     end;
  1137.     if Assigned(FIShellFolder2) then
  1138.       Result := FIShellFolder2
  1139.     else
  1140.       Result := FIShellDetails;
  1141.     FDetailInterface := Result;
  1142.   end
  1143.   else
  1144.     Result := FDetailInterface;
  1145. end;
  1146.  
  1147. function TShellFolder.GetShellDetails: IShellDetails;
  1148. begin
  1149.   if not Assigned(FDetailInterface) then
  1150.     GetDetailInterface;
  1151.   Result := FIShellDetails;
  1152. end;
  1153.  
  1154. function TShellFolder.GetShellFolder2: IShellFolder2;
  1155. begin
  1156.   if not Assigned(FDetailInterface) then
  1157.     GetDetailInterface;
  1158.   Result := FIShellFolder2;
  1159. end;
  1160.  
  1161. procedure TShellFolder.LoadColumnDetails(RootFolder: TShellFolder;
  1162.   Handle: THandle; ColumnCount: integer);
  1163.  
  1164.   procedure GetDetailsOf(AFolder: TShellFolder; var Details: TWin32FindData);
  1165.   var
  1166.     szPath: array[ 0 .. MAX_PATH] of char;
  1167.     Path: string;
  1168.     Handle: THandle;
  1169.   begin
  1170.     FillChar(Details, SizeOf(Details), 0);
  1171.     FillChar(szPath,MAX_PATH,0);
  1172.     Path := AFolder.PathName;
  1173.     Handle := Windows.FindFirstFile(PChar(Path), Details);
  1174.     try
  1175.       if Handle = INVALID_HANDLE_VALUE then
  1176.         NoFolderDetails(AFolder, Windows.GetLastError);
  1177.     finally
  1178.       Windows.FindClose(Handle);
  1179.     end;
  1180.   end;
  1181.  
  1182.   function CalcFileSize(FindData: TWin32FindData): int64;
  1183.   begin
  1184.     if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
  1185.       Result := FindData.nFileSizeHigh * MAXDWORD + FindData.nFileSizeLow
  1186.     else
  1187.       Result := -1;
  1188.   end;
  1189.  
  1190.   function CalcModifiedDate(FindData: TWin32FindData): TDateTime;
  1191.   var
  1192.     LocalFileTime: TFileTime;
  1193.     Age : integer;
  1194.   begin
  1195.     if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
  1196.     begin
  1197.       FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
  1198.       if FileTimeToDosDateTime(LocalFileTime, LongRec(Age).Hi,
  1199.         LongRec(Age).Lo) then
  1200.       begin
  1201.         Result := FileDateToDateTime(Age);
  1202.         Exit;
  1203.       end;
  1204.     end;
  1205.     Result := -1;
  1206.   end;
  1207.  
  1208.   function DefaultDetailColumn(FindData: TWin32FindData; Col: integer): string;
  1209.   begin
  1210.     case Col of
  1211.     //1 : Result := FindData.cFileName; // Name
  1212.     1 : Result := IntToStr(CalcFileSize(FindData)); // Size
  1213.     2 : Result := ExtractFileExt(FindData.cFileName); // Type
  1214.     3 : Result := DateTimeToStr(CalcModifiedDate(FindData)); // Modified
  1215.     4 : Result := IntToStr(FindData.dwFileAttributes);
  1216.     end;
  1217.   end;
  1218.  
  1219.   procedure AddDetail(HR: HResult; PIDL: PItemIDList; SD: TShellDetails);
  1220.   begin
  1221.     if HR = S_OK then
  1222.       FDetails.Add(StrRetToString(PIDL, SD.str))
  1223.     else
  1224.       FDetails.Add('');
  1225.   end;
  1226.   
  1227. var
  1228.   SF2: IShellFolder2;
  1229.   ISD: IShellDetails;
  1230.   J: Integer;
  1231.   SD: TShellDetails;
  1232.   HR: HResult;
  1233.   //AFolder: TShellFolder;
  1234.   FindData: TWin32FindData;
  1235.  
  1236. begin
  1237.   if not Assigned(FDetails) or (FDetails.Count >= ColumnCount) then Exit; // Details are loaded
  1238.   FDetails.Clear;
  1239.   FViewHandle := Handle;
  1240.   SF2 := RootFolder.ShellFolder2;
  1241.   {//!
  1242.   if fpFileSystem in Properties then
  1243.     ColumnCount := 4;
  1244.   }
  1245.   if Assigned(SF2) then
  1246.   begin
  1247.     // Already have name and icon, so see if we can provide details
  1248.     for J := 1 to ColumnCount do
  1249.     begin
  1250.       HR := SF2.GetDetailsOf(FPIDL, J, SD);
  1251.       AddDetail(HR, FPIDL, SD);
  1252.     end;
  1253.   end
  1254.   else
  1255.   begin
  1256.     ISD := RootFolder.ShellDetails;
  1257.     if Assigned(ISD) then
  1258.     begin
  1259.       for J := 1 to ColumnCount do
  1260.       begin
  1261.         HR := ISD.GetDetailsOf(FPIDL, J, SD);
  1262.         AddDetail(HR, FPIDL, SD);
  1263.       end;
  1264.     end
  1265.     else if (fpFileSystem in RootFolder.Properties) then
  1266.     begin
  1267.       GetDetailsOf(Self, FindData);
  1268.       for J := 1 to ColumnCount do
  1269.         FDetails.Add(DefaultDetailColumn(FindData, J));
  1270.     end;
  1271.   end;
  1272. end;
  1273.  
  1274. function TShellFolder.GetDetails(Index: integer): string;
  1275. begin
  1276.   if FDetails.Count > 0 then
  1277.     Result := FDetails[Index-1] // Index is 1-based
  1278.   else
  1279.     Raise Exception.CreateFmt(SCallLoadDetails, [ Self.DisplayName ] );
  1280. end;
  1281.  
  1282. procedure TShellFolder.SetDetails(Index: integer; const Value: string);
  1283. begin
  1284.   if Index < FDetails.Count then
  1285.     FDetails[Index - 1] := Value // Index is 1-based
  1286.   else
  1287.     FDetails.Insert(Index - 1, Value); // Index is 1-based
  1288. end;
  1289.  
  1290. function TShellFolder.ParentShellFolder: IShellFolder;
  1291. begin
  1292.   if FParent <> nil then
  1293.     Result := FParent.ShellFolder
  1294.   else
  1295.     OLECheck(SHGetDesktopFolder(Result));
  1296. end;
  1297.  
  1298. function TShellFolder.Properties: TShellFolderProperties;
  1299. begin
  1300.   Result := GetProperties(ParentShellFolder, FPIDL);
  1301. end;
  1302.  
  1303. function TShellFolder.Capabilities: TShellFolderCapabilities;
  1304. begin
  1305.   Result := GetCaps(ParentShellFolder, FPIDL);
  1306. end;
  1307.  
  1308. function TShellFolder.SubFolders: Boolean;
  1309. begin
  1310.   Result := GetHasSubFolders(ParentShellFolder, FPIDL);
  1311. end;
  1312.  
  1313. function TShellFolder.IsFolder: Boolean;
  1314. begin
  1315.   Result := GetIsFolder(ParentShellFolder, FPIDL);
  1316. end;
  1317.  
  1318. function TShellFolder.PathName: string;
  1319. begin
  1320.   Result := GetDisplayName(DesktopShellFolder, FFullPIDL, SHGDN_FORPARSING);
  1321. end;
  1322.  
  1323. function TShellFolder.DisplayName: string;
  1324. var
  1325.   ParentFolder: IShellFolder;
  1326. begin
  1327.   if Parent <> nil then
  1328.     ParentFolder := ParentShellFolder
  1329.   else
  1330.     ParentFolder := DesktopShellFolder;
  1331.   Result := GetDisplayName(ParentFolder, FPIDL, SHGDN_INFOLDER)
  1332. end;
  1333.  
  1334. function TShellFolder.Rename(const NewName: Widestring): boolean;
  1335. var
  1336.   NewPIDL: PItemIDList;
  1337. begin
  1338.   Result := False;
  1339.   if not (fcCanRename in Capabilities) then Exit;
  1340.  
  1341.   Result := ParentShellFolder.SetNameOf(
  1342.        0,
  1343.        FPIDL,
  1344.        PWideChar(NewName),
  1345.        SHGDN_NORMAL,
  1346.        NewPIDL) = S_OK;
  1347.   if Result then
  1348.   begin
  1349.     DisposePIDL(FPIDL);
  1350.     DisposePIDL(FFullPIDL);
  1351.     FPIDL := NewPIDL;
  1352.     if (FParent <> nil) then
  1353.       FFullPIDL := ConcatPIDLs(FParent.FPIDL, NewPIDL)
  1354.     else
  1355.       FFullPIDL := CopyPIDL(NewPIDL);
  1356.   end
  1357.   else
  1358.     Raise Exception.Create(Format(SRenamedFailedError,[NewName]));
  1359. end;
  1360.  
  1361. function TShellFolder.ImageIndex(LargeIcon: Boolean): Integer;
  1362. begin
  1363.   Result := GetShellImage(AbsoluteID, LargeIcon, False);
  1364. end;
  1365.  
  1366. function TShellFolder.ExecuteDefault: Integer;
  1367. var
  1368.   SEI: TShellExecuteInfo;
  1369. begin
  1370.   FillChar(SEI, SizeOf(SEI), 0);
  1371.   with SEI do
  1372.   begin
  1373.     cbSize := SizeOf(SEI);
  1374.     wnd := Application.Handle;
  1375.     fMask := SEE_MASK_INVOKEIDLIST;
  1376.     lpIDList := AbsoluteID;
  1377.     nShow := SW_SHOW;
  1378.   end;
  1379.   Result := Integer(ShellExecuteEx(@SEI));
  1380. end;
  1381.  
  1382. { TCustomShellChangeNotifier }
  1383.  
  1384. procedure TCustomShellChangeNotifier.Change;
  1385.  
  1386.   function NotifyOptionFlags: DWORD;
  1387.   begin
  1388.     Result := 0;
  1389.     if nfFileNameChange in FFilters then
  1390.       Result := Result or FILE_NOTIFY_CHANGE_FILE_NAME;
  1391.     if nfDirNameChange in FFilters then
  1392.       Result := Result or FILE_NOTIFY_CHANGE_DIR_NAME;
  1393.     if nfSizeChange in FFilters then
  1394.       Result := Result or FILE_NOTIFY_CHANGE_SIZE;
  1395.     if nfAttributeChange in FFilters then
  1396.       Result := Result or FILE_NOTIFY_CHANGE_ATTRIBUTES;
  1397.     if nfWriteChange in FFilters then
  1398.       Result := Result or FILE_NOTIFY_CHANGE_LAST_WRITE;
  1399.     if nfSecurityChange in FFilters then
  1400.       Result := Result or FILE_NOTIFY_CHANGE_SECURITY;
  1401.   end;
  1402.  
  1403. begin
  1404.   if Assigned(FThread) then
  1405.   begin
  1406.     FThread.SetDirectoryOptions(Root, LongBool(FWatchSubTree),
  1407.       NotifyOptionFlags);
  1408.   end;
  1409. end;
  1410.  
  1411. constructor TCustomShellChangeNotifier.Create(AOwner : TComponent);
  1412. begin
  1413.   inherited;
  1414.   FRoot := 'C:\';      { Do not localize }
  1415.   FWatchSubTree := True;
  1416.   FFilters := [nfFilenameChange, nfDirNameChange];
  1417.   Start;
  1418. end;
  1419.  
  1420. destructor TCustomShellChangeNotifier.Destroy;
  1421. var
  1422.   Temp : TShellChangeThread;
  1423. begin
  1424.   if Assigned(FThread) then
  1425.   begin
  1426.     Temp := FThread;
  1427.     FThread := nil;
  1428.     Temp.Terminate;
  1429.     ReleaseMutex(Temp.FMutex);
  1430.   end;
  1431.   inherited;
  1432. end;
  1433.  
  1434. procedure TCustomShellChangeNotifier.SetRoot(const Value: TRoot);
  1435. begin
  1436.   if not SameText(FRoot, Value) then
  1437.   begin
  1438.     FRoot := Value;
  1439.     Change;
  1440.   end;
  1441. end;
  1442.  
  1443. procedure TCustomShellChangeNotifier.SetFilters(const Value: TNotifyFilters);
  1444. begin
  1445.   FFilters := Value;
  1446.   Change;
  1447. end;
  1448.  
  1449. procedure TCustomShellChangeNotifier.SetOnChange(const Value: TThreadMethod);
  1450. begin
  1451.   FOnChange := Value;
  1452.   if Assigned(FThread) then
  1453.     FThread.ChangeEvent := FOnChange
  1454.   else
  1455.     Start;
  1456. end;
  1457.  
  1458. procedure TCustomShellChangeNotifier.SetWatchSubTree(const Value: Boolean);
  1459. begin
  1460.   FWatchSubTree := Value;
  1461.   Change;
  1462. end;
  1463.  
  1464. procedure TCustomShellChangeNotifier.Start;
  1465.  
  1466.   function NotifyOptionFlags: DWORD;
  1467.   begin
  1468.     Result := 0;
  1469.     if nfFileNameChange in FFilters then
  1470.       Result := Result or FILE_NOTIFY_CHANGE_FILE_NAME;
  1471.     if nfDirNameChange in FFilters then
  1472.       Result := Result or FILE_NOTIFY_CHANGE_DIR_NAME;
  1473.     if nfSizeChange in FFilters then
  1474.       Result := Result or FILE_NOTIFY_CHANGE_SIZE;
  1475.     if nfAttributeChange in FFilters then
  1476.       Result := Result or FILE_NOTIFY_CHANGE_ATTRIBUTES;
  1477.     if nfWriteChange in FFilters then
  1478.       Result := Result or FILE_NOTIFY_CHANGE_LAST_WRITE;
  1479.     if nfSecurityChange in FFilters then
  1480.       Result := Result or FILE_NOTIFY_CHANGE_SECURITY;
  1481.   end;
  1482.  
  1483. begin
  1484.   if Assigned(FOnChange) then
  1485.   begin
  1486.     FThread := TShellChangeThread.Create(FOnChange);
  1487.     FThread.SetDirectoryOptions(FRoot,
  1488.       LongBool(FWatchSubTree), NotifyOptionFlags);
  1489.     FThread.Resume;
  1490.   end;
  1491. end;
  1492.  
  1493. { TShellChangeThread }
  1494.  
  1495. constructor TShellChangeThread.Create(ChangeEvent: TThreadMethod);
  1496. begin
  1497.   FreeOnTerminate := True;
  1498.   FChangeEvent := ChangeEvent;
  1499.   FMutex := CreateMutex(nil, True, nil);
  1500.   //Mutex is used to wake up the thread as it waits for any change notifications.
  1501.   WaitForSingleObject(FMutex, INFINITE); //Grab the mutex.
  1502.   FWaitChanged := false;
  1503.   inherited Create(True);
  1504. end;
  1505.  
  1506. destructor TShellChangeThread.Destroy;
  1507. begin
  1508.   if FWaitHandle <> ERROR_INVALID_HANDLE then
  1509.     FindCloseChangeNotification(FWaitHandle);
  1510.   CloseHandle(FMutex);
  1511.   inherited Destroy;
  1512. end;
  1513.  
  1514. procedure TShellChangeThread.Execute;
  1515. var
  1516.   Obj: DWORD;
  1517.   Handles: array[0..1] of DWORD;
  1518. begin
  1519.   EnterCriticalSection(CS);
  1520.   FWaitHandle := FindFirstChangeNotification(PChar(FDirectory),
  1521.      LongBool(FWatchSubTree), FNotifyOptionFlags);
  1522.   LeaveCriticalSection(CS);
  1523.   if FWaitHandle = ERROR_INVALID_HANDLE then Exit;
  1524.   while not Terminated do
  1525.   begin
  1526.     Handles[0] := FWaitHandle;
  1527.     Handles[1] := FMutex;
  1528.     Obj := WaitForMultipleObjects(2, @Handles, False, INFINITE);
  1529.     case Obj of
  1530.       WAIT_OBJECT_0:
  1531.         begin
  1532.           Synchronize(FChangeEvent);
  1533.           FindNextChangeNotification(FWaitHandle);
  1534.         end;
  1535.       WAIT_OBJECT_0 + 1:
  1536.         ReleaseMutex(FMutex);
  1537.       WAIT_FAILED:
  1538.         Exit;
  1539.     end;
  1540.     EnterCriticalSection(CS);
  1541.     if FWaitChanged then
  1542.     begin
  1543.       FWaitHandle := FindFirstChangeNotification(PChar(FDirectory),
  1544.          LongBool(FWatchSubTree), FNotifyOptionFlags);
  1545.       FWaitChanged := false;
  1546.     end;
  1547.     LeaveCriticalSection(CS);
  1548.   end;
  1549. end;
  1550.  
  1551. procedure TShellChangeThread.SetDirectoryOptions(Directory: String;
  1552.   WatchSubTree: Boolean; NotifyOptionFlags: DWORD);
  1553. begin
  1554.   EnterCriticalSection(CS);
  1555.   FDirectory := Directory;
  1556.   FWatchSubTree := WatchSubTree;
  1557.   FNotifyOptionFlags := NotifyOptionFlags;
  1558.  
  1559.   // Release the current notification handle
  1560.   FindCloseChangeNotification(FWaitHandle);
  1561.   FWaitChanged := true;
  1562.   LeaveCriticalSection(CS);
  1563. end;
  1564.  
  1565. { TCustomShellTreeView }
  1566.  
  1567. constructor TCustomShellTreeView.Create(AOwner: TComponent);
  1568. var
  1569.   FileInfo: TSHFileInfo;
  1570. begin
  1571.   inherited Create(AOwner);
  1572.   FRootFolder := nil;
  1573.   ShowRoot := False;
  1574.   FObjectTypes := [otFolders];
  1575.   RightClickSelect := True;
  1576.   FAutoContext := True;
  1577.   //! OnDeletion := NodeDeleted;
  1578.   FUpdating := False;
  1579.   FComboBox := nil;
  1580.   FListView := nil;
  1581.   FImageListChanging := False;
  1582.   FUseShellImages := True;
  1583.   FImages := SHGetFileInfo('C:\',     { Do not localize }
  1584.     0, FileInfo, SizeOf(FileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  1585.  
  1586.   FNotifier := TShellChangeNotifier.Create(Self);
  1587.   FNotifier.FComponentStyle := FNotifier.FComponentStyle + [ csSubComponent ];
  1588.   FRoot := SRFDesktop;
  1589.   FLoadingRoot := False;
  1590. end;
  1591.  
  1592. procedure TCustomShellTreeView.ClearItems;
  1593. var
  1594.   I: Integer;
  1595. begin
  1596.   Items.BeginUpdate;
  1597.   try
  1598.     for I := 0 to Items.Count-1 do
  1599.     begin
  1600.       if Assigned(Folders[i]) then
  1601.         Folders[I].Free;
  1602.       Items[I].Data := nil;
  1603.     end;
  1604.     Items.Clear;
  1605.   finally
  1606.     Items.EndUpdate;
  1607.   end;
  1608. end;
  1609.  
  1610. procedure TCustomShellTreeView.CreateWnd;
  1611. begin
  1612.   inherited CreateWnd;
  1613.   if (Items.Count > 0) then
  1614.     ClearItems;
  1615.   if not Assigned(Images) then SetUseShellImages(FUseShellImages);
  1616.   { TODO : What is the Items.Count test for here? }
  1617.   if (not FLoadingRoot) {and (Items.Count = 0)} then
  1618.     CreateRoot;
  1619. end;
  1620.  
  1621. procedure TCustomShellTreeView.DestroyWnd;
  1622. begin
  1623.   ClearItems;
  1624.   inherited DestroyWnd;
  1625. end;
  1626.  
  1627. procedure TCustomShellTreeView.CommandCompleted(Verb: String;
  1628.   Succeeded: Boolean);
  1629. var
  1630.   Fldr : TShellFolder;
  1631. begin
  1632.   if not Succeeded then Exit;
  1633.   if Assigned(Selected) then
  1634.   begin
  1635.     if SameText(Verb, SCmdVerbDelete) then
  1636.     begin
  1637.       Fldr := TShellFolder(Selected.Data);
  1638.       if not FileExists(Fldr.PathName) then
  1639.       begin
  1640.         Selected.Data := nil;
  1641.         Selected.Delete;
  1642.         FreeAndNil(Fldr);
  1643.       end;
  1644.     end
  1645.     else if SameText(Verb, SCmdVerbPaste) then
  1646.       Refresh(Selected)
  1647.     else if SameText(Verb, SCmdVerbOpen) then
  1648.       SetCurrentDirectory(PChar(FSavePath));
  1649.   end;
  1650. end;
  1651.  
  1652. procedure TCustomShellTreeView.ExecuteCommand(Verb: String;
  1653.   var Handled: Boolean);
  1654. var
  1655.   szPath: array[0..MAX_PATH] of char;
  1656. begin
  1657.   if SameText(Verb, SCmdVerbRename) and Assigned(Selected) then
  1658.   begin
  1659.     Selected.EditText;
  1660.     Handled := True;
  1661.   end
  1662.   else if SameText(Verb, SCmdVerbOpen) then
  1663.   begin
  1664.     GetCurrentDirectory(MAX_PATH, szPath);
  1665.     FSavePath := StrPas(szPath);
  1666.     StrPCopy(szPath, ExtractFilePath(TShellFolder(Selected.Data).PathName));
  1667.     SetCurrentDirectory(szPath);
  1668.   end;
  1669.  
  1670. end;
  1671.  
  1672. function TreeSortFunc(Node1, Node2: TTreeNode; lParam: Integer): Integer; stdcall;
  1673. begin
  1674.   Result := SmallInt(TShellFolder(Node1.Data).ParentShellFolder.CompareIDs(
  1675.        0, TShellFolder(Node1.Data).RelativeID, TShellFolder(Node2.Data).RelativeID));
  1676. end;
  1677.  
  1678. procedure TCustomShellTreeView.InitNode(NewNode: TTreeNode; ID: PItemIDList; ParentNode: TTreeNode);
  1679. var
  1680.   CanAdd: Boolean;
  1681.   NewFolder: IShellFolder;
  1682.   AFolder: TShellFolder;
  1683. begin
  1684.   AFolder := TShellFolder(ParentNode.Data);
  1685.   NewFolder := GetIShellFolder(AFolder.ShellFolder, ID);
  1686.   NewNode.Data := TShellFolder.Create(AFolder, ID, NewFolder);
  1687.   with TShellFolder(NewNode.Data) do
  1688.   begin
  1689.     NewNode.Text := DisplayName;
  1690.     if FUseShellImages and not Assigned(Images) then
  1691.     begin
  1692.       NewNode.ImageIndex := GetShellImage(AbsoluteID, False, False);
  1693.       NewNode.SelectedIndex := GetShellImage(AbsoluteID, False, True);
  1694.     end;
  1695.     if NewNode.SelectedIndex = 0 then NewNode.SelectedIndex := NewNode.ImageIndex;
  1696.     NewNode.HasChildren := SubFolders;
  1697.     if fpShared in Properties then NewNode.OverlayIndex := 0;
  1698.     if (otNonFolders in ObjectTypes) and (ShellFolder <> nil) then
  1699.       NewNode.HasChildren := GetHasSubItems(ShellFolder, ObjectFlags(FObjectTypes));
  1700.   end;
  1701.  
  1702.   CanAdd := True;
  1703.   if Assigned(FOnAddFolder) then FOnAddFolder(Self, TShellFolder(NewNode.Data), CanAdd);
  1704.   if not CanAdd then
  1705.     NewNode.Delete;
  1706. end;
  1707.  
  1708. procedure TCustomShellTreeView.PopulateNode(Node: TTreeNode);
  1709. var
  1710.   ID: PItemIDList;
  1711.   EnumList: IEnumIDList;
  1712.   NewNode: TTreeNode;
  1713.   NumIDs: LongWord;
  1714.   SaveCursor: TCursor;
  1715.   HR: HResult;
  1716. begin
  1717.   SaveCursor := Screen.Cursor;
  1718.   Screen.Cursor := crHourglass;
  1719.   Items.BeginUpdate;
  1720.   try
  1721.     try
  1722.       HR := TShellFolder(Node.Data).ShellFolder.EnumObjects(Application.Handle,
  1723.                      ObjectFlags(FObjectTypes),
  1724.                      EnumList);
  1725.       if HR <> 0 then Exit;
  1726.     except on E:Exception do end;
  1727.  
  1728.     while EnumList.Next(1, ID, NumIDs) = S_OK do
  1729.     begin
  1730.       NewNode := Items.AddChild(Node, '');
  1731.       InitNode(NewNode, ID, Node);
  1732.     end;
  1733.  
  1734.     Node.CustomSort(@TreeSortFunc, 0);
  1735.   finally
  1736.     Items.EndUpdate;
  1737.     Screen.Cursor := SaveCursor;
  1738.   end;
  1739. end;
  1740.  
  1741. procedure TCustomShellTreeView.SetObjectTypes(Value: TShellObjectTypes);
  1742. begin
  1743.   FObjectTypes := Value;
  1744.   RootChanged;
  1745. end;
  1746.  
  1747. procedure TCustomShellTreeView.CreateRoot;
  1748. var
  1749.   RootNode: TTreeNode;
  1750.   ErrorMsg: string;
  1751. begin
  1752.   if (csLoading in ComponentState) then Exit;
  1753.   try
  1754.     FRootFolder := CreateRootFolder(FRootFolder, FOldRoot, FRoot);
  1755.     ErrorMsg := '';
  1756.   except
  1757.     on E : Exception do ErrorMsg := E.Message;
  1758.   end;
  1759.  
  1760.   if Assigned(FRootFolder) then
  1761.   begin
  1762.     FLoadingRoot := true;
  1763.     try
  1764.       if Items.Count > 0 then
  1765.         ClearItems;
  1766.       RootNode := Items.Add(nil, '');
  1767.       with RootNode do
  1768.       begin
  1769.         Data := TShellFolder.Create(nil, FRootFolder.AbsoluteID, FRootFolder.ShellFolder);
  1770.  
  1771.         Text := GetDisplayName(DesktopShellFolder,
  1772.                                TShellFolder(Data).AbsoluteID,
  1773.                                SHGDN_NORMAL);
  1774.  
  1775.         if FUseShellImages and not Assigned(Images) then
  1776.         begin
  1777.           RootNode.ImageIndex := GetShellImage(TShellFolder(RootNode.Data).AbsoluteID, False, False);
  1778.           RootNode.SelectedIndex := GetShellImage(TShellFolder(RootNode.Data).AbsoluteID, False, True);
  1779.         end;
  1780.         RootNode.HasChildren := TShellFolder(RootNode.Data).SubFolders;
  1781.       end;
  1782.       RootNode.Expand(False);
  1783.       Selected := RootNode;
  1784.     finally
  1785.       FLoadingRoot := False;
  1786.     end;
  1787.   end;
  1788.   if ErrorMsg <> '' then
  1789.     Raise Exception.Create( ErrorMsg );
  1790. end;
  1791.  
  1792. function TCustomShellTreeView.CanExpand(Node: TTreeNode): Boolean;
  1793. var
  1794.   Fldr: TShellFolder;
  1795. begin
  1796.   Result := True;
  1797.   Fldr := TShellFolder(Node.Data);
  1798.   if (csDesigning in ComponentState) and (Node.Level > 0) then Exit;
  1799.   if Assigned(OnExpanding) then OnExpanding(Self, Node, Result);
  1800.   if Result then
  1801.     if Fldr.IsFolder and (Node.HasChildren) and (Node.Count = 0) then
  1802.       PopulateNode(Node)
  1803.     else if not Fldr.IsFolder then
  1804.     begin
  1805.       ShellExecute(Handle, nil, PChar(Fldr.PathName), nil,
  1806.         PChar(ExtractFilePath(Fldr.PathName)), 0);
  1807.     end;
  1808.   Node.HasChildren := Node.Count > 0;
  1809. end;
  1810.  
  1811. procedure TCustomShellTreeView.Edit(const Item: TTVItem);
  1812. var
  1813.   S: string;
  1814.   Node: TTreeNode;
  1815. begin
  1816.   with Item do
  1817.     if pszText <> nil then
  1818.     begin
  1819.       S := pszText;
  1820.       Node := Items.GetNode(Item.hItem);
  1821.       if Assigned(OnEdited) then OnEdited(Self, Node, S);
  1822.       if ( Node <> nil ) and TShellFolder(Node.Data).Rename(S) then
  1823.         Node.Text := S;
  1824.     end;
  1825. end;
  1826.  
  1827. procedure TCustomShellTreeView.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1828. begin
  1829.   //! Commenting this out fixes #107480, #109250
  1830.   (*
  1831.   if (Button = mbRight) and FAutoContext and (Selected <> nil) and (Selected.Data <> nil) then
  1832.     InvokeContextMenu(Self, SelectedFolder, X, Y)
  1833.   else
  1834.   (**)  
  1835.     inherited MouseUp(Button, Shift, X, Y);
  1836. end;
  1837.  
  1838. function TCustomShellTreeView.NodeFromRelativeID(ParentNode: TTreeNode; ID: PItemIDList): TTreeNode;
  1839. var
  1840.   HR: HResult;
  1841. begin
  1842.   Result := ParentNode.GetFirstChild;
  1843.   while (Result <> nil) do
  1844.   begin
  1845.     HR := TShellFolder(ParentNode.Data).ShellFolder.CompareIDs(0, ID, TShellFolder(Result.Data).RelativeID);
  1846.     if HR = 0 then Exit;
  1847.     Result := ParentNode.GetNextChild(Result);
  1848.   end;
  1849. end;
  1850.  
  1851. function TCustomShellTreeView.NodeFromAbsoluteID(StartNode: TTreeNode; ID: PItemIDList): TTreeNode;
  1852. var
  1853.   HR: HResult;
  1854. begin
  1855.   Result := StartNode;
  1856.   while Result <> nil do
  1857.   begin
  1858.     HR := DesktopShellFolder.CompareIDs(0, ID, TShellFolder(Result.Data).AbsoluteID);
  1859.     if HR = 0 then Exit;
  1860.     Result := Result.GetNext;
  1861.   end;
  1862. end;
  1863.  
  1864. procedure TCustomShellTreeView.Delete(Node: TTreeNode);
  1865. begin
  1866.   if Assigned(Node.Data) then
  1867.   begin
  1868.     TShellFolder(Node.Data).Free;
  1869.     Node.Data := nil;
  1870.   end;
  1871.   inherited Delete(Node);
  1872. end;
  1873.  
  1874. (*
  1875. procedure TCustomShellTreeView.NodeDeleted(Sender: TObject; Node: TTreeNode);
  1876. begin
  1877.   if Assigned(Node.Data) then
  1878.   begin
  1879.     TShellFolder(Node.Data).Free;
  1880.     Node.Data := nil;
  1881.   end;
  1882. end;
  1883. (**)
  1884.  
  1885. procedure TCustomShellTreeView.RootChanged;
  1886. begin
  1887.   if FUpdating then Exit;
  1888.   FUpdating := True;
  1889.   try
  1890.     CreateRoot;
  1891.     if Assigned(FComboBox) then
  1892.       FComboBox.SetRoot(FRoot);
  1893.     if Assigned(FListView) then
  1894.       FListView.SetRoot(FRoot);
  1895.   finally
  1896.     FUpdating := False;
  1897.   end;
  1898. end;
  1899.  
  1900. function TCustomShellTreeView.FolderExists(FindID: PItemIDList; InNode: TTreeNode): TTreeNode;
  1901. var
  1902.   ALevel: Integer;
  1903. begin
  1904.   Result := nil;
  1905.   ALevel := InNode.Level;
  1906.   repeat
  1907.     if DesktopShellFolder.CompareIDs(
  1908.       0,
  1909.       FindID,
  1910.       TShellFolder(InNode.Data).AbsoluteID) = 0 then
  1911.     begin
  1912.       Result := InNode;
  1913.       Exit;
  1914.     end else
  1915.       InNode := InNode.GetNext;
  1916.   until (InNode = nil) or (InNode.Level <= ALevel);
  1917. end;
  1918.  
  1919. procedure TCustomShellTreeView.RefreshEvent;
  1920. begin
  1921.   if Assigned(Selected) then
  1922.     Refresh(Selected);
  1923. end;
  1924.  
  1925. procedure TCustomShellTreeView.Refresh(Node: TTreeNode);
  1926. var
  1927.   NewNode, OldNode, Temp: TTreeNode;
  1928.   OldFolder, NewFolder: TShellFolder;
  1929.   ThisLevel: Integer;
  1930.   SaveCursor: TCursor;
  1931.   TopID, SelID: PItemIDList;
  1932.   ParentFolder: TShellFolder;
  1933. begin
  1934.   if TShellFolder(Node.Data).ShellFolder = nil then Exit;
  1935.   SaveCursor := Screen.Cursor;
  1936.   ParentFolder := nil;
  1937.   //Need absolute PIDL to search for top item once tree is rebuilt.
  1938.   TopID := CopyPIDL(TShellFolder(TopItem.Data).RelativeID);
  1939.   if TShellFolder(TopItem.Data).Parent <> nil then
  1940.     TopID := ConcatPIDLs(TShellFolder(TopItem.Data).Parent.AbsoluteID, TopID);
  1941.   //Same thing for SelID
  1942.   SelID := nil;
  1943.   if (Selected <> nil) and (Selected.Data <> nil) then
  1944.   begin
  1945.     SelID := CopyPIDL(TShellFolder(Selected.Data).RelativeID);
  1946.     if TShellFolder(Selected.Data).Parent <> nil then
  1947.       SelID := ConcatPIDLs(TShellFolder(Selected.Data).Parent.AbsoluteID, SelID);
  1948.   end;
  1949.  
  1950.   Items.BeginUpdate;
  1951.   try
  1952.     Screen.Cursor := crHourglass;
  1953.     OldFolder := Node.Data;
  1954.     NewNode := Items.Insert(Node, '');
  1955.     if Node.Parent <> nil then
  1956.       ParentFolder := TShellFolder(Node.Parent.Data);
  1957.     NewNode.Data := TShellFolder.Create(ParentFolder,
  1958.                                    OldFolder.RelativeID,
  1959.                                    OldFolder.ShellFolder);
  1960.     PopulateNode(NewNode);
  1961.     with NewNode do
  1962.     begin
  1963.       NewFolder := Data;
  1964.       ImageIndex := GetShellImage(NewFolder.AbsoluteID, False, False);
  1965.       SelectedIndex := GetShellImage(NewFolder.AbsoluteID, False, True);
  1966.       HasChildren := NewFolder.SubFolders;
  1967.       Text := NewFolder.DisplayName;
  1968.     end;
  1969.  
  1970.     ThisLevel := Node.Level;
  1971.     OldNode := Node;
  1972.     repeat
  1973.       Temp := FolderExists(TShellFolder(OldNode.Data).AbsoluteID, NewNode);
  1974.       if (Temp <> nil) and OldNode.Expanded then
  1975.         Temp.Expand(False);
  1976.       OldNode := OldNode.GetNext;
  1977.     until (OldNode = nil) or (OldNode.Level = ThisLevel);
  1978.  
  1979.     if Assigned(Node.Data) then
  1980.     begin
  1981.       TShellFolder(Node.Data).Free;
  1982.       Node.Data := nil;
  1983.     end;
  1984.     Node.Delete;
  1985.     if SelID <> nil then
  1986.     begin
  1987.       Temp := FolderExists(SelID, Items[0]);
  1988.       Selected := Temp;
  1989.     end;
  1990.     Temp := FolderExists(TopID, Items[0]);
  1991.     TopItem := Temp;
  1992.   finally
  1993.     Items.EndUpdate;
  1994.     DisposePIDL(TopID);
  1995.     if SelID <> nil then DisposePIDL(SelID);
  1996.     Screen.Cursor := SaveCursor;
  1997.   end;
  1998. end;
  1999.  
  2000. procedure TCustomShellTreeView.Notification(AComponent: TComponent;
  2001.   Operation: TOperation);
  2002. begin
  2003.   inherited Notification(AComponent, Operation);
  2004.   if (Operation = opRemove) then
  2005.   begin
  2006.     if (AComponent = FComboBox) then
  2007.       FComboBox := nil
  2008.     else if (AComponent = FListView) then
  2009.       FListView := nil;
  2010.   end;
  2011. end;
  2012.  
  2013. function TCustomShellTreeView.CanChange(Node: TTreeNode): Boolean;
  2014. var
  2015.   Fldr: TShellFolder;
  2016.   StayFresh: boolean;
  2017. begin
  2018.   Result := inherited CanChange(Node);
  2019.   if Result and (not FUpdating) and Assigned(Node) then
  2020.   begin
  2021.     Fldr := TShellFolder(Node.Data);
  2022.     StayFresh := FAutoRefresh;
  2023.     AutoRefresh := False;
  2024.     if not Fldr.IsFolder then
  2025.       Fldr := Fldr.Parent;
  2026.     FUpdating := True;
  2027.     try
  2028.       if Assigned(FComboBox) then
  2029.         FComboBox.TreeUpdate(Fldr.AbsoluteID);
  2030.       if Assigned(FListView) then
  2031.         FListView.TreeUpdate(Fldr.AbsoluteID);
  2032.     finally
  2033.       FUpdating := False;
  2034.     end;
  2035.     FNodeToMonitor := Node;
  2036.     try
  2037.       AutoRefresh := StayFresh;
  2038.     finally
  2039.       FNodeToMonitor := nil;
  2040.     end;
  2041.   end;
  2042. end;
  2043.  
  2044. function TCustomShellTreeView.GetFolder(Index: Integer): TShellFolder;
  2045. begin
  2046.   Result := TShellFolder(Items[Index].Data);
  2047. end;
  2048.  
  2049. function TCustomShellTreeView.SelectedFolder: TShellFolder;
  2050. begin
  2051.   Result := nil;
  2052.   if Selected <> nil then Result := TShellFolder(Selected.Data);
  2053. end;
  2054.  
  2055. function TCustomShellTreeView.GetPath: String;
  2056. begin
  2057.   if SelectedFolder <> nil then
  2058.     Result := SelectedFolder.PathName
  2059.   else
  2060.     Result := '';
  2061. end;
  2062.  
  2063. procedure TCustomShellTreeView.SetPath(const Value: string);
  2064. var
  2065.   P: PWideChar;
  2066.   NewPIDL: PItemIDList;
  2067.   Flags,
  2068.   NumChars: LongWord;
  2069. begin
  2070.   NumChars := Length(Value);
  2071.   Flags := 0;
  2072.   P := StringToOleStr(Value);
  2073.   try
  2074.     OLECheck(DesktopShellFolder.ParseDisplayName(
  2075.         0,
  2076.         nil,
  2077.         P,
  2078.         NumChars,
  2079.         NewPIDL,
  2080.         Flags)
  2081.      );
  2082.     FUpdating := True;
  2083.     SetPathFromID(NewPIDL);
  2084.   except on EOleSysError do
  2085.     raise EInvalidPath.CreateFmt(SErrorSettingPath, [Value]);
  2086.   end;
  2087.   FUpdating := False;
  2088. end;
  2089.  
  2090. procedure TCustomShellTreeView.SetPathFromID(ID: PItemIDList);
  2091. var
  2092.   I: Integer;
  2093.   Pidls: TList;
  2094.   Temp, Node: TTreeNode;
  2095. begin
  2096.   if FUpdating or (csLoading in ComponentState)
  2097.     or ((SelectedFolder <> nil) and SamePIDL(SelectedFolder.AbsoluteID, ID)) then Exit;
  2098.   FUpdating := True;
  2099.   Items.BeginUpdate;
  2100.   try
  2101.     Pidls := CreatePIDLList(ID);
  2102.     try
  2103.       Node := Items[0];
  2104.       for I := 0 to Pidls.Count-1 do
  2105.       begin
  2106.         Temp := FolderExists(Pidls[I], Node);
  2107.         if Temp <> nil then
  2108.         begin
  2109.           Node := Temp;
  2110.           Node.Expand(False);
  2111.         end;
  2112.       end;
  2113.       Node := FolderExists(ID, Node);
  2114.       Selected := Node;
  2115.       if Assigned(Node) then
  2116.       begin
  2117.         if Assigned(FListView) then
  2118.           FListView.TreeUpdate(TShellFolder(Node.Data).AbsoluteID);
  2119.         if Assigned(FComboBox) then
  2120.           FComboBox.TreeUpdate(TShellFolder(Node.Data).AbsoluteID);
  2121.       end;
  2122.     finally
  2123.       DestroyPIDLList(Pidls);
  2124.     end;
  2125.   finally
  2126.     Items.EndUpdate;
  2127.     FUpdating := False;
  2128.   end;
  2129. end;
  2130.  
  2131. procedure TCustomShellTreeView.SetRoot(const Value: TRoot);
  2132. begin
  2133.   if not SameText(FRoot, Value) then
  2134.   begin
  2135.     FOldRoot := FRoot;
  2136.     FRoot := Value;
  2137.     RootChanged;
  2138.   end;
  2139. end;
  2140.  
  2141. procedure TCustomShellTreeView.GetImageIndex(Node: TTreeNode);
  2142. begin
  2143.   if Assigned(Images) then
  2144.     inherited GetImageIndex(Node);
  2145. end;
  2146.  
  2147. procedure TCustomShellTreeView.GetSelectedIndex(Node: TTreeNode);
  2148. begin
  2149.   if Assigned(Images) then
  2150.     inherited GetSelectedIndex(Node);
  2151. end;
  2152.  
  2153. procedure TCustomShellTreeView.WndProc(var Message: TMessage);
  2154. var
  2155.   ImageListHandle: THandle;
  2156. begin
  2157.   case Message.Msg of
  2158.     WM_INITMENUPOPUP,
  2159.     WM_DRAWITEM,
  2160.     WM_MENUCHAR,
  2161.     WM_MEASUREITEM:
  2162.       if Assigned(ICM2) then
  2163.       begin
  2164.         ICM2.HandleMenuMsg(Message.Msg, Message.wParam, Message.lParam);
  2165.         Message.Result := 0;
  2166.       end;
  2167.  
  2168.     TVM_SETIMAGELIST:
  2169.       if not FImageListChanging then
  2170.       begin
  2171.         FImageListChanging := True;
  2172.         try
  2173.          if not Assigned(Images) then
  2174.            if FUseShellImages then
  2175.              ImageListHandle := FImages
  2176.            else
  2177.              ImageListHandle := 0
  2178.          else
  2179.            ImageListHandle := Images.Handle;
  2180.  
  2181.            SendMessage(Self.Handle, TVM_SETIMAGELIST, TVSIL_NORMAL, ImageListHandle);
  2182.            //RootChanged;
  2183.         finally
  2184.           FImageListChanging := False;
  2185.         end;
  2186.       end
  2187.       else inherited;
  2188.   else
  2189.     inherited WndProc(Message);
  2190.   end;
  2191. end;
  2192.  
  2193. procedure TCustomShellTreeView.SetUseShellImages(const Value: Boolean);
  2194. var
  2195.   ImageListHandle: THandle;
  2196. begin
  2197.   FUseShellImages := Value;
  2198.   if not Assigned(Images) then
  2199.     if FUseShellImages then
  2200.       ImageListHandle := FImages
  2201.     else
  2202.       ImageListHandle := 0
  2203.   else
  2204.     ImageListHandle := Images.Handle;
  2205.   SendMessage(Handle, TVM_SETIMAGELIST, TVSIL_NORMAL, ImageListHandle);
  2206. end;
  2207.  
  2208. procedure TCustomShellTreeView.WMDestroy(var Message: TWMDestroy);
  2209. begin
  2210.   ClearItems;
  2211.   inherited;
  2212. end;
  2213.  
  2214. procedure TCustomShellTreeView.Loaded;
  2215. begin
  2216.   inherited Loaded;
  2217.   CreateRoot;
  2218. end;
  2219.  
  2220. procedure TCustomShellTreeView.DoContextPopup(MousePos: TPoint;
  2221.   var Handled: Boolean);
  2222. begin
  2223.   if AutoContextMenus and not (Assigned(PopupMenu) and PopupMenu.AutoPopup) then
  2224.     InvokeContextMenu(Self, SelectedFolder, MousePos.X, MousePos.Y)
  2225.   else
  2226.     inherited;
  2227. end;
  2228.  
  2229. procedure TCustomShellTreeView.SetComboBox(Value: TCustomShellComboBox);
  2230. begin
  2231.   if Value = FComboBox then Exit;
  2232.   if Value <> nil then
  2233.   begin
  2234.     Value.Root := Root;
  2235.     Value.FTreeView := Self;
  2236.   end else
  2237.     if FComboBox <> nil then
  2238.       FComboBox.FTreeView := nil;
  2239.  
  2240.   if FComboBox <> nil then
  2241.     FComboBox.FreeNotification(Self);
  2242.   FComboBox := Value;
  2243. end;
  2244.  
  2245. procedure TCustomShellTreeView.SetListView(const Value: TCustomShellListView);
  2246. begin
  2247.   if Value = FListView then Exit;
  2248.   if Value <> nil then
  2249.   begin
  2250.     Value.Root := Root;
  2251.     Value.FTreeView := Self;
  2252.   end else
  2253.     if FListView <> nil then
  2254.       FListView.FTreeView := nil;
  2255.  
  2256.   if FListView <> nil then
  2257.     FListView.FreeNotification(Self);
  2258.   FListView := Value;
  2259. end;
  2260.  
  2261. procedure TCustomShellTreeView.SetAutoRefresh(const Value: boolean);
  2262. begin
  2263.   FAutoRefresh := Value;
  2264.   if not (csLoading in ComponentState) then
  2265.   begin
  2266.     if FAutoRefresh then
  2267.     begin
  2268.       if Assigned(FNotifier) then
  2269.         FreeAndNil(FNotifier);
  2270.       FNotifier := TShellChangeNotifier.Create(Self);
  2271.       FNotifier.FComponentStyle := FNotifier.FComponentStyle + [ csSubComponent ];
  2272.       FNotifier.WatchSubTree := False;
  2273.       if Assigned(FNodeToMonitor) then
  2274.         FNotifier.Root := TShellFolder(FNodeToMonitor.Data).PathName
  2275.       else
  2276.         FNotifier.Root := FRootFolder.PathName;
  2277.       FNotifier.OnChange := Self.RefreshEvent;
  2278.     end
  2279.     else if Assigned(FNotifier) then
  2280.       FreeAndNil(FNotifier);
  2281.   end;
  2282. end;
  2283.  
  2284. { TCustomShellComboBox }
  2285.  
  2286. constructor TCustomShellComboBox.Create(AOwner: TComponent);
  2287. var
  2288.   FileInfo: TSHFileInfo;
  2289. begin
  2290.   inherited Create(AOwner);
  2291.   FRootFolder := nil;
  2292.   FImages := SHGetFileInfo('C:\',    { Do not localize }
  2293.     0, FileInfo, SizeOf(FileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  2294.   ImageList_GetIconSize(FImages, FImageWidth, FImageHeight);
  2295.   FUpdating := False;
  2296.   Style := csExDropDown;
  2297.   FObjectTypes := [otFolders];
  2298.   FRoot := SRFDesktop;
  2299.   FUseShellImages := True;
  2300. end;
  2301.  
  2302. procedure TCustomShellComboBox.ClearItems;
  2303. var
  2304.   I: Integer;
  2305. begin
  2306.   ItemsEx.BeginUpdate;
  2307.   try
  2308.     for I := 0 to ItemsEx.Count-1 do
  2309.     begin
  2310.       if Assigned(Folders[i]) then
  2311.         Folders[I].Free;
  2312.       ItemsEx[I].Data := nil;
  2313.     end;
  2314.     ItemsEx.Clear;
  2315.   finally
  2316.     ItemsEx.EndUpdate;
  2317.   end;    
  2318. end;
  2319.  
  2320. procedure TCustomShellComboBox.CreateRoot;
  2321. var
  2322.   AFolder: TShellFolder;
  2323.   Text: string;
  2324.   ImageIndex: integer;
  2325. begin
  2326.   if (csLoading in ComponentState) then Exit;
  2327.   ItemsEx.BeginUpdate;
  2328.   try
  2329.     ClearItems;
  2330.     FRootFolder := CreateRootFolder(FRootFolder, FOldRoot, FRoot);
  2331.     AFolder := TShellFolder.Create(nil,
  2332.                               FRootFolder.AbsoluteID,
  2333.                               FRootFolder.ShellFolder);
  2334.     Text := AFolder.DisplayName; //! PathName;
  2335.  
  2336.     ImageIndex := GetShellImageIndex(AFolder);
  2337.     ItemsEx.AddItem(Text, ImageIndex, ImageIndex,
  2338.       -1, 0, AFolder);
  2339.     Init;
  2340.     ItemIndex := 0;
  2341.     if FUseShellImages then // Force image update
  2342.     begin
  2343.       SetUseShellImages(False);
  2344.       SetUseShellImages(True);
  2345.     end;
  2346.   finally
  2347.     ItemsEx.EndUpdate;
  2348.   end;    
  2349. end;
  2350.  
  2351. procedure TCustomShellComboBox.CreateWnd;
  2352. begin
  2353.   inherited CreateWnd;
  2354.   if FImages <> 0 then
  2355.     SendMessage(Handle, CBEM_SETIMAGELIST, 0, FImages);
  2356.   SetUseShellImages(FUseShellImages);
  2357.   if ItemsEx.Count = 0 then
  2358.     CreateRoot;
  2359. end;
  2360.  
  2361. procedure TCustomShellComboBox.DestroyWnd;
  2362. begin
  2363.   ClearItems;
  2364.   inherited DestroyWnd;
  2365. end;
  2366.  
  2367. procedure TCustomShellComboBox.SetObjectTypes(Value: TShellObjectTypes);
  2368. begin
  2369.   FObjectTypes := Value;
  2370.   RootChanged;
  2371. end;
  2372.  
  2373. procedure TCustomShellComboBox.TreeUpdate(NewPath: PItemIDList);
  2374. begin
  2375.   if FUpdating or ((ItemIndex > -1)
  2376.     and SamePIDL(Folders[ItemIndex].AbsoluteID, NewPath)) then Exit;
  2377.   FUpdating := True;
  2378.   try
  2379.     SetPathFromID(NewPath);
  2380.   finally
  2381.     FUpdating := False;
  2382.   end;
  2383. end;
  2384.  
  2385. procedure TCustomShellComboBox.SetTreeView(Value: TCustomShellTreeView);
  2386. begin
  2387.   if Value = FTreeView then Exit;
  2388.   if Value <> nil then
  2389.   begin
  2390.     Value.Root := Root;
  2391.     Value.FComboBox := Self;
  2392.   end else
  2393.     if FTreeView <> nil then
  2394.       FTreeView.FComboBox := nil;
  2395.  
  2396.   if FTreeView <> nil then
  2397.     FTreeView.FreeNotification(Self);
  2398.   FTreeView := Value;
  2399. end;
  2400.  
  2401. procedure TCustomShellComboBox.SetListView(Value: TCustomShellListView);
  2402. begin
  2403.   if Value = FListView then Exit;
  2404.   if Value <> nil then
  2405.   begin
  2406.     Value.Root := Root;
  2407.     Value.FComboBox := Self;
  2408.   end else
  2409.     if FListView <> nil then
  2410.       FListView.FComboBox := nil;
  2411.  
  2412.   if FListView <> nil then
  2413.     FListView.FreeNotification(Self);
  2414.   FListView := Value;
  2415. end;
  2416.  
  2417. procedure TCustomShellComboBox.Notification(AComponent: TComponent;
  2418.   Operation: TOperation);
  2419. begin
  2420.   inherited Notification(AComponent, Operation);
  2421.   if (Operation = opRemove) then
  2422.   begin
  2423.     if (AComponent = FTreeView) then
  2424.       FTreeView := nil
  2425.     else if (AComponent = FListView) then
  2426.       FListView := nil
  2427.     else if (AComponent = FImageList) then
  2428.       FImageList := nil;
  2429.   end;    
  2430. end;
  2431.  
  2432. function TCustomShellComboBox.GetFolder(Index: Integer): TShellFolder;
  2433. begin
  2434.   if Index > ItemsEx.Count - 1 then
  2435.     Index := ItemsEx.Count - 1;
  2436.   Result := TShellFolder(ItemsEx[Index].Data);
  2437. end;
  2438.  
  2439. function TCustomShellComboBox.InitItem(ParentFolder: TShellFolder; ID: PItemIDList): TShellFolder;
  2440. var
  2441.   SF: IShellFolder;
  2442. begin
  2443.   SF := GetIShellFolder(ParentFolder.ShellFolder, ID);
  2444.   Result := TShellFolder.Create(ParentFolder, ID, SF);
  2445. end;
  2446.  
  2447. var
  2448.   CompareFolder: TShellFolder = nil;
  2449.  
  2450. function ListSortFunc(Item1, Item2: Pointer): Integer;
  2451. const
  2452.   R: array[Boolean] of Byte = (0, 1);
  2453. begin
  2454.   Result := 0;
  2455.   if (Item1 = nil) or (Item2 = nil) then Exit;
  2456.  
  2457.   Result := R[TShellFolder(Item2).IsFolder] - R[TShellFolder(Item1).IsFolder];
  2458.   if (Result = 0) and (TShellFolder(Item1).ParentShellFolder <> nil) then
  2459.     Result := Smallint(
  2460.                   TShellFolder(Item1).ParentShellFolder.CompareIDs(
  2461.                   0,
  2462.                   TShellFolder(Item1).RelativeID,
  2463.                   TShellFolder(Item2).RelativeID)
  2464.               );
  2465. end;
  2466.  
  2467. function ComboSortFunc(Item1, Item2: Pointer): Integer;
  2468. begin
  2469.   Result := 0;
  2470.   if CompareFolder = nil then Exit;
  2471.   Result := SmallInt(CompareFolder.ShellFolder.CompareIDs(0,
  2472.     PItemIDList(Item1), PItemIDList(Item2)));
  2473. end;
  2474.  
  2475. procedure TCustomShellComboBox.AddItems(Index: Integer; ParentFolder: TShellFolder);
  2476. var
  2477.   EnumList: IEnumIDList;
  2478.   ID: PItemIDList;
  2479.   ImageIndex: integer;
  2480.   Item: TComboExItem;
  2481.   NumIDs: integer;
  2482.   List: TList;
  2483.   ItemText: string;
  2484.   AFolder: TShellFolder;
  2485. begin
  2486.   OLECheck(ParentFolder.ShellFolder.EnumObjects(0, ObjectFlags(FObjectTypes), EnumList));
  2487.   CompareFolder := ParentFolder;
  2488.   List := nil;
  2489.   ItemsEx.BeginUpdate;
  2490.   try
  2491.     List := TList.Create;
  2492.     while EnumList.Next(1, ID, LongWord(NumIDs)) = S_OK do
  2493.       List.Add(ID);
  2494.     List.Sort(ComboSortFunc);
  2495.  
  2496.     for NumIDs := 0 to List.Count-1 do
  2497.     begin
  2498.       AFolder := InitItem(ParentFolder, List[NumIDs]);
  2499.       ItemText := AFolder.DisplayName;
  2500.       Item := ItemsEx.Insert(NumIDs+1);
  2501.       Item.Caption := ItemText;
  2502.       Item.Data := AFolder;
  2503.       Item.Indent := AFolder.Level;
  2504.       Item.ImageIndex := GetShellImageIndex(AFolder);
  2505.       Item.SelectedImageIndex := Item.ImageIndex;
  2506.  
  2507.       if Assigned(FOnGetImageIndex) and (Assigned(FImageList) or FUseShellImages) then
  2508.       begin
  2509.         ImageIndex := ItemsEx[NumIDs+1].ImageIndex;
  2510.         FOnGetImageIndex(Self, NumIDs+1, ImageIndex);
  2511.         ItemsEx[NumIDs+1].ImageIndex := ImageIndex;
  2512.       end;
  2513.     end;
  2514.  
  2515.   finally
  2516.     CompareFolder := nil;
  2517.     List.Free;
  2518.     ItemsEx.EndUpdate;
  2519.   end;
  2520. end;
  2521.  
  2522. procedure TCustomShellComboBox.Init;
  2523. var
  2524.   MyComputer: PItemIDList;
  2525.   Index: Integer;
  2526. begin
  2527.   //show desktop contents, expand My Computer if at desktop.
  2528.   //!!!otherwise expand the root.
  2529.   ItemsEx.BeginUpdate;
  2530.   try
  2531.     AddItems(0, FRootFolder);
  2532.  
  2533.     if Root = SRFDesktop then
  2534.     begin
  2535.       SHGetSpecialFolderLocation(0, CSIDL_DRIVES, MyComputer);
  2536.       Index := IndexFromID(MyComputer);
  2537.       if Index <> -1 then
  2538.         AddItems(Index, Folders[Index]);
  2539.     end;
  2540.   finally
  2541.     ItemsEx.EndUpdate;
  2542.   end;    
  2543. end;
  2544.  
  2545. function TCustomShellComboBox.IndexFromID(AbsoluteID: PItemIDList): Integer;
  2546. begin
  2547.   Result := ItemsEx.Count-1;
  2548.   while Result >= 0 do
  2549.   begin
  2550.     if DesktopShellFolder.CompareIDs(
  2551.       0,
  2552.       AbsoluteID,
  2553.       Folders[Result].AbsoluteID) = 0 then Exit;
  2554.     Dec(Result);
  2555.   end;
  2556. end;
  2557.  
  2558. procedure TCustomShellComboBox.SetRoot(const Value: TRoot);
  2559. begin
  2560.   if not SameText(FRoot, Value) then
  2561.   begin
  2562.     FOldRoot := FRoot;
  2563.     FRoot := Value;
  2564.     RootChanged;
  2565.   end;
  2566. end;
  2567.  
  2568. procedure TCustomShellComboBox.RootChanged;
  2569. begin
  2570.   FUpdating := True;
  2571.   try
  2572.     ClearItems;
  2573.     CreateRoot;
  2574.     if Assigned(FTreeView) then
  2575.       FTreeView.SetRoot(FRoot);
  2576.     if Assigned(FListView) then
  2577.       FListView.SetRoot(FRoot);
  2578.   finally
  2579.     FUpdating := False;
  2580.   end;
  2581. end;
  2582.  
  2583. function TCustomShellComboBox.GetPath: string;
  2584. var
  2585.   Folder : TShellFolder;
  2586. begin
  2587.   Result := '';
  2588.   if ItemIndex > -1 then
  2589.   begin
  2590.     Folder := Folders[ItemIndex];
  2591.     if Assigned(Folder) then
  2592.       Result := Folder.PathName
  2593.     else
  2594.       Result := '';  
  2595.   end;
  2596. end;
  2597.  
  2598. procedure TCustomShellComboBox.SetPath(const Value: string);
  2599. var
  2600.   P: PWideChar;
  2601.   NewPIDL: PItemIDList;
  2602.   Flags,
  2603.   NumChars: LongWord;
  2604. begin
  2605.   NumChars := Length(Value);
  2606.   Flags := 0;
  2607.   P := StringToOleStr(Value);
  2608.   try
  2609.     OLECheck(DesktopShellFolder.ParseDisplayName(
  2610.         0,
  2611.         nil,
  2612.         P,
  2613.         NumChars,
  2614.         NewPIDL,
  2615.         Flags)
  2616.      );
  2617.     SetPathFromID(NewPIDL);
  2618.   except on EOleSysError do
  2619.     raise EInvalidPath.CreateFmt(SErrorSettingPath, [Value]);
  2620.   end;
  2621. end;
  2622.  
  2623. procedure TCustomShellComboBox.SetPathFromID(ID: PItemIDList);
  2624. var
  2625.   Pidls: TList;
  2626.   I, Item, Temp: Integer;
  2627.   AFolder: TShellFolder;
  2628.   RelID: PItemIDList;
  2629.  
  2630.   procedure InsertItemObject(Position: integer; Text: string; AFolder: TShellFolder);
  2631.  
  2632.   var
  2633.     Item : TComboExItem;
  2634.   begin
  2635.     Item := ItemsEx.Insert(Position);
  2636.     Item.Caption := Text;
  2637.     Item.Indent := AFolder.Level;
  2638.     Item.Data := AFolder;
  2639.     if AFolder = nil then
  2640.       Item.Data := AFolder;
  2641.     Item.ImageIndex := GetShellImageIndex(AFolder);
  2642.   end;
  2643.  
  2644. begin
  2645.   Item := -1;
  2646.   ItemsEx.BeginUpdate;
  2647.   try
  2648.     CreateRoot;
  2649.     Pidls := CreatePIDLList(ID);
  2650.     try
  2651.       I := Pidls.Count-1;
  2652.       while I >= 0 do
  2653.       begin
  2654.         Item := IndexFromID(Pidls[I]);
  2655.         if Item <> -1 then Break;
  2656.         Dec(I);
  2657.       end;
  2658.  
  2659.       if I < 0 then Exit;
  2660.  
  2661.       while I < Pidls.Count-1 do
  2662.       begin
  2663.         Inc(I);
  2664.         RelID := RelativeFromAbsolute(Pidls[I]);
  2665.         AFolder := InitItem(Folders[Item], RelID);
  2666.         InsertItemObject(Item+1, AFolder.DisplayName, AFolder);
  2667.         Inc(Item);
  2668.       end;
  2669.  
  2670.       Temp := IndexFromID(ID);
  2671.       if Temp < 0 then
  2672.       begin
  2673.         RelID := RelativeFromAbsolute(ID);
  2674.         AFolder := InitItem(Folders[Item], RelID);
  2675.         Temp := Item + 1;
  2676.         InsertItemObject(Item+1, AFolder.DisplayName, AFolder);
  2677.       end;
  2678.       ItemIndex := Temp;
  2679.     finally
  2680.       DestroyPIDLList(Pidls);
  2681.     end;
  2682.   finally
  2683.     ItemsEx.EndUpdate;
  2684.   end;
  2685. end;
  2686.  
  2687. function TCustomShellComboBox.GetShellImageIndex(
  2688.   AFolder: TShellFolder): integer;
  2689. begin
  2690.   if FUseShellImages then
  2691.     Result := GetShellImage(AFolder.AbsoluteID, False, False)
  2692.   else
  2693.     Result := -1;
  2694. end;
  2695.  
  2696. procedure TCustomShellComboBox.SetUseShellImages(const Value: Boolean);
  2697. var
  2698.   ImageListHandle: THandle;
  2699. begin
  2700.   FUseShellImages := Value;
  2701.   if not Assigned(Images) then
  2702.     if FUseShellImages then
  2703.       ImageListHandle := FImages
  2704.     else
  2705.       ImageListHandle := 0
  2706.   else
  2707.     ImageListHandle := Images.Handle;
  2708.   SendMessage(Handle, CBEM_SETIMAGELIST, 0, ImageListHandle);
  2709.   
  2710.   if FUseShellImages and not Assigned(FImageList) then
  2711.     ImageList_GetIconSize(FImages, FImageWidth, FImageHeight)
  2712.   else
  2713.     if not Assigned(FImageList) then
  2714.     begin
  2715.       FImageWidth := 16;
  2716.       FImageHeight := 16;
  2717.     end
  2718.     else
  2719.     begin
  2720.       FImageWidth := FImageList.Width;
  2721.       FImageHeight := FImageList.Height;
  2722.     end;
  2723. end;
  2724.  
  2725. destructor TCustomShellComboBox.Destroy;
  2726. begin
  2727.   inherited Destroy;
  2728.   if Assigned(FImageList) then FImageList.Free;
  2729. end;
  2730.  
  2731. procedure TCustomShellComboBox.Loaded;
  2732. begin
  2733.   inherited Loaded;
  2734.   CreateRoot;
  2735. end;
  2736.  
  2737. type
  2738.   TAccessItemUpdateCount = class(TComboExItems);
  2739.  
  2740. procedure TCustomShellComboBox.Change;
  2741. var
  2742.   Node : TShellFolder;
  2743. begin
  2744.   if TAccessItemUpdateCount(ItemsEx).UpdateCount > 0 then Exit;
  2745.  
  2746.   inherited Change;
  2747.   if (ItemIndex > -1) and (not FUpdating) and (not DroppedDown) then
  2748.   begin
  2749.     FUpdating := True;
  2750.     try
  2751.       Node := Folders[ItemIndex];
  2752.       if Assigned(Node) then
  2753.       begin
  2754.         if Assigned(FTreeView) then
  2755.           FTreeView.SetPathFromID(Node.AbsoluteID);
  2756.         if Assigned(FListView) then
  2757.           FListView.TreeUpdate(Node.AbsoluteID);
  2758.       end;
  2759.     finally
  2760.       FUpdating := False;
  2761.     end;
  2762.   end;
  2763. end;
  2764.  
  2765. procedure TCustomShellComboBox.Click;
  2766. var
  2767.   Temp: PItemIDList;
  2768. begin
  2769.   FUpdating := True;
  2770.   try
  2771.     Temp := CopyPIDL(Folders[ItemIndex].AbsoluteID);
  2772.     //Folder will be destroyed when removing the lower level ShellFolders.
  2773.     try
  2774.       SetPathFromID(Temp);
  2775.       inherited;
  2776.     finally
  2777.      DisposePIDL(Temp);
  2778.     end;
  2779.   finally
  2780.     FUpdating := False;
  2781.   end;    
  2782. end;
  2783.  
  2784. { TCustomShellListView }
  2785.  
  2786. constructor TCustomShellListView.Create(AOwner: TComponent);
  2787. var
  2788.   FileInfo: TSHFileInfo;
  2789. begin
  2790.   inherited Create(AOwner);
  2791.   FRootFolder := nil;
  2792.   OwnerData := True;
  2793.   FSorted := True;
  2794.   FObjectTypes := [otFolders, otNonFolders];
  2795.   FAutoContext := True;
  2796.   FAutoNavigate := True;
  2797.   FAutoRefresh := False;
  2798.   FFolders := TList.Create;
  2799.   FTreeView := nil;
  2800.   FUpdating := False;
  2801.   FSettingRoot := False;
  2802.   FSmallImages := SHGetFileInfo('C:\', { Do not localize }
  2803.     0, FileInfo, SizeOf(FileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  2804.   FLargeImages := SHGetFileInfo('C:\', { Do not localize }
  2805.     0, FileInfo, SizeOf(FileInfo), SHGFI_SYSICONINDEX or SHGFI_LARGEICON);
  2806.   FRoot := SRFDesktop;
  2807.   HideSelection := False;
  2808. end;
  2809.  
  2810. destructor TCustomShellListView.Destroy;
  2811. begin
  2812.   ClearItems;
  2813.   FFolders.Free;
  2814.   inherited;
  2815. end;
  2816.  
  2817. procedure TCustomShellListView.ClearItems;
  2818. var
  2819.   I: Integer;
  2820. begin
  2821.   if not (csDestroying in ComponentState) then
  2822.     Items.Count := 0;
  2823.   for I := 0 to FFolders.Count-1 do
  2824.     if Assigned(Folders[i]) then
  2825.       Folders[I].Free;
  2826.  
  2827.   FFolders.Clear;
  2828. end;
  2829.  
  2830. procedure TCustomShellListView.CommandCompleted(Verb: String;
  2831.   Succeeded: Boolean);
  2832. begin
  2833.   if not Succeeded then Exit;
  2834.   if SameText(Verb, SCmdVerbDelete) or SameText(Verb, SCmdVerbPaste) then
  2835.     Refresh
  2836.   else if SameText(Verb, SCmdVerbOpen) then
  2837.     SetCurrentDirectory(PChar(FSavePath));
  2838. end;
  2839.  
  2840. procedure TCustomShellListView.ExecuteCommand(Verb: String;
  2841.   var Handled: Boolean);
  2842. var
  2843.   szPath: array[0..MAX_PATH] of char;
  2844. begin
  2845.   if SameText(Verb, SCmdVerbRename) then
  2846.   begin
  2847.     EditText;
  2848.     Handled := True;
  2849.   end
  2850.   else if SameText(Verb, SCmdVerbOpen) then
  2851.   begin
  2852.     GetCurrentDirectory(MAX_PATH, szPath);
  2853.     FSavePath := StrPas(szPath);
  2854.     StrPCopy(szPath, ExtractFilePath(Folders[Selected.Index].PathName));
  2855.     SetCurrentDirectory(szPath);
  2856.   end;
  2857. end;
  2858.  
  2859. procedure TCustomShellListView.CreateWnd;
  2860. begin
  2861.   inherited CreateWnd;
  2862.   if HandleAllocated then
  2863.   begin
  2864.     if FSmallImages <> 0 then
  2865.       SendMessage(Handle, LVM_SETIMAGELIST, LVSIL_SMALL, FSmallImages);
  2866.     if FLargeImages <> 0 then
  2867.       SendMessage(Handle, LVM_SETIMAGELIST, LVSIL_NORMAL, FLargeImages);
  2868.   end;
  2869.   CreateRoot;
  2870.   RootChanged;
  2871. end;
  2872.  
  2873. procedure TCustomShellListView.DestroyWnd;
  2874. begin
  2875.   ClearItems;
  2876.   inherited DestroyWnd;
  2877. end;
  2878.  
  2879. procedure TCustomShellListView.SetObjectTypes(Value: TShellObjectTypes);
  2880. begin
  2881.   FObjectTypes := Value;
  2882.   if not (csLoading in ComponentState) then
  2883.     RootChanged;
  2884. end;
  2885.  
  2886. procedure TCustomShellListView.RootChanged;
  2887. var
  2888.   StayFresh: boolean;
  2889. begin
  2890.   if FUpdating then Exit;
  2891.  
  2892.   FUpdating := True;
  2893.   try
  2894.     StayFresh := FAutoRefresh;
  2895.     AutoRefresh := False;
  2896.     SynchPaths;
  2897.     Populate;
  2898.     if ViewStyle = vsReport then EnumColumns;
  2899.     AutoRefresh := StayFresh;
  2900.   finally
  2901.     FUpdating := False;
  2902.   end;
  2903. end;
  2904.  
  2905. procedure TCustomShellListView.Populate;
  2906. var
  2907.   ID: PItemIDList;
  2908.   EnumList: IEnumIDList;
  2909.   NumIDs: LongWord;
  2910.   SaveCursor: TCursor;
  2911.   HR: HResult;
  2912.   CanAdd: Boolean;
  2913.   NewFolder: IShellFolder;
  2914.   Count: Integer;
  2915.   AFolder: TShellFolder;
  2916.  
  2917. begin
  2918.   if (csLoading in ComponentState) and not HandleAllocated then Exit;
  2919.   Items.BeginUpdate;
  2920.   try
  2921.     ClearItems;
  2922.     Count := 0;
  2923.     SaveCursor := Screen.Cursor;
  2924.     try
  2925.       Screen.Cursor := crHourglass;
  2926.       HR := FRootFolder.ShellFolder.EnumObjects(Application.Handle,
  2927.          ObjectFlags(FObjectTypes), EnumList);
  2928.  
  2929.       if HR <> 0 then Exit;
  2930.  
  2931.       while EnumList.Next(1, ID, NumIDs) = S_OK do
  2932.       begin
  2933.         NewFolder := GetIShellFolder(FRootFolder.ShellFolder, ID);
  2934.         AFolder := TShellFolder.Create(FRootFolder, ID, NewFolder);
  2935.         CanAdd := True;
  2936.         if Assigned(FOnAddFolder) then FOnAddFolder(Self, AFolder, CanAdd);
  2937.  
  2938.         if CanAdd then
  2939.         begin
  2940.           Inc(Count);
  2941.           FFolders.Add(AFolder);
  2942.         end else
  2943.           AFolder.Free;
  2944.       end;
  2945.       Items.Count := Count;
  2946.       if FSorted then
  2947.       begin
  2948.         CompareFolder := FRootFolder;
  2949.         try
  2950.           FFolders.Sort(@ListSortFunc);
  2951.         finally
  2952.           CompareFolder := nil;
  2953.         end;
  2954.       end;
  2955.     finally
  2956.       Screen.Cursor := SaveCursor;
  2957.     end;
  2958.   finally
  2959.     Items.EndUpdate;
  2960.   end;
  2961. end;
  2962.  
  2963. procedure TCustomShellListView.Notification(AComponent: TComponent; Operation: TOperation);
  2964. begin
  2965.   inherited Notification(AComponent, Operation);
  2966.   if (Operation = opRemove) then
  2967.   begin
  2968.     if (AComponent = FTreeView) then
  2969.       FTreeView := nil
  2970.     else if (AComponent = FComboBox) then
  2971.       FComboBox := nil;
  2972.   end;
  2973. end;
  2974.  
  2975. procedure TCustomShellListView.DblClick;
  2976. begin
  2977.   if FAutoNavigate and (Selected <> nil) then
  2978.     with Folders[Selected.Index] do
  2979.       if IsFolder then
  2980.         SetPathFromID(AbsoluteID)
  2981.       else
  2982.         ShellExecute(Handle, nil, PChar(PathName), nil,
  2983.           PChar(ExtractFilePath(PathName)), 0);  
  2984.   inherited DblClick;
  2985. end;
  2986.  
  2987. procedure TCustomShellListView.EditText;
  2988. begin
  2989.   if Selected <> nil then
  2990.     ListView_EditLabel(Handle, Selected.Index);
  2991. end;
  2992.  
  2993. procedure TCustomShellListView.Edit(const Item: TLVItem);
  2994. var
  2995.   S: string;
  2996. begin
  2997.   with Item do
  2998.   begin
  2999.     if iItem >= FFolders.Count then Exit;
  3000.     if pszText <> nil then
  3001.     begin
  3002.       S := pszText;
  3003.       TShellFolder(FFolders[iItem]).Rename(S);
  3004.       ListView_RedrawItems(Handle, iItem, iItem);
  3005.     end;
  3006.   end;
  3007. end;
  3008.  
  3009. procedure TCustomShellListView.SetAutoRefresh(const Value: Boolean);
  3010. begin
  3011.   FAutoRefresh := Value;
  3012.   if not (csLoading in ComponentState) then
  3013.   begin
  3014.     if FAutoRefresh then
  3015.     begin
  3016.       if Assigned(FNotifier) then
  3017.         FreeAndNil(FNotifier);
  3018.       FNotifier := TShellChangeNotifier.Create(Self);
  3019.       FNotifier.FComponentStyle := FNotifier.FComponentStyle + [ csSubComponent ];
  3020.       FNotifier.WatchSubTree := False;
  3021.       FNotifier.Root := FRootFolder.PathName;
  3022.       FNotifier.OnChange := Self.Refresh;
  3023.     end
  3024.     else if Assigned(FNotifier) then
  3025.       FreeAndNil(FNotifier);
  3026.   end;
  3027. end;
  3028.  
  3029. procedure TCustomShellListView.SetRoot(const Value: TRoot);
  3030. begin
  3031.   if not SameText(Value, FRoot) then
  3032.   begin
  3033.     FOldRoot := FRoot;
  3034.     FRoot := Value;
  3035.     CreateRoot;
  3036.     FSettingRoot := True;
  3037.     RootChanged;
  3038.   end;
  3039. end;
  3040.  
  3041. function TCustomShellListView.SelectedFolder: TShellFolder;
  3042. begin
  3043.   Result := nil;
  3044.   if Selected <> nil then Result := Folders[Selected.Index];
  3045. end;
  3046.  
  3047. function TCustomShellListView.OwnerDataFetch(Item: TListItem;
  3048.   Request: TItemRequest): Boolean;
  3049.  
  3050. var
  3051.   AFolder: TShellFolder;
  3052.   J: integer;
  3053. begin
  3054.   Result := True;
  3055.   AFolder := Folders[Item.Index];
  3056.   if not Assigned(AFolder) then exit;
  3057.  
  3058.   if (Item.Index > FFolders.Count - 1) or (Item.Index < 0) then Exit;
  3059.   if irText in Request then
  3060.     Item.Caption := AFolder.DisplayName;
  3061.   if irImage in Request then
  3062.     Item.ImageIndex := AFolder.ImageIndex(ViewStyle = vsIcon);
  3063.     
  3064.   if ViewStyle <> vsReport then Exit;
  3065.  
  3066.   //PIDL := AFolder.FPIDL;
  3067.  
  3068.   AFolder.LoadColumnDetails(FRootFolder, Self.Handle, Columns.Count);
  3069.   for J := 1 to Columns.Count - 1 do
  3070.     Item.SubItems.Add(AFolder.Details[J]);
  3071.  
  3072.   (*
  3073.   FRootFolder.ViewHandle := Self.Handle;
  3074.   SF2 := FRootFolder.ShellFolder2;
  3075.   if Assigned(SF2) then
  3076.   begin
  3077.     // Already have name and icon, so see if we can provide details
  3078.     for J := 1 to Columns.Count - 1 do
  3079.     begin
  3080.       HR := SF2.GetDetailsOf(PIDL, J, SD);
  3081.       Item.SubItems.Add(StrRetToString(PIDL, SD.str, Format('**%x**', [HR])));
  3082.     end;
  3083.   end
  3084.   else
  3085.   begin
  3086.     ISD := FRootFolder.ShellDetails;
  3087.     if Assigned(ISD) then
  3088.     begin
  3089.       PIDL := TShellFolder(FFolders[Item.Index]).FPIDL;
  3090.       for J := 1 to Columns.Count - 1 do
  3091.       begin
  3092.         ISD.GetDetailsOf(PIDL, J, SD);
  3093.         Item.SubItems.Add(StrRetToString(PIDL, SD.str));
  3094.       end;
  3095.     end
  3096.     else if (fpFileSystem in FRootFolder.Properties) then
  3097.     begin
  3098.       GetDetailsOf(TShellFolder(FFolders[Item.Index]), FindData);
  3099.       for J := 1 to Columns.Count - 1 do
  3100.         Item.SubItems.Add(DefaultDetailColumn(FindData, J));
  3101.     end;
  3102.   end;
  3103.   (**)
  3104. end;
  3105.  
  3106. function TCustomShellListView.GetFolder(Index: Integer): TShellFolder;
  3107. begin
  3108.   Result := TShellFolder(FFolders[Index]);
  3109. end;
  3110.  
  3111. function TCustomShellListView.OwnerDataFind(Find: TItemFind;
  3112.   const FindString: string; const FindPosition: TPoint; FindData: Pointer;
  3113.   StartIndex: Integer; Direction: TSearchDirection;
  3114.   Wrap: Boolean): Integer;
  3115. var
  3116.   I: Integer;
  3117.   Found: Boolean;
  3118. //OnDataFind gets called in response to calls to FindCaption, FindData,
  3119. //GetNearestItem, etc. It also gets called for each keystroke sent to the
  3120. //ListView (for incremental searching)
  3121. begin
  3122.   Result := -1;
  3123.   I := StartIndex;
  3124.   if (Find = ifExactString) or (Find = ifPartialString) then
  3125.   begin
  3126.     repeat
  3127.       if (I = FFolders.Count-1) then
  3128.         if Wrap then I := 0 else Exit;
  3129.       Found := Pos(UpperCase(FindString), UpperCase(Folders[I].DisplayName)) = 1;
  3130.       Inc(I);
  3131.     until Found or (I = StartIndex);
  3132.     if Found then Result := I-1;
  3133.   end;
  3134. end;
  3135.  
  3136. procedure TCustomShellListView.SetSorted(const Value: Boolean);
  3137. begin
  3138.   if FSorted <> Value then
  3139.   begin
  3140.     FSorted := Value;
  3141.     Populate;
  3142.   end;
  3143. end;
  3144.  
  3145. procedure TCustomShellListView.Loaded;
  3146. begin
  3147.   inherited Loaded;
  3148.   Populate;
  3149.   if csLoading in ComponentState then
  3150.     inherited Loaded;
  3151.   SetAutoRefresh(FAutoRefresh);
  3152.  
  3153. end;
  3154.  
  3155. procedure TCustomShellListView.DoContextPopup(MousePos: TPoint;
  3156.   var Handled: Boolean);
  3157. begin
  3158.   if FAutoContext and (SelectedFolder <> nil) then
  3159.   begin
  3160.     InvokeContextMenu(Self, SelectedFolder, MousePos.X, MousePos.Y);
  3161.     Handled := True;
  3162.   end else
  3163.     inherited;
  3164. end;
  3165.  
  3166. procedure TCustomShellListView.Back;
  3167. var
  3168.   RootPIDL: PItemIDList;
  3169. begin
  3170.   RootPIDL := CopyPIDL(FRootFolder.AbsoluteID);
  3171.   try
  3172.     StripLastID(RootPIDL);
  3173.     SetPathFromID(RootPIDL);
  3174.   finally
  3175.     DisposePIDL(RootPIDL);
  3176.   end;
  3177. end;
  3178.  
  3179. (*
  3180.  
  3181. The method I outlined previously works for me (just tested for Printers):
  3182.  
  3183.  - Start with the required IShellFolder interface
  3184.  - See if it supports IShellDetails
  3185.  - If not, use FShellFolder.CreateViewObject to get IShellDetails
  3186.  - If it is a normal file folder (SFGAO_FILESYSTEM) you know what to do
  3187.  - If not, call IShellDetails.GetDetailsOf on the virtual folder until
  3188.    it returns the same column name twice (gives you the column types,
  3189.    names, and count).  Use nil for the first parameter.
  3190.  - For each virtual file, call IShellDetails.GetDetailsOf the number of
  3191.    columns times passing in the PItemIDList this time to get details.
  3192.  
  3193. > Furthermore, I have not yet found a way to determine that a PIDL I
  3194. > happen to have is a virtual folder, or a specific virtual folder. Still
  3195. > looking for suggestions there as well.
  3196.  
  3197.   You can tell a normal folder using IShellFolder.GetAttributesOf and
  3198. checking for SFGAO_FILESYSTEM.  This returns false for printers, scheduled
  3199. tasks, etc.
  3200.  
  3201. (**)
  3202. procedure TCustomShellListView.EnumColumns;
  3203.  
  3204. var
  3205.   ColNames: TStringList;
  3206.  
  3207.   function AddColumn(SD: TShellDetails) : boolean;
  3208.   var
  3209.     PIDL: PItemIDList;
  3210.     ColName: string;
  3211.  
  3212.     function ColumnIsUnique(const Name: string): boolean;
  3213.     var
  3214.       i : integer;
  3215.     begin
  3216.       for i := 0 to ColNames.Count - 1 do
  3217.         if SameText(ColNames[i], Name) then
  3218.         begin
  3219.           Result := False;
  3220.           exit;
  3221.         end;
  3222.       Result := True;
  3223.     end;
  3224.  
  3225.   begin
  3226.     PIDL := nil;
  3227.     ColName := StrRetToString(PIDL, SD.Str);
  3228.     if ColName <> '' then
  3229.     begin
  3230.       Result := ColumnIsUnique(ColName);
  3231.       if Result then
  3232.         with Columns.Add do
  3233.         begin
  3234.           Caption := ColName;
  3235.           case SD.fmt of
  3236.             LVCFMT_CENTER: Alignment := taCenter;
  3237.             LVCFMT_LEFT: Alignment := taLeftJustify;
  3238.             LVCFMT_RIGHT: Alignment := taRightJustify;
  3239.           end;
  3240.           Width := SD.cxChar * Canvas.TextWidth('X');
  3241.           ColNames.Add(ColName);
  3242.         end;
  3243.     end
  3244.     else
  3245.       Result := True;
  3246.   end;
  3247.  
  3248.   procedure AddDefaultColumn(const ACaption: string; const AAlignment: TAlignment;
  3249.     AWidth: integer);
  3250.   begin
  3251.     with Columns.Add do
  3252.     begin
  3253.       Caption := ACaption;
  3254.       Alignment := AAlignment;
  3255.       Width := AWidth * Canvas.TextWidth('X');
  3256.     end;
  3257.   end;
  3258.  
  3259.   procedure AddDefaultColumns(const ColCount: integer = 1);
  3260.   begin
  3261.     if ColCount > 0 then
  3262.       AddDefaultColumn(SShellDefaultNameStr, taLeftJustify, 25);
  3263.     if ColCount > 1 then
  3264.       AddDefaultColumn(SShellDefaultSizeStr, taRightJustify, 10);
  3265.     if ColCount > 2 then
  3266.       AddDefaultColumn(SShellDefaultTypeStr, taLeftJustify, 10);
  3267.     if ColCount > 3 then
  3268.       AddDefaultColumn(SShellDefaultModifiedStr, taLeftJustify, 14);
  3269.   end;
  3270.  
  3271. var
  3272.   Col: Integer;
  3273.   SD: TShellDetails;
  3274.   PIDL: PItemIDList;
  3275.   SF2: IShellFolder2;
  3276.   ISD: IShellDetails;
  3277.   ColFlags: LongWord;
  3278.   Default: Boolean;
  3279. begin
  3280.   if (not Assigned(FRootFolder)) or (not Assigned(FRootFolder.ShellFolder)) then Exit;
  3281.   ColNames := TStringList.Create;
  3282.   try
  3283.     Columns.BeginUpdate;
  3284.     try
  3285.       Columns.Clear;
  3286.       Col := 0;
  3287.       PIDL := nil;
  3288.       Default := False;
  3289.       FillChar(SD, SizeOf(SD), 0);
  3290.  
  3291.       FRootFolder.ViewHandle := Self.Handle;
  3292.       SF2 := FRootFolder.ShellFolder2;
  3293.       if Assigned(SF2) then // Have IShellFolder2 interface
  3294.       begin
  3295.         while SF2.GetDetailsOf(PIDL, Col, SD) = S_OK do
  3296.         begin
  3297.           SF2.GetDefaultColumnState(Col, ColFlags);
  3298.           Default := Default or Boolean(ColFlags and SHCOLSTATE_ONBYDEFAULT);
  3299.           if Default and not Boolean(ColFlags and SHCOLSTATE_ONBYDEFAULT) then Exit;
  3300.           AddColumn(SD);
  3301.           Inc(Col);
  3302.         end;
  3303.       end
  3304.       else
  3305.       begin
  3306.         ISD := FRootFolder.ShellDetails;
  3307.         if Assigned(ISD) then
  3308.         begin
  3309.           while (ISD.GetDetailsOf(nil, Col, SD) = S_OK) do
  3310.           begin
  3311.             if (AddColumn(SD)) then
  3312.               Inc(Col)
  3313.             else
  3314.               Break;
  3315.           end;
  3316.         end
  3317.         else
  3318.         begin
  3319.           if (fpFileSystem in FRootFolder.Properties) then
  3320.             AddDefaultColumns(4)
  3321.           else
  3322.             AddDefaultColumns(1);
  3323.         end;
  3324.       end;
  3325.  
  3326.     finally
  3327.       Columns.EndUpdate;
  3328.     end;
  3329.   finally
  3330.     ColNames.Free;
  3331.   end;
  3332. end;
  3333.  
  3334. procedure TCustomShellListView.KeyDown(var Key: Word; Shift: TShiftState);
  3335. begin
  3336.   inherited;
  3337.   if FAutoNavigate then
  3338.     case Key of
  3339.       VK_RETURN:
  3340.         if ssAlt in Shift then
  3341.         begin
  3342.           DoContextMenuVerb(SelectedFolder, cmvProperties);
  3343.           Key := 0;
  3344.         end
  3345.         else if (SelectedFolder <> nil) then
  3346.           if SelectedFolder.IsFolder then
  3347.           begin
  3348.             SetPathFromID(SelectedFolder.AbsoluteID);
  3349.           end
  3350.           else
  3351.             SelectedFolder.ExecuteDefault;
  3352.       VK_BACK: if not IsEditing then Back;
  3353.       VK_F5: Refresh;
  3354.     end;
  3355. end;
  3356.  
  3357. procedure TCustomShellListView.SetViewStyle(Value: TViewStyle);
  3358. begin
  3359.   inherited;
  3360.   if (Value = vsReport) and not (csLoading in ComponentState) then
  3361.     EnumColumns;
  3362. end;
  3363.  
  3364. procedure TCustomShellListView.SetTreeView(Value: TCustomShellTreeView);
  3365. begin
  3366.   if Value = FTreeView then Exit;
  3367.   if Value <> nil then
  3368.   begin
  3369.     Value.Root := Root;
  3370.     Value.FListView := Self;
  3371.   end else
  3372.     if FTreeView <> nil then
  3373.       FTreeView.FListView := nil;
  3374.  
  3375.   if FTreeView <> nil then
  3376.     FTreeView.FreeNotification(Self);
  3377.   FTreeView := Value;
  3378. end;
  3379.  
  3380. procedure TCustomShellListView.SetComboBox(Value: TCustomShellComboBox);
  3381. begin
  3382.   if Value = FComboBox then Exit;
  3383.   if Value <> nil then
  3384.   begin
  3385.     Value.Root := Root;
  3386.     Value.FListView := Self;
  3387.   end else
  3388.     if FComboBox <> nil then
  3389.       FComboBox.FListView := nil;
  3390.  
  3391.   if FComboBox <> nil then
  3392.     FComboBox.FreeNotification(Self);
  3393.   FComboBox := Value;
  3394. end;
  3395.  
  3396. procedure TCustomShellListView.TreeUpdate(NewRoot: PItemIDList);
  3397. begin
  3398.   if FUpdating or (Assigned(FRootFolder)
  3399.     and SamePIDL(FRootFolder.AbsoluteID, NewRoot)) then Exit;
  3400.   SetPathFromID(NewRoot);
  3401. end;
  3402.  
  3403. procedure TCustomShellListView.WndProc(var Message: TMessage);
  3404. begin
  3405.   //to handle submenus of context menus.
  3406.   with Message do
  3407.     if ((Msg = WM_INITMENUPOPUP) or (Msg = WM_DRAWITEM) or (Msg = WM_MENUCHAR)
  3408.     or (Msg = WM_MEASUREITEM)) and Assigned(ICM2) then
  3409.     begin
  3410.       ICM2.HandleMenuMsg(Msg, wParam, lParam);
  3411.       Result := 0;
  3412.     end;
  3413.   inherited;
  3414. end;
  3415.  
  3416. procedure TCustomShellListView.Refresh;
  3417. var
  3418.   SelectedIndex: Integer;
  3419.   RootPIDL: PItemIDList;
  3420. begin
  3421.   SelectedIndex := -1;
  3422.   if Selected <> nil then SelectedIndex := Selected.Index;
  3423.   Selected := nil;
  3424.   RootPIDL := CopyPIDL(FRootFolder.AbsoluteID);
  3425.   try
  3426.     FreeAndNil(FRootFolder);
  3427.     SetPathFromID(RootPIDL);
  3428.   finally
  3429.     DisposePIDL(RootPIDL);
  3430.   end;
  3431.   if (SelectedIndex > -1) and (SelectedIndex < Items.Count - 1) then
  3432.     Selected := Items[SelectedIndex];
  3433. end;
  3434.  
  3435. procedure TCustomShellListView.SetPathFromID(ID: PItemIDList);
  3436. begin
  3437.   if FUpdating then Exit;
  3438.  
  3439.   if Assigned(FRootFolder) then
  3440.     if SamePIDL(FRootFolder.AbsoluteID, ID) then
  3441.       Exit // Note! Exits routine
  3442.     else
  3443.       FRootFolder.Free;
  3444.  
  3445.   FSettingRoot := False;
  3446.   FRootFolder := CreateRootFromPIDL(ID);
  3447.   RootChanged;
  3448. end;
  3449.  
  3450. procedure TCustomShellListView.CreateRoot;
  3451. begin
  3452.   FRootFolder := CreateRootFolder(FRootFolder, FOldRoot, FRoot);
  3453. end;
  3454.  
  3455. procedure TCustomShellListView.SynchPaths;
  3456. begin
  3457.   try
  3458.     if FSettingRoot then
  3459.     begin
  3460.       if Assigned(FTreeView) then
  3461.         FTreeView.SetRoot(FRoot);
  3462.       if Assigned(FComboBox) then
  3463.         FComboBox.SetRoot(FRoot);
  3464.     end
  3465.     else
  3466.     begin
  3467.       if Assigned(FTreeView) then
  3468.         FTreeView.SetPathFromID(FRootFolder.AbsoluteID);
  3469.       if Assigned(FComboBox) then
  3470.         FComboBox.TreeUpdate(FRootFolder.AbsoluteID);
  3471.     end;
  3472.   finally
  3473.     FSettingRoot := False;
  3474.   end;
  3475. end;
  3476.  
  3477.  
  3478. initialization
  3479.  
  3480.   CreateDesktopFolder;
  3481.   InitializeCriticalSection(CS);
  3482.   OleInitialize(nil);
  3483.   
  3484. finalization
  3485.  
  3486.   if Assigned(DesktopFolder) then
  3487.     DesktopFolder.Free;
  3488.   DeleteCriticalSection(CS);
  3489.   OleUninitialize;
  3490.  
  3491. end.