home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d123456 / DFS.ZIP / SystemListView.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-28  |  81KB  |  2,535 lines
  1. {$I DFS.INC}                    { Defines for all Delphi Free Stuff components }
  2. {$I SYSTEMCONTROLPACK.INC}      { Defines specific to these components }
  3.  
  4. { -----------------------------------------------------------------------------}
  5. { TdfsSystemListView                                                           }
  6. { -----------------------------------------------------------------------------}
  7. { A list view control that acts as the list in the Windows Explorer.  This is  }
  8. { part of the System Control Pack.                                             }
  9. {                                                                              }
  10. { Copyright 2000-2001, Brad Stowers.  All Rights Reserved.                     }
  11. {                                                                              }
  12. { Copyright:                                                                   }
  13. { All Delphi Free Stuff (hereafter "DFS") source code is copyrighted by        }
  14. { Bradley D. Stowers (hereafter "author"), and shall remain the exclusive      }
  15. { property of the author.                                                      }
  16. {                                                                              }
  17. { Distribution Rights:                                                         }
  18. { You are granted a non-exlusive, royalty-free right to produce and distribute }
  19. { compiled binary files (executables, DLLs, etc.) that are built with any of   }
  20. { the DFS source code unless specifically stated otherwise.                    }
  21. { You are further granted permission to redistribute any of the DFS source     }
  22. { code in source code form, provided that the original archive as found on the }
  23. { DFS web site (http://www.delphifreestuff.com) is distributed unmodified. For }
  24. { example, if you create a descendant of TDFSColorButton, you must include in  }
  25. { the distribution package the colorbtn.zip file in the exact form that you    }
  26. { downloaded it from http://www.delphifreestuff.com/mine/files/colorbtn.zip.   }
  27. {                                                                              }
  28. { Restrictions:                                                                }
  29. { Without the express written consent of the author, you may not:              }
  30. {   * Distribute modified versions of any DFS source code by itself. You must  }
  31. {     include the original archive as you found it at the DFS site.            }
  32. {   * Sell or lease any portion of DFS source code. You are, of course, free   }
  33. {     to sell any of your own original code that works with, enhances, etc.    }
  34. {     DFS source code.                                                         }
  35. {   * Distribute DFS source code for profit.                                   }
  36. {                                                                              }
  37. { Warranty:                                                                    }
  38. { There is absolutely no warranty of any kind whatsoever with any of the DFS   }
  39. { source code (hereafter "software"). The software is provided to you "AS-IS", }
  40. { and all risks and losses associated with it's use are assumed by you. In no  }
  41. { event shall the author of the softare, Bradley D. Stowers, be held           }
  42. { accountable for any damages or losses that may occur from use or misuse of   }
  43. { the software.                                                                }
  44. {                                                                              }
  45. { Support:                                                                     }
  46. { Support is provided via the DFS Support Forum, which is a web-based message  }
  47. { system.  You can find it at http://www.delphifreestuff.com/discus/           }
  48. { All DFS source code is provided free of charge. As such, I can not guarantee }
  49. { any support whatsoever. While I do try to answer all questions that I        }
  50. { receive, and address all problems that are reported to me, you must          }
  51. { understand that I simply can not guarantee that this will always be so.      }
  52. {                                                                              }
  53. { Clarifications:                                                              }
  54. { If you need any further information, please feel free to contact me directly.}
  55. { This agreement can be found online at my site in the "Miscellaneous" section.}
  56. {------------------------------------------------------------------------------}
  57. { The lateset version of my components are always available on the web at:     }
  58. {   http://www.delphifreestuff.com/                                            }
  59. { See SCP.txt for notes, known issues, and revision history.                   }
  60. { -----------------------------------------------------------------------------}
  61. { Date last modified:  June 28, 2001                                           }
  62. { -----------------------------------------------------------------------------}
  63.  
  64. unit SystemListView;
  65.  
  66. interface
  67.  
  68. {$IFNDEF DFS_SCP_SYSLISTVIEW}
  69.   'Error, shouldn''t be compiling this unit!'
  70. {$ENDIF}
  71.  
  72. uses
  73.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  74.   {$IFDEF DFS_COMPILER_3_UP} ShlObj, ActiveX, {$ELSE} MyShlObj, OLE2, {$ENDIF}
  75.   {$IFDEF DFS_DEBUG} MMSystem, {$ENDIF}
  76.   SystemControlPack, PidlHelp, ItemProp, Menus, ComCtrls, StdCtrls,
  77.   CommCtrl, _Res__IDs;
  78.  
  79. const
  80.   DFS_COMPONENT_LIST_VERSION = 'TdfsSystemListView ' + DFS_SCP_VERSION;
  81.  
  82. {$IFDEF DFS_COMPILER_3_UP}
  83. resourcestring
  84. {$ELSE}
  85. const
  86. {$ENDIF}
  87.   strColName        = 'Name';
  88.   strColType        = 'Type';
  89.   strColTotalSize   = 'Total Size';
  90.   strColFreeSpace   = 'Free Space';
  91.   strColDescription = 'Description';
  92.   strColDocuments   = 'Documents';
  93.   strColPhone       = 'Phone #';
  94.   strColStatus      = 'Status';
  95.   strColComment     = 'Comment';
  96.   strColEntryName   = 'Entry name';
  97.   strColDeviceName  = 'Device name';
  98.   strColSize        = 'Size';
  99.   strColModified    = 'Modified';
  100.   strColUserDefined = 'User defined';
  101.   strKilobytes      = ' KB';
  102.   strColAttrib      = 'Attributes';
  103.   strSystemFolder   = 'System Folder';
  104.  
  105.   strReadOnlyChar   = 'R';
  106.   strHiddenChar     = 'H';
  107.   strSystemChar     = 'S';
  108.   strArchiveChar    = 'A';
  109.  
  110. type
  111.   TSLVAddListItem = procedure(Sender: TObject; AItem: TListItem) of object;
  112.   TSLVCreateColumns = TNotifyEvent;
  113.   TColumnType = (ctFileSystem, ctMachine, ctControlPanel, ctPrinters, ctDUNet,
  114.      ctNetwork, ctUser, ctUnknown);
  115.  
  116.   TdfsSystemListView = class(TdfsCustomSystemListView)
  117.   private
  118.     FCurrentPIDL: PItemIDList;
  119.     FCurrentShellFolder: IShellFolder;
  120.     FLastNodeWasDesktop: boolean;
  121.     FFileMask: string;
  122.     FFileMaskList: TStringList;
  123.     FNeedsReset: boolean;
  124.     FPopupMenuMethod: TPopupMenuMethod;
  125.     FOnCreateColumns: TSLVCreateColumns;
  126.     FAutoscroll: boolean;
  127.     FOnAddListItem: TSLVAddListItem;
  128.     FShowErrorsInMsgBox: boolean;
  129.     FLastNode: TTreeNode;
  130.     // This will eventually be a set of attributes (system, read-only, etc.)
  131.     FShowHiddenFiles: boolean;
  132.     FShowFolders: boolean;
  133.     FColumnType: TColumnType;
  134.     FColumnWidths: record
  135.       cwName, cwSize, cwType, cwModified, cwAttr: integer;
  136.     end;
  137.     FRecreatingWnd: boolean;
  138.     {$IFNDEF DFS_SLV_USING_ELV}
  139.     FLastSortOrder : ByteBool;
  140.     FLastColumnIndexSort : Integer;
  141.     {$ENDIF}
  142.  
  143.     FOnPopulated: TNotifyEvent;
  144.  
  145.     function AddItemData(ItemFolder: IShellFolder; aIDList,
  146.        aFQ_IDList: PItemIDList; Attrs: UINT): TFolderItemData;
  147.     procedure FreeItemData(Item: TListItem);
  148.     procedure FreeAllItemData;
  149.     procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
  150.     {$IFDEF DFS_COMPILER_5_UP}
  151.     procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU;
  152.     {$ELSE}
  153.     procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
  154.     {$ENDIF}
  155.   protected
  156.     { Base Class Abstract Implementations }
  157.     // Implementation must return the actual ID list.  Caller will make a copy
  158.     // of it it wants it's own.  Implementer owns this one, i.e. it's the "real
  159.     // thing".  If there isn't one, return NIL.
  160.     function GetSelectionPIDL: PItemIDList; override;
  161.     function GetSelectionParentFolder: IShellFolder; override;
  162.  
  163.     // Implementation notes: IDList parameter belongs to someone else.  If
  164.     // needed by this component, a copy must be made of it.  This differs from
  165.     // the Reset method in that it does not notify linked controls of a change
  166.     // because that could result in an endless cycle of notifications. Return
  167.     // value indicates success or failure.
  168.     function LinkedReset(const ParentFolder: IShellFolder;
  169.        const IDList: PItemIDList; ForceUpdate: boolean): boolean; override;
  170.  
  171.     function GetItemFromAPIItem(const Item: TLVItem): TListItem;
  172.     procedure CreateColumns(ColType: TColumnType); dynamic;
  173.     procedure SetColumnType(ColType: TColumnType);
  174.     procedure SetShowFolders(Val: boolean);
  175.     function GetFilename(Index: TListItem): string;
  176.     function GetFullFilename(Index: TListItem): string;
  177.     function CanEdit(Item: TListItem): boolean; override;
  178.     procedure Edit(const Item: TLVItem); override;
  179.     function GetVersion: string; {$IFDEF DFS_SLV_USING_ELV} override; {$ENDIF}
  180.     {$IFNDEF DFS_SLV_USING_ELV}
  181.     procedure SetVersion(const Val: string);
  182.     {$ENDIF}
  183.     function GetItems: TListItems;
  184.     procedure SetFileMask(const Val: string);
  185.  
  186.     procedure CreateWnd; override;
  187.     procedure DestroyWnd; override;
  188.     procedure Loaded; override;
  189.     function GetPopupMenu: TPopupMenu; override;
  190.     function EnumerateFiles(const Folder: IShellFolder;
  191.        const IDList: PItemIDList): boolean;
  192.     function GetItemData(Item: TListItem): TFolderItemData;
  193.     function AddNode(const ShellFolder: IShellFolder; FQ_IDList,
  194.        IDList: PItemIDList): TListItem; dynamic;
  195.  
  196.     {$IFNDEF DFS_SLV_USING_ELV}
  197.     // Added by Fabrice FOUQUET 30/03/98
  198.     // To change the sort
  199.     procedure ColClick(Column: TListColumn); override;
  200.     function CustomSort(SortProc: TLVCompare; Data: Longint): Boolean; dynamic;
  201.     function AlphaSort: Boolean; 
  202.     {$ENDIF}
  203.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  204.     procedure Compute_ListMoves(X, Y: integer); dynamic;
  205.     procedure DblClick; override;
  206.     procedure Populated; dynamic;
  207.     function FindItemFromID(AnID: PItemIDList): TListItem;
  208.   public
  209.     constructor Create(AOwner: TComponent); override;
  210.     destructor Destroy; override;
  211.  
  212.     // Useful functions for applications.  These modify permanently, not just
  213.     // the item.  i.e. if you rename 'My Computer' to 'Crasher', it is renamed
  214.     // system wide, not just in your app.  If you delete the 'C:\WINDOWS'
  215.     // folder, you are in deep trouble and I deny any responsibility.
  216.     function RenameItem(const Item: TListItem; const NewName: string): boolean;
  217.     function DeleteItem(const Item: TListItem): boolean;
  218.     // Move up one directory, i.e. "cd .."
  219.     procedure ChangeToParent;
  220.  
  221.     procedure DefaultDblClickAction(Item: TListItem);
  222.     procedure Reset; override;
  223.     procedure RecreateColumns; virtual;
  224.     function DisplayContextMenu(Item: TListItem; Where: TPoint): boolean;
  225.        dynamic;
  226.     function DisplaySelectedContextMenu(Where: TPoint): boolean; dynamic;
  227.  
  228.     procedure SetColumnWidths(NameWidth, SizeWidth, TypeWidth, ModifiedWidth,
  229.        AttrWidth: integer);
  230.     function GetItemAttrs(const Item: TListItem): UINT;
  231.     function GetFullPath(const Item: TListItem): string;
  232.     // The var parameter of this function is a memory block allocated with
  233.     // GetMem.  The caller of the function MUST release the memory with FreeMem
  234.     // when done with the array. The PPIDLArray type is defined in the ItemProp
  235.     // unit. The return value is the number of items in the array.
  236.     function GetSelectedPIDLs(var SelPIDLs: PPIDLArray): integer;
  237.  
  238.     property ShowErrorsInMsgBox: boolean
  239.        read FShowErrorsInMsgBox write FShowErrorsInMsgBox default TRUE;
  240.     property Items
  241.        read GetItems;
  242.     property Filename[Index: TListItem]: string
  243.        read GetFilename;
  244.     property FullFilename[Index: TListItem]: string
  245.        read GetFullFilename;
  246.     property ItemData[Item: TListItem]: TFolderItemData
  247.        read GetItemData;
  248.  
  249.     property Columns;
  250.     {$IFDEF DFS_SLV_USE_EXTLISTVIEW}
  251.     property LastColumnClicked;
  252.     property CurrentColumnWidth;
  253.     property HeaderHandle;
  254.     property SubItem_BoundsRect;
  255.     property SubItem_IconRect;
  256.     property SubItem_LabelRect;
  257.     property SubItem_SelectBoundsRect;
  258.     property HotItem;
  259.     property HotCursor;
  260.     property WorkArea;
  261.     property IsChecked;
  262.     property SubItem_ImageIndex;
  263.     property SelectionMark;
  264.     property ItemIndent;
  265.     property CurrentSortAscending;
  266.     {$ELSE}
  267.     {$IFDEF DFS_SLV_USE_ENHLISTVIEW}
  268.     property HeaderHandle;
  269.     property CurrentSortAscending;
  270.     property LastColumnClicked;
  271.     property CurrentColumnWidth;
  272.     {$ENDIF}
  273.     {$ENDIF}
  274.   published
  275.     property Version: string
  276.        read GetVersion
  277.        write SetVersion
  278.        stored FALSE;
  279.     property PopupMenuMethod: TPopupMenuMethod
  280.        read FPopupMenuMethod
  281.        write FPopupMenuMethod
  282.        default pmmContextUser;
  283.     property ColumnType: TColumnType
  284.        read FColumnType write SetColumnType default ctFileSystem;
  285.     property ShowHiddenFiles: boolean
  286.        read FShowHiddenFiles write FShowHiddenFiles default TRUE;
  287.     property ShowFolders: boolean
  288.        read FShowFolders write SetShowFolders default TRUE;
  289.     property Autoscroll: boolean
  290.        read FAutoscroll write FAutoscroll default FALSE;
  291.     property FileMask: string
  292.        read FFileMask write SetFileMask;
  293.  
  294.  
  295.     property OnCreateColumns: TSLVCreateColumns
  296.        read FOnCreateColumns write FOnCreateColumns;
  297.     property OnAddListItem: TSLVAddListItem
  298.        read FOnAddListItem write FOnAddListItem;
  299.     property OnPopulated: TNotifyEvent
  300.        read FOnPopulated write FOnPopulated;
  301.  
  302.     {$IFDEF DFS_SCP_SYSTREEVIEW}
  303.     property TreeView;
  304.     {$ENDIF}
  305.     {$IFDEF DFS_SCP_SYSCOMBOBOX}
  306.     property ComboBox;
  307.     {$ENDIF}
  308.  
  309.     {$IFDEF DFS_SLV_USE_EXTLISTVIEW}
  310.     property HideSelection;
  311.     property ExtendedStyles;
  312.     property VirtualMode;
  313.     property HoverTime;
  314.     property RequireComCtlUpdate;
  315.     {$IFDEF DFS_TRY_BACKGROUND_IMAGE}
  316.     property BackgroundImage;
  317.     {$ENDIF}
  318.     property SaveSettings;
  319.     property ColumnsFormat;
  320.     // New Events
  321.     property OnMarqueeBegin;
  322.     property OnItemActivate;
  323.     property OnHotTrack;
  324.     {$IFDEF DFS_TRY_INFOTIP}
  325.     property OnInfoTip;
  326.     {$ENDIF}
  327.     property OnVMGetItemInfo;
  328.     property OnVMCacheHint;
  329.     property OnVMFindItem;
  330.     property OnVMStateChanged;
  331.     property ShowSortArrows;
  332.  
  333.  
  334.     // Publish inherited protected properties
  335.     property AutoColumnSort;
  336.     property AutoSortStyle;
  337.     property AutoResort;
  338.     property AutoSortAscending;
  339.     property ReverseSortArrows;
  340.     property Style;
  341.  
  342.     property OnDrawHeader;
  343.     property OnMeasureItem;
  344.     property OnDrawItem;
  345.     property OnDrawSubItem;
  346.     property OnAfterDefaultDrawItem;
  347.     property OnSortItems;
  348.     property OnSortBegin;
  349.     property OnSortFinished;
  350.     property OnEditCanceled;
  351.  
  352.  
  353.     property Align;
  354.     {$IFDEF DFS_COMPILER_4_UP}
  355.     property Anchors;
  356.     property BiDiMode;
  357.     {$ENDIF}
  358.     property BorderStyle;
  359.     {$IFDEF DFS_COMPILER_4_UP}
  360.     property BorderWidth;
  361.     {$ENDIF}
  362.     property Color;
  363.     property ColumnClick;
  364.     {$IFDEF DFS_COMPILER_4_UP}
  365.     property Constraints;
  366.     {$ENDIF}
  367.     property OnClick;
  368.     property OnDblClick;
  369.     property Ctl3D;
  370.     property DragMode;
  371.     {$IFDEF DFS_COMPILER_4_UP}
  372.     property DragKind;
  373.     {$ENDIF}
  374.     property ReadOnly
  375.        default False;
  376.     property Enabled;
  377.     property Font;
  378.     property IconOptions;
  379.     property AllocBy;
  380.     property MultiSelect;
  381.     property OnChange;
  382.     property OnChanging;
  383.     property OnColumnClick;
  384.     property OnDeletion;
  385.     property OnEdited;
  386.     property OnEditing;
  387.     {$IFDEF DFS_COMPILER_4_UP}
  388.     property OnEndDock;
  389.     {$ENDIF}
  390.     property OnEnter;
  391.     property OnExit;
  392.     property OnInsert;
  393.     property OnDragDrop;
  394.     property OnDragOver;
  395.     property DragCursor;
  396.     property OnStartDrag;
  397.     property OnEndDrag;
  398.     property OnMouseDown;
  399.     property OnMouseMove;
  400.     property OnMouseUp;
  401.     {$IFDEF DFS_COMPILER_4_UP}
  402.     property OnResize;
  403.     property OnSelectItem;
  404.     property OnStartDock;
  405.     {$ENDIF}
  406.     property ParentColor
  407.        default False;
  408.     property ParentFont;
  409.     property ParentShowHint;
  410.     {$IFDEF DFS_COMPILER_4_UP}
  411.     property ParentBiDiMode;
  412.     {$ENDIF}
  413.     property ShowHint;
  414.     property PopupMenu;
  415.     property ShowColumnHeaders;
  416.     property TabOrder;
  417.     property TabStop
  418.        default True;
  419.     property ViewStyle;
  420.     property Visible;
  421.     property OnKeyDown;
  422.     property OnKeyPress;
  423.     property OnKeyUp;
  424.     property LargeImages;
  425.     property StateImages;
  426.     {$ELSE}
  427.     {$IFDEF DFS_SLV_USE_ENHLISTVIEW}
  428.     property AutoColumnSort;
  429.     property AutoSortStyle;
  430.     property AutoResort;
  431.     property AutoSortAscending;
  432.     property ReverseSortArrows;
  433.     property ShowSortArrows;
  434.     property SaveSettings;
  435.     property Style;
  436.  
  437.     property OnMeasureItem;
  438.     property OnDrawItem;
  439.     property OnDrawSubItem;
  440.     property OnAfterDefaultDrawItem;
  441.     property OnDrawHeader;
  442.     property OnSortItems;
  443.     property OnSortBegin;
  444.     property OnSortFinished;
  445.     property OnEditCanceled;
  446.  
  447.     { Publish TCustomListView inherited protected properties }
  448.     property Align;
  449.     {$IFDEF DFS_COMPILER_4_UP}
  450.     property Anchors;
  451.     property BiDiMode;
  452.     {$ENDIF}
  453.     property BorderStyle;
  454.     {$IFDEF DFS_COMPILER_4_UP}
  455.     property BorderWidth;
  456.     {$ENDIF}
  457.     property Color;
  458.     property ColumnClick;
  459.     property OnClick;
  460.     property OnDblClick;
  461.     {$IFDEF DFS_COMPILER_4_UP}
  462.     property Constraints;
  463.     {$ENDIF}
  464.     property Ctl3D;
  465.     {$IFDEF DFS_COMPILER_4_UP}
  466.     property DragKind;
  467.     {$ENDIF}
  468.     property DragMode;
  469.     property ReadOnly
  470.        default False;
  471.     property Enabled;
  472.     property Font;
  473.     {$IFDEF DFS_COMPILER_4_UP}
  474.     property FullDrag;
  475.     {$ENDIF}
  476.     property HideSelection;
  477.     property IconOptions;
  478.     property AllocBy;
  479.     property MultiSelect;
  480.     property OnChange;
  481.     property OnChanging;
  482.     property OnColumnClick;
  483.     property OnDeletion;
  484.     property OnEdited;
  485.     property OnEditing;
  486.     {$IFDEF DFS_COMPILER_4_UP}
  487.     property OnEndDock;
  488.     {$ENDIF}
  489.     property OnEnter;
  490.     property OnExit;
  491.     property OnInsert;
  492.     property OnDragDrop;
  493.     property OnDragOver;
  494.     property DragCursor;
  495.     property OnStartDrag;
  496.     property OnEndDrag;
  497.     property OnMouseDown;
  498.     property OnMouseMove;
  499.     property OnMouseUp;
  500.     {$IFDEF DFS_COMPILER_4_UP}
  501.     property OnResize;
  502.     property OnSelectItem;
  503.     property OnStartDock;
  504.     {$ENDIF}
  505.     property ParentColor
  506.        default False;
  507.     property ParentFont;
  508.     property ParentShowHint;
  509.     {$IFDEF DFS_COMPILER_4_UP}
  510.     property ParentBiDiMode;
  511.     {$ENDIF}
  512.     property ShowHint;
  513.     property PopupMenu;
  514.     property ShowColumnHeaders;
  515.     property TabOrder;
  516.     property TabStop
  517.        default True;
  518.     property ViewStyle;
  519.     property Visible;
  520.     property OnKeyDown;
  521.     property OnKeyPress;
  522.     property OnKeyUp;
  523.     property LargeImages;
  524.     property SmallImages;
  525.     property StateImages;
  526.     {$ELSE}
  527.     { Published protected properties }
  528.     property Align;
  529.     property AllocBy;
  530.     {$IFDEF DFS_COMPILER_4_UP}
  531.     property Anchors;
  532.     property BiDiMode;
  533.     {$ENDIF}
  534.     property BorderStyle;
  535.     {$IFDEF DFS_COMPILER_4_UP}
  536.     property BorderWidth;
  537.     {$ENDIF}
  538.     {$IFDEF DFS_COMPILER_3_UP}
  539.     property Checkboxes;
  540.     {$ENDIF}
  541.     property Color;
  542.     property ColumnClick;
  543.     {$IFDEF DFS_COMPILER_4_UP}
  544.     property Constraints;
  545.     {$ENDIF}
  546.     property Ctl3D;
  547.     property DragCursor;
  548.     {$IFDEF DFS_COMPILER_4_UP}
  549.     property DragKind;
  550.     {$ENDIF}
  551.     property DragMode;
  552.     {$IFDEF DFS_COMPILER_3_UP}
  553.     property Enabled;
  554.     {$ENDIF}
  555.     {$IFDEF DFS_COMPILER_4_UP}
  556.     property FlatScrollBars;
  557.     {$ENDIF}
  558.     property Font;
  559.     {$IFDEF DFS_COMPILER_4_UP}
  560.     property FullDrag;
  561.     {$ENDIF}
  562.     {$IFDEF DFS_COMPILER_3_UP}
  563.     property GridLines;
  564.     {$ENDIF}
  565.     property HideSelection;
  566.     {$IFDEF DFS_COMPILER_3_UP}
  567.     property HotTrack;
  568.     {$ENDIF}
  569.     {$IFDEF DFS_COMPILER_4_UP}
  570.     property HotTrackStyles;
  571.     {$ENDIF}
  572.     property IconOptions;
  573.     property MultiSelect;
  574.     property OnChange;
  575.     property OnChanging;
  576.     property OnClick;
  577.     property OnColumnClick;
  578.     property OnCompare;
  579.     {$IFDEF DFS_COMPILER_4_UP}
  580.     property OnCustomDraw;
  581.     property OnCustomDrawItem;
  582.     property OnCustomDrawSubItem;
  583.     property OnData;
  584.     property OnDataFind;
  585.     property OnDataHint;
  586.     property OnDataStateChange;
  587.     {$ENDIF}
  588.     property OnDblClick;
  589.     property OnDeletion;
  590.     property OnDragDrop;
  591.     property OnDragOver;
  592.     {$IFDEF DFS_COMPILER_4_UP}
  593.     property OnDrawItem;
  594.     {$ENDIF}
  595.     property OnEdited;
  596.     property OnEditing;
  597.     {$IFDEF DFS_COMPILER_4_UP}
  598.     property OnEndDock;
  599.     {$ENDIF}
  600.     property OnEndDrag;
  601.     property OnEnter;
  602.     property OnExit;
  603.     {$IFDEF DFS_COMPILER_4_UP}
  604.     property OnGetImageIndex;
  605.     {$ENDIF}
  606.     property OnInsert;
  607.     property OnKeyDown;
  608.     property OnKeyPress;
  609.     property OnKeyUp;
  610.     property OnMouseDown;
  611.     property OnMouseMove;
  612.     property OnMouseUp;
  613.     {$IFDEF DFS_COMPILER_4_UP}
  614.     property OnResize;
  615.     property OnSelectItem;
  616.     property OnStartDock;
  617.     {$ENDIF}
  618.     property OnStartDrag;
  619.     {$IFDEF DFS_COMPILER_4_UP}
  620.     property OwnerDraw;
  621.     property ParentBiDiMode;
  622.     {$ENDIF}
  623.     {$IFDEF DFS_COMPILER_3_UP}
  624.     property ParentColor default False;
  625.     property ParentFont;
  626.     {$ENDIF}
  627.     property ParentShowHint;
  628.     property PopupMenu;
  629.     property ReadOnly default False;
  630.     {$IFDEF DFS_COMPILER_3_UP}
  631.     property RowSelect;
  632.     {$ENDIF}
  633.     property ShowColumnHeaders;
  634.     property ShowHint;
  635.     property SortType;
  636.     property TabOrder;
  637.     property TabStop default True;
  638.     property ViewStyle;
  639.     property Visible;
  640.     {$ENDIF}
  641.     {$ENDIF}
  642.   end;
  643.  
  644.  
  645. implementation
  646.  
  647. uses
  648.   ShellAPI, MaskSearch,
  649.   {$IFDEF DFS_COMPILER_4_UP} ImgList, {$ENDIF}
  650.   {$IFDEF DFS_COMPILER_3_UP} ComObj, {$ELSE} OleAuto, {$ENDIF}
  651.   Registry;
  652.  
  653. const
  654.   SORT_ALPHA = -1;
  655.   SORT_CURRENT = -2;
  656.   
  657. var
  658.   NewCount: Longint;
  659.  
  660.  
  661. function Commaize(S: string): string;
  662. var
  663.   Len: Integer;
  664. begin
  665.   Len := Length(S);
  666.   if Len > 3 then
  667.   begin
  668.     Result := '';
  669.     while Len > 3 do
  670.     begin
  671.       Insert(',' + Copy(S, Len-2, 3), Result, 1);
  672.       Delete(S, Len-2, 3);
  673.       Dec(Len, 3);
  674.     end;
  675.     if Len > 0 then
  676.       Insert(S, Result, 1);
  677.   end else
  678.     Result := S;
  679. end;
  680.  
  681.  
  682.  
  683. constructor TdfsSystemListView.Create(AOwner: TComponent);
  684. type
  685.   PWordArray = ^TWordArray;
  686.   TWordArray = array[0..300] of word;
  687. var
  688.   OptRIF : TRegIniFile;
  689.   BufferPtr: PWordArray;
  690.   DataBuffer : array[0..4] of word;
  691.   DataSize: integer;
  692.   x: integer;
  693. begin
  694.   // These need to be before inherited!
  695.   FLastNodeWasDesktop := FALSE;
  696.   FNeedsReset := FALSE;
  697.   FLastNode := NIL;
  698.   FCurrentPIDL := NIL;
  699.   // Set the defaults.
  700.   FAutoscroll := FALSE;
  701.   FShowErrorsInMsgBox := TRUE;
  702.   FShowHiddenFiles := TRUE;
  703.   FShowFolders := TRUE;
  704.   FColumnType := ctFileSystem;
  705.   FFileMaskList := TStringList.Create;
  706.   {$IFNDEF DFS_SLV_USING_ELV}
  707.   FLastColumnIndexSort := -1;
  708.   {$ENDIF}
  709.  
  710.   inherited Create(AOwner);
  711.  
  712.   FPopupMenuMethod := pmmContextUser;
  713.  
  714.   // Added by Fabrice FOUQUET 30/03/98
  715.   // Read the columns width for Explorer in the registry
  716.   // Must we do to update this value in destroy event ?
  717.   // Default values:
  718.   DataBuffer[0] := 120;
  719.   DataBuffer[1] := 60;
  720.   DataBuffer[2] := 120;
  721.   DataBuffer[3] := 120;
  722.   DataBuffer[4] := 60;
  723.   OptRIF := TRegIniFile.Create('Software\Microsoft\Windows\CurrentVersion\Explorer');
  724.   try
  725.     DataSize := optRIF.GetDataSize('DirectoryCols');
  726.     if DataSize > 0 then
  727.     begin
  728.       GetMem(BufferPtr, DataSize);
  729.       try
  730.         OptRIF.ReadBinaryData('DirectoryCols', BufferPtr^, DataSize);
  731.         for x := 0 to (DataSize div SizeOf(Word))-1 do
  732.         begin
  733.           if x > 4 then break;                        {//}
  734.           DataBuffer[x] := BufferPtr^[x];
  735.         end;
  736.       finally
  737.         FreeMem(BufferPtr);
  738.       end;
  739.     end;
  740.   finally
  741.     OptRIF.Free;
  742.   end;
  743.   SetColumnWidths(DataBuffer[0], DataBuffer[1], DataBuffer[2], DataBuffer[3],
  744.      DataBuffer[4]);
  745. end; {Create}
  746.  
  747.  
  748. destructor TdfsSystemListView.Destroy;
  749. begin
  750.   FreePIDL(FCurrentPIDL);
  751.   {$IFNDEF DFS_NO_COM_CLEANUP}
  752.   if FCurrentShellFolder <> NIL then
  753.     FCurrentShellFolder.Release;
  754.   {$ENDIF}
  755.  
  756.   LargeImages.Free;
  757.   SmallImages.Free;
  758.   FFileMaskList.Free;
  759.  
  760.   inherited Destroy;
  761. end;
  762.  
  763. procedure TdfsSystemListView.CreateWnd;
  764. var
  765.   x: integer;
  766.   {$IFDEF DFS_COMPILER_5_UP}
  767.   ExtStyle: DWORD;
  768.   {$ENDIF}
  769. begin
  770.   inherited CreateWnd;
  771.  
  772.   {$IFDEF DFS_COMPILER_5_UP}
  773.   // Silly VCL explicitly turns on subitem images
  774.   ExtStyle := ListView_GetExtendedListViewStyle(Handle);
  775.   ExtStyle := ExtStyle and not LVS_EX_SUBITEMIMAGES;
  776.   ListView_SetExtendedListViewStyle(Handle, ExtStyle);
  777.   {$ENDIF}
  778.  
  779.   if not (csLoading in ComponentState) then
  780.     CreateColumns(FColumnType);
  781.  
  782.   if FRecreatingWnd or FNeedsReset then
  783.   begin
  784.     if FRecreatingWnd then
  785.     begin
  786.       // Re-creation restores Data prop pointer values, but we've freed them all
  787.       for x := 0 to Items.Count - 1 do
  788.         Items[x].Data := NIL;
  789.     end;
  790.     FRecreatingWnd := FALSE;
  791.     Reset;
  792.   end;
  793. end;
  794.  
  795. procedure TdfsSystemListView.DestroyWnd;
  796. begin
  797.   // The window is only being recreated.
  798.   FRecreatingWnd := TRUE;
  799.  
  800.   inherited DestroyWnd;
  801.  
  802.   FNeedsReset := TRUE;
  803. end;
  804.  
  805. procedure TdfsSystemListView.Loaded;
  806. begin
  807.   inherited Loaded;
  808.  
  809.   CreateColumns(FColumnType);
  810.   FNeedsReset := TRUE; // Force the reset
  811.   Reset; // We've finished loading, we can populate the list now.
  812. end;
  813.  
  814. function TdfsSystemListView.GetItems: TListItems;
  815. begin
  816.   Result := inherited Items;
  817. end;
  818.  
  819. procedure TdfsSystemListView.SetColumnType(ColType: TColumnType);
  820. begin
  821.   if ColType = FColumnType then exit;
  822.   FColumnType := ColType;
  823.   if not (csLoading in ComponentState) then
  824.     CreateColumns(ColType);
  825. end;
  826.  
  827. procedure TdfsSystemListView.RecreateColumns;
  828. begin
  829.   if HandleAllocated then
  830.     CreateColumns(FColumnType);
  831. end;
  832.  
  833. // This will be based on what type of stuff we are enumerating eventually
  834. procedure TdfsSystemListView.CreateColumns(ColType: TColumnType);
  835. {var
  836.   ShellDetails: IShellDetails;
  837.   Details: TShellDetails;}
  838. begin
  839.   HandleNeeded;
  840.  
  841.   Columns.Clear;
  842.  
  843.   //!!! This will work on Win2k, in theory
  844. (*
  845.   if FCurrentShellFolder <> NIL then
  846.   begin
  847.     if Succeeded(FCurrentShellFolder.CreateViewObject(Handle, IID_IShellDetails,
  848.       ShellDetails)) then
  849.     begin
  850.       MessageBeep(MB_ICONSTOP);
  851.       exit;
  852.     end;
  853.   end;
  854. *)
  855.  
  856.   case ColType of
  857.     ctMachine:
  858.       begin
  859.         with Columns.Add do
  860.         begin
  861.           Caption := strColName;
  862.           Width := FColumnWidths.cwName;
  863.         end;
  864.         with Columns.Add do
  865.         begin
  866.           Caption := strColType;
  867.           Width := FColumnWidths.cwSize;
  868.         end;
  869.         with Columns.Add do
  870.         begin
  871.           Caption := strColTotalSize;
  872.           Alignment := taRightJustify;
  873.           Width := FColumnWidths.cwType;
  874.         end;
  875.         with Columns.Add do
  876.         begin
  877.           Caption := strColFreeSpace;
  878.           Alignment := taRightJustify;
  879.           Width := FColumnWidths.cwModified;
  880.         end;
  881.       end;
  882.     ctControlPanel:
  883.       begin
  884.         with Columns.Add do
  885.         begin
  886.           Caption := strColName;
  887.           Width := FColumnWidths.cwName;
  888.         end;
  889.         with Columns.Add do
  890.         begin
  891.           Caption := strColDescription;
  892.           Width := FColumnWidths.cwSize;
  893.         end;
  894.       end;
  895.     ctPrinters:
  896.       begin
  897.         with Columns.Add do
  898.         begin
  899.           Caption := strColName;
  900.           Width := FColumnWidths.cwName;
  901.         end;
  902.         with Columns.Add do
  903.         begin
  904.           Caption := strColDocuments;
  905.           Alignment := taCenter;
  906.           Width := FColumnWidths.cwSize;
  907.         end;
  908.         with Columns.Add do
  909.         begin
  910.           Caption := strColStatus;
  911.           Width := FColumnWidths.cwType;
  912.         end;
  913.         with Columns.Add do
  914.         begin
  915.           Caption := strColComment;
  916.           Width := FColumnWidths.cwModified;
  917.         end;
  918.       end;
  919.     ctDUNet:
  920.       begin
  921.         with Columns.Add do
  922.         begin
  923.           Caption := strColEntryName;
  924.           Width := FColumnWidths.cwName;
  925.         end;
  926.         with Columns.Add do
  927.         begin
  928.           Caption := strColPhone;
  929.           Alignment := taRightJustify;
  930.           Width := FColumnWidths.cwSize;
  931.         end;
  932.         with Columns.Add do
  933.         begin
  934.           Caption := strColDeviceName;
  935.           Width := FColumnWidths.cwType;
  936.         end;
  937.       end;
  938.     ctNetwork:
  939.       begin
  940.         with Columns.Add do
  941.         begin
  942.           Caption := strColName;
  943.           Width := FColumnWidths.cwName;
  944.         end;
  945.         with Columns.Add do
  946.         begin
  947.           Caption := strColComment;
  948.           Width := FColumnWidths.cwSize;
  949.         end;
  950.       end;
  951.     ctFileSystem:
  952.       begin
  953.         with Columns.Add do
  954.         begin
  955.           Caption := strColName;
  956.           Width := FColumnWidths.cwName;
  957.         end;
  958.         with Columns.Add do
  959.         begin
  960.           Caption := strColSize;
  961.           Alignment := taRightJustify;
  962.           Width := FColumnWidths.cwSize;
  963.         end;
  964.         with Columns.Add do
  965.         begin
  966.           Caption := strColType;
  967.           Width := FColumnWidths.cwType;
  968.         end;
  969.         with Columns.Add do
  970.         begin
  971.           Caption := strColModified;
  972.           Width := FColumnWidths.cwModified;
  973.         end;
  974.         with Columns.Add do
  975.         begin
  976.           Caption := strColAttrib;
  977.           Width := FColumnWidths.cwAttr;
  978.           Alignment := taRightJustify;
  979.         end;                                             
  980.       end;
  981.     ctUser:
  982.       begin
  983.         if csDesigning in ComponentState then
  984.         begin
  985.           with Columns.Add do
  986.           begin
  987.             Caption := strColUserDefined;
  988.             Width := 150;
  989.           end;
  990.         end else begin
  991.           if assigned(FOnCreateColumns) then
  992.             FOnCreateColumns(Self)
  993.           else
  994.             ColumnType := ctUnknown;
  995.         end;
  996.       end;
  997.   else // ctUnknown;
  998.     with Columns.Add do
  999.     begin
  1000.       Caption := strColName;
  1001.       Width := FColumnWidths.cwName;
  1002.     end;
  1003.   end;
  1004. end;
  1005.  
  1006. // Searches the list for a relative PIDL.  Relative search is faster, and we
  1007. // don't need fully-qualified since the tree should take care of that part.
  1008. function TdfsSystemListView.FindItemFromID(AnID: PItemIDList): TListItem;
  1009. var
  1010.   SearchID: PItemIDList;
  1011.   Count: integer;
  1012.   Item: TListItem;
  1013.   ShellFolder: IShellFolder;
  1014. begin
  1015.   if (AnID.mkid.cb = 0) or (Items.Count < 1) then // nothing to search for.
  1016.   begin
  1017.     Result := NIL;
  1018.     exit;
  1019.   end;
  1020.  
  1021.   // Initialize some stuff
  1022.   Count := 0;
  1023.   Item := Items[0];
  1024.   with GetItemData(Item) do // Get the first item's data.
  1025.   begin
  1026.     SearchID := IDList; // It's relative ID
  1027.     ShellFolder := SFParent; // It's parent shell folder
  1028.   end;
  1029.  
  1030.   while assigned(SearchID) and assigned(AnID) do
  1031.   begin
  1032.     // Is the current portion of the ID we're looking for this node's child?
  1033.     if ShellFolder.CompareIDs(0, SearchID, AnID) = 0 then
  1034.     begin
  1035.       // Found it.
  1036.       break;
  1037.     end else begin
  1038.       inc(Count);
  1039.       if Count < Items.Count then
  1040.       begin
  1041.         Item := Items[Count];
  1042.         with GetItemData(Item) do
  1043.         begin
  1044.           SearchID := IDList; // it's relative ID
  1045.           ShellFolder := SFParent; // it's shell folder
  1046.         end;
  1047.       end else begin
  1048.         Item := NIL;
  1049.         break;
  1050.       end;
  1051.     end;
  1052.   end; // while
  1053.  
  1054.   Result := Item; // Return the deepest match we found.
  1055. end; // FindNodeFromID
  1056.  
  1057. procedure TdfsSystemListView.Reset;
  1058. var
  1059.   SelPIDL: PItemIDList;
  1060.   SelFolder: IShellFolder;
  1061. begin
  1062.   // The list prefers to work from a linked treeview, if available.  If not,
  1063.   // it works from a linked combo.  If neither are available, it works from
  1064.   // it's current selection, or the desktop root if there's no selection.
  1065.  
  1066.   {$IFDEF DFS_SCP_SYSTREEVIEW}
  1067.   if TreeView <> NIL then
  1068.   begin
  1069.     SelPIDL := TreeView.SelectionPIDL;
  1070.     SelFolder := TreeView.SelectionParentFolder;
  1071.   end else
  1072.   {$ENDIF}
  1073.  
  1074.   {$IFDEF DFS_SCP_SYSCOMBOBOX}
  1075.   if ComboBox <> NIL then
  1076.   begin
  1077.     SelPIDL := ComboBox.SelectionPIDL;
  1078.     SelFolder := ComboBox.SelectionParentFolder;
  1079.   end else
  1080.   {$ENDIF}
  1081.  
  1082.   begin
  1083.     SelPIDL := FCurrentPIDL;
  1084.     SelFolder := FCurrentShellFolder;
  1085.   end;
  1086.  
  1087.   LinkedReset(SelFolder, SelPIDL, FALSE);
  1088.  
  1089.   inherited Reset;
  1090. end;
  1091.  
  1092. (* Old v0.95 code that tied the list to the tree.  bad idea (tm)
  1093. procedure TdfsSystemListView.ResetNode(const ParentNode: TTreeNode;
  1094.    IsDesktopNode: boolean);
  1095. var
  1096.   SubFolder: IShellFolder;
  1097.   Attrs: UINT;
  1098.   AnIDList: PItemIDList;
  1099.   CurrentItemID: PItemIDList;
  1100. {$IFDEF DFS_DEBUG}
  1101.   TC: DWORD;
  1102. {$ENDIF}
  1103. begin
  1104. {$IFDEF DFS_DEBUG} TC := timeGetTime; {$ENDIF}
  1105.   if (ParentNode = NIL) or (ParentNode.Data = NIL) then exit;
  1106.   FLastNode := ParentNode;
  1107.   FLastNodeWasDesktop := IsDesktopNode;
  1108.   if (not HandleAllocated) then
  1109.   begin
  1110.     FNeedsReset := TRUE;
  1111.     exit;
  1112.   end else begin
  1113.     FNeedsReset := FALSE;
  1114.   end;
  1115.  
  1116.   // If we have a selection, stash the item ID so we can find it after
  1117.   // resetting. All of the node data is going to get cleared, so we have to
  1118.   // copy the selected ID, not just store the the current pointer.
  1119.   if (ItemFocused <> NIL) and (ItemFocused.Data <> NIL) and
  1120.      (TFolderItemData(ItemFocused.Data).FQ_IDList <> NIL) then
  1121.     CurrentItemID := CopyPIDL(TFolderItemData(ItemFocused.Data).IDList)
  1122.   else
  1123.     CurrentItemID := NIL;
  1124.   Items.BeginUpdate;
  1125.   try
  1126.     // Clear old stuff
  1127.     Selected := NIL;
  1128.     FreeAllItemData;
  1129.     Items.Clear;
  1130.  
  1131.     if (IsDesktopNode) then
  1132.     begin
  1133.       SHGetDesktopFolder(SubFolder);
  1134.       if ColumnType <> ctUser then
  1135.         ColumnType := ctFileSystem;
  1136.       EnumerateFiles(SubFolder, ParentNode);
  1137.       {$IFNDEF DFS_NO_COM_CLEANUP} SubFolder.Release; {$ENDIF}
  1138.     end else begin
  1139.       with TFolderItemData(ParentNode.Data) do
  1140.       begin
  1141.         Attrs := SFGAO_FILESYSTEM;
  1142.         AnIDList := IDList;
  1143.         if SUCCEEDED(SFParent.GetAttributesOf(1, AnIDList, Attrs)) then
  1144.         begin
  1145.           if (Attrs and SFGAO_FILESYSTEM) <> 0 then
  1146.           begin
  1147.             if ColumnType <> ctUser then
  1148.               ColumnType := ctFileSystem;
  1149.           end else begin
  1150.             // need to find out what kind of object we have.  No idea how.
  1151.             if ColumnType <> ctUser then
  1152.               ColumnType := ctUnknown;
  1153.           end;
  1154.         end else
  1155.           if ColumnType <> ctUser then
  1156.             ColumnType := ctUnknown;
  1157.  
  1158.         if SUCCEEDED(SFParent.BindToObject(IDList, NIL, IID_IShellFolder,
  1159.            pointer(SubFolder))) then
  1160.         begin
  1161.           EnumerateFiles(SubFolder, ParentNode);
  1162.           {$IFNDEF DFS_NO_COM_CLEANUP} SubFolder.Release; {$ENDIF}
  1163.         end; // if
  1164.       end; // with
  1165.     end; //if
  1166.     if CurrentItemID <> NIL then
  1167.       ItemFocused := FindItemFromID(CurrentItemID);
  1168.   finally
  1169.     Items.EndUpdate;
  1170.   end;
  1171.   // Have to do this after Items.EndUpdate because BeginUpdate sets SortType to
  1172.   // stNone.  EndUpdate restores it.
  1173.   if SortType <> stNone then
  1174.     AlphaSort;
  1175.  
  1176.   Populated;
  1177.  
  1178. {$IFDEF DFS_DEBUG} ODM(Format('SLV.Reset %s: %d', [ParentNode.Text, timeGetTime-TC])); {$ENDIF}
  1179. end; {ResetNode}
  1180. *)
  1181.  
  1182. function TdfsSystemListView.EnumerateFiles(const Folder: IShellFolder;
  1183.    const IDList: PItemIDList): boolean;
  1184. var
  1185.   Flags: DWORD;
  1186.   EnumList: IEnumIDList;
  1187.   FQ_List,
  1188.   List: PItemIDList;
  1189.   Fetched: ULONG;
  1190.   OldCursor: TCursor;
  1191. begin
  1192.   Result := FALSE;
  1193.  
  1194.   if Folder = NIL then exit;
  1195.  
  1196.   // Inhibit screen painting for speed
  1197.   Items.BeginUpdate;
  1198.   // I wish there was some way to find out the number of items being enumerated,
  1199.   // and only set the hourglass cursor if there were many of them....
  1200.   OldCursor := Cursor;
  1201.   Cursor := crHourglass;
  1202.  
  1203.   try
  1204.     Flags := SHCONTF_NONFOLDERS;
  1205.     if FShowHiddenFiles then
  1206.       Flags := Flags or SHCONTF_INCLUDEHIDDEN;
  1207.     if FShowFolders then
  1208.       Flags := Flags or SHCONTF_FOLDERS;
  1209.  
  1210.     if SUCCEEDED(Folder.EnumObjects(GetValidHandle, Flags, EnumList)) then
  1211. //    if SUCCEEDED(Folder.EnumObjects(GetValidHandle, Flags, EnumList)) then
  1212.     begin
  1213.       // Walk the folders.
  1214.       // The list will be saved so don't free it anywhere in here.
  1215.       while EnumList.Next(1, List, Fetched) = S_OK do
  1216.       begin
  1217.         Result := TRUE;  // only successful if we managed to enumerate at least once.
  1218.         FQ_List := ConcatPIDLs(IDList, List);
  1219.         AddNode(Folder, FQ_List, List);
  1220.       end; {while}
  1221.  
  1222.       {$IFNDEF DFS_NO_COM_CLEANUP} EnumList.Release; {$ENDIF}
  1223.     end else
  1224.       // Maybe an event for this???  No items to enum when there should be.
  1225.       ;
  1226.   finally
  1227.     // always protect this stuff to make sure it gets reset.
  1228.     Items.EndUpdate;
  1229.     Cursor := OldCursor;
  1230.   end;
  1231. end;
  1232.  
  1233. function TdfsSystemListView.AddNode(const ShellFolder: IShellFolder; FQ_IDList,
  1234.    IDList: PItemIDList): TListItem;
  1235.  
  1236.   function IsADrive(const Path: string): boolean;
  1237.   begin
  1238.     Result := FALSE;
  1239.     if (Path <> '') and (Length(Path) < 4) then
  1240.       Result := (Copy(Path, 2, 2) = ':\');
  1241.   end;
  1242.  
  1243.   function IsFolderObject(Attrs: UINT): boolean;
  1244.   begin
  1245.     Result := ((Attrs and (SFGAO_FOLDER or SFGAO_HASSUBFOLDER)) <> 0);
  1246.   end;
  1247.  
  1248.   function IsFileObject(Attrs: UINT): boolean;
  1249.   begin
  1250.     Result := ((Attrs and SFGAO_FILESYSTEM) <> 0) and not IsFolderObject(Attrs);
  1251.   end;
  1252.  
  1253. var
  1254.   NiceName, FullName: string;
  1255.   Attrs: UINT;
  1256. {$IFNDEF DFS_SLV_FASTMODE}
  1257.   FullPath: array[0..MAX_PATH] of char;
  1258.   Normal,
  1259.   Selected: integer;
  1260.   FI: TSHFileInfo;
  1261.   FD: TWin32FindData;
  1262.   DI: TSHDescriptionID;
  1263.   SysTime: TSystemTime;
  1264.   SubStr,
  1265.   DateStr,
  1266.   TimeStr: string;
  1267.   FFFH: THandle;
  1268.   GotPath: boolean;
  1269.   GotData: boolean;
  1270.   Res: HRESULT;
  1271. {$ENDIF}
  1272.   NoPIDL: PItemIDList;
  1273. begin
  1274.   Result := NIL;
  1275.   NoPIDL := NIL;
  1276.   Attrs := SFGAO_VALIDATE;
  1277.   // Invalidate cached information.
  1278.   ShellFolder.GetAttributesOf(0, NoPIDL, Attrs);
  1279.   NiceName := GetDisplayName(ShellFolder, IDList, dntNormal);
  1280.   begin
  1281.     // SFGAO_CONTENTSMASK is incorrect in the SDK header (not Borland's fault).
  1282.     Attrs := SFGAO_CAPABILITYMASK or SFGAO_DISPLAYATTRMASK and
  1283.        (not SFGAO_READONLY) or SFGAO_REMOVABLE or $F0000000;{SFGAO_CONTENTSMASK}
  1284.  
  1285.     ShellFolder.GetAttributesOf(1, IDList, Attrs);
  1286.  
  1287.     // Don't show drives and other stuff not filtered out by SHCONTF_FOLDERS.
  1288.     if (not FShowFolders) and ((Attrs and SFGAO_HASSUBFOLDER) <> 0) then
  1289.       exit;
  1290.  
  1291.     // mask!
  1292.     if (FFileMask <> '') and ((Attrs and SFGAO_FOLDER) = 0) then
  1293.     begin
  1294.       SetLength(FullName, MAX_PATH);
  1295.       if SHGetPathFromIDList(FQ_IDList, PChar(FullName)) then
  1296.       begin
  1297.         SetLength(FullName, StrLen(PChar(FullName)));
  1298.         if not MaskSearch.FileMatches(FullName, FFileMaskList) then
  1299.         begin
  1300.           Result := NIL;
  1301.           FreePIDL(IDList);
  1302.           FreePIDL(FQ_IDList);
  1303.           exit;
  1304.         end;
  1305.       end;
  1306.     end;
  1307.  
  1308.     Result := Items.Add;
  1309.  
  1310.     Result.Data := AddItemData(ShellFolder, IDList, FQ_IDList, Attrs);
  1311.  
  1312. {$IFDEF DFS_SLV_FASTMODE}
  1313.  
  1314.     Result.Caption := '';
  1315.     Result.SubItems.Add('');
  1316.     Result.SubItems.Add('');
  1317.     Result.SubItems.Add('');
  1318.     Result.SubItems.Add('');
  1319.  
  1320.     // Added by Peter Ruskin 28/09/97
  1321.     if (Attrs and SFGAO_SHARE) <> 0 then
  1322.       Result.OverlayIndex := 0         { 0 is the OverlayIndex for share }
  1323.     else if (Attrs and SFGAO_LINK) <> 0 then
  1324.     begin
  1325.       Result.OverlayIndex := 1;        { 1 is the OverlayIndex for links }
  1326.       NiceName := ExtractFileName(GetFullPath(Result));
  1327.     end;
  1328.  
  1329.     if assigned(FOnAddListItem) then
  1330.       FOnAddListItem(Self, Result)
  1331. {$ELSE}
  1332.     GetNormalAndSelectedIcons(FQ_IDList, Normal, Selected);
  1333.     Result.ImageIndex := Normal;
  1334.  
  1335.     // Added by Peter Ruskin 28/09/97
  1336.     if (Attrs and SFGAO_SHARE) <> 0 then
  1337.       Result.OverlayIndex := 0        { 0 is the OverlayIndex for share }
  1338.     // Get link file extensions if this is not the desktop
  1339.     else if ((Attrs and SFGAO_LINK) <> 0) {and (ParentNode.Parent <> NIL)} then
  1340.     begin
  1341.       Result.OverlayIndex := 1;        { 1 is the OverlayIndex for links }
  1342.       NiceName := ExtractFileName(GetFullPath(Result));
  1343.     end;
  1344.     Result.Caption := NiceName;
  1345.  
  1346.     if assigned(FOnAddListItem) then
  1347.       FOnAddListItem(Self, Result)
  1348.     else begin
  1349.       GotPath := SHGetPathFromIDList(FQ_IDList, FullPath);
  1350.       // If you get a compiler error here, check step five in ShellFix.txt.
  1351.       // It is new.
  1352.       GotData := SUCCEEDED(SHGetDataFromIDList(ShellFolder, IDList,
  1353.          SHGDFIL_FINDDATA, @FD, SizeOf(FD)));
  1354.  
  1355.       Res := SHGetDataFromIDList(ShellFolder, IDList, SHGDFIL_DESCRIPTIONID,
  1356.          @DI, SizeOf(DI));
  1357.  
  1358.       if Res = E_INVALIDARG then
  1359.         // Not implemented until v4.71 of Shell32.dll.  Just treat everything
  1360.         // as a file system object.
  1361.         DI.dwDescriptionID := SHDID_FS_FILE;
  1362.  
  1363.       if (not GotData) and GotPath and ((Attrs and SFGAO_REMOVABLE) <>
  1364.         SFGAO_REMOVABLE) then
  1365.       begin
  1366.         FFFH := Windows.FindFirstFile(FullPath, FD);
  1367.         if FFFH <> INVALID_HANDLE_VALUE then
  1368.         begin
  1369.           GotData := TRUE;
  1370.           Windows.FindClose(FFFH);
  1371.         end;
  1372.       end;
  1373.  
  1374.       // size in KBs
  1375.       // Don't bother for removable drives since they might be empty
  1376.       // drives, and won't have a size at any rate.  Also ignore folders
  1377.       // since they don't have sizes.
  1378.       if ((GotPath and IsADrive(FullPath)) and
  1379.          ((Attrs and SFGAO_REMOVABLE) <> 0)) or IsFolderObject(Attrs) or
  1380.          not IsFileObject(Attrs) then
  1381.         SubStr := ''
  1382.       else begin
  1383.         if GotData then
  1384.         begin
  1385.           TFolderItemData(Result.Data).FileSizeLow := FD.nFileSizeLow;
  1386.           TFolderItemData(Result.Data).FileSizeHigh := FD.nFileSizeHigh;
  1387.         end else begin
  1388.           TFolderItemData(Result.Data).FileSizeLow := 0;
  1389.           TFolderItemData(Result.Data).FileSizeHigh := 0;
  1390.         end;
  1391. {$IFDEF DFS_COMPILER_4_UP}
  1392.         SubStr := Commaize(IntToStr((TFolderItemData(Result.Data).FileSize +
  1393.            1023) div 1024)) + strKilobytes;
  1394. {$ELSE}
  1395. {$IFDEF DELPHI}
  1396.         SubStr := Commaize(Format('%.0f',
  1397.            [(TFolderItemData(Result.Data).FileSize + 1023) / 1024])) +
  1398.            strKilobytes;
  1399. {$ELSE}
  1400.         SubStr := Commaize(IntToStr((TFolderItemData(Result.Data).FileSizeLow +
  1401.            1023) div 1024)) + strKilobytes;
  1402. {$ENDIF}
  1403. {$ENDIF}
  1404.       end;
  1405.       Result.SubItems.Add(SubStr);
  1406.  
  1407.       // File type description
  1408.       if DI.dwDescriptionId = SHDID_ROOT_REGITEM then
  1409.         // System folder
  1410.         SubStr := strSystemFolder
  1411.       else if {GotData and }(SHGetFileInfo(PChar(FQ_IDLIST), 0, FI, SizeOf(FI),
  1412.          SHGFI_PIDL or SHGFI_TYPENAME) <> 0) then
  1413.         SubStr := FI.szTypeName
  1414.       else
  1415.         SubStr := '';
  1416.       Result.SubItems.Add(SubStr);
  1417.  
  1418.       // date/time modified
  1419.       if GotData and (FD.ftLastWriteTime.dwLowDateTime <> 0) and
  1420.          (FD.ftLastWriteTime.dwHighDateTime <> 0) then
  1421.       begin
  1422.         FileTimeToLocalFileTime(FD.ftLastWriteTime, FD.ftLastWriteTime);
  1423.         FileTimeToSystemTime(FD.ftLastWriteTime, SysTime);
  1424.         SetLength(DateStr, 256);
  1425.         SetLength(DateStr, GetDateFormat(LOCALE_USER_DEFAULT, 0, @SysTime,
  1426.            NIL, PChar(DateStr), 255) - 1);
  1427.         SetLength(TimeStr, 256);
  1428.         SetLength(TimeStr, GetTimeFormat(LOCALE_USER_DEFAULT, 0, @SysTime,
  1429.            NIL, PChar(TimeStr), 255)  - 1);
  1430.         SubStr := DateStr + ' ' + TimeStr;
  1431.       end else
  1432.         SubStr := '';
  1433.       Result.SubItems.Add(SubStr);
  1434.  
  1435.       SubStr := '';
  1436.       if GotData then
  1437.       begin
  1438.         if (FD.dwFileAttributes and faReadOnly) <> 0 then
  1439.           SubStr := SubStr + strReadOnlyChar;
  1440.         if (FD.dwFileAttributes and faHidden) <> 0 then
  1441.           SubStr := SubStr + strHiddenChar;
  1442.         if (FD.dwFileAttributes and faSysFile) <> 0 then
  1443.           SubStr := SubStr + strSystemChar;
  1444.         if (FD.dwFileAttributes and faArchive) <> 0 then
  1445.           SubStr := SubStr + strArchiveChar;
  1446.       end;
  1447.       Result.SubItems.Add(SubStr);
  1448.     end;
  1449. {$ENDIF}
  1450.   end;
  1451. (*
  1452. var
  1453.   NiceName: string;
  1454.   Normal,
  1455.   Selected: integer;
  1456.   FullPath: array[0..MAX_PATH] of char;
  1457.   FI: TSHFileInfo;
  1458.   SysTime: TSystemTime;
  1459.   DateStr,
  1460.   TimeStr: string;
  1461.   Attrs: UINT;
  1462.   FD: TWin32FindData;
  1463.   DI: TSHDescriptionID;
  1464.   Res: HResult;
  1465. begin
  1466.   Result := NIL;
  1467.   if GetNiceName(ShellFolder, IDList, SHGDN_NORMAL, NiceName) then begin
  1468.     Result := Items.Add;
  1469.     Attrs := SFGAO_CAPABILITYMASK or SFGAO_DISPLAYATTRMASK or SFGAO_CONTENTSMASK;
  1470.     ShellFolder.GetAttributesOf(1, IDList, Attrs);
  1471.     Result.Data := AddItemData(ShellFolder, IDList, FQ_IDList, Attrs);
  1472.     GetNormalAndSelectedIcons(FQ_IDList, Normal, Selected);
  1473.     Result.ImageIndex := Normal;
  1474. //    Result.SelectedIndex := Selected;
  1475.     Result.Caption := NiceName;
  1476. // This needs to be different for types other than files...
  1477.  
  1478.  
  1479.     // If you get a compiler error here, check step five in ShellFix.txt.  It is new.
  1480.     Res := SHGetDataFromIDList(ShellFolder, IDList, SHGDFIL_DESCRIPTIONID, DI, SizeOf(DI));
  1481.  
  1482.     if Res = E_INVALIDARG then
  1483.       DI.dwDescriptionID := SHDID_FS_FILE // I think this call is only working on NT 4.0.
  1484.     else
  1485.       if not DESCR_FLAG then
  1486.         ShowMessage('Something unexpected, but very interesting, has happened.'#13 +
  1487.                     'Please email me (bstowers@pobox.com) with information on what'#13 +
  1488.                     'operating system you are using, including service packs, etc.'#13 +
  1489.                     'Also, please send the file date and time of your Shell32.dll file.')
  1490.       else
  1491.         DESCR_FLAG := TRUE;
  1492.  
  1493.     case DI.dwDescriptionID of
  1494.       SHDID_FS_FILE,
  1495.       SHDID_FS_DIRECTORY,
  1496.       SHDID_FS_OTHER:
  1497.         begin
  1498.           if SHGetPathFromIDList(FQ_IDList, FullPath) then begin
  1499.             if SUCCEEDED(SHGetDataFromIDList(ShellFolder, IDList, SHGDFIL_FINDDATA, FD, SizeOf(FD))) then begin
  1500.  
  1501.               // size in KBs
  1502.               Result.SubItems.Add(IntTOStr((FD.nFileSizeLow+1023) div 1024) + 'KB');
  1503.  
  1504.               // type
  1505.               if SHGetFileInfo(FullPath, 0, FI, SizeOf(FI), SHGFI_TYPENAME) <> 0 then
  1506.                 Result.SubItems.Add(FI.szTypeName)
  1507.               else
  1508.                 Result.SubItems.Add(''); // couldn't get type.
  1509.  
  1510.               // date / time
  1511.               FileTimeToLocalFileTime(FD.ftLastWriteTime, SysTime);
  1512.               FileTimeToSystemTime(FD.ftLastWriteTime, SysTime);
  1513.               SetLength(DateStr, 256);
  1514.               SetLength(DateStr, GetDateFormat(LOCALE_USER_DEFAULT, 0, @SysTime, NIL,
  1515.                                                PChar(DateStr), 255) - 1);
  1516.               SetLength(TimeStr, 256);
  1517.               SetLength(TimeStr, GetTimeFormat(LOCALE_USER_DEFAULT, 0, @SysTime, NIL,
  1518.                                                PChar(TimeStr), 255)  - 1);
  1519.  
  1520.               Result.SubItems.Add(DateStr + ' ' + TimeStr);
  1521.             end;
  1522.           end;
  1523.         end;
  1524.  
  1525.       SHDID_COMPUTER_DRIVE35,
  1526.       SHDID_COMPUTER_DRIVE525,
  1527.       SHDID_COMPUTER_REMOVABLE,
  1528.       SHDID_COMPUTER_FIXED,
  1529.       SHDID_COMPUTER_NETDRIVE,
  1530.       SHDID_COMPUTER_CDROM,
  1531.       SHDID_COMPUTER_RAMDISK,
  1532.       SHDID_COMPUTER_OTHER:
  1533.         begin
  1534.           Result.SubItems.Add('Computer');
  1535.         end;
  1536.  
  1537.       SHDID_NET_DOMAIN,
  1538.       SHDID_NET_SERVER,
  1539.       SHDID_NET_SHARE,
  1540.       SHDID_NET_RESTOFNET,
  1541.       SHDID_NET_OTHER:
  1542.         begin
  1543.           Result.SubItems.Add('Net');
  1544.         end;
  1545.  
  1546.     else { don't know what to do with it... }
  1547.     end;
  1548.   end; {if}
  1549. *)
  1550. end; {AddNode}
  1551.  
  1552.  
  1553. procedure TdfsSystemListView.SetFileMask(const Val: string);
  1554. begin
  1555.   if Val <> FFileMask then
  1556.   begin
  1557.     FFileMask := Val;
  1558.     MaskSearch.BuildMask(FFileMask, FFileMaskList);
  1559.     FNeedsReset := TRUE; // Added by Tamas Demjen
  1560.   end;
  1561.   Reset;
  1562. end;
  1563.  
  1564.  
  1565. function TdfsSystemListView.AddItemData(ItemFolder: IShellFolder;
  1566.    aIDList, aFQ_IDList: PItemIDList; Attrs: UINT): TFolderItemData;
  1567. begin
  1568.   Result := TFolderItemData.Create;
  1569.   with Result do
  1570.   begin
  1571.     Initialized := FALSE;
  1572.     SFParent := ItemFolder;
  1573.     {$IFNDEF DFS_NO_COM_CLEANUP} SFParent.AddRef; {$ENDIF}
  1574.     IDList := aIDList;
  1575.     FQ_IDList := aFQ_IDList;
  1576.     Attributes := Attrs;
  1577.   end;
  1578.   inc(NewCount);
  1579. end; {AddItemDta}
  1580.  
  1581.  
  1582. procedure TdfsSystemListView.FreeItemData(Item: TListItem);
  1583. begin
  1584.   if Item.Data <> NIL then
  1585.   begin
  1586.     with TFolderItemData(Item.Data) do
  1587.     begin
  1588.       {$IFNDEF DFS_NO_COM_CLEANUP}
  1589.       if SFParent <> NIL then
  1590.         SFParent.Release;
  1591.       {$ENDIF}
  1592.       FreePIDL(FIDList);
  1593.       FreePIDL(FFQ_IDList);
  1594.     end;
  1595.     TFolderItemData(Item.Data).Free;
  1596.     Item.Data := NIL;
  1597.     dec(NewCount);
  1598.   end;
  1599. end; {FreeItemData}
  1600.  
  1601.  
  1602. procedure TdfsSystemListView.FreeAllItemData;
  1603. var
  1604.   x: integer;
  1605. begin
  1606.   for x := 0 to Items.Count-1 do
  1607.     FreeItemData(Items[x]);
  1608. end; {FreeAllItemData}
  1609.  
  1610.  
  1611. (*******************************************************************************
  1612.   CNNotify:  Trap notification messages sent to the window.
  1613.     This is damn silly, but it's the only way we can know when an item is being
  1614.     deleted.  I think it's an oversight in the VCL, so until Borland fixes it,
  1615.     just live with it.
  1616. *******************************************************************************)
  1617. procedure TdfsSystemListView.CNNotify(var Message: TWMNotify);
  1618. {$IFDEF DFS_SLV_FASTMODE}
  1619. var
  1620.   Item:TListItem;
  1621.   NiceName: string;
  1622.   FI: TSHFileInfo;
  1623.   DI: TSHDescriptionID;
  1624.   FD: TWin32FindData;
  1625.   Res: HRESULT;
  1626.   fTime: TFileTime;
  1627.   SysTime: TSystemTime;
  1628.   DateStr,
  1629.   TimeStr: string;
  1630.   N, S: integer;
  1631. {$ENDIF}
  1632. begin
  1633. {$IFNDEF DFS_SLV_FASTMODE}
  1634.   if Message.NMHdr.code = LVN_DELETEITEM then
  1635.   begin
  1636.     with PNMListView(Pointer(Message.NMHdr))^ do
  1637.       FreeItemData(TListItem(lParam));
  1638.     // we can't do the actual delete processing here because we don't have
  1639.     // access to some of the stuff needed.  Let default handling do it below.
  1640.   end;
  1641.  
  1642.   inherited;
  1643. {$ELSE}
  1644.   Assert(Message.NMHdr <> NIL);
  1645.   
  1646.   case Message.NMHdr.code of
  1647.     LVN_DELETEITEM:
  1648.       begin
  1649.          with PNMListView(Pointer(Message.NMHdr))^ do
  1650.            FreeItemData(TListItem(lParam));
  1651.  
  1652.         // we can't do the actual delete processing here because we don't have
  1653.         // access to some of the stuff needed.  Let default handling do it.
  1654.         inherited;
  1655.       end;
  1656.  
  1657.     LVN_GETDISPINFO:
  1658.       begin
  1659.         with PLVDispInfo(Pointer(Message.NMHdr))^.item do
  1660.         begin
  1661.           if (mask and LVIF_PARAM) <> 0 then
  1662.             Item := TListItem(lParam)
  1663.           else
  1664.             Item := Items[IItem];
  1665.  
  1666.           if (Item = NIL) or (Item.Data = NIL) then
  1667.           begin
  1668.             if (mask and LVIF_TEXT) <> 0 then
  1669.               pszText[0] := #0;
  1670.             if (mask and LVIF_IMAGE) <> 0 then
  1671.               iImage := -1;
  1672.           end
  1673.           else
  1674.           begin
  1675.             with TFolderItemData(Item.Data) do
  1676.             begin
  1677.               if (mask and LVIF_TEXT) <> 0 then
  1678.               begin
  1679.                 if iSubItem = 0 then
  1680.                 begin
  1681.                   NiceName := GetDisplayName(SFParent, IDList, dntNormal);
  1682.                   StrPLCopy(pszText, NiceName, cchTextMax);
  1683.                 end else begin
  1684.                   with Item.SubItems do
  1685.                   begin
  1686.                     if iSubItem <= Count then
  1687.                     begin
  1688.                       NiceName := '';
  1689.                       case iSubItem of
  1690.                         1: //Size
  1691.                           begin
  1692.                             if SUCCEEDED(SHGetDataFromIDList(SFParent, IDList,
  1693.                                SHGDFIL_FINDDATA, @FD, SizeOf(FD))) then
  1694.                             begin
  1695.                               // size in KBs
  1696.                               if ((Attributes and
  1697.                                  (SFGAO_FOLDER or SFGAO_HASSUBFOLDER)) <> 0) then
  1698.                                 NiceName := ''
  1699.                               else begin
  1700.                                 FileSizeLow := FD.nFileSizeLow;
  1701.                                 FileSizeHigh := FD.nFileSizeHigh;
  1702.                                 {$IFDEF DFS_COMPILER_4_UP}
  1703.                                 NiceName := Commaize(IntToStr((FileSize + 1023)
  1704.                                    div 1024)) + strKilobytes;
  1705.                                 {$ELSE}
  1706.                                 NiceName := Commaize(Format('%.0f', [(FileSize +
  1707.                                    1023) / 1024])) + strKilobytes;
  1708.                                 {$ENDIF}
  1709.                               end;
  1710.                             end else
  1711.                               NiceName := '';
  1712.                           end;
  1713.                         2: //Type
  1714.                           begin
  1715.                             Res := SHGetDataFromIDList(SFParent, IDList,
  1716.                                SHGDFIL_DESCRIPTIONID, @DI, SizeOf(DI));
  1717.                             if Res = E_INVALIDARG then
  1718.                               // Not implemented until v4.71 of Shell32.dll.  Just
  1719.                               // treat everything as a file system object.
  1720.                               DI.dwDescriptionID := SHDID_FS_FILE;
  1721.                             if DI.dwDescriptionId = SHDID_ROOT_REGITEM then
  1722.                               // System folder
  1723.                               nicename := strSystemFolder
  1724.                             else if (SHGetFileInfo(PChar(FQ_IDLIST), 0, FI,
  1725.                                SizeOf(FI), SHGFI_PIDL or SHGFI_TYPENAME)<>0) then
  1726.                               nicename := FI.szTypeName
  1727.                             else
  1728.                               nicename := '';
  1729.                           end;
  1730.                         3://Modified
  1731.                           begin
  1732.                             if SUCCEEDED(SHGetDataFromIDList(SFParent, IDList,
  1733.                                SHGDFIL_FINDDATA, @FD, SizeOf(FD))) then
  1734.                             begin
  1735.                               FileTimeToLocalFileTime(FD.ftLastWriteTime, fTime);
  1736.                               FileTimeToSystemTime(fTime, SysTime);
  1737.                               SetLength(DateStr, 256);
  1738.                               SetLength(DateStr, GetDateFormat(LOCALE_USER_DEFAULT,
  1739.                                  0, @SysTime, NIL, PChar(DateStr), 255) - 1);
  1740.                               SetLength(TimeStr, 256);
  1741.                               SetLength(TimeStr, GetTimeFormat(LOCALE_USER_DEFAULT,
  1742.                                  0, @SysTime, NIL, PChar(TimeStr), 255)  - 1);
  1743.                               NiceName := DateStr + ' ' + TimeStr;
  1744.                             end;
  1745.                           end;
  1746.                         4://Attributes
  1747.                           begin
  1748.                             NiceName := '';
  1749.                             if SUCCEEDED(SHGetDataFromIDList(SFParent, IDList,
  1750.                                SHGDFIL_FINDDATA, @FD, SizeOf(FD))) then
  1751.                             begin
  1752.                               if (FD.dwFileAttributes and faReadOnly) <> 0 then
  1753.                                 NiceName := NiceName + strReadOnlyChar;
  1754.                               if (FD.dwFileAttributes and faHidden) <> 0 then
  1755.                                 NiceName := NiceName + strHiddenChar;
  1756.                               if (FD.dwFileAttributes and faSysFile) <> 0 then
  1757.                                 NiceName := NiceName + strSystemChar;
  1758.                               if (FD.dwFileAttributes and faArchive) <> 0 then
  1759.                                 NiceName := NiceName + strArchiveChar;
  1760.                             end;
  1761.                           end;
  1762.                       end; { case }
  1763.                       StrPLCopy(pszText, NiceName, cchTextMax);
  1764.                     end else
  1765.                       pszText[0] := #0;
  1766.                   end;
  1767.                 end;
  1768.               end;
  1769.               if (mask and LVIF_IMAGE) <> 0 then
  1770.               begin
  1771.                 if iSubItem = 0 then
  1772.                 begin
  1773.                   GetNormalAndSelectedIcons(FQ_IDList, N, S);
  1774.                   if Item.Selected then
  1775.                     iImage := S
  1776.                   else
  1777.                     iImage := N;
  1778.                 end
  1779.                 else
  1780.                   iImage := -1;
  1781.               end;
  1782.               // Don't ask for it again!
  1783.               mask := mask or LVIF_DI_SETITEM;
  1784.             end;
  1785.           end;
  1786.         end;
  1787.       end;
  1788.   else
  1789.     inherited;
  1790.   end;
  1791. {$ENDIF}
  1792. end; {CNNotify}
  1793.  
  1794.  
  1795. function TdfsSystemListView.GetItemData(Item: TListItem): TFolderItemData;
  1796. begin
  1797.   Result := Item.Data;
  1798.   if Result = NIL then
  1799.   begin
  1800.     if FShowErrorsInMsgBox then
  1801.       MessageDlg(LoadStr(IDS_NOFOLDERDATA), mtError, [mbOK], 0)
  1802.     else
  1803.       raise ENoFolderData.Create(LoadStr(IDS_NOFOLDERDATA));
  1804.   end
  1805. end;
  1806.  
  1807. procedure TdfsSystemListView.SetColumnWidths(NameWidth, SizeWidth, TypeWidth,
  1808.    ModifiedWidth, AttrWidth: integer);
  1809. begin
  1810.   with FColumnWidths do
  1811.   begin
  1812.     cwName := NameWidth;
  1813.     cwSize := SizeWidth;
  1814.     cwType := TypeWidth;
  1815.     cwModified := ModifiedWidth;
  1816.     cwAttr := AttrWidth;
  1817.   end;
  1818.   RecreateColumns;
  1819. end;
  1820.  
  1821. (*******************************************************************************
  1822.   DisplayContextMenu:
  1823. *******************************************************************************)
  1824. function TdfsSystemListView.DisplayContextMenu(Item: TListItem;
  1825.    Where: TPoint): boolean;
  1826. var
  1827.   ItemData: TFolderItemData;
  1828.   WantsToRename: boolean;
  1829. begin
  1830.   ItemData := GetItemData(Item);
  1831.   if (ItemData <> NIL) and (ItemData.IDList <> NIL) then
  1832.   begin
  1833. {$IFDEF DFS_COMPILER_4_UP}
  1834.     Result := ItemProp.DisplayContextMenu(ItemData.SFParent, ItemData.FIDList,
  1835.        ItemData.Attributes, DFS_HWND(Handle), Where, 1, TRUE,
  1836.        WantsToRename);
  1837. {$ELSE}
  1838.     Result := ItemProp.DisplayContextMenuPIDL(ItemData.SFParent,
  1839.        ItemData.FIDList, ItemData.Attributes,
  1840.        {$IFDEF DFS_CPPB} Pointer(Handle) {$ELSE} Handle {$ENDIF}, Where, 1, TRUE,
  1841.        WantsToRename);
  1842. {$ENDIF}
  1843.     if WantsToRename then
  1844.       Item.EditCaption;
  1845.   end
  1846.   else
  1847.     Result := FALSE;
  1848. end;
  1849.  
  1850. // The var parameter of this function is a memory block allocated with GetMem.
  1851. // The caller of the function MUST release the memory with FreeMem when
  1852. // done with the array. The PPIDLArray type is defined in the ItemProp unit.
  1853. // The return value is the number of items in the array.
  1854. function TdfsSystemListView.GetSelectedPIDLs(var SelPIDLs: PPIDLArray): integer;
  1855. var
  1856.   ItemData: TFolderItemData;
  1857.   NextItem: TListItem;
  1858. begin
  1859.   Result := 0;
  1860.   SelPIDLs := NIL;
  1861.   if SelCount < 1 then
  1862.     exit;
  1863.  
  1864.   GetMem(SelPIDLs, SizeOf(PItemIDList) * SelCount);
  1865.   try
  1866.     NextItem := GetNextItem(NIL, sdAll, [isSelected]);
  1867.     if NextItem = NIL then
  1868.     begin
  1869.       // Should never happen...
  1870.       FreeMem(SelPIDLs);
  1871.       SelPIDLs := NIL;
  1872.       exit;
  1873.     end;
  1874.     ItemData := GetItemData(NextItem);
  1875.     if (ItemData.IDList <> NIL) then
  1876.     begin
  1877.       while NextItem <> NIL do
  1878.       begin
  1879.         if (NextItem.Data <> NIL) and
  1880.            (TFolderItemData(NextItem.Data).IDList <> NIL) then
  1881.         begin
  1882. { Turn off range checking because SelPILDs is typed as an array of 0..0.}
  1883. {$IFOPT R+} {$DEFINE DFS_RESET_RANGE_CHECKING} {$R-} {$ENDIF}
  1884.           SelPIDLs[Result] := TFolderItemData(NextItem.Data).FIDList;
  1885. {$IFDEF DFS_RESET_RANGE_CHECKING} {$R+} {$UNDEF DFS_RESET_RANGE_CHECKING} {$ENDIF}
  1886.           inc(Result);
  1887.         end;
  1888.         NextItem := GetNextItem(NextItem, sdAll, [isSelected]);
  1889.       end;
  1890.     end;
  1891.   except
  1892.     // Something bad happend.  Release the allocated memory and reraise it.
  1893.     // Don't free the pidls in the array, they don't belong to us!
  1894.     FreeMem(SelPIDLs);
  1895.     raise;
  1896.   end;
  1897. end;
  1898.  
  1899. function TdfsSystemListView.DisplaySelectedContextMenu(Where: TPoint): boolean;
  1900. var
  1901.   ItemData: TFolderItemData;
  1902.   SelPIDLs: PPIDLArray;
  1903.   Count: integer;
  1904.   WantsToRename: boolean;
  1905. begin
  1906.   Result := FALSE;
  1907.   Count := GetSelectedPIDLs(SelPIDLs);
  1908.   if SelPIDLs = NIL then
  1909.     exit;
  1910.  
  1911.   try
  1912.     ItemData := GetItemData(Selected);
  1913. {$IFDEF DFS_COMPILER_4_UP}
  1914.     Result := ItemProp.DisplayContextMenu(ItemData.SFParent, SelPIDLs^[0],
  1915.        ItemData.Attributes, DFS_HWND(Handle), Where, Count, TRUE, WantsToRename);
  1916. {$ELSE}
  1917.     Result := ItemProp.DisplayContextMenuPIDL(ItemData.SFParent, SelPIDLs^[0],
  1918.        ItemData.Attributes,
  1919.        {$IFDEF DFS_CPPB} Pointer(Handle) {$ELSE} Handle {$ENDIF}, Where, Count,
  1920.        TRUE, WantsToRename);
  1921. {$ENDIF}
  1922.     if (ItemFocused <> NIL) and WantsToRename then
  1923.       ItemFocused.EditCaption;
  1924.   finally
  1925.     // Free the array that was allocated by GetSelectedPIDLs.
  1926.     // Don't free the pidls in the array, they don't belong to us!
  1927.     FreeMem(SelPIDLs);
  1928.   end;
  1929. end;
  1930.  
  1931. function TdfsSystemListView.GetPopupMenu: TPopupMenu;
  1932. begin
  1933.   if FPopupMenuMethod in [pmmUser, pmmContextUser] then
  1934.     Result := inherited GetPopupMenu
  1935.   else
  1936.     Result := NIL;
  1937. end;
  1938.  
  1939. {$IFDEF DFS_COMPILER_5_UP}
  1940. procedure TdfsSystemListView.WMContextMenu(var Message: TWMContextMenu);
  1941. {$ELSE}
  1942. procedure TdfsSystemListView.WMRButtonUp(var Message: TWMRButtonUp);
  1943. {$ENDIF}
  1944. var
  1945.   SelItem: TListItem;
  1946.   Pt: TPoint;
  1947. begin
  1948.   case FPopupMenuMethod of
  1949.     pmmContext,
  1950.     pmmContextUser:
  1951.       begin
  1952.         {$IFDEF DFS_COMPILER_5_UP}
  1953.         Pt := ScreenToClient(Point(Message.XPos, Message.YPos));
  1954.         {$ELSE}
  1955.         Pt := Point(Message.XPos, Message.YPos);
  1956.         {$ENDIF}
  1957.         SelItem := GetItemAt(Pt.x, Pt.y);
  1958.         if SelItem <> NIL then
  1959.         begin
  1960.           if not SelItem.Selected then
  1961.           begin
  1962.             Selected := SelItem;
  1963.             if DisplayContextMenu(SelItem, ClientToScreen(Pt)) then
  1964.               Message.Result := 1;
  1965.           end else begin
  1966.             if DisplaySelectedContextMenu(ClientToScreen(Pt)) then
  1967.               Message.Result := 1;
  1968.           end;
  1969.         end;
  1970.       end;
  1971.   end;
  1972.   inherited;
  1973. end;
  1974.  
  1975. function TdfsSystemListView.GetItemAttrs(const Item: TListItem): UINT;
  1976. begin
  1977.   if (Item <> NIL) and (Item.Data <> NIL) then
  1978.     Result := GetItemData(Item).Attributes
  1979.   else
  1980.     Result := 0;
  1981. end;
  1982.  
  1983. function TdfsSystemListView.GetFullPath(const Item: TListItem): string;
  1984. begin
  1985.   Result := '';
  1986.   if (Item <> NIL) and (Item.Data <> NIL) then
  1987.   begin
  1988.     SetLength(Result, MAX_PATH);
  1989.     if SHGetPathFromIDList(GetItemData(Item).FQ_IDList, PChar(Result)) then
  1990.     begin
  1991.       SetLength(Result, StrLen(PChar(Result)));
  1992.       if ((GetItemAttrs(Item) and SFGAO_FOLDER) <> 0) and
  1993.          (Length(Result) <> 0) and (Result[Length(Result)] <> '\') then
  1994.         Result := Result + '\';
  1995.     end else
  1996.       Result := '';
  1997.   end;
  1998. end;
  1999.  
  2000.  
  2001. procedure TdfsSystemListView.SetShowFolders(Val: boolean);
  2002. begin
  2003.   if Val = FShowFolders then exit;
  2004.   FShowFolders := Val;
  2005.   Reset;
  2006. end;
  2007.  
  2008. function TdfsSystemListView.GetFilename(Index: TListItem): string;
  2009. begin
  2010.   if Index = NIL then
  2011.     Result := ''
  2012.   else
  2013.     Result := Index.Caption;
  2014. end;
  2015.  
  2016. function TdfsSystemListView.GetFullFilename(Index: TListItem): string;
  2017. begin
  2018.   if Index = NIL then
  2019.     Result := ''
  2020.   else
  2021.     Result := GetFullPath(Index);
  2022. end;
  2023.  
  2024.  
  2025. function DefaultListViewSort(Item1, Item2: TListItem; lParam: Integer): Integer; stdcall;
  2026. begin
  2027.   // CompareIDs can probably handle NIL pointers.  need to try it.
  2028.   if Item1 = Item2 then
  2029.     Result := 0
  2030.   else if Item1 = NIL then
  2031.     Result := -1
  2032.   else if Item2 = NIL then
  2033.     Result := 1
  2034.   else begin
  2035.     if Item1.Data <> NIL then
  2036.       with TFolderItemData(Item1.Data) do
  2037.         // Status is returned in the 'code' portion (low word) of the result.
  2038.         // Search for 'HResult' in Winodws.pas to read more about it.
  2039.         // 0 means sort by name.
  2040.         if ((Attributes and (SFGAO_HASSUBFOLDER or SFGAO_FOLDER)) <> 0) xor
  2041.            ((TFolderItemData(Item2.Data).Attributes and
  2042.            (SFGAO_HASSUBFOLDER or SFGAO_FOLDER)) <> 0) then
  2043.         begin
  2044.           // One is has children and one does not.  Folders come first
  2045.           if ((Attributes and (SFGAO_HASSUBFOLDER or SFGAO_FOLDER)) <> 0) then
  2046.             Result := -1
  2047.           else
  2048.             Result := 1;
  2049.         end else
  2050.           // Both items are same type
  2051.           Result := shortint(SFParent.CompareIDs(LoWord(Cardinal(lParam)),
  2052.              TFolderItemData(Item1.Data).IDList,
  2053.              TFolderItemData(Item2.Data).IDList))
  2054.     else
  2055.       Result := 0;
  2056.   end;
  2057.   if HiWord(Cardinal(lparam)) <> 0 then
  2058.     Result := -Result;
  2059. end;
  2060.  
  2061. {$IFNDEF DFS_SLV_USING_ELV}
  2062. function TdfsSystemListView.CustomSort(SortProc: TLVCompare; Data: Longint): Boolean;
  2063. var
  2064.   decrease: ByteBool;
  2065.   SortData: Longint;
  2066. begin
  2067.   Result := False;
  2068.   if Data = SORT_ALPHA then
  2069.   begin
  2070.     SortData := 0;
  2071.     decrease := FALSE;
  2072.   end
  2073.   else
  2074.   begin
  2075.     if Data = SORT_CURRENT then
  2076.     begin
  2077.       Data := FLastColumnIndexSort;
  2078.       decrease := FLastSortOrder;
  2079.     end
  2080.     else
  2081.     begin
  2082.       decrease := FLastColumnIndexSort = Data;
  2083.       if decrease then
  2084.         decrease := not FLastSortOrder;
  2085.     end;
  2086.     SortData := Data + Ord(decrease) SHL 16;
  2087.   end;
  2088.   if HandleAllocated then
  2089.   begin
  2090.     if not Assigned(SortProc) then SortProc := @DefaultListViewSort;
  2091.     Result := ListView_SortItems(Handle, SortProc, SortData);
  2092.   end;
  2093.   if Data >= 0 then
  2094.   begin
  2095.     FLastColumnIndexSort := Data;
  2096.     FLastSortOrder := decrease;
  2097.   end;
  2098. end; // CustomSort
  2099.  
  2100. function TdfsSystemListView.AlphaSort: Boolean;
  2101. begin
  2102.   if HandleAllocated then
  2103.   begin
  2104.     Result := CustomSort(@DefaultListViewSort, SORT_ALPHA);
  2105.     FLastColumnIndexSort := 0;
  2106.     FLastSortOrder := FALSE;
  2107.   end
  2108.   else
  2109.     Result := False;
  2110. end;
  2111.  
  2112. procedure TdfsSystemListView.ColClick(Column: TListColumn);
  2113. begin
  2114.   inherited ColClick(Column);
  2115.   CustomSort(@DefaultListViewSort, Column.Index);
  2116. end;
  2117. {$ENDIF}
  2118.  
  2119. procedure TdfsSystemListView.DblClick;
  2120. begin
  2121.   if (csDesigning in ComponentState) then exit;
  2122.  
  2123.   if not assigned(OnDblClick) then
  2124.   begin
  2125.     DefaultDblClickAction(Selected);
  2126.   end else
  2127.     inherited DblClick;
  2128. end;
  2129.  
  2130. procedure TdfsSystemListView.DefaultDblClickAction(Item: TListItem);
  2131. var
  2132.   Attrs : UINT;
  2133.   ItemData: TFolderItemData;
  2134. begin
  2135.   if (Item <> NIL) then
  2136.   begin
  2137.     ItemData := GetItemData(Item);
  2138.     if (ItemData <> NIL) and (ItemData.IDList <> NIL) then
  2139.     begin
  2140.       Attrs := GetItemAttrs(Item);
  2141.       if ((Attrs and (SFGAO_FOLDER or SFGAO_HASSUBFOLDER)) <> 0) then
  2142.       begin
  2143.         LinkedReset(FCurrentShellFolder, ItemData.FQ_IDList, FALSE);
  2144.         NotifyLinkedControls(FALSE);
  2145.  
  2146. (* Old v0.95 code.
  2147.         NewPath := GetFullPath(Item);
  2148.         if ((Attrs and (SFGAO_FOLDER or SFGAO_HASSUBFOLDER)) <> 0) and
  2149. //        if ((Attrs and SFGAO_FOLDER) <> 0) and (NewPath <> '') and
  2150.            (TreeView <> NIL) then
  2151.         begin
  2152.           if (NewPath <> '') then
  2153.           begin
  2154.             // if ending with '\\' delete the last '\'
  2155.             if (NewPath[Length(NewPath)-1] = '\') and
  2156.                (NewPath[Length(NewPath)] = '\') then
  2157.               System.Delete(NewPath, Length(NewPath)-1, 1);
  2158. //!!! Fix this!!!
  2159. //            TreeView.Selection := NewPath;
  2160.           end else begin
  2161. // This FAILS for rfNetHood and computer names being double-clicked
  2162. //!!! Fix this!!!
  2163. //            TreeView.ListViewSetSelectionPIDL(ItemData.IDList);
  2164.           end;
  2165. *)
  2166.       end else begin
  2167. {$IFDEF DFS_COMPILER_4_UP}
  2168.         ItemProp.PerformDefaultAction(ItemData.SFParent, ItemData.FIDList,
  2169.            ItemData.Attributes, DFS_HWND(Handle), 1);
  2170. {$ELSE}
  2171.         ItemProp.PerformDefaultActionPIDL(ItemData.SFParent,
  2172.            ItemData.FIDList, ItemData.Attributes,
  2173.            {$IFDEF DFS_CPPB} Pointer(Handle) {$ELSE} Handle {$ENDIF}, 1);
  2174. {$ENDIF}
  2175.       end;
  2176.     end;
  2177.   end;
  2178. end;
  2179.  
  2180.  
  2181. function TdfsSystemListView.GetItemFromAPIItem(const Item: TLVItem): TListItem;
  2182. begin
  2183.   with Item do
  2184.     if (state and LVIF_PARAM) <> 0 then
  2185.       Result := Pointer(lParam)
  2186.     else
  2187.       Result := Items[iItem];
  2188. end;
  2189.  
  2190. function TdfsSystemListView.CanEdit(Item : TListItem): boolean;
  2191. begin
  2192.   Result := (Item.Data <> NIL) and ItemData[Item].ItemHasFlag(SFGAO_CANRENAME);
  2193. end;
  2194.  
  2195. procedure TdfsSystemListView.Edit(const Item: TLVItem);
  2196. begin
  2197.   if RenameItem(GetItemFromAPIItem(Item), Item.pszText) then
  2198.     inherited Edit(Item);
  2199. end;
  2200.  
  2201. function TdfsSystemListView.RenameItem(const Item: TListItem;
  2202.    const NewName: string): boolean;
  2203. var
  2204.   pstr: PWideChar;
  2205.   AnIDList: PItemIDList;
  2206. begin
  2207.   Result := FALSE;
  2208.   if (Item = NIL) or (Item.Data = NIL) or (NewName = '') then exit;
  2209.  
  2210.   pstr := StringToOleStr(NewName); //make an OLE string for SetNameOf
  2211.   try
  2212.     with GetItemData(Item) do
  2213.     begin
  2214.       AnIDList := CreatePIDL(1);
  2215.       // SetNameOf will free the first IDList passed and return the new IDList
  2216.       // in the second PIDL parameter.
  2217.       Result := SUCCEEDED(SFParent.SetNameOf(GetValidHandle, IDList, pstr,
  2218.          SHCONTF_FOLDERS, AnIDList));
  2219.       if Result then
  2220.       begin
  2221.         Item.Caption := NewName;
  2222.         IDList := AnIDList;
  2223. (* Old v0.95 version code
  2224.         if (assigned(FLastNode.Parent) and
  2225.            (assigned(FLastNode.Parent.Data))) then
  2226.           FQ_IDList := ConcatPIDLS(TFolderItemData(FLastNode.Parent.Data).FQ_IDList,
  2227.              IDList)
  2228.         else
  2229. *)        
  2230.           FQ_IDList := ConcatPIDLs(NIL, IDList);
  2231.       end;
  2232.     end;
  2233.   finally
  2234.     ShellMalloc.Free(pstr); // Don't forget to free the OLE string
  2235.   end;
  2236. end;
  2237.  
  2238. function TdfsSystemListView.DeleteItem(const Item: TListItem): boolean;
  2239. var
  2240.   ItemData: TFolderItemData;
  2241. begin
  2242.   Result := FALSE;
  2243.   ItemData := GetItemData(Item);
  2244.   if (ItemData <> NIL) and (ItemData.IDList <> NIL) then
  2245. {$IFDEF DFS_COMPILER_4_UP}
  2246.     Result := ItemProp.PerformVerb('delete', ItemData.SFParent, ItemData.FIDList,
  2247.        ItemData.Attributes, DFS_HWND(Handle), 1);
  2248. {$ELSE}
  2249.     Result := ItemProp.PerformVerbPIDL('delete', ItemData.SFParent,
  2250.        ItemData.FIDList, ItemData.Attributes,
  2251.        {$IFDEF DFS_CPPB} Pointer(Handle) {$ELSE} Handle {$ENDIF}, 1);
  2252. {$ENDIF}
  2253.  
  2254. (*
  2255.   if (Item = NIL) or (Item.Data = NIL) then exit;
  2256.  
  2257.   Filename := GetFullPath(Item);
  2258.   if Filename = '' then exit;
  2259.   Result := DeleteFile(Filename);
  2260.   if Result then
  2261.     Items.Delete(Item.Index); // Notification message will free Data
  2262. *)
  2263. end;
  2264.  
  2265.  
  2266. function TdfsSystemListView.GetVersion: string;
  2267. begin
  2268.   Result := DFS_COMPONENT_LIST_VERSION;
  2269. end;
  2270.  
  2271. {$IFNDEF DFS_SLV_USING_ELV}
  2272. procedure TdfsSystemListView.SetVersion(const Val: string);
  2273. begin
  2274.   { empty write method, just needed to get it to show up in Object Inspector }
  2275. end;
  2276. {$ENDIF}
  2277.  
  2278. (*******************************************************************************
  2279.  Computes if list must be moved up or down, left or right, depending on mouse
  2280.  position.
  2281. *******************************************************************************)
  2282. procedure TdfsSystemListView.Compute_ListMoves(X, Y: integer);
  2283. var
  2284.   NbPixels: Integer;
  2285.   RMin, RMax: Integer;
  2286.   HOffset,
  2287.   VOffset: Integer;
  2288. begin
  2289.   // Comments by Aristide Torrelli
  2290.   {--------------------------------------------------------------------}
  2291.   { Algorithm :                                                        }
  2292.   { -----------                                                        }
  2293.   { . Detect scroll bars (horizontal and/or vertical) to set offsets   }
  2294.   { . If mouse is near upper edge or lower edge, scroll the control to }
  2295.   {   up or down by one line                                           }
  2296.   { . If mouse is near left or right edge, scroll the control to one   }
  2297.   {   page left or one page right                                      }
  2298.   {--------------------------------------------------------------------}
  2299.   if not FAutoscroll then exit;
  2300.   {--------------------------------------------------------------------}
  2301.   { Retrieve the scroll bar ranges, if such scroll bars exist (either  }
  2302.   { horizontal or vertical). An offset must be set if there is a       }
  2303.   { scroll bar, i-e if there is a range (RMin <> RMax).                }
  2304.   {--------------------------------------------------------------------}
  2305.   GetScrollRange(Handle, SB_HORZ, RMin, RMax);
  2306.   if RMin = RMax then
  2307.      HOffset := 0
  2308.   else
  2309.     HOffset := 16;
  2310.   GetScrollRange(Handle, SB_VERT, RMin, RMax);
  2311.   If RMin = RMax then
  2312.     VOffset := 0
  2313.   else
  2314.     VOffset := 16;
  2315.  
  2316.   {--------------------------------------------------------------------}
  2317.   { Near an edge means at a maximum of (half) a line, i-e half the     }
  2318.   { pixles of the current font.                                        }
  2319.   {--------------------------------------------------------------------}
  2320.   NbPixels := Abs((Font.Height));
  2321.  
  2322.   if (Y < NbPixels) then
  2323.     Perform(WM_VSCROLL, SB_LINEUP, 0)
  2324.   else if (Y > Height - VOffset - NbPixels) then
  2325.     Perform(WM_VSCROLL, SB_LINEDOWN, 0);
  2326.  
  2327.   if (X < NbPixels ) then
  2328.     Perform(WM_HSCROLL, SB_LINELEFT, 0)
  2329.   else if (X > Width - HOffset - NbPixels) then
  2330.     Perform(WM_HSCROLL, SB_LINERIGHT, 0);
  2331. end;
  2332.  
  2333. procedure TdfsSystemListView.MouseMove(Shift: TShiftState; X, Y: Integer);
  2334. begin
  2335.   if FAutoScroll then
  2336.     Compute_ListMoves( X, Y );
  2337.   inherited MouseMove( Shift, X, Y );
  2338. end;
  2339.  
  2340. procedure TdfsSystemListView.Populated;
  2341. begin
  2342.   if assigned(FOnPopulated) then
  2343.     FOnPopulated(Self);
  2344. end;
  2345.  
  2346.  
  2347.  
  2348. // Implementation must return the actual ID list.  Caller will make a copy
  2349. // of it it wants it's own.  Implementer owns this one, i.e. it's the "real
  2350. // thing".  If there isn't one, return NIL.
  2351. function TdfsSystemListView.GetSelectionPIDL: PItemIDList;
  2352. begin
  2353.   Result := FCurrentPIDL;
  2354. end;
  2355.  
  2356. function TdfsSystemListView.GetSelectionParentFolder: IShellFolder;
  2357. begin
  2358.   Result := FCurrentShellFolder;
  2359. end;
  2360.  
  2361.  
  2362. // Implementation notes: IDList parameter belongs to someone else.  If
  2363. // needed by this component, a copy must be made of it.  This differs from
  2364. // the Reset method in that it does not notify linked controls of a change
  2365. // because that could result in an endless cycle of notifications. Return
  2366. // value indicates success or failure.
  2367. function TdfsSystemListView.LinkedReset(const ParentFolder: IShellFolder;
  2368.    const IDList: PItemIDList; ForceUpdate: boolean): boolean;
  2369. var
  2370.   SubFolder: IShellFolder;
  2371.   Attrs: UINT;
  2372.   DesktopPIDL,
  2373.   ParentPIDL,
  2374.   RelativePIDL,
  2375.   CurrentItemID: PItemIDList;
  2376.   RootIsDesktop: boolean;
  2377. {$IFDEF DFS_DEBUG}
  2378.   TC: DWORD;
  2379. {$ENDIF}
  2380. begin
  2381.  
  2382. {$IFDEF DFS_DEBUG} TC := timeGetTime; {$ENDIF}
  2383.  
  2384.   Result := FALSE;
  2385.  
  2386.   if FRecreatingWnd or ((not ForceUpdate) and ComparePIDLs(IDList, FCurrentPIDL)
  2387.     and (not FNeedsReset)) then
  2388.   begin
  2389.     Result := TRUE;
  2390.     exit; // They're the same, don't need to do anything
  2391.   end;
  2392.  
  2393.   OLECheck(SHGetSpecialFolderLocation(GetValidHandle, CSIDL_DESKTOP,
  2394.      DesktopPIDL));
  2395.   try
  2396.     {$IFNDEF DFS_NO_COM_CLEANUP}
  2397.     if FCurrentShellFolder <> NIL then
  2398.       FCurrentShellFolder.Release;
  2399.     {$ENDIF}
  2400.     FCurrentShellFolder := NIL;
  2401.     // Free the current pidl
  2402.     FreePIDL(FCurrentPIDL);
  2403.  
  2404.     if IDList = NIL then
  2405.     begin
  2406.       // We've got nothing to start with, we'll use the desktop.
  2407.       OLECheck(SHGetDesktopFolder(FCurrentShellFolder));
  2408.       FCurrentPIDL := CopyPIDL(DesktopPIDL);
  2409.       RootIsDesktop := TRUE;
  2410.     end else begin
  2411.       FCurrentShellFolder := ParentFolder;
  2412.       FCurrentPIDL := CopyPIDL(IDList);
  2413.       RootIsDesktop := ComparePIDLs(DesktopPIDL, IDList);
  2414.     end;
  2415.     //!!!
  2416.     CreateColumns(FColumnType);
  2417.  
  2418.     {$IFNDEF DFS_NO_COM_CLEANUP} FCurrentShellFolder.AddRef; {$ENDIF}
  2419.   finally
  2420.     FreePIDL(DesktopPIDL);
  2421.   end;
  2422.  
  2423.   if (not HandleAllocated) then
  2424.   begin
  2425.     FNeedsReset := TRUE;
  2426.     exit;
  2427.   end else begin
  2428.     FNeedsReset := FALSE;
  2429.   end;
  2430.  
  2431.   // If we have a selection, stash the item ID so we can find it after
  2432.   // resetting. All of the node data is going to get cleared, so we have to
  2433.   // copy the selected ID, not just store the the current pointer.
  2434.   if (ItemFocused <> NIL) and (ItemFocused.Data <> NIL) and
  2435.      (TFolderItemData(ItemFocused.Data).FQ_IDList <> NIL) then
  2436.     CurrentItemID := CopyPIDL(TFolderItemData(ItemFocused.Data).IDList)
  2437.   else
  2438.     CurrentItemID := NIL;
  2439.  
  2440.   Items.BeginUpdate;
  2441.   try
  2442.     // Clear old stuff
  2443.     Selected := NIL;
  2444.     FreeAllItemData;
  2445.     Items.Clear;
  2446.  
  2447.     if (RootIsDesktop) then
  2448.     begin
  2449.       if ColumnType <> ctUser then
  2450.         ColumnType := ctFileSystem;
  2451.       Result := EnumerateFiles(FCurrentShellFolder, FCurrentPIDL);
  2452.     end else begin
  2453.       RelativePIDL := CopyLastID(FCurrentPIDL);
  2454.       ParentPIDL := CopyParentPIDL(FCurrentPIDL);
  2455.       try
  2456.         Attrs := SFGAO_FILESYSTEM or SFGAO_FOLDER;
  2457.  
  2458.         if SUCCEEDED(FCurrentShellFolder.GetAttributesOf(1, RelativePIDL,
  2459.            Attrs)) then
  2460.         begin
  2461.           if ((Attrs and SFGAO_FILESYSTEM) <> 0) then
  2462.           begin
  2463.             if ColumnType <> ctUser then
  2464.               ColumnType := ctFileSystem;
  2465.           end else begin
  2466.             // need to find out what kind of object we have.  No idea how.
  2467.             if ColumnType <> ctUser then
  2468.               ColumnType := ctUnknown;
  2469.           end;
  2470.         end else
  2471.           if ColumnType <> ctUser then
  2472.             ColumnType := ctUnknown;
  2473.  
  2474.          if SUCCEEDED(FCurrentShellFolder.BindToObject(fcurrentpidl, NIL,
  2475.            IID_IShellFolder, pointer(SubFolder))) then
  2476. (*
  2477.         if SUCCEEDED(FCurrentShellFolder.BindToObject(RelativePIDL, NIL,
  2478.            IID_IShellFolder, pointer(SubFolder))) then
  2479. *)
  2480.         begin
  2481.           Result := EnumerateFiles(SubFolder, FCurrentPIDL);
  2482. (*
  2483.           Result := EnumerateFiles(SubFolder, FCurrentPIDL);
  2484. *)
  2485.           {$IFNDEF DFS_NO_COM_CLEANUP} SubFolder.Release; {$ENDIF}
  2486.         end; // if
  2487.       finally
  2488.         FreePIDL(ParentPIDL);
  2489.         FreePIDL(RelativePIDL);
  2490.       end;
  2491.     end; //if
  2492.     if CurrentItemID <> NIL then
  2493.     begin
  2494.       ItemFocused := FindItemFromID(CurrentItemID);
  2495.       FreePIDL(CurrentItemID);
  2496.     end;
  2497.   finally
  2498.     Items.EndUpdate;
  2499.   end;
  2500.   // Have to do this after Items.EndUpdate because BeginUpdate sets SortType to
  2501.   // stNone.  EndUpdate restores it.
  2502.   if FLastColumnIndexSort <> -1 then
  2503.     CustomSort(@DefaultListViewSort, SORT_CURRENT)
  2504.   else
  2505.   if SortType <> stNone then
  2506.     AlphaSort;
  2507.  
  2508.   Populated;
  2509. end;
  2510.  
  2511. procedure TdfsSystemListView.ChangeToParent;
  2512. var
  2513.   ParentPIDL: PItemIDList;
  2514. begin
  2515.   ParentPIDL := CopyParentPIDL(FCurrentPIDL);
  2516.   try
  2517.     LinkedReset(FCurrentShellFolder, ParentPIDL, FALSE);
  2518.     NotifyLinkedControls(FALSE);
  2519.   finally
  2520.     FreePIDL(ParentPIDL);
  2521.   end;
  2522. end;
  2523.  
  2524. initialization
  2525.   NewCount := 0;
  2526.  
  2527. finalization
  2528.   // You might want to take this out for production releases.  I wanted to do
  2529.   // it with an {$IFDEF}, but the compiler is nasty about it.
  2530.   if NewCount > 0 then
  2531.     raise ELeaking.Create(MEMLEAK_STR);
  2532.  
  2533. end.
  2534.  
  2535.