DirView.pas 98 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381
  1. unit DirView;
  2. {===============================================================
  3. Component TDirView / Version 2.6, January 2000
  4. ===============================================================
  5. Description:
  6. ============
  7. Displays files of a single directory as listview with shell
  8. icons. Complete drag&Drop support for files and directories.
  9. Author:
  10. =======
  11. (c) Ingo Eckel 1998, 1999
  12. Sodener Weg 38
  13. 65812 Bad Soden
  14. Germany
  15. Modifications (for WinSCP):
  16. ===========================
  17. (c) Martin Prikryl 2001- 2004
  18. V2.6:
  19. - Shows "shared"-symbol with directories
  20. - Delphi5 compatible
  21. For detailed documentation and history see TDirView.htm.
  22. ===============================================================}
  23. interface
  24. {$WARN UNIT_PLATFORM OFF}
  25. {$WARN SYMBOL_PLATFORM OFF}
  26. uses
  27. Windows, ShlObj, ComCtrls, CompThread, CustomDirView,
  28. ExtCtrls, Graphics, FileOperator, DiscMon, Classes, DirViewColProperties,
  29. DragDrop, Messages, ListViewColProperties, CommCtrl, DragDropFilesEx,
  30. FileCtrl, SysUtils, BaseUtils, Controls, CustomDriveView, System.Generics.Collections, Winapi.ShellAPI;
  31. const
  32. msThreadChangeDelay = 10; // TDiscMonitor: change delay
  33. MaxWaitTimeOut = 10; // TFileDeleteThread: wait nn seconds for deleting files or directories
  34. {$WARN SYMBOL_DEPRECATED OFF}
  35. FileAttr = SysUtils.faAnyFile and (not SysUtils.faVolumeID);
  36. {$WARN SYMBOL_DEPRECATED ON}
  37. SpecialExtensions = 'EXE,LNK,ICO,ANI,CUR,PIF,JOB,CPL';
  38. ExeExtension = 'EXE';
  39. type
  40. // Exceptions:
  41. EDragDrop = class(Exception);
  42. TClipboardOperation = (cboNone, cboCut, cboCopy);
  43. // Record for each file item:
  44. PFileRec = ^TFileRec;
  45. TFileRec = record
  46. Empty: Boolean;
  47. IconEmpty: Boolean;
  48. IsDirectory: Boolean;
  49. IsRecycleBin: Boolean;
  50. IsParentDir: Boolean;
  51. FileName: string;
  52. Displayname: string;
  53. FileExt: string;
  54. TypeName: string;
  55. ImageIndex: Integer;
  56. Thumbnail: TBitmap;
  57. ThumbnailSize: TSize;
  58. Size: Int64;
  59. Attr: LongWord;
  60. FileTime: TFileTime;
  61. PIDL: PItemIDList; // Fully qualified PIDL
  62. CalculatedSize: Int64;
  63. end;
  64. // Additional events:
  65. type
  66. TDirViewFileSizeChanged = procedure(Sender: TObject; Item: TListItem) of object;
  67. TDirViewFileIconForName = procedure(Sender: TObject; var FileName: string) of object;
  68. type
  69. TDirView = class;
  70. // TIconUpdateThread (Fetch shell icons via thread)
  71. TIconUpdateThread = class(TCompThread)
  72. private
  73. FOwner: TDirView;
  74. FSyncIcon: Integer;
  75. FSyncThumbnail: TBitmap;
  76. FCurrentIndex: Integer;
  77. FCurrentFilePath: string;
  78. FCurrentItemData: TFileRec;
  79. protected
  80. constructor Create(Owner: TDirView);
  81. procedure Execute; override;
  82. public
  83. destructor Destroy; override;
  84. end;
  85. // WORKAROUND: TQueue<Integer>.Create fails when TDirView is created in IDE, while TQueue<TIconUpdateSchedule>.Create works
  86. TIconUpdateSchedule = record
  87. Index: Integer;
  88. end;
  89. // TDirView
  90. TDirView = class(TCustomDirView)
  91. private
  92. FConfirmDelete: Boolean;
  93. FConfirmOverwrite: Boolean;
  94. FDriveView: TCustomDriveView;
  95. FChangeTimer: TTimer;
  96. FChangeInterval: Cardinal;
  97. FUseIconUpdateThread: Boolean;
  98. FDriveType: Integer;
  99. FParentFolder: IShellFolder;
  100. FDesktopFolder: IShellFolder;
  101. FDirOK: Boolean;
  102. FPath: string;
  103. FHiddenCount: Integer;
  104. FFilteredCount: Integer;
  105. FNotRelative: Boolean;
  106. // shFileOperation-shell component TFileOperator:
  107. FFileOperator: TFileOperator;
  108. // Additional thread components:
  109. FIconUpdateThread: TIconUpdateThread;
  110. // only ever accessed by GUI thread
  111. FIconUpdateSet: TDictionary<Integer, Boolean>;
  112. FIconUpdateQueue: TQueue<TIconUpdateSchedule>;
  113. FIconUpdateQueueDeferred: TQueue<TIconUpdateSchedule>;
  114. FDiscMonitor: TDiscMonitor;
  115. FHomeDirectory: string;
  116. // Additional events:
  117. FOnFileIconForName: TDirViewFileIconForName;
  118. iRecycleFolder: iShellFolder;
  119. PIDLRecycle: PItemIDList;
  120. FLastPath: TDictionary<string, string>;
  121. FTimeoutShellIconRetrieval: Boolean;
  122. FAnyCut: Boolean;
  123. // Drag&Drop:
  124. function GetDirColProperties: TDirViewColProperties;
  125. function GetHomeDirectory: string;
  126. // Drag&drop helper functions:
  127. procedure SignalFileDelete(Sender: TObject; Files: TStringList);
  128. procedure PerformDragDropFileOperation(TargetPath: string; Effect: Integer);
  129. procedure SetDirColProperties(Value: TDirViewColProperties);
  130. protected
  131. function NewColProperties: TCustomListViewColProperties; override;
  132. function SortAscendingByDefault(Index: Integer): Boolean; override;
  133. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  134. procedure Delete(Item: TListItem); override;
  135. procedure DDError(ErrorNo: TDDError);
  136. // Shell namespace functions:
  137. function GetShellFolder(Dir: string): iShellFolder;
  138. function GetDirOK: Boolean; override;
  139. procedure GetDisplayInfo(ListItem: TListItem; var DispInfo: TLVItem); override;
  140. procedure DDDragDetect(grfKeyState: Longint; DetectStart, Point: TPoint;
  141. DragStatus: TDragDetectStatus); override;
  142. procedure DDMenuPopup(Sender: TObject; AMenu: HMenu; DataObj: IDataObject;
  143. AMinCustCmd:integer; grfKeyState: Longint; pt: TPoint); override;
  144. procedure DDMenuDone(Sender: TObject; AMenu: HMenu); override;
  145. procedure DDDropHandlerSucceeded(Sender: TObject; grfKeyState: Longint;
  146. Point: TPoint; dwEffect: Longint); override;
  147. procedure DDChooseEffect(grfKeyState: Integer; var dwEffect: Integer; PreferredEffect: Integer); override;
  148. function GetPathName: string; override;
  149. procedure SetChangeInterval(Value: Cardinal); virtual;
  150. procedure LoadFromRecycleBin(Dir: string); virtual;
  151. procedure SetLoadEnabled(Value: Boolean); override;
  152. function GetPath: string; override;
  153. procedure SetPath(Value: string); override;
  154. procedure PathChanged; override;
  155. procedure SetItemImageIndex(Item: TListItem; Index: Integer); override;
  156. procedure ChangeDetected(Sender: TObject; const Directory: string;
  157. var SubdirsChanged: Boolean);
  158. procedure ChangeInvalid(Sender: TObject; const Directory: string; const ErrorStr: string);
  159. procedure TimerOnTimer(Sender: TObject);
  160. procedure ResetItemImage(Index: Integer);
  161. procedure SetWatchForChanges(Value: Boolean); override;
  162. procedure AddParentDirItem;
  163. procedure AddToDragFileList(FileList: TFileList; Item: TListItem); override;
  164. function DragCompleteFileList: Boolean; override;
  165. procedure ExecuteFile(Item: TListItem); override;
  166. function GetIsRoot: Boolean; override;
  167. procedure InternalEdit(const HItem: TLVItem); override;
  168. function ItemColor(Item: TListItem): TColor; override;
  169. function ItemThumbnail(Item: TListItem; Size: TSize): TBitmap; override;
  170. function ItemFileExt(Item: TListItem): string;
  171. function ItemFileNameOnly(Item: TListItem): string;
  172. function ItemImageIndex(Item: TListItem; Cache: Boolean): Integer; override;
  173. function ItemIsFile(Item: TListItem): Boolean; override;
  174. function ItemIsRecycleBin(Item: TListItem): Boolean; override;
  175. function ItemMatchesFilter(Item: TListItem; const Filter: TFileFilter): Boolean; override;
  176. function FileMatches(FileName: string; const SearchRec: TSearchRec): Boolean;
  177. function ItemOverlayIndexes(Item: TListItem): Word; override;
  178. procedure LoadFiles; override;
  179. procedure PerformItemDragDropOperation(Item: TListItem; Effect: Integer; Paste: Boolean); override;
  180. procedure SortItems; override;
  181. function ThumbnailNeeded(ItemData: PFileRec): Boolean;
  182. procedure DoFetchIconUpdate;
  183. procedure DoUpdateIcon;
  184. procedure StartFileDeleteThread;
  185. procedure IconUpdateEnqueue(ListItem: TListItem);
  186. function IconUpdatePeek: Integer;
  187. procedure IconUpdateDequeue;
  188. procedure WMDestroy(var Msg: TWMDestroy); message WM_DESTROY;
  189. procedure Load(DoFocusSomething: Boolean); override;
  190. procedure DoFetchIcon(
  191. FilePath: string; IsSpecialExt: Boolean; CanTimeout: Boolean; FileRec: PFileRec; var ImageIndex: Integer; var TypeName: string);
  192. function GetFileInfo(
  193. CanUsePIDL: Boolean; PIDL: PItemIDList; Path: string; CanTimeout: Boolean;
  194. dwFileAttributes: DWORD; var psfi: TSHFileInfoW; uFlags: UINT): DWORD_PTR;
  195. function DoCopyToClipboard(Focused: Boolean; Cut: Boolean; Operation: TClipBoardOperation): Boolean;
  196. procedure ClearCutState;
  197. function HiddenCount: Integer; override;
  198. function FilteredCount: Integer; override;
  199. public
  200. // Runtime, readonly properties:
  201. property DriveType: Integer read FDriveType;
  202. // Linked component TDriveView:
  203. property DriveView: TCustomDriveView read FDriveView write FDriveView;
  204. // required, otherwise AV generated, when dragging columns
  205. property Columns stored False;
  206. property ParentFolder: IShellFolder read FParentFolder;
  207. // Clipboard fileoperation methods (requires drag&drop enabled):
  208. procedure EmptyClipboard; dynamic;
  209. function CopyToClipBoard(Focused: Boolean): Boolean;
  210. function CutToClipBoard(Focused: Boolean): Boolean;
  211. function PasteFromClipBoard(TargetPath: string = ''): Boolean; override;
  212. procedure DisplayPropertiesMenu; override;
  213. procedure DisplayContextMenu(Where: TPoint); override;
  214. procedure ExecuteParentDirectory; override;
  215. procedure ExecuteRootDirectory; override;
  216. function ItemIsDirectory(Item: TListItem): Boolean; override;
  217. function ItemFullFileName(Item: TListItem): string; override;
  218. function ItemIsParentDirectory(Item: TListItem): Boolean; override;
  219. function ItemFileName(Item: TListItem): string; override;
  220. function ItemFileSize(Item: TListItem): Int64; override;
  221. function ItemFileTime(Item: TListItem; var Precision: TDateTimePrecision): TDateTime; override;
  222. procedure SetItemCalculatedSize(Item: TListItem; ASize: Int64); override;
  223. procedure OpenFallbackPath(Value: string);
  224. // Thread handling:
  225. procedure StartWatchThread;
  226. procedure StopWatchThread;
  227. function WatchThreadActive: Boolean;
  228. procedure StartIconUpdateThread;
  229. procedure StopIconUpdateThread;
  230. procedure TerminateThreads;
  231. // Create a new subdirectory:
  232. procedure CreateDirectory(DirName: string); override;
  233. // Delete all selected files:
  234. // Check, if file or files still exists:
  235. procedure ValidateFile(Item: TListItem); overload;
  236. procedure ValidateFile(FileName:TFileName); overload;
  237. procedure ValidateSelectedFiles; dynamic;
  238. // Access the internal data-structures:
  239. function AddItem(SRec: SysUtils.TSearchRec): TListItem; reintroduce;
  240. procedure GetDisplayData(Item: TListItem; FetchIcon: Boolean);
  241. function GetFileRec(Index: Integer): PFileRec;
  242. // Populate / repopulate the filelist:
  243. procedure Reload(CacheIcons : Boolean); override;
  244. procedure Reload2;
  245. function GetAttrString(Attr: Integer): string; virtual;
  246. constructor Create(AOwner: TComponent); override;
  247. destructor Destroy; override;
  248. procedure ExecuteHomeDirectory; override;
  249. procedure ReloadDirectory; override;
  250. procedure ExecuteDrive(Drive: string);
  251. property HomeDirectory: string read GetHomeDirectory write FHomeDirectory;
  252. property TimeoutShellIconRetrieval: Boolean read FTimeoutShellIconRetrieval write FTimeoutShellIconRetrieval;
  253. property AnyCut: Boolean read FAnyCut;
  254. published
  255. property DirColProperties: TDirViewColProperties read GetDirColProperties write SetDirColProperties;
  256. property PathLabel;
  257. property OnUpdateStatusBar;
  258. property DimmHiddenFiles;
  259. property ShowHiddenFiles;
  260. property WantUseDragImages;
  261. property TargetPopupMenu;
  262. property AddParentDir;
  263. property OnSelectItem;
  264. property OnStartLoading;
  265. property OnLoaded;
  266. property OnDDDragEnter;
  267. property OnDDDragLeave;
  268. property OnDDDragOver;
  269. property OnDDDrop;
  270. property OnDDQueryContinueDrag;
  271. property OnDDGiveFeedback;
  272. property OnDDDragDetect;
  273. property OnDDCreateDragFileList;
  274. property OnDDEnd;
  275. property OnDDCreateDataObject;
  276. property OnDDTargetHasDropHandler;
  277. // Drag&Drop:
  278. property DDLinkOnExeDrag default True;
  279. property OnDDProcessDropped;
  280. property OnDDError;
  281. property OnDDExecuted;
  282. property OnDDFileOperation;
  283. property OnDDFileOperationExecuted;
  284. property OnExecFile;
  285. property OnMatchMask;
  286. property OnGetOverlay;
  287. property OnGetItemColor;
  288. // Confirm deleting files
  289. property ConfirmDelete: Boolean
  290. read FConfirmDelete write FConfirmDelete default True;
  291. // Confirm overwriting files
  292. property ConfirmOverwrite: Boolean
  293. read FConfirmOverwrite write fConfirmOverwrite default True;
  294. // Reload the directory after only the interval:
  295. property ChangeInterval: Cardinal
  296. read FChangeInterval write SetChangeInterval default MSecsPerSec;
  297. // Fetch shell icons by thread:
  298. property UseIconUpdateThread: Boolean
  299. read FUseIconUpdateThread write FUseIconUpdateThread default False;
  300. // Watch current directory for filename changes (create, rename, delete files)
  301. property WatchForChanges;
  302. // Additional events:
  303. property OnFileIconForName: TDirViewFileIconForName
  304. read FOnFileIconForName write FOnFileIconForName;
  305. property UseSystemContextMenu;
  306. property OnContextPopup;
  307. property OnHistoryChange;
  308. property OnHistoryGo;
  309. property OnPathChange;
  310. property OnBusy;
  311. property OnChangeFocus;
  312. property ColumnClick;
  313. property MultiSelect;
  314. property ReadOnly;
  315. property DirViewStyle;
  316. // The only way to make Items stored automatically and survive handle recreation.
  317. // Though we should implement custom persisting to avoid publishing this
  318. property Items;
  319. end; // TDirView
  320. procedure Register;
  321. // Returns True, if the specified extension matches one of the extensions in ExtList:
  322. function MatchesFileExt(Ext: string; const FileExtList: string): Boolean;
  323. function DropLink(Item: PFDDListItem; TargetPath: string): Boolean;
  324. function DropFiles(
  325. DragDropFilesEx: TCustomizableDragDropFilesEx; Effect: Integer; FileOperator: TFileOperator; TargetPath: string;
  326. IsRecycleBin: Boolean; ConfirmDelete: Boolean; ConfirmOverwrite: Boolean;
  327. Sender: TObject; OnDDFileOperation: TDDFileOperationEvent;
  328. out SourcePath: string; out SourceIsDirectory: Boolean): Boolean;
  329. procedure CheckCanOpenDirectory(Path: string);
  330. implementation
  331. uses
  332. OperationWithTimeout,
  333. PIDL, Forms, Dialogs,
  334. ComObj,
  335. ActiveX, ImgList,
  336. ShellDialogs, IEDriveInfo,
  337. FileChanges, Math, PasTools, StrUtils, Types, UITypes;
  338. var
  339. ThumbnailNotNeeded: TSize;
  340. var
  341. DaylightHack: Boolean;
  342. procedure Register;
  343. begin
  344. RegisterComponents('DriveDir', [TDirView]);
  345. end;
  346. function MatchesFileExt(Ext: string; const FileExtList: string): Boolean;
  347. begin
  348. Result := (Length(Ext) = 3) and (Pos(Ext, FileExtList) <> 0);
  349. end;
  350. function FileTimeToDateTime(FileTime: TFileTime): TDateTime;
  351. var
  352. SysTime: TSystemTime;
  353. UniverzalSysTime: TSystemTime;
  354. LocalFileTime: TFileTime;
  355. begin
  356. // duplicated in Common.cpp
  357. // The 0xFFF... is sometime seen for invalid timestamps,
  358. // it would cause failure in SystemTimeToDateTime below
  359. if FileTime.dwLowDateTime = High(DWORD) then
  360. begin
  361. Result := MinDateTime;
  362. end
  363. else
  364. begin
  365. if not DaylightHack then
  366. begin
  367. FileTimeToSystemTime(FileTime, UniverzalSysTime);
  368. SystemTimeToTzSpecificLocalTime(nil, UniverzalSysTime, SysTime);
  369. end
  370. else
  371. begin
  372. FileTimeToLocalFileTime(FileTime, LocalFileTime);
  373. FileTimeToSystemTime(LocalFileTime, SysTime);
  374. end;
  375. Result := SystemTimeToDateTime(SysTime);
  376. end;
  377. end;
  378. function SizeFromSRec(const SRec: SysUtils.TSearchRec): Int64;
  379. begin
  380. {$WARNINGS OFF}
  381. Result := Int64(SRec.FindData.nFileSizeHigh) shl 32 + SRec.FindData.nFileSizeLow;
  382. {$WARNINGS ON}
  383. end;
  384. function DropLink(Item: PFDDListItem; TargetPath: string): Boolean;
  385. var
  386. Drive: string;
  387. SourcePath: string;
  388. SourceFile: string;
  389. begin
  390. SourceFile := Item.Name;
  391. if IsRootPath(SourceFile) then
  392. begin
  393. Drive := DriveInfo.GetDriveKey(SourceFile);
  394. SourcePath := Copy(DriveInfo.Get(Drive).PrettyName, 4, 255) + ' (' + Drive + ')'
  395. end
  396. else
  397. begin
  398. SourcePath := ExtractFileName(SourceFile);
  399. end;
  400. Result :=
  401. CreateFileShortCut(SourceFile,
  402. IncludeTrailingBackslash(TargetPath) + ChangeFileExt(SourcePath, '.lnk'),
  403. ExtractFileNameOnly(SourceFile));
  404. end;
  405. function DropFiles(
  406. DragDropFilesEx: TCustomizableDragDropFilesEx; Effect: Integer; FileOperator: TFileOperator; TargetPath: string;
  407. IsRecycleBin: Boolean; ConfirmDelete: Boolean; ConfirmOverwrite: Boolean;
  408. Sender: TObject; OnDDFileOperation: TDDFileOperationEvent;
  409. out SourcePath: string; out SourceIsDirectory: Boolean): Boolean;
  410. var
  411. Index: Integer;
  412. DoFileOperation: Boolean;
  413. begin
  414. SourcePath := '';
  415. // Set the source filenames:
  416. for Index := 0 to DragDropFilesEx.FileList.Count - 1 do
  417. begin
  418. FileOperator.OperandFrom.Add(
  419. TFDDListItem(DragDropFilesEx.FileList[Index]^).Name);
  420. if DragDropFilesEx.FileNamesAreMapped then
  421. FileOperator.OperandTo.Add(IncludeTrailingPathDelimiter(TargetPath) +
  422. TFDDListItem(DragDropFilesEx.FileList[Index]^).MappedName);
  423. if SourcePath = '' then
  424. begin
  425. if DirectoryExists(TFDDListItem(DragDropFilesEx.FileList[Index]^).Name) then
  426. begin
  427. SourcePath := TFDDListItem(DragDropFilesEx.FileList[Index]^).Name;
  428. SourceIsDirectory := True;
  429. end
  430. else
  431. begin
  432. SourcePath := ExtractFilePath(TFDDListItem(DragDropFilesEx.FileList[Index]^).Name);
  433. SourceIsDirectory := False;
  434. end;
  435. end;
  436. end;
  437. FileOperator.Flags := FileOperatorDefaultFlags;
  438. var RenameOnCollision := SameText(ExcludeTrailingPathDelimiter(SourcePath), ExcludeTrailingPathDelimiter(TargetPath));
  439. if RenameOnCollision then
  440. begin
  441. FileOperator.Flags := FileOperator.Flags + [foRenameOnCollision];
  442. FileOperator.WantMappingHandle := True;
  443. end
  444. else FileOperator.WantMappingHandle := False;
  445. // Set the target directory or the target filenames:
  446. if DragDropFilesEx.FileNamesAreMapped and (not IsRecycleBin) then
  447. begin
  448. FileOperator.Flags := FileOperator.Flags + [foMultiDestFiles];
  449. end
  450. else
  451. begin
  452. FileOperator.Flags := FileOperator.Flags - [foMultiDestFiles];
  453. FileOperator.OperandTo.Clear;
  454. FileOperator.OperandTo.Add(TargetPath);
  455. end;
  456. // if the target directory is the recycle bin, then delete the selected files:
  457. if IsRecycleBin then
  458. begin
  459. FileOperator.Operation := foDelete;
  460. end
  461. else
  462. begin
  463. case Effect of
  464. DROPEFFECT_COPY: FileOperator.Operation := foCopy;
  465. DROPEFFECT_MOVE: FileOperator.Operation := foMove;
  466. end;
  467. end;
  468. if IsRecycleBin then
  469. begin
  470. if not ConfirmDelete then
  471. FileOperator.Flags := FileOperator.Flags + [foNoConfirmation];
  472. end
  473. else
  474. begin
  475. if not ConfirmOverwrite then
  476. FileOperator.Flags := FileOperator.Flags + [foNoConfirmation];
  477. end;
  478. DoFileOperation := True;
  479. if Assigned(OnDDFileOperation) then
  480. begin
  481. OnDDFileOperation(Sender, Effect, SourcePath, TargetPath, False, DoFileOperation);
  482. end;
  483. Result := DoFileOperation and (FileOperator.OperandFrom.Count > 0);
  484. if Result then
  485. begin
  486. FileOperator.Execute;
  487. end;
  488. end;
  489. function GetShellDisplayName(
  490. const ShellFolder: IShellFolder; IDList: PItemIDList; Flags: DWORD; var Name: string): Boolean;
  491. var
  492. Str: TStrRet;
  493. begin
  494. Result := True;
  495. Name := '';
  496. if ShellFolder.GetDisplayNameOf(IDList, Flags, Str) = NOERROR then
  497. begin
  498. case Str.uType of
  499. STRRET_WSTR: Name := WideCharToString(Str.pOleStr);
  500. STRRET_OFFSET: Name := PChar(UINT(IDList) + Str.uOffset);
  501. STRRET_CSTR: Name := string(Str.cStr);
  502. else Result := False;
  503. end;
  504. end
  505. else Result := False;
  506. end;
  507. procedure CheckCanOpenDirectory(Path: string);
  508. var
  509. DosError: Integer;
  510. SRec: SysUtils.TSearchRec;
  511. begin
  512. if not DirectoryExistsFix(Path) then
  513. begin
  514. DosError := GetLastError;
  515. if (DosError = ERROR_FILE_NOT_FOUND) or (DosError = ERROR_PATH_NOT_FOUND) then
  516. raise Exception.CreateFmt(SDirNotExists, [Path])
  517. else
  518. RaiseLastOSError;
  519. end;
  520. DosError := SysUtils.FindFirst(ApiPath(IncludeTrailingPathDelimiter(Path) + '*.*'), FileAttr, SRec);
  521. if DosError = ERROR_SUCCESS then
  522. begin
  523. FindClose(SRec);
  524. end
  525. else
  526. begin
  527. // File not found is expected when accessing a root folder of an empty drive
  528. if DosError <> ERROR_FILE_NOT_FOUND then
  529. begin
  530. RaiseLastOSError;
  531. end;
  532. end;
  533. end;
  534. // TIconUpdateThread
  535. constructor TIconUpdateThread.Create(Owner: TDirView);
  536. begin
  537. inherited Create(True);
  538. FOwner := Owner;
  539. end; // TIconUpdateThread.Create
  540. destructor TIconUpdateThread.Destroy;
  541. begin
  542. FreeAndNil(FSyncThumbnail);
  543. inherited;
  544. end;
  545. procedure TIconUpdateThread.Execute;
  546. var
  547. IsSpecialExt: Boolean;
  548. TypeName: string;
  549. PrevPIDL: PItemIDList;
  550. begin
  551. CoInitialize(nil); // needed for SHGetFileInfo
  552. while not Terminated do
  553. begin
  554. FCurrentIndex := -1;
  555. Synchronize(FOwner.DoFetchIconUpdate);
  556. if (FCurrentIndex >= 0) and
  557. (not Terminated) then
  558. begin
  559. FSyncIcon := -1;
  560. if Assigned(FSyncThumbnail) then
  561. FreeAndNil(FSyncThumbnail);
  562. if FCurrentItemData.IconEmpty then
  563. begin
  564. PrevPIDL := FCurrentItemData.PIDL;
  565. try
  566. IsSpecialExt := MatchesFileExt(FCurrentItemData.FileExt, SpecialExtensions);
  567. FOwner.DoFetchIcon(FCurrentFilePath, IsSpecialExt, False, @FCurrentItemData, FSyncIcon, TypeName);
  568. except
  569. // Capture exceptions generated by the shell
  570. FSyncIcon := UnknownFileIcon;
  571. end;
  572. if Assigned(FCurrentItemData.PIDL) and
  573. (PrevPIDL <> FCurrentItemData.PIDL) then
  574. begin
  575. FreePIDL(FCurrentItemData.PIDL);
  576. end;
  577. end;
  578. if FOwner.ThumbnailNeeded(@FCurrentItemData) then
  579. begin
  580. FSyncThumbnail := GetThumbnail(FCurrentFilePath, FCurrentItemData.ThumbnailSize);
  581. end;
  582. if not Terminated then
  583. begin
  584. Synchronize(FOwner.DoUpdateIcon);
  585. end;
  586. end;
  587. SetLength(FCurrentFilePath, 0);
  588. end;
  589. end;
  590. // TDirView
  591. constructor TDirView.Create(AOwner: TComponent);
  592. begin
  593. inherited Create(AOwner);
  594. FDriveType := DRIVE_UNKNOWN;
  595. FConfirmDelete := True;
  596. FParentFolder := nil;
  597. FDesktopFolder := nil;
  598. DragOnDriveIsMove := True;
  599. FHiddenCount := 0;
  600. FFilteredCount := 0;
  601. FNotRelative := False;
  602. FFileOperator := TFileOperator.Create(Self);
  603. FDirOK := True;
  604. FPath := '';
  605. FDiscMonitor := nil;
  606. // ChangeTimer:
  607. if FChangeInterval = 0 then FChangeInterval := MSecsPerSec;
  608. FChangeTimer := TTimer.Create(Self);
  609. FChangeTimer.Interval := FChangeInterval;
  610. FChangeTimer.Enabled := False;
  611. FChangeTimer.OnTimer := TimerOnTimer;
  612. // Drag&drop:
  613. FConfirmOverwrite := True;
  614. DDLinkOnExeDrag := True;
  615. DragDropFilesEx.SourceEffects := DragSourceEffects;
  616. DragDropFilesEx.TargetEffects := [deCopy, deMove, deLink];
  617. DragDropFilesEx.ShellExtensions.DragDropHandler := True;
  618. DragDropFilesEx.ShellExtensions.DropHandler := True;
  619. FIconUpdateSet := TDictionary<Integer, Boolean>.Create;
  620. FIconUpdateQueue := TQueue<TIconUpdateSchedule>.Create;
  621. FIconUpdateQueueDeferred := TQueue<TIconUpdateSchedule>.Create;
  622. FLastPath := nil;
  623. end;
  624. destructor TDirView.Destroy;
  625. begin
  626. FreeAndNil(FIconUpdateQueue);
  627. FreeAndNil(FIconUpdateQueueDeferred);
  628. FreeAndNil(FIconUpdateSet);
  629. if Assigned(PIDLRecycle) then FreePIDL(PIDLRecycle);
  630. FLastPath.Free;
  631. FFileOperator.Free;
  632. FChangeTimer.Free;
  633. inherited Destroy;
  634. FPath := '';
  635. end;
  636. procedure TDirView.WMDestroy(var Msg: TWMDestroy);
  637. begin
  638. Selected := nil;
  639. ClearItems;
  640. TerminateThreads;
  641. inherited;
  642. end;
  643. procedure TDirView.TerminateThreads;
  644. begin
  645. StopIconUpdateThread;
  646. StopWatchThread;
  647. if Assigned(FDiscMonitor) then
  648. begin
  649. FDiscMonitor.Free;
  650. FDiscMonitor := nil;
  651. end;
  652. end;
  653. function TDirView.GetHomeDirectory: string;
  654. begin
  655. if FHomeDirectory <> '' then Result := FHomeDirectory
  656. else
  657. begin
  658. Result := UserDocumentDirectory;
  659. // in rare case the CSIDL_PERSONAL cannot be resolved
  660. if Result = '' then
  661. begin
  662. Result := DriveInfo.AnyValidPath;
  663. end;
  664. end;
  665. end;
  666. function TDirView.GetIsRoot: Boolean;
  667. begin
  668. Result := IsRootPath(Path);
  669. end;
  670. function TDirView.GetPath: string;
  671. begin
  672. Result := FPath;
  673. end;
  674. procedure TDirView.PathChanged;
  675. var
  676. Expanded: string;
  677. begin
  678. inherited;
  679. // make sure to use PathName as Path maybe just X: what
  680. // ExpandFileName resolves to current working directory
  681. // on the drive, not to root path
  682. Expanded := ExpandFileName(PathName);
  683. if not Assigned(FLastPath) then
  684. begin
  685. FLastPath := TDictionary<string, string>.Create;
  686. end;
  687. FLastPath.AddOrSetValue(DriveInfo.GetDriveKey(Expanded), Expanded);
  688. end;
  689. procedure TDirView.SetPath(Value: string);
  690. const
  691. LongPathPrefix = '\\?\';
  692. var
  693. LongPath: string;
  694. P, Len: Integer;
  695. begin
  696. // do checks before passing directory to drive view, because
  697. // it would truncate non-existing directory to first superior existing
  698. Value := ReplaceStr(Value, '/', '\');
  699. // Particularly the TDriveView.FindPathNode (its ExtractFileDir) cannot handle double backslashes
  700. while True do
  701. begin
  702. P := Value.LastIndexOf('\\'); // 0-based
  703. if P <= 0 then // not found or UNC
  704. Break
  705. else
  706. begin
  707. System.Delete(Value, P + 1, 1);
  708. end;
  709. end;
  710. // GetLongPathName would resolve to it the current working directory
  711. if (Length(Value) = 2) and CharInSet(UpperCase(Value)[1], ['A'..'Z']) and (Value[2] = ':') then
  712. begin
  713. Value := Value + '\';
  714. end
  715. else
  716. // Convert to long path
  717. begin
  718. Len := GetLongPathName(PChar(ApiPath(Value)), nil, 0);
  719. SetLength(LongPath, Len);
  720. Len := GetLongPathName(PChar(ApiPath(Value)), PChar(LongPath), Len);
  721. if Len > 0 then
  722. begin
  723. Value := Copy(LongPath, 1, Len);
  724. if StartsStr(LongPathPrefix, Value) then
  725. System.Delete(Value, 1, Length(LongPathPrefix));
  726. end;
  727. end;
  728. CheckCanOpenDirectory(Value);
  729. if Assigned(FDriveView) and
  730. (FDriveView.Directory <> Value) then
  731. begin
  732. FDriveView.Directory := Value;
  733. end
  734. else
  735. if FPath <> Value then
  736. try
  737. while ExcludeTrailingPathDelimiter(Value) <> Value do
  738. begin
  739. Value := ExcludeTrailingPathDelimiter(Value);
  740. end;
  741. PathChanging(not FNotRelative);
  742. FPath := Value;
  743. Load(True);
  744. finally
  745. PathChanged;
  746. end;
  747. end;
  748. procedure TDirView.OpenFallbackPath(Value: string);
  749. var
  750. APath: string;
  751. begin
  752. while True do
  753. begin
  754. APath := ExtractFileDir(Value);
  755. if (APath = '') or (APath = Value) then
  756. begin
  757. Break;
  758. end
  759. else
  760. begin
  761. try
  762. Path := APath;
  763. Break;
  764. except
  765. Value := APath;
  766. end;
  767. end;
  768. end;
  769. end;
  770. procedure TDirView.SetLoadEnabled(Value: Boolean);
  771. begin
  772. if Value <> LoadEnabled then
  773. begin
  774. FLoadEnabled := Enabled;
  775. if LoadEnabled and Dirty then
  776. begin
  777. if Items.Count > 100 then Reload2
  778. else Reload(True);
  779. end;
  780. end;
  781. end;
  782. function TDirView.GetPathName: string;
  783. begin
  784. if IsRoot then Result := IncludeTrailingBackslash(Path)
  785. else Result := Path;
  786. end;
  787. function TDirView.GetFileRec(Index: Integer): PFileRec;
  788. begin
  789. if Index > Pred(Items.Count) then Result := nil
  790. else Result := Items[index].Data;
  791. end;
  792. function TDirView.HiddenCount: Integer;
  793. begin
  794. Result := FHiddenCount;
  795. end;
  796. function TDirView.FilteredCount: Integer;
  797. begin
  798. Result := FFilteredCount;
  799. end;
  800. function TDirView.AddItem(SRec: SysUtils.TSearchRec): TListItem;
  801. var
  802. PItem: PFileRec;
  803. Item: TListItem;
  804. begin
  805. Item := TListItem.Create(Items);
  806. New(PItem);
  807. // must be set as soon as possible, at least before Caption is set,
  808. // because if come column is "autosized" setting Caption invokes some callbacks
  809. Item.Data := PItem;
  810. PItem^.FileName := SRec.Name;
  811. PItem^.FileExt := UpperCase(ExtractFileExt(SRec.Name));
  812. PItem^.FileExt := Copy(PItem^.FileExt, 2, Length(PItem^.FileExt) - 1);
  813. PItem^.DisplayName := PItem^.FileName;
  814. {$WARNINGS OFF}
  815. PItem^.Attr := SRec.FindData.dwFileAttributes;
  816. {$WARNINGS ON}
  817. PItem^.IsParentDir := False;
  818. PItem^.IsDirectory := ((PItem^.Attr and SysUtils.faDirectory) <> 0);
  819. PItem^.IsRecycleBin := PItem^.IsDirectory and (Length(Path) = 2) and
  820. Bool(PItem^.Attr and SysUtils.faSysFile) and
  821. ((UpperCase(PItem^.FileName) = 'RECYCLED') or (UpperCase(PItem^.FileName) = 'RECYCLER'));
  822. if not PItem^.IsDirectory then PItem^.Size := SizeFromSRec(SRec)
  823. else PItem^.Size := -1;
  824. {$WARNINGS OFF}
  825. PItem^.FileTime := SRec.FindData.ftLastWriteTime;
  826. {$WARNINGS ON}
  827. PItem^.Empty := True;
  828. PItem^.IconEmpty := True;
  829. PItem^.Thumbnail := nil;
  830. PItem^.ThumbnailSize := ThumbnailNotNeeded;
  831. if PItem^.Size > 0 then Inc(FFilesSize, PItem^.Size);
  832. PItem^.PIDL := nil;
  833. PItem^.CalculatedSize := -1;
  834. // Need to add before assigning to .Caption and .OverlayIndex,
  835. // as the setters these call back to owning view.
  836. // Assignment is redundant
  837. Item := Items.AddItem(Item);
  838. if not Self.IsRecycleBin then Item.Caption := SRec.Name;
  839. if PItem^.FileExt = 'LNK' then Item.OverlayIndex := 1;
  840. Result := Item;
  841. end;
  842. procedure TDirView.AddParentDirItem;
  843. var
  844. PItem: PFileRec;
  845. Item: TListItem;
  846. SRec: SysUtils.TSearchRec;
  847. begin
  848. FHasParentDir := True;
  849. Item := Items.Add;
  850. New(PItem);
  851. if FindFirst(ApiPath(FPath), faAnyFile, SRec) = 0 then
  852. FindClose(SRec);
  853. Item.Data := PItem;
  854. PItem^.FileName := '..';
  855. PItem^.FileExt := '';
  856. PItem^.DisplayName := '..';
  857. PItem^.Attr := SRec.Attr;
  858. PItem^.IsDirectory := True;
  859. PItem^.IsRecycleBin := False;
  860. PItem^.IsParentDir := True;
  861. PItem^.Size := -1;
  862. PItem^.CalculatedSize := -1;
  863. Item.Caption := '..';
  864. {$WARNINGS OFF}
  865. PItem^.FileTime := SRec.FindData.ftLastWriteTime;
  866. {$WARNINGS ON}
  867. PItem^.Empty := True;
  868. PItem^.IconEmpty := False;
  869. PItem^.Thumbnail := nil;
  870. PItem^.ThumbnailSize := ThumbnailNotNeeded;
  871. PItem^.PIDL := nil;
  872. PItem^.ImageIndex := StdDirIcon;
  873. PItem^.TypeName := SParentDir;
  874. PItem^.Empty := False;
  875. end;
  876. procedure TDirView.LoadFromRecycleBin(Dir: string);
  877. var
  878. PIDLRecycleLocal: PItemIDList;
  879. PCurrList: PItemIDList;
  880. FQPIDL: PItemIDList;
  881. EnumList: IEnumIDList;
  882. Fetched: ULONG;
  883. SRec: SysUtils.TSearchRec;
  884. DisplayName: string;
  885. FullPath: string;
  886. NewItem: TListItem;
  887. FileRec: PFileRec;
  888. FileInfo: TSHFileInfo;
  889. DosError: Integer;
  890. begin
  891. if not Assigned(iRecycleFolder) then
  892. begin
  893. PIDLRecycleLocal := nil;
  894. try
  895. OLECheck(SHGetSpecialFolderLocation(Self.Handle,
  896. CSIDL_BITBUCKET, PIDLRecycleLocal));
  897. PIDLRecycle := PIDL_Concatenate(nil, PIDLRecycleLocal);
  898. if not SUCCEEDED(FDesktopFolder.BindToObject(PIDLRecycle, nil,
  899. IID_IShellFolder, Pointer(iRecycleFolder))) then Exit;
  900. finally
  901. if Assigned(PIDLRecycleLocal) then
  902. FreePIDL(PIDLRecycleLocal);
  903. end;
  904. end;
  905. FParentFolder := iRecycleFolder;
  906. if AddParentDir then AddParentDirItem;
  907. FHiddenCount := 0;
  908. FFilteredCount := 0;
  909. if SUCCEEDED(iRecycleFolder.EnumObjects(Self.Handle,
  910. SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN, EnumList)) then
  911. begin
  912. while (EnumList.Next(1, PCurrList, Fetched) = S_OK) and not AbortLoading do
  913. begin
  914. if Assigned(PCurrList) then
  915. try
  916. FQPIDL := PIDL_Concatenate(PIDLRecycle, PCurrList);
  917. // Physical filename:
  918. SetLength(FullPath, MAX_PATH);
  919. if shGetPathFromIDList(FQPIDL, PChar(FullPath)) then
  920. SetLength(FullPath, StrLen(PChar(FullPath)));
  921. // Filesize, attributes and -date:
  922. DosError := FindFirst(ApiPath(FullPath), faAnyFile, SRec);
  923. FindClose(Srec);
  924. SRec.Name := ExtractFilePath(FullPath) + SRec.Name;
  925. // Displayname:
  926. GetShellDisplayName(iRecycleFolder, PCurrList, SHGDN_FORPARSING, DisplayName);
  927. if (DosError = 0) and
  928. (((SRec.Attr and faDirectory) <> 0) or
  929. FileMatches(DisplayName, SRec)) then
  930. begin
  931. // Filetype and icon:
  932. GetFileInfo(True, FQPIDL, '', False, 0, FileInfo, SHGFI_TYPENAME or SHGFI_SYSICONINDEX);
  933. NewItem := AddItem(Srec);
  934. NewItem.Caption := DisplayName;
  935. FileRec := NewItem.Data;
  936. FileRec^.Empty := False;
  937. FileRec^.IconEmpty := False;
  938. FileRec^.DisplayName := DisplayName;
  939. FileRec^.PIDL := FQPIDL;
  940. FileRec^.TypeName := FileInfo.szTypeName;
  941. if FileRec^.Typename = EmptyStr then
  942. FileRec^.TypeName := Format(STextFileExt, [FileRec.FileExt]);
  943. FileRec^.ImageIndex := FileInfo.iIcon;
  944. end
  945. else
  946. begin
  947. FreePIDL(FQPIDL);
  948. end;
  949. FreePIDL(PCurrList);
  950. except
  951. if Assigned(PCurrList) then
  952. try
  953. FreePIDL(PCurrList);
  954. except
  955. end;
  956. end;
  957. end; // While EnumList ...
  958. end;
  959. end;
  960. function TDirView.GetShellFolder(Dir: string): iShellFolder;
  961. var
  962. Eaten: ULONG;
  963. Attr: ULONG;
  964. NewPIDL: PItemIDList;
  965. begin
  966. Result := nil;
  967. if not Assigned(FDesktopFolder) then
  968. SHGetDesktopFolder(FDesktopFolder);
  969. if Assigned(FDesktopFolder) then
  970. begin
  971. Attr := 0;
  972. if Succeeded(FDesktopFolder.ParseDisplayName(
  973. ParentForm.Handle, nil, PChar(Dir), Eaten, NewPIDL, Attr)) then
  974. begin
  975. try
  976. assert(Assigned(NewPIDL));
  977. FDesktopFolder.BindToObject(NewPIDL, nil, IID_IShellFolder, Pointer(Result));
  978. Assert(Assigned(Result));
  979. finally
  980. FreePIDL(NewPIDL);
  981. end;
  982. end;
  983. end;
  984. end;
  985. function TDirView.ItemIsDirectory(Item: TListItem): Boolean;
  986. begin
  987. Result :=
  988. (Assigned(Item) and Assigned(Item.Data) and
  989. PFileRec(Item.Data)^.IsDirectory);
  990. end;
  991. function TDirView.ItemIsFile(Item: TListItem): Boolean;
  992. begin
  993. Result :=
  994. (Assigned(Item) and Assigned(Item.Data) and
  995. (not PFileRec(Item.Data)^.IsParentDir));
  996. end;
  997. function TDirView.ItemIsParentDirectory(Item: TListItem): Boolean;
  998. begin
  999. Result :=
  1000. (Assigned(Item) and Assigned(Item.Data) and
  1001. PFileRec(Item.Data)^.IsParentDir);
  1002. end;
  1003. function TDirView.ItemIsRecycleBin(Item: TListItem): Boolean;
  1004. begin
  1005. Result := (Assigned(Item) and Assigned(Item.Data) and
  1006. PFileRec(Item.Data)^.IsRecycleBin);
  1007. end;
  1008. function TDirView.ItemMatchesFilter(Item: TListItem; const Filter: TFileFilter): Boolean;
  1009. var
  1010. FileRec: PFileRec;
  1011. begin
  1012. Assert(Assigned(Item) and Assigned(Item.Data));
  1013. FileRec := PFileRec(Item.Data);
  1014. Result :=
  1015. ((Filter.Masks = '') or
  1016. FileNameMatchesMasks(FileRec^.FileName, FileRec^.IsDirectory,
  1017. FileRec^.Size, FileTimeToDateTime(FileRec^.FileTime), Filter.Masks, False) or
  1018. (FileRec^.IsDirectory and Filter.Directories and
  1019. FileNameMatchesMasks(FileRec^.FileName, False,
  1020. FileRec^.Size, FileTimeToDateTime(FileRec^.FileTime), Filter.Masks, False)));
  1021. end;
  1022. function TDirView.FileMatches(FileName: string; const SearchRec: TSearchRec): Boolean;
  1023. var
  1024. Directory: Boolean;
  1025. FileSize: Int64;
  1026. begin
  1027. Result := (ShowHiddenFiles or ((SearchRec.Attr and SysUtils.faHidden) = 0));
  1028. if not Result then
  1029. begin
  1030. Inc(FHiddenCount);
  1031. end
  1032. else
  1033. if FEffectiveMask <> '' then
  1034. begin
  1035. Directory := ((SearchRec.Attr and faDirectory) <> 0);
  1036. if Directory then FileSize := 0
  1037. else FileSize := SizeFromSRec(SearchRec);
  1038. Result :=
  1039. FileNameMatchesMasks(
  1040. FileName,
  1041. Directory,
  1042. FileSize,
  1043. FileTimeToDateTime(SearchRec.FindData.ftLastWriteTime),
  1044. FEffectiveMask, True);
  1045. if not Result then
  1046. begin
  1047. Inc(FFilteredCount);
  1048. end;
  1049. end;
  1050. end;
  1051. function TDirView.ItemOverlayIndexes(Item: TListItem): Word;
  1052. begin
  1053. Result := inherited ItemOverlayIndexes(Item);
  1054. if Assigned(Item) and Assigned(Item.Data) then
  1055. begin
  1056. if PFileRec(Item.Data)^.IsParentDir then
  1057. Inc(Result, oiDirUp);
  1058. end;
  1059. end;
  1060. procedure TDirView.Load(DoFocusSomething: Boolean);
  1061. begin
  1062. try
  1063. StopIconUpdateThread;
  1064. FIconUpdateQueue.Clear;
  1065. FIconUpdateQueueDeferred.Clear;
  1066. FIconUpdateSet.Clear;
  1067. StopWatchThread;
  1068. FChangeTimer.Enabled := False;
  1069. FChangeTimer.Interval := 0;
  1070. inherited;
  1071. finally
  1072. if DirOK and not AbortLoading then
  1073. begin
  1074. if not IsRecycleBin then
  1075. StartIconUpdateThread;
  1076. StartWatchThread;
  1077. end;
  1078. end;
  1079. end;
  1080. procedure TDirView.LoadFiles;
  1081. var
  1082. SRec: SysUtils.TSearchRec;
  1083. DosError: Integer;
  1084. DirsCount: Integer;
  1085. SelTreeNode: TTreeNode;
  1086. Drive: string;
  1087. begin
  1088. FHiddenCount := 0;
  1089. FFilteredCount := 0;
  1090. FAnyCut := False;
  1091. try
  1092. if Length(FPath) > 0 then
  1093. begin
  1094. Drive := DriveInfo.GetDriveKey(FPath);
  1095. DriveInfo.ReadDriveStatus(Drive, dsSize);
  1096. FDriveType := DriveInfo.Get(Drive).DriveType;
  1097. FDirOK := DriveInfo.Get(Drive).DriveReady and DirectoryExists(ApiPath(FPath));
  1098. end
  1099. else
  1100. begin
  1101. FDriveType := DRIVE_UNKNOWN;
  1102. FDirOK := False;
  1103. end;
  1104. if DirOK then
  1105. begin
  1106. if Assigned(FDriveView) then
  1107. SelTreeNode := FDriveView.FindNodeToPath(FPath)
  1108. else SelTreeNode := nil;
  1109. if Assigned(FDriveView) and Assigned(SelTreeNode) then
  1110. FIsRecycleBin := FDriveView.NodeIsRecycleBin(SelTreeNode)
  1111. else
  1112. FIsRecycleBin :=
  1113. (Uppercase(Copy(FPath, 2, 10)) = ':\RECYCLED') or
  1114. (Uppercase(Copy(FPath, 2, 10)) = ':\RECYCLER');
  1115. if not Assigned(FDesktopFolder) then
  1116. SHGetDesktopFolder(FDesktopFolder);
  1117. if IsRecycleBin then LoadFromRecycleBin(Path)
  1118. else
  1119. begin
  1120. FParentFolder := GetShellFolder(PathName);
  1121. DosError :=
  1122. FindFirstEx(ApiPath(IncludeTrailingPathDelimiter(FPath) + '*.*'), FileAttr, SRec, FIND_FIRST_EX_LARGE_FETCH_PAS);
  1123. while (DosError = 0) and (not AbortLoading) do
  1124. begin
  1125. if (SRec.Attr and faDirectory) = 0 then
  1126. begin
  1127. if FileMatches(SRec.Name, SRec) then
  1128. begin
  1129. AddItem(SRec);
  1130. end;
  1131. end;
  1132. DosError := FindNext(SRec);
  1133. end;
  1134. SysUtils.FindClose(SRec);
  1135. if AddParentDir and (not IsRoot) then
  1136. begin
  1137. AddParentDirItem;
  1138. end;
  1139. // Search for directories:
  1140. DirsCount := 0;
  1141. DosError :=
  1142. FindFirstEx(ApiPath(IncludeTrailingPathDelimiter(FPath) + '*.*'), DirAttrMask, SRec, FIND_FIRST_EX_LARGE_FETCH_PAS);
  1143. while (DosError = 0) and (not AbortLoading) do
  1144. begin
  1145. if (SRec.Name <> '.') and (SRec.Name <> '..') and
  1146. ((Srec.Attr and faDirectory) <> 0) then
  1147. begin
  1148. Inc(DirsCount);
  1149. if FileMatches(SRec.Name, SRec) then
  1150. begin
  1151. AddItem(Srec);
  1152. end;
  1153. end;
  1154. DosError := FindNext(SRec);
  1155. end;
  1156. SysUtils.FindClose(SRec);
  1157. // Update TDriveView's subdir indicator:
  1158. if Assigned(FDriveView) and (FDriveType = DRIVE_REMOTE) and (DirsCount = 0) then
  1159. begin
  1160. FDriveView.DirHasNoChildren(PathName);
  1161. end;
  1162. end; // not isRecycleBin
  1163. end
  1164. else FIsRecycleBin := False;
  1165. finally
  1166. end;
  1167. end;
  1168. procedure TDirView.Reload2;
  1169. type
  1170. PEFileRec = ^TEFileRec;
  1171. TEFileRec = record
  1172. iSize: Int64;
  1173. iAttr: Integer;
  1174. iFileTime: TFileTime;
  1175. iIndex: Integer;
  1176. end;
  1177. var
  1178. Index: Integer;
  1179. EItems: TStringList;
  1180. FItems: TStringList;
  1181. NewItems: TStringList;
  1182. Srec: SysUtils.TSearchRec;
  1183. DosError: Integer;
  1184. PSrec: ^SysUtils.TSearchRec;
  1185. Dummy: Integer;
  1186. ItemIndex: Integer;
  1187. AnyUpdate: Boolean;
  1188. PUpdate: Boolean;
  1189. PEFile: PEFileRec;
  1190. SaveCursor: TCursor;
  1191. FSize: Int64;
  1192. FocusedIsVisible: Boolean;
  1193. begin
  1194. if (not Loading) and LoadEnabled then
  1195. begin
  1196. if IsRecycleBin then Reload(True)
  1197. else
  1198. begin
  1199. if not DirectoryExists(Path) then
  1200. begin
  1201. ClearItems;
  1202. FDirOK := False;
  1203. FDirty := False;
  1204. end
  1205. else
  1206. begin
  1207. FocusedIsVisible := Assigned(ItemFocused) and IsItemVisible(ItemFocused);
  1208. SaveCursor := Screen.Cursor;
  1209. Screen.Cursor := crHourGlass;
  1210. FChangeTimer.Enabled := False;
  1211. FChangeTimer.Interval := 0;
  1212. EItems := TStringlist.Create;
  1213. EItems.CaseSensitive := True; // We want to reflect changes in file name case
  1214. FItems := TStringlist.Create;
  1215. FItems.CaseSensitive := True;
  1216. NewItems := TStringlist.Create;
  1217. PUpdate := False;
  1218. AnyUpdate := False;
  1219. FHiddenCount := 0;
  1220. FFilteredCount := 0;
  1221. try
  1222. // Store existing files and directories:
  1223. for Index := 0 to Items.Count - 1 do
  1224. begin
  1225. New(PEFile);
  1226. var PItem := PFileRec(Items[Index].Data);
  1227. PEFile^.iSize := PItem.Size;
  1228. PEFile^.iAttr := PItem.Attr;
  1229. PEFile^.iFileTime := PItem.FileTime;
  1230. PEFile^.iIndex := Index;
  1231. EItems.AddObject(PItem^.FileName, Pointer(PEFile));
  1232. end;
  1233. EItems.Sort;
  1234. DosError :=
  1235. FindFirstEx(ApiPath(IncludeTrailingPathDelimiter(FPath) + '*.*'), FileAttr, SRec, FIND_FIRST_EX_LARGE_FETCH_PAS);
  1236. while DosError = 0 do
  1237. begin
  1238. if (SRec.Attr and faDirectory) = 0 then
  1239. begin
  1240. if FileMatches(SRec.Name, SRec) then
  1241. begin
  1242. ItemIndex := -1;
  1243. if not EItems.Find(SRec.Name, ItemIndex) then
  1244. begin
  1245. New(PSrec);
  1246. PSRec^ := SRec;
  1247. NewItems.AddObject(SRec.Name, Pointer(PSrec));
  1248. FItems.Add(Srec.Name);
  1249. end
  1250. else
  1251. begin
  1252. FSize := SizeFromSRec(SRec);
  1253. var PEFile2 := PEFileRec(EItems.Objects[ItemIndex]);
  1254. {$WARNINGS OFF}
  1255. if (PEFile2^.iSize <> FSize) or (PEFile2^.iAttr <> SRec.Attr) or
  1256. not CompareMem(@PEFile2^.iFileTime, @SRec.FindData.ftLastWriteTime,
  1257. SizeOf(PEFile2^.iFileTime)) Then
  1258. {$WARNINGS ON}
  1259. begin
  1260. var PItem := PFileRec(Items[PEFile2^.iIndex].Data);
  1261. Dec(FFilesSize, PItem^.Size);
  1262. Inc(FFilesSize, FSize);
  1263. if Items[PEFile2^.iIndex].Selected then
  1264. begin
  1265. Dec(FFilesSelSize, PItem^.Size);
  1266. Inc(FFilesSelSize, FSize);
  1267. end;
  1268. PItem^.Size := FSize;
  1269. PItem^.Attr := SRec.Attr;
  1270. {$WARNINGS OFF}
  1271. PItem^.FileTime := SRec.FindData.ftLastWriteTime;
  1272. {$WARNINGS ON}
  1273. InvalidateItem(Items[PEFile2^.iIndex]);
  1274. AnyUpdate := True;
  1275. end;
  1276. FItems.Add(Srec.Name);
  1277. end;
  1278. end;
  1279. end;
  1280. DosError := FindNext(Srec);
  1281. end;
  1282. SysUtils.FindClose(Srec);
  1283. // Search new directories:
  1284. DosError :=
  1285. FindFirstEx(ApiPath(FPath + '\*.*'), DirAttrMask, SRec, FIND_FIRST_EX_LARGE_FETCH_PAS);
  1286. while DosError = 0 do
  1287. begin
  1288. if (Srec.Attr and faDirectory) <> 0 then
  1289. begin
  1290. if (SRec.Name <> '.') and (SRec.Name <> '..') then
  1291. begin
  1292. if not EItems.Find(SRec.Name, ItemIndex) then
  1293. begin
  1294. if FileMatches(SRec.Name, SRec) then
  1295. begin
  1296. New(PSrec);
  1297. PSrec^ := SRec;
  1298. NewItems.AddObject(Srec.Name, Pointer(PSrec));
  1299. FItems.Add(SRec.Name);
  1300. end;
  1301. end
  1302. else
  1303. begin
  1304. FItems.Add(SRec.Name);
  1305. end;
  1306. end
  1307. else
  1308. begin
  1309. FItems.Add(SRec.Name);
  1310. end;
  1311. end;
  1312. DosError := FindNext(SRec);
  1313. end;
  1314. SysUtils.FindClose(SRec);
  1315. // Check wether displayed Items still exists:
  1316. FItems.Sort;
  1317. for Index := Items.Count - 1 downto 0 do
  1318. begin
  1319. if not FItems.Find(PFileRec(Items[Index].Data)^.FileName, Dummy) then
  1320. begin
  1321. if not PUpdate then
  1322. begin
  1323. PUpdate := True;
  1324. Items.BeginUpdate;
  1325. end;
  1326. AnyUpdate := True;
  1327. Dec(FFilesSize, PFileRec(Items[Index].Data)^.Size);
  1328. // No need to decrease FFilesSelSize here as LVIF_STATE/deselect
  1329. // is called for item being deleted
  1330. Items[Index].Delete;
  1331. end;
  1332. end;
  1333. finally
  1334. try
  1335. for Index := 0 to EItems.Count - 1 do
  1336. Dispose(PEFileRec(EItems.Objects[Index]));
  1337. EItems.Free;
  1338. FItems.Free;
  1339. for Index := 0 to NewItems.Count - 1 do
  1340. begin
  1341. if not PUpdate then
  1342. begin
  1343. PUpdate := True;
  1344. Items.BeginUpdate;
  1345. end;
  1346. AnyUpdate := True;
  1347. PSrec := Pointer(NewItems.Objects[Index]);
  1348. AddItem(PSrec^);
  1349. Dispose(PSrec);
  1350. end;
  1351. NewItems.Free;
  1352. // if we are sorted by name and there were only updates to existing
  1353. // items, there is no need for sorting
  1354. if PUpdate or
  1355. (AnyUpdate and (DirColProperties.SortDirColumn <> dvName)) then
  1356. begin
  1357. SortItems;
  1358. end;
  1359. if PUpdate then
  1360. Items.EndUpdate;
  1361. finally
  1362. FDirOK := True;
  1363. FDirty := false;
  1364. if not FIsRecycleBin then
  1365. StartIconUpdateThread;
  1366. StartWatchThread;
  1367. // make focused item visible, only if it was before
  1368. if FocusedIsVisible and Assigned(ItemFocused) then
  1369. ItemFocused.MakeVisible(False);
  1370. DoUpdateStatusBar;
  1371. Screen.Cursor := SaveCursor;
  1372. end;
  1373. end;
  1374. end;
  1375. if Assigned(FDriveView) then
  1376. begin
  1377. FDriveView.ValidateCurrentDirectoryIfNotMonitoring;
  1378. end;
  1379. end;
  1380. end;
  1381. end;
  1382. procedure TDirView.PerformItemDragDropOperation(Item: TListItem; Effect: Integer; Paste: Boolean);
  1383. var
  1384. TargetPath: string;
  1385. begin
  1386. TargetPath := '';
  1387. if Assigned(Item) then
  1388. begin
  1389. if Assigned(Item.Data) then
  1390. begin
  1391. if ItemIsParentDirectory(Item) then
  1392. TargetPath := ExcludeTrailingPathDelimiter(ExtractFilePath(Path))
  1393. else
  1394. TargetPath := IncludeTrailingPathDelimiter(PathName) + ItemFileName(Item);
  1395. end;
  1396. end
  1397. else
  1398. begin
  1399. TargetPath := PathName;
  1400. end;
  1401. if TargetPath <> '' then
  1402. PerformDragDropFileOperation(TargetPath, Effect);
  1403. end;
  1404. procedure TDirView.ReLoad(CacheIcons: Boolean);
  1405. begin
  1406. if not FLoadEnabled then FDirty := True
  1407. else inherited;
  1408. end;
  1409. function TDirView.GetAttrString(Attr: Integer): string;
  1410. const
  1411. Attrs: array[1..5] of Integer =
  1412. (FILE_ATTRIBUTE_COMPRESSED, FILE_ATTRIBUTE_ARCHIVE,
  1413. FILE_ATTRIBUTE_SYSTEM, FILE_ATTRIBUTE_HIDDEN,
  1414. FILE_ATTRIBUTE_READONLY);
  1415. AttrChars: array[1..5] of Char = ('c', 'a', 's', 'h', 'r');
  1416. var
  1417. Index: Integer;
  1418. LowBound: Integer;
  1419. begin
  1420. Result := '';
  1421. if Attr <> 0 then
  1422. begin
  1423. LowBound := Low(Attrs);
  1424. for Index := LowBound to High(Attrs) do
  1425. if (Attr and Attrs[Index] <> 0) then
  1426. Result := Result + AttrChars[Index]
  1427. else
  1428. Result := Result;
  1429. end;
  1430. end;
  1431. function TDirView.GetFileInfo(
  1432. CanUsePIDL: Boolean; PIDL: PItemIDList; Path: string; CanTimeout: Boolean;
  1433. dwFileAttributes: DWORD; var psfi: TSHFileInfoW; uFlags: UINT): DWORD_PTR;
  1434. var
  1435. pszPath: LPCWSTR;
  1436. cbFileInfo: UINT;
  1437. begin
  1438. cbFileInfo := SizeOf(psfi);
  1439. FillChar(psfi, cbFileInfo, #0);
  1440. if CanUsePIDL and Assigned(PIDL) then
  1441. begin
  1442. pszPath := PChar(PIDL);
  1443. uFlags := uFlags or SHGFI_PIDL;
  1444. end
  1445. else pszPath := PChar(Path);
  1446. // CanTimeout is False in scenarios, where we did not have any reports of hangs, to avoid thread overhead.
  1447. if TimeoutShellIconRetrieval and CanTimeout then
  1448. begin
  1449. Result := SHGetFileInfoWithTimeout(pszPath, dwFileAttributes, psfi, cbFileInfo, uFlags, MSecsPerSec div 4);
  1450. end
  1451. else
  1452. begin
  1453. Result := SHGetFileInfo(pszPath, dwFileAttributes, psfi, cbFileInfo, uFlags);
  1454. end;
  1455. if Result = 0 then
  1456. begin
  1457. psfi.szTypeName[0] := #0;
  1458. psfi.iIcon := 0;
  1459. end;
  1460. end;
  1461. procedure TDirView.DoFetchIcon(
  1462. FilePath: string; IsSpecialExt: Boolean; CanTimeout: Boolean; FileRec: PFileRec; var ImageIndex: Integer; var TypeName: string);
  1463. var
  1464. Eaten: ULONG;
  1465. shAttr: ULONG;
  1466. FileInfo: TShFileInfo;
  1467. ForceByName: Boolean;
  1468. FileIconForName: string;
  1469. begin
  1470. // Fetch the Item FQ-PIDL:
  1471. if not Assigned(FileRec^.PIDL) and IsSpecialExt then
  1472. begin
  1473. try
  1474. ShAttr := 0;
  1475. FDesktopFolder.ParseDisplayName(
  1476. ParentForm.Handle, nil, PChar(FilePath), Eaten, FileRec^.PIDL, ShAttr);
  1477. except
  1478. end;
  1479. end;
  1480. if FileRec^.IsDirectory then
  1481. begin
  1482. if FDriveType = DRIVE_FIXED then
  1483. begin
  1484. try
  1485. // Retrieve icon and typename for the directory
  1486. GetFileInfo(True, FileRec^.PIDL, FilePath, False, 0, FileInfo, SHGFI_TYPENAME or SHGFI_SYSICONINDEX);
  1487. if (FileInfo.iIcon <= 0) or (FileInfo.iIcon > SmallImages.Count) then
  1488. begin
  1489. // Invalid icon returned: retry with access file attribute flag:
  1490. GetFileInfo(
  1491. False, nil, FilePath, False,
  1492. FILE_ATTRIBUTE_DIRECTORY, FileInfo, SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
  1493. end;
  1494. TypeName := FileInfo.szTypeName;
  1495. ImageIndex := FileInfo.iIcon;
  1496. except
  1497. // Capture exceptions generated by the shell
  1498. TypeName := StdDirTypeName;
  1499. ImageIndex := StdDirIcon;
  1500. end;
  1501. end
  1502. else
  1503. begin
  1504. TypeName := StdDirTypeName;
  1505. ImageIndex := StdDirIcon;
  1506. end;
  1507. end
  1508. else
  1509. begin
  1510. // Retrieve icon and typename for the file
  1511. try
  1512. ForceByName := False;
  1513. FileIconForName := FilePath;
  1514. if Assigned(OnFileIconForName) then
  1515. begin
  1516. OnFileIconForName(Self, FileIconForName);
  1517. ForceByName := (FileIconForName <> FilePath);
  1518. end;
  1519. // Files with PIDL are typically .exe files.
  1520. // It may take long to retrieve an icon from exe file.
  1521. // We typically do not get here, now that we have UseIconUpdateThread enabled.
  1522. if GetFileInfo(
  1523. (not ForceByName), FileRec^.PIDL, FileIconForName, CanTimeout, FILE_ATTRIBUTE_NORMAL, FileInfo,
  1524. SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX) = 0 then
  1525. begin
  1526. if Assigned(FileRec^.PIDL) then
  1527. begin
  1528. FileInfo.iIcon := DefaultExeIcon;
  1529. end;
  1530. end;
  1531. TypeName := FileInfo.szTypeName;
  1532. ImageIndex := FileInfo.iIcon;
  1533. except
  1534. // Capture exceptions generated by the shell
  1535. ImageIndex := UnknownFileIcon;
  1536. end;
  1537. end;
  1538. end;
  1539. procedure TDirView.GetDisplayData(Item: TListItem; FetchIcon: Boolean);
  1540. var
  1541. FileInfo: TShFileInfo;
  1542. IsSpecialExt: Boolean;
  1543. FileRec: PFileRec;
  1544. FilePath: string;
  1545. FileAttributes: UINT;
  1546. begin
  1547. Assert(Assigned(Item) and Assigned(Item.Data));
  1548. FileRec := PFileRec(Item.Data);
  1549. IsSpecialExt := MatchesFileExt(FileRec^.FileExt, SpecialExtensions);
  1550. FetchIcon := FileRec^.IconEmpty and (FetchIcon or not IsSpecialExt);
  1551. if FileRec^.Empty or FetchIcon then
  1552. begin
  1553. FilePath := FPath + '\' + FileRec^.FileName;
  1554. if FetchIcon then
  1555. begin
  1556. DoFetchIcon(FilePath, IsSpecialExt, True, FileRec, FileRec^.ImageIndex, FileRec^.TypeName);
  1557. FileRec^.IconEmpty := False;
  1558. if Length(FileRec^.TypeName) = 0 then
  1559. FileRec^.TypeName := Format(STextFileExt, [FileRec^.FileExt]);
  1560. end
  1561. else
  1562. begin
  1563. try
  1564. if FileRec^.IsDirectory then FileAttributes := FILE_ATTRIBUTE_DIRECTORY
  1565. else FileAttributes := FILE_ATTRIBUTE_NORMAL;
  1566. GetFileInfo(
  1567. False, nil, FilePath, False, FileAttributes, FileInfo,
  1568. SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES);
  1569. FileRec^.TypeName := FileInfo.szTypeName;
  1570. except
  1571. // Capture exceptions generated by the shell
  1572. FileRec^.TypeName := '';
  1573. end;
  1574. if FileRec^.IconEmpty then
  1575. begin
  1576. if FileRec^.FileExt = ExeExtension then FileRec^.ImageIndex := DefaultExeIcon
  1577. else FileRec^.ImageIndex := UnknownFileIcon;
  1578. end;
  1579. end;
  1580. FileRec^.Empty := False;
  1581. end;
  1582. end;
  1583. function TDirView.GetDirOK: Boolean;
  1584. begin
  1585. Result := FDirOK;
  1586. end;
  1587. function TDirView.ItemFullFileName(Item: TListItem): string;
  1588. begin
  1589. if Assigned(Item) and Assigned(Item.Data) then
  1590. begin
  1591. if not IsRecycleBin then
  1592. begin
  1593. if PFileRec(Item.Data)^.IsParentDir then
  1594. begin
  1595. Result := ExcludeTrailingBackslash(ExtractFilePath(FPath));
  1596. end
  1597. else
  1598. begin
  1599. Result := FPath + '\' + PFileRec(Item.Data)^.FileName;
  1600. end;
  1601. end
  1602. else
  1603. Result := PFileRec(Item.Data)^.FileName;
  1604. end
  1605. else
  1606. Result := EmptyStr;
  1607. end;
  1608. function TDirView.ItemFileNameOnly(Item: TListItem): string;
  1609. begin
  1610. Assert(Assigned(Item) and Assigned(Item.Data));
  1611. Result := PFileRec(Item.Data)^.FileName;
  1612. SetLength(Result, Length(Result) - Length(ItemFileExt(Item)));
  1613. end;
  1614. function TDirView.ItemFileExt(Item: TListItem): string;
  1615. begin
  1616. Assert(Assigned(Item) and Assigned(Item.Data));
  1617. Result := ExtractFileExt(PFileRec(Item.Data)^.FileName);
  1618. end;
  1619. function CompareFileType(I1, I2: TListItem; P1, P2: PFileRec): Integer;
  1620. var
  1621. Key1, Key2: string;
  1622. begin
  1623. if P1.Empty then TDirView(I1.ListView).GetDisplayData(I1, False);
  1624. if P2.Empty then TDirView(I2.ListView).GetDisplayData(I2, False);
  1625. if P1.IsDirectory then
  1626. begin
  1627. Key1 := P1.TypeName + ' ' + P1.DisplayName;
  1628. Key2 := P2.TypeName + ' ' + P2.DisplayName;
  1629. end
  1630. else
  1631. begin
  1632. Key1 := P1.TypeName + ' ' + P1.FileExt + ' ' + P1.DisplayName;
  1633. Key2 := P2.TypeName + ' ' + P2.FileExt + ' ' + P2.DisplayName;
  1634. end;
  1635. Result := CompareLogicalTextPas(Key1, Key2, TDirView(I1.ListView).NaturalOrderNumericalSorting);
  1636. end;
  1637. function CompareFileTime(P1, P2: PFileRec): Integer;
  1638. var
  1639. Time1, Time2: Int64;
  1640. begin
  1641. Time1 := Int64(P1.FileTime.dwHighDateTime) shl 32 + P1.FileTime.dwLowDateTime;
  1642. Time2 := Int64(P2.FileTime.dwHighDateTime) shl 32 + P2.FileTime.dwLowDateTime;
  1643. if Time1 < Time2 then Result := -1
  1644. else
  1645. if Time1 > Time2 then Result := 1
  1646. else Result := 0; // fallback
  1647. end;
  1648. function GetItemFileSize(P: PFileRec): Int64; inline;
  1649. begin
  1650. Result := 0;
  1651. if P.Size >= 0 then Result := P.Size
  1652. else
  1653. if P.CalculatedSize >= 0 then Result := P.CalculatedSize;
  1654. end;
  1655. function CompareFile(I1, I2: TListItem; AOwner: TDirView): Integer; stdcall;
  1656. var
  1657. ConsiderDirection: Boolean;
  1658. P1, P2: PFileRec;
  1659. begin
  1660. ConsiderDirection := True;
  1661. if I1 = I2 then Result := 0
  1662. else
  1663. if I1 = nil then Result := -1
  1664. else
  1665. if I2 = nil then Result := 1
  1666. else
  1667. begin
  1668. P1 := PFileRec(I1.Data);
  1669. P2 := PFileRec(I2.Data);
  1670. if P1.isParentDir then
  1671. begin
  1672. Result := -1;
  1673. ConsiderDirection := False;
  1674. end
  1675. else
  1676. if P2.isParentDir then
  1677. begin
  1678. Result := 1;
  1679. ConsiderDirection := False;
  1680. end
  1681. else
  1682. // Directories should always appear "grouped":
  1683. if P1.isDirectory <> P2.isDirectory then
  1684. begin
  1685. if P1.isDirectory then
  1686. begin
  1687. Result := -1;
  1688. ConsiderDirection := False;
  1689. end
  1690. else
  1691. begin
  1692. Result := 1;
  1693. ConsiderDirection := False;
  1694. end;
  1695. end
  1696. else
  1697. begin
  1698. Result := 0;
  1699. if P1.isDirectory and AOwner.AlwaysSortDirectoriesByName then
  1700. begin
  1701. // fallback
  1702. end
  1703. else
  1704. begin
  1705. case AOwner.DirColProperties.SortDirColumn of
  1706. dvName:
  1707. ; // fallback
  1708. dvSize:
  1709. if GetItemFileSize(P1) < GetItemFileSize(P2) then Result := -1
  1710. else
  1711. if GetItemFileSize(P1) > GetItemFileSize(P2) then Result := 1
  1712. else ; // fallback
  1713. dvType:
  1714. Result := CompareFileType(I1, I2, P1, P2);
  1715. dvChanged:
  1716. Result := CompareFileTime(P1, P2);
  1717. dvAttr:
  1718. if P1.Attr < P2.Attr then Result := -1
  1719. else
  1720. if P1.Attr > P2.Attr then Result := 1
  1721. else ; // fallback
  1722. dvExt:
  1723. if not P1.isDirectory then
  1724. begin
  1725. Result := CompareLogicalTextPas(
  1726. P1.FileExt + ' ' + P1.DisplayName, P2.FileExt + ' ' + P2.DisplayName,
  1727. AOwner.NaturalOrderNumericalSorting);
  1728. end
  1729. else ; //fallback
  1730. else
  1731. ; // fallback
  1732. end;
  1733. end;
  1734. if Result = 0 then
  1735. begin
  1736. Result := CompareLogicalTextPas(P1.DisplayName, P2.DisplayName, AOwner.NaturalOrderNumericalSorting)
  1737. end;
  1738. end;
  1739. end;
  1740. if ConsiderDirection and (not AOwner.SortAscending) then
  1741. begin
  1742. Result := -Result;
  1743. end;
  1744. end;
  1745. procedure TDirView.SortItems;
  1746. begin
  1747. if HandleAllocated then
  1748. begin
  1749. StopIconUpdateThread;
  1750. try
  1751. CustomSortItems(@CompareFile);
  1752. finally
  1753. if (not Loading) then
  1754. StartIconUpdateThread;
  1755. end;
  1756. end
  1757. end;
  1758. procedure TDirView.ValidateFile(Item : TListItem);
  1759. var
  1760. Index: Integer;
  1761. begin
  1762. if Assigned(Item) and Assigned(Item.Data) then
  1763. begin
  1764. Index := Item.Index;
  1765. if not FileExists(ApiPath(ItemFullFileName(Items[Index]))) then
  1766. begin
  1767. Item.Delete;
  1768. end;
  1769. end;
  1770. end;
  1771. procedure TDirView.ValidateFile(FileName: TFileName);
  1772. var
  1773. FilePath: string;
  1774. begin
  1775. FilePath := ExcludeTrailingPathDelimiter(ExtractFilePath(FileName));
  1776. if IsRecycleBin then ValidateFile(FindFileItem(FileName))
  1777. else
  1778. if FilePath = Path then
  1779. ValidateFile(FindFileItem(ExtractFileName(FileName)));
  1780. end;
  1781. procedure TDirView.ValidateSelectedFiles;
  1782. var
  1783. FileList: TStrings;
  1784. i: Integer;
  1785. ToDelete: Boolean;
  1786. Updating: Boolean;
  1787. Updated: Boolean;
  1788. Item: TListItem;
  1789. begin
  1790. if SelCount > 50 then Reload2
  1791. else
  1792. begin
  1793. Updating := False;
  1794. Updated := False;
  1795. FileList := CustomCreateFileList(True, False, True, nil, True);
  1796. try
  1797. for i := 0 to FileList.Count - 1 do
  1798. begin
  1799. Item := TListItem(FileList.Objects[i]);
  1800. if ItemIsDirectory(Item) then
  1801. ToDelete := not DirectoryExists(ApiPath(FileList[i]))
  1802. else
  1803. ToDelete := not FileExists(ApiPath(FileList[i]));
  1804. if ToDelete then
  1805. begin
  1806. if (SelCount > 10) and (not Updating) then
  1807. begin
  1808. Items.BeginUpdate;
  1809. Updating := True;
  1810. end;
  1811. Dec(FFilesSize, PFileRec(Item.Data)^.Size);
  1812. // No need to decrease FFilesSelSize here as LVIF_STATE/deselect
  1813. // is called for item being deleted
  1814. Item.Delete;
  1815. Updated := True;
  1816. end;
  1817. end;
  1818. finally
  1819. if Updating then
  1820. Items.EndUpdate;
  1821. if Updated then
  1822. DoUpdateStatusBar;
  1823. FileList.Free;
  1824. end;
  1825. end;
  1826. end;
  1827. procedure TDirView.CreateDirectory(DirName: string);
  1828. var
  1829. SRec: SysUtils.TSearchRec;
  1830. Item: TListItem;
  1831. begin
  1832. // keep absolute path as is
  1833. if ExtractFileDrive(DirName) = '' then
  1834. DirName := Path + '\' + DirName;
  1835. if WatchForChanges then StopWatchThread;
  1836. if Assigned(FDriveView) then
  1837. FDriveView.StopWatchThread;
  1838. StopIconUpdateThread;
  1839. try
  1840. // create the physical directory:
  1841. Win32Check(Windows.CreateDirectory(PChar(ApiPath(DirName)), nil));
  1842. if IncludeTrailingBackslash(ExtractFilePath(ExpandFileName(DirName))) =
  1843. IncludeTrailingBackslash(Path) then
  1844. begin
  1845. // Create the TListItem:
  1846. if FindFirst(ApiPath(DirName), faAnyFile, SRec) = 0 then
  1847. begin
  1848. Item := AddItem(SRec);
  1849. ItemFocused := FindFileItem(GetFileRec(Item.Index)^.FileName);
  1850. SortItems;
  1851. if Assigned(ItemFocused) then
  1852. begin
  1853. ItemFocused.MakeVisible(False);
  1854. end;
  1855. end;
  1856. FindClose(SRec);
  1857. end;
  1858. finally
  1859. StartIconUpdateThread;
  1860. if WatchForChanges then StartWatchThread;
  1861. if Assigned(DriveView) then
  1862. begin
  1863. if Assigned(DriveView.Selected) then
  1864. DriveView.ValidateDirectory(DriveView.Selected);
  1865. FDriveView.StartWatchThread;
  1866. end;
  1867. end;
  1868. end;
  1869. procedure TDirView.DisplayContextMenu(Where: TPoint);
  1870. var
  1871. FileList: TStringList;
  1872. Index: Integer;
  1873. Item: TListItem;
  1874. DefDir: string;
  1875. Verb: string;
  1876. PIDLArray: PPIDLArray;
  1877. Count: Integer;
  1878. DiffSelectedPath: Boolean;
  1879. WithEdit: Boolean;
  1880. PIDLRel: PItemIDList;
  1881. PIDLPath: PItemIDList;
  1882. Handled: Boolean;
  1883. begin
  1884. GetDir(0, DefDir);
  1885. ChDir(PathName);
  1886. Verb := EmptyStr;
  1887. StopWatchThread;
  1888. try
  1889. try
  1890. if Assigned(OnContextPopup) then
  1891. begin
  1892. Handled := False;
  1893. OnContextPopup(Self, ScreenToClient(Where), Handled);
  1894. if Handled then Abort;
  1895. end;
  1896. if (MarkedCount > 1) and
  1897. ((not Assigned(ItemFocused)) or ItemFocused.Selected) then
  1898. begin
  1899. if FIsRecycleBin then
  1900. begin
  1901. Count := 0;
  1902. GetMem(PIDLArray, SizeOf(PItemIDList) * SelCount);
  1903. try
  1904. FillChar(PIDLArray^, Sizeof(PItemIDList) * SelCount, #0);
  1905. for Index := Selected.Index to Items.Count - 1 do
  1906. if Items[Index].Selected then
  1907. begin
  1908. PIDL_GetRelative(PFileRec(Items[Index].Data)^.PIDL, PIDLPath, PIDLRel);
  1909. FreePIDL(PIDLPath);
  1910. PIDLArray^[Count] := PIDLRel;
  1911. Inc(Count);
  1912. end;
  1913. try
  1914. ShellDisplayContextMenu(ParentForm.Handle, Where, iRecycleFolder, Count,
  1915. PidlArray^[0], False, Verb, False);
  1916. finally
  1917. for Index := 0 to Count - 1 do
  1918. FreePIDL(PIDLArray[Index]);
  1919. end;
  1920. finally
  1921. FreeMem(PIDLArray, Count);
  1922. end;
  1923. end
  1924. else
  1925. begin
  1926. FileList := TStringList.Create;
  1927. CreateFileList(False, True, FileList);
  1928. for Index := 0 to FileList.Count - 1 do
  1929. FileList[Index] := ExtractFileName(FileList[Index]);
  1930. ShellDisplayContextMenu(ParentForm.Handle, Where, PathName,
  1931. FileList, Verb, False);
  1932. FileList.Destroy;
  1933. end;
  1934. // ------------ Cut -----------
  1935. if Verb = shcCut then
  1936. begin
  1937. ClearCutState;
  1938. // Set property cut to TRUE for all selected items:
  1939. Item := GetNextItem(nil, sdAll, [isSelected]);
  1940. while Assigned(Item) do
  1941. begin
  1942. Item.Cut := True;
  1943. FAnyCut := True;
  1944. Item := GetNextItem(Item, sdAll, [isSelected]);
  1945. end;
  1946. end
  1947. else
  1948. // ----------- Copy -----------
  1949. if Verb = shcCopy then
  1950. begin
  1951. ClearCutState;
  1952. end
  1953. else
  1954. // ----------- Paste ----------
  1955. if Verb = shcPaste then
  1956. PasteFromClipBoard(ItemFullFileName(Selected))
  1957. else
  1958. if not FIsRecycleBin then Reload2;
  1959. end
  1960. else
  1961. if Assigned(ItemFocused) and Assigned(ItemFocused.Data) then
  1962. begin
  1963. Verb := EmptyStr;
  1964. WithEdit := not FIsRecycleBin and CanEdit(ItemFocused);
  1965. LoadEnabled := True;
  1966. if FIsRecycleBin then
  1967. begin
  1968. PIDL_GetRelative(PFileRec(ItemFocused.Data)^.PIDL, PIDLPath, PIDLRel);
  1969. ShellDisplayContextMenu(ParentForm.Handle, Where,
  1970. iRecycleFolder, 1, PIDLRel, False, Verb, False);
  1971. FreePIDL(PIDLRel);
  1972. FreePIDL(PIDLPath);
  1973. end
  1974. else
  1975. begin
  1976. ShellDisplayContextMenu(ParentForm.Handle, Where,
  1977. ItemFullFileName(ItemFocused), WithEdit, Verb,
  1978. not PFileRec(ItemFocused.Data)^.isDirectory);
  1979. LoadEnabled := True;
  1980. end;
  1981. // ---------- Rename ----------
  1982. if Verb = shcRename then ItemFocused.EditCaption
  1983. else
  1984. // ------------ Cut -----------
  1985. if Verb = shcCut then
  1986. begin
  1987. ClearCutState;
  1988. ItemFocused.Cut := True;
  1989. FAnyCut := True;
  1990. end
  1991. else
  1992. // ----------- Copy -----------
  1993. if Verb = shcCopy then
  1994. begin
  1995. ClearCutState;
  1996. end
  1997. else
  1998. // ----------- Paste ----------
  1999. if Verb = shcPaste then
  2000. begin
  2001. if PFileRec(ItemFocused.Data)^.IsDirectory then
  2002. PasteFromClipBoard(ItemFullFileName(ItemFocused));
  2003. end
  2004. else
  2005. if not FIsRecycleBin then Reload2;
  2006. end;
  2007. finally
  2008. ChDir(DefDir);
  2009. end;
  2010. if IsRecycleBin and (Verb <> shcCut) and (Verb <> shcProperties) and (SelCount > 0) then
  2011. begin
  2012. DiffSelectedPath := False;
  2013. for Index := Selected.Index to Items.Count - 1 do
  2014. if ExtractFilePath(PFileRec(Items[Index].Data)^.FileName) <> FPath + '\' then
  2015. begin
  2016. DiffSelectedPath := True;
  2017. Break;
  2018. end;
  2019. if DiffSelectedPath then
  2020. begin
  2021. StartFileDeleteThread;
  2022. Exit;
  2023. end;
  2024. end;
  2025. Sleep(250);
  2026. ValidateSelectedFiles;
  2027. finally
  2028. StartWatchThread;
  2029. end;
  2030. end;
  2031. procedure TDirView.GetDisplayInfo(ListItem: TListItem;
  2032. var DispInfo: TLVItem);
  2033. var
  2034. Value: string;
  2035. ASize: Int64;
  2036. FetchIcon: Boolean;
  2037. begin
  2038. Assert(Assigned(ListItem) and Assigned(ListItem.Data));
  2039. var PItem := PFileRec(ListItem.Data);
  2040. // Fetch display data of current file:
  2041. if PItem^.Empty then
  2042. begin
  2043. FetchIcon :=
  2044. PItem^.IconEmpty and
  2045. (not FUseIconUpdateThread or (ViewStyle <> vsReport));
  2046. GetDisplayData(ListItem, FetchIcon);
  2047. end;
  2048. if PItem^.IconEmpty and
  2049. (not FUseIconUpdateThread or
  2050. (ViewStyle <> vsReport)) and
  2051. ((DispInfo.mask and LVIF_IMAGE) <> 0) then
  2052. GetDisplayData(ListItem, True);
  2053. // Set IconUpdatethread :
  2054. if PItem^.IconEmpty and UseIconUpdateThread and (not FIsRecycleBin) then
  2055. begin
  2056. IconUpdateEnqueue(ListItem);
  2057. end;
  2058. if (DispInfo.Mask and LVIF_TEXT) <> 0 then
  2059. begin
  2060. Value := '';
  2061. if DispInfo.iSubItem = 0 then Value := PItem^.DisplayName
  2062. else
  2063. if DispInfo.iSubItem < DirViewColumns then
  2064. begin
  2065. case TDirViewCol(DispInfo.iSubItem) of
  2066. dvSize:
  2067. begin
  2068. if not PItem^.IsDirectory then ASize := PItem^.Size
  2069. else ASize := PItem^.CalculatedSize;
  2070. if ASize >= 0 then Value := FormatPanelBytes(ASize, FormatSizeBytes);
  2071. end;
  2072. dvType:
  2073. Value := PItem^.TypeName;
  2074. dvChanged:
  2075. // Keep consistent with UserModificationStr
  2076. Value := FormatDateTime('ddddd tt', FileTimeToDateTime(PItem^.FileTime));
  2077. dvAttr:
  2078. Value := GetAttrString(PItem^.Attr);
  2079. dvExt:
  2080. Value := PItem^.FileExt;
  2081. end
  2082. end;
  2083. StrPLCopy(DispInfo.pszText, Value, DispInfo.cchTextMax - 1);
  2084. end;
  2085. // Set display icon of current file:
  2086. if (DispInfo.iSubItem = 0) and ((DispInfo.mask and LVIF_IMAGE) <> 0) then
  2087. begin
  2088. DispInfo.iImage := PItem^.ImageIndex;
  2089. DispInfo.mask := DispInfo.mask or LVIF_DI_SETITEM;
  2090. end;
  2091. end;
  2092. function TDirView.ItemColor(Item: TListItem): TColor;
  2093. begin
  2094. if PFileRec(Item.Data).Attr and FILE_ATTRIBUTE_COMPRESSED <> 0 then
  2095. begin
  2096. if SupportsDarkMode and DarkMode then Result := clSkyBlue
  2097. else Result := clBlue;
  2098. end
  2099. else
  2100. if DimmHiddenFiles and not Item.Selected and
  2101. (PFileRec(Item.Data).Attr and FILE_ATTRIBUTE_HIDDEN <> 0) then
  2102. Result := clGrayText
  2103. else
  2104. Result := clDefaultItemColor;
  2105. end;
  2106. function TDirView.ItemThumbnail(Item: TListItem; Size: TSize): TBitmap;
  2107. var
  2108. ItemData: PFileRec;
  2109. begin
  2110. if not UseIconUpdateThread then
  2111. begin
  2112. // not supported without update thread
  2113. Result := nil;
  2114. end
  2115. else
  2116. begin
  2117. ItemData := PFileRec(Item.Data);
  2118. if (not Assigned(ItemData.Thumbnail)) or
  2119. (ItemData.ThumbnailSize <> Size) then
  2120. begin
  2121. FreeAndNil(ItemData.Thumbnail);
  2122. ItemData.ThumbnailSize := Size;
  2123. Result := nil;
  2124. IconUpdateEnqueue(Item);
  2125. end
  2126. else
  2127. begin
  2128. Result := ItemData.Thumbnail;
  2129. end;
  2130. end;
  2131. end;
  2132. procedure TDirView.StartFileDeleteThread;
  2133. var
  2134. Files: TStringList;
  2135. begin
  2136. Files := TStringList.Create;
  2137. try
  2138. CreateFileList(False, True, Files);
  2139. TFileDeleteThread.Create(Files, MaxWaitTimeOut, SignalFileDelete);
  2140. finally
  2141. Files.Free;
  2142. end;
  2143. end;
  2144. procedure TDirView.IconUpdateEnqueue(ListItem: TListItem);
  2145. var
  2146. Schedule: TIconUpdateSchedule;
  2147. begin
  2148. if not FIconUpdateSet.ContainsKey(ListItem.Index) then
  2149. begin
  2150. FIconUpdateSet.Add(ListItem.Index, False);
  2151. Schedule.Index := ListItem.Index;
  2152. FIconUpdateQueue.Enqueue(Schedule);
  2153. Assert(FIconUpdateSet.Count = FIconUpdateQueue.Count + FIconUpdateQueueDeferred.Count);
  2154. end;
  2155. StartIconUpdateThread;
  2156. end;
  2157. function TDirView.IconUpdatePeek: Integer;
  2158. begin
  2159. if FIconUpdateQueue.Count > 0 then
  2160. Result := FIconUpdateQueue.Peek.Index
  2161. else if FIconUpdateQueueDeferred.Count > 0 then
  2162. Result := FIconUpdateQueueDeferred.Peek.Index
  2163. else
  2164. Result := -1;
  2165. end;
  2166. procedure TDirView.IconUpdateDequeue;
  2167. begin
  2168. if FIconUpdateQueue.Count > 0 then
  2169. FIconUpdateQueue.Dequeue
  2170. else
  2171. FIconUpdateQueueDeferred.Dequeue;
  2172. FIconUpdateSet.Remove(FIconUpdateThread.FCurrentIndex);
  2173. Assert(FIconUpdateSet.Count = FIconUpdateQueue.Count + FIconUpdateQueueDeferred.Count);
  2174. end;
  2175. function TDirView.ThumbnailNeeded(ItemData: PFileRec): Boolean;
  2176. begin
  2177. Result := (not Assigned(ItemData.Thumbnail)) and (ItemData.ThumbnailSize <> ThumbnailNotNeeded);
  2178. end;
  2179. procedure TDirView.DoFetchIconUpdate;
  2180. var
  2181. Item: TListItem;
  2182. ItemData: PFileRec;
  2183. Invisible: Boolean;
  2184. begin
  2185. FIconUpdateThread.FCurrentIndex := IconUpdatePeek;
  2186. if FIconUpdateThread.FCurrentIndex < 0 then
  2187. begin
  2188. FIconUpdateThread.Suspend;
  2189. end
  2190. else
  2191. begin
  2192. // We could loop here until we find a valid item, but we want to release the GUI thread frequently
  2193. if FIconUpdateThread.FCurrentIndex >= Items.Count then
  2194. begin
  2195. FIconUpdateThread.FCurrentIndex := -1;
  2196. IconUpdateDequeue;
  2197. end
  2198. else
  2199. begin
  2200. Item := Items[FIconUpdateThread.FCurrentIndex];
  2201. Assert(Assigned(Item));
  2202. Assert(Assigned(Item.Data));
  2203. ItemData := PFileRec(Item.Data);
  2204. Invisible := not IsItemVisible(Item);
  2205. if (Invisible or (not FThumbnail)) and
  2206. (not Assigned(ItemData.Thumbnail)) then
  2207. begin
  2208. ItemData.ThumbnailSize := ThumbnailNotNeeded; // not needed anymore
  2209. end;
  2210. // Deprioritizing unvisible item taken from priority queue.
  2211. // As we ask Window to cache the image index (LVIF_DI_SETITEM), we won't get asked again,
  2212. // so we have to retrieve the image eventually (but not thumbnail)
  2213. if (FIconUpdateQueue.Count > 0) and
  2214. Invisible then
  2215. begin
  2216. Assert(not ThumbnailNeeded(ItemData));
  2217. if ItemData.IconEmpty then
  2218. begin
  2219. FIconUpdateQueueDeferred.Enqueue(FIconUpdateQueue.Dequeue);
  2220. end
  2221. else
  2222. begin
  2223. IconUpdateDequeue;
  2224. end;
  2225. FIconUpdateThread.FCurrentIndex := -1;
  2226. end
  2227. else
  2228. begin
  2229. if ItemData.IconEmpty or
  2230. ThumbnailNeeded(ItemData) then
  2231. begin
  2232. FIconUpdateThread.FCurrentFilePath := ItemFullFileName(Item);
  2233. FIconUpdateThread.FCurrentItemData := ItemData^;
  2234. end
  2235. else
  2236. begin
  2237. IconUpdateDequeue;
  2238. FIconUpdateThread.FCurrentIndex := -1;
  2239. end;
  2240. end;
  2241. end;
  2242. end;
  2243. end;
  2244. procedure TDirView.DoUpdateIcon;
  2245. var
  2246. Item: TListItem;
  2247. ItemData: PFileRec;
  2248. LVI: TLVItem;
  2249. begin
  2250. // otherwise just throw away the resolved icon and let this or future background thread
  2251. // retry with the same or different item the next time
  2252. if (not Loading) and
  2253. (not FIconUpdateThread.Terminated) and
  2254. (FIconUpdateThread.FCurrentIndex = IconUpdatePeek) then
  2255. begin
  2256. IconUpdateDequeue;
  2257. if (FIconUpdateThread.FCurrentIndex >= 0) and
  2258. (FIconUpdateThread.FCurrentIndex < Items.Count) then
  2259. begin
  2260. Item := Items[FIconUpdateThread.FCurrentIndex];
  2261. if FIconUpdateThread.FCurrentFilePath = ItemFullFileName(Item) then
  2262. begin
  2263. Assert(Assigned(Item));
  2264. Assert(Assigned(Item.Data));
  2265. ItemData := PFileRec(Item.Data);
  2266. if (FIconUpdateThread.FSyncIcon >= 0) and (ItemData^.ImageIndex <> FIconUpdateThread.FSyncIcon) then
  2267. begin
  2268. ItemData^.ImageIndex := FIconUpdateThread.FSyncIcon;
  2269. if not FIconUpdateThread.Terminated then
  2270. begin
  2271. // To avoid flickering of the display use ListView_SetItem
  2272. // instead of using the property ImageIndex:
  2273. LVI.mask := LVIF_IMAGE;
  2274. LVI.iItem := FIconUpdateThread.FCurrentIndex;
  2275. LVI.iSubItem := 0;
  2276. LVI.iImage := I_IMAGECALLBACK;
  2277. ListView_SetItem(Handle, LVI);
  2278. end;
  2279. end;
  2280. ItemData^.IconEmpty := False;
  2281. if Assigned(FIconUpdateThread.FSyncThumbnail) then
  2282. begin
  2283. ItemData^.Thumbnail := FIconUpdateThread.FSyncThumbnail;
  2284. FIconUpdateThread.FSyncThumbnail := nil;
  2285. // It can happen that this is called while the very item is being painted,
  2286. // (particularly ImageFactory.GetImage pumps the queue).
  2287. // Calling InvalidateRect directly would get ignored then.
  2288. PostMessage(WindowHandle, WM_USER_INVALIDATEITEM, Item.Index, 0);
  2289. end;
  2290. end;
  2291. end;
  2292. end;
  2293. end;
  2294. procedure TDirView.StartIconUpdateThread;
  2295. begin
  2296. if DirOK and UseIconUpdateThread then
  2297. begin
  2298. if not Assigned(FIconUpdateThread) then
  2299. FIconUpdateThread := TIconUpdateThread.Create(Self);
  2300. FIconUpdateThread.Resume;
  2301. end;
  2302. end;
  2303. procedure TDirView.StopIconUpdateThread;
  2304. begin
  2305. if Assigned(FIconUpdateThread) then
  2306. begin
  2307. FIconUpdateThread.Terminate;
  2308. FIconUpdateThread.Priority := tpHigher;
  2309. if FIconUpdateThread.Suspended then
  2310. FIconUpdateThread.Resume;
  2311. if not FIconUpdateThread.WaitFor(MSecsPerSec div 4) then
  2312. begin
  2313. // This prevents Destroy from waiting for (stalled) thread
  2314. FIconUpdateThread.Suspend;
  2315. end;
  2316. FreeAndNil(FIconUpdateThread);
  2317. end;
  2318. end;
  2319. procedure TDirView.StopWatchThread;
  2320. begin
  2321. if Assigned(FDiscMonitor) then
  2322. begin
  2323. FDiscMonitor.Enabled := False;
  2324. end;
  2325. end;
  2326. procedure TDirView.StartWatchThread;
  2327. begin
  2328. if (Length(Path) > 0) and WatchForChanges and DirOK then
  2329. begin
  2330. if not Assigned(FDiscMonitor) then
  2331. begin
  2332. FDiscMonitor := TDiscMonitor.Create(Self);
  2333. FDiscMonitor.ChangeDelay := msThreadChangeDelay;
  2334. FDiscMonitor.SubTree := False;
  2335. FDiscMonitor.Filters := [moDirName, moFileName, moSize, moAttributes, moLastWrite];
  2336. FDiscMonitor.SetDirectory(PathName);
  2337. FDiscMonitor.OnChange := ChangeDetected;
  2338. FDiscMonitor.OnInvalid := ChangeInvalid;
  2339. FDiscMonitor.Open;
  2340. end
  2341. else
  2342. begin
  2343. FDiscMonitor.SetDirectory(PathName);
  2344. FDiscMonitor.Enabled := True;
  2345. end;
  2346. end;
  2347. end;
  2348. procedure TDirView.TimerOnTimer(Sender: TObject);
  2349. begin
  2350. if not Loading then
  2351. begin
  2352. // fix by MP: disable timer and reload directory before call to event
  2353. FChangeTimer.Enabled := False;
  2354. FChangeTimer.Interval := 0;
  2355. Reload2;
  2356. end;
  2357. end;
  2358. procedure TDirView.ChangeDetected(Sender: TObject; const Directory: string;
  2359. var SubdirsChanged: Boolean);
  2360. begin
  2361. // avoid prolonging the actual update with each change, as if continous change
  2362. // is occuring in current directory, the panel will never be updated
  2363. if not FChangeTimer.Enabled then
  2364. begin
  2365. FDirty := True;
  2366. FChangeTimer.Interval := FChangeInterval;
  2367. FChangeTimer.Enabled := True;
  2368. end;
  2369. end;
  2370. procedure TDirView.ChangeInvalid(Sender: TObject; const Directory: string;
  2371. const ErrorStr: string);
  2372. begin
  2373. FDiscMonitor.Close;
  2374. end;
  2375. function TDirView.WatchThreadActive: Boolean;
  2376. begin
  2377. Result := WatchForChanges and Assigned(FDiscMonitor) and
  2378. FDiscMonitor.Active and FDiscMonitor.Enabled;
  2379. end;
  2380. procedure TDirView.SetChangeInterval(Value: Cardinal);
  2381. begin
  2382. if Value > 0 then
  2383. begin
  2384. FChangeInterval := Value;
  2385. FChangeTimer.Interval := Value;
  2386. end;
  2387. end;
  2388. procedure TDirView.SetDirColProperties(Value: TDirViewColProperties);
  2389. begin
  2390. if Value <> ColProperties then
  2391. ColProperties := Value;
  2392. end;
  2393. function TDirView.GetDirColProperties: TDirViewColProperties;
  2394. begin
  2395. Result := TDirViewColProperties(ColProperties);
  2396. end;
  2397. procedure TDirView.SetWatchForChanges(Value: Boolean);
  2398. begin
  2399. if WatchForChanges <> Value then
  2400. begin
  2401. FWatchForChanges := Value;
  2402. if not (csDesigning in ComponentState) then
  2403. begin
  2404. if Value then StartWatchThread
  2405. else StopWatchThread;
  2406. end;
  2407. end;
  2408. end;
  2409. procedure TDirView.DisplayPropertiesMenu;
  2410. var
  2411. FileList: TStringList;
  2412. Index: Integer;
  2413. PIDLRel: PItemIDList;
  2414. PIDLPath: PItemIDList;
  2415. begin
  2416. if not Assigned(ItemFocused) then
  2417. ShellExecuteContextCommand(ParentForm.Handle, shcProperties, PathName)
  2418. else
  2419. if (not IsRecycleBin) and (MarkedCount > 1) and ItemFocused.Selected then
  2420. begin
  2421. FileList := TStringList.Create;
  2422. try
  2423. CreateFileList(False, True, FileList);
  2424. for Index := 0 to Pred(FileList.Count) do
  2425. FileList[Index] := ExtractFileName(FileList[Index]);
  2426. ShellExecuteContextCommand(ParentForm.Handle, shcProperties,
  2427. PathName, FileList);
  2428. finally
  2429. FileList.Free;
  2430. end;
  2431. end
  2432. else
  2433. if Assigned(ItemFocused.Data) then
  2434. begin
  2435. if IsRecycleBin then
  2436. begin
  2437. if Assigned(PFileRec(ItemFocused.Data)^.PIDL) then
  2438. begin
  2439. PIDL_GetRelative(PFileRec(ItemFocused.Data)^.PIDL, PIDLPath, PIDLRel);
  2440. ShellExecuteContextCommand(ParentForm.Handle, shcProperties, iRecycleFolder, 1, PIDLRel);
  2441. FreePIDL(PIDLRel);
  2442. FreePIDL(PIDLPath);
  2443. end;
  2444. end
  2445. else
  2446. ShellExecuteContextCommand(ParentForm.Handle, shcProperties,
  2447. ItemFullFileName(ItemFocused));
  2448. end;
  2449. end;
  2450. procedure TDirView.ExecuteFile(Item: TListItem);
  2451. var
  2452. DefDir: string;
  2453. FileName: string;
  2454. begin
  2455. if (UpperCase(PFileRec(Item.Data)^.FileExt) = 'LNK') or
  2456. PFileRec(Item.Data)^.IsDirectory then
  2457. begin
  2458. if PFileRec(Item.Data)^.IsDirectory then
  2459. begin
  2460. FileName := ItemFullFileName(Item);
  2461. end
  2462. else
  2463. FileName := ResolveFileShortCut(ItemFullFileName(Item), True);
  2464. // Don't check link target existence, if is does not exist, let it fail later, so that an error message is shown
  2465. if DirectoryExistsFix(FileName, False) then
  2466. begin
  2467. Path := FileName;
  2468. Exit;
  2469. end
  2470. else
  2471. if not FileExistsFix(ApiPath(FileName)) then
  2472. begin
  2473. Exit;
  2474. end;
  2475. end;
  2476. GetDir(0, DefDir);
  2477. ChDir(PathName);
  2478. try
  2479. ShellExecuteContextCommand(ParentForm.Handle, shcDefault,
  2480. ItemFullFileName(Item));
  2481. finally
  2482. ChDir(DefDir);
  2483. end;
  2484. end;
  2485. procedure TDirView.ExecuteDrive(Drive: string);
  2486. var
  2487. APath: string;
  2488. DriveRoot: string;
  2489. begin
  2490. if Assigned(FLastPath) and FLastPath.ContainsKey(Drive) then
  2491. begin
  2492. APath := FLastPath[Drive];
  2493. if not DirectoryExists(ApiPath(APath)) then
  2494. begin
  2495. if DriveInfo.IsRealDrive(Drive) then
  2496. APath := Format('%s:', [Drive])
  2497. else
  2498. APath := Drive;
  2499. end;
  2500. end
  2501. else
  2502. begin
  2503. if DriveInfo.IsRealDrive(Drive) then
  2504. begin
  2505. GetDir(Integer(Drive[1]) - Integer('A') + 1, APath);
  2506. DriveRoot := DriveInfo.GetDriveRoot(Drive);
  2507. // When the drive is not valid, the GetDir returns the current drive working directory, detect that,
  2508. // and let it fail later when trying to open root of the invalid drive.
  2509. // (maybe GetLongPathName would not have that side effect?)
  2510. if not StartsText(DriveRoot, APath) then
  2511. APath := DriveRoot;
  2512. APath := ExcludeTrailingPathDelimiter(APath);
  2513. end
  2514. else
  2515. begin
  2516. APath := Drive;
  2517. end;
  2518. end;
  2519. if Path <> APath then
  2520. Path := APath;
  2521. end;
  2522. procedure TDirView.ExecuteHomeDirectory;
  2523. begin
  2524. Path := HomeDirectory;
  2525. end;
  2526. procedure TDirView.ExecuteParentDirectory;
  2527. begin
  2528. if Valid then
  2529. begin
  2530. if Assigned(DriveView) and Assigned(DriveView.Selected) then
  2531. begin
  2532. DriveView.Selected := DriveView.Selected.Parent
  2533. end
  2534. else
  2535. begin
  2536. Path := ExtractFilePath(Path);
  2537. end;
  2538. end;
  2539. end;
  2540. procedure TDirView.ExecuteRootDirectory;
  2541. begin
  2542. if Valid then
  2543. begin
  2544. FNotRelative := True;
  2545. try
  2546. Path := ExtractFileDrive(Path);
  2547. finally
  2548. FNotRelative := False;
  2549. end;
  2550. end;
  2551. end;
  2552. procedure TDirView.Delete(Item: TListItem);
  2553. begin
  2554. if Assigned(Item) and Assigned(Item.Data) and not (csRecreating in ControlState) then
  2555. begin
  2556. var PItem := PFileRec(Item.Data);
  2557. SetLength(PItem.FileName, 0);
  2558. SetLength(PItem.TypeName, 0);
  2559. SetLength(PItem.DisplayName, 0);
  2560. if Assigned(PItem.PIDL) then FreePIDL(PItem.PIDL);
  2561. FreeAndNil(PItem.Thumbnail);
  2562. Dispose(PFileRec(Item.Data));
  2563. Item.Data := nil;
  2564. end;
  2565. inherited Delete(Item);
  2566. end;
  2567. procedure TDirView.InternalEdit(const HItem: TLVItem);
  2568. var
  2569. Item: TListItem;
  2570. Info: string;
  2571. NewCaption: string;
  2572. IsDirectory: Boolean;
  2573. begin
  2574. Item := GetItemFromHItem(HItem);
  2575. IsDirectory := DirectoryExists(ItemFullFileName(Item));
  2576. NewCaption := HItem.pszText;
  2577. StopWatchThread;
  2578. if IsDirectory and Assigned(FDriveView) then
  2579. FDriveView.StopWatchThread;
  2580. FFileOperator.Flags := FileOperatorDefaultFlags + [foNoConfirmation];
  2581. FFileOperator.Operation := foRename;
  2582. FFileOperator.OperandFrom.Clear;
  2583. FFileOperator.OperandTo.Clear;
  2584. FFileOperator.OperandFrom.Add(ItemFullFileName(Item));
  2585. FFileOperator.OperandTo.Add(FPath + '\' + HItem.pszText);
  2586. try
  2587. var PItem := GetFileRec(Item.Index);
  2588. if FFileOperator.Execute then
  2589. begin
  2590. if IsDirectory and Assigned(FDriveView) then
  2591. if Assigned(FDriveView.Selected) then
  2592. FDriveView.ValidateDirectory(FDriveView.Selected);
  2593. PItem^.Empty := True;
  2594. PItem^.IconEmpty := True;
  2595. PItem^.FileName := NewCaption;
  2596. PItem^.DisplayName := PItem^.FileName;
  2597. PItem^.FileExt := UpperCase(ExtractFileExt(HItem.pszText));
  2598. PItem^.FileExt := Copy(PItem^.FileExt, 2, Length(PItem^.FileExt) - 1);
  2599. PItem^.TypeName := EmptyStr;
  2600. if Assigned(PItem^.PIDL) then
  2601. FreePIDL(PItem^.PIDL);
  2602. GetDisplayData(Item, True);
  2603. ResetItemImage(Item.Index);
  2604. UpdateItems(Item.Index, Item.Index);
  2605. if Assigned(OnEdited) then OnEdited(Self, Item, NewCaption);
  2606. if Item <> nil then Item.Caption := NewCaption;
  2607. SortItems;
  2608. if Assigned(ItemFocused) then ItemFocused.MakeVisible(False);
  2609. end
  2610. else
  2611. begin
  2612. Item.Caption := PItem^.FileName;
  2613. Item.Update;
  2614. if FileOrDirExists(IncludeTrailingPathDelimiter(FPath) + HItem.pszText) then
  2615. Info := SErrorRenameFileExists + HItem.pszText
  2616. else
  2617. Info := SErrorRenameFile + HItem.pszText;
  2618. MessageBeep(MB_ICONHAND);
  2619. if MessageDlg(FormatLastOSError(Info), mtError, [mbOK, mbAbort], 0) = mrOK then
  2620. RetryRename(HItem.pszText);
  2621. end;
  2622. finally
  2623. Sleep(0);
  2624. LoadEnabled := True;
  2625. if FWatchForChanges and (not WatchThreadActive) then
  2626. StartWatchThread;
  2627. if Assigned(FDriveView) then
  2628. FDriveView.StartWatchThread;
  2629. end;
  2630. end;
  2631. function TDirView.ItemFileName(Item: TListItem): string;
  2632. begin
  2633. if Assigned(Item) and Assigned(Item.Data) then
  2634. Result := ExtractFileName(PFileRec(Item.Data)^.FileName)
  2635. else
  2636. Result := '';
  2637. end;
  2638. function TDirView.ItemFileSize(Item: TListItem): Int64;
  2639. begin
  2640. Result := 0;
  2641. if Assigned(Item) and Assigned(Item.Data) then
  2642. Result := GetItemFileSize(PFileRec(Item.Data));
  2643. end;
  2644. function TDirView.ItemFileTime(Item: TListItem;
  2645. var Precision: TDateTimePrecision): TDateTime;
  2646. begin
  2647. Result := FileTimeToDateTime(PFileRec(Item.Data)^.FileTime);
  2648. Precision := tpMillisecond;
  2649. end;
  2650. function TDirView.ItemImageIndex(Item: TListItem;
  2651. Cache: Boolean): Integer;
  2652. begin
  2653. if Assigned(Item) and Assigned(Item.Data) then
  2654. begin
  2655. if PFileRec(Item.Data)^.IconEmpty then
  2656. begin
  2657. if Cache then Result := -1
  2658. else Result := UnknownFileIcon;
  2659. end
  2660. else
  2661. begin
  2662. if (not Cache) or MatchesFileExt(PFileRec(Item.Data)^.FileExt, SpecialExtensions) then
  2663. Result := PFileRec(Item.Data)^.ImageIndex
  2664. else
  2665. Result := -1
  2666. end;
  2667. end
  2668. else Result := -1;
  2669. end;
  2670. procedure TDirView.Notification(AComponent: TComponent; Operation: TOperation);
  2671. begin
  2672. inherited Notification(AComponent, Operation);
  2673. if (Operation = opRemove) and (AComponent = FDriveView) then
  2674. FDriveView := nil;
  2675. end;
  2676. procedure TDirView.ReloadDirectory;
  2677. begin
  2678. Reload(True);
  2679. end;
  2680. procedure TDirView.ResetItemImage(Index: Integer);
  2681. var
  2682. LVI: TLVItem;
  2683. begin
  2684. // Update imageindex:
  2685. LVI.mask := LVIF_STATE or LVIF_DI_SETITEM or LVIF_IMAGE;
  2686. LVI.iItem := Index;
  2687. LVI.iSubItem := 0;
  2688. if ListView_GetItem(Handle, LVI) then
  2689. begin
  2690. LVI.iImage := I_IMAGECALLBACK;
  2691. LVI.mask := LVI.mask and (not LVIF_DI_SETITEM);
  2692. ListView_SetItem(Handle, LVI);
  2693. end;
  2694. end;
  2695. // Drag&Drop handling
  2696. procedure TDirView.SignalFileDelete(Sender: TObject; Files: TStringList);
  2697. // Called by TFileDeleteThread, when a file was deleted by the Drag&Drop target window:
  2698. var
  2699. Index: Integer;
  2700. begin
  2701. if Files.Count > 0 then
  2702. for Index := 0 to Files.Count - 1 do
  2703. ValidateFile(Files[Index]);
  2704. end;
  2705. procedure TDirView.DDMenuPopup(Sender: TObject; AMenu: HMenu; DataObj: IDataObject;
  2706. AMinCustCmd: Integer; grfKeyState: Longint; pt: TPoint);
  2707. begin
  2708. if Assigned(FDriveView) then
  2709. begin
  2710. // When a change is detected while menu is popped up
  2711. // it loses focus (or something similar)
  2712. // preventing it from handling subsequent click.
  2713. // This typically happens when right-dragging from remote to local panel,
  2714. // what causes temp directory being created+deleted.
  2715. // This is HACK, we should implement some uniform watch disabling/enabling
  2716. FDriveView.SuspendChangeTimer;
  2717. end;
  2718. inherited;
  2719. end;
  2720. procedure TDirView.DDMenuDone(Sender: TObject; AMenu: HMenu);
  2721. begin
  2722. if not WatchThreadActive then
  2723. begin
  2724. FChangeTimer.Interval := Min(FChangeInterval * 2, 3000);
  2725. FChangeTimer.Enabled := True;
  2726. end;
  2727. if Assigned(FDriveView) then
  2728. begin
  2729. FDriveView.ResumeChangeTimer;
  2730. end;
  2731. inherited;
  2732. end;
  2733. procedure TDirView.DDDropHandlerSucceeded(Sender: TObject; grfKeyState: Longint;
  2734. Point: TPoint; dwEffect: Longint);
  2735. begin
  2736. // Not sure why is this here. There's no "disable" counterparty.
  2737. if not WatchThreadActive then
  2738. begin
  2739. FChangeTimer.Interval := FChangeInterval;
  2740. FChangeTimer.Enabled := True;
  2741. end;
  2742. inherited;
  2743. end;
  2744. procedure TDirView.AddToDragFileList(FileList: TFileList; Item: TListItem);
  2745. begin
  2746. Assert(Assigned(Item));
  2747. if IsRecycleBin then
  2748. begin
  2749. if Assigned(Item.Data) then
  2750. begin
  2751. if UpperCase(ExtractFileExt(PFileRec(Item.Data)^.DisplayName)) =
  2752. ('.' + PFileRec(Item.Data)^.FileExt) then
  2753. FileList.AddItemEx(PFileRec(Item.Data)^.PIDL,
  2754. ItemFullFileName(Item), PFileRec(Item.Data)^.DisplayName)
  2755. else
  2756. FileList.AddItemEx(PFileRec(Item.Data)^.PIDL,
  2757. ItemFullFileName(Item), PFileRec(Item.Data)^.DisplayName +
  2758. ExtractFileExt(PFileRec(Item.Data)^.FileName));
  2759. end;
  2760. end
  2761. else inherited;
  2762. end;
  2763. procedure TDirView.DDDragDetect(grfKeyState: Longint; DetectStart, Point: TPoint;
  2764. DragStatus: TDragDetectStatus);
  2765. var
  2766. WasWatchThreadActive: Boolean;
  2767. begin
  2768. if (DragStatus = ddsDrag) and (MarkedCount > 0) then
  2769. begin
  2770. WasWatchThreadActive := WatchThreadActive;
  2771. inherited;
  2772. if (LastDDResult = drMove) and (not WasWatchThreadActive) then
  2773. StartFileDeleteThread;
  2774. end;
  2775. end;
  2776. procedure TDirView.DDChooseEffect(grfKeyState: Integer; var dwEffect: Integer; PreferredEffect: Integer);
  2777. begin
  2778. if DragDropFilesEx.OwnerIsSource and
  2779. (dwEffect = DROPEFFECT_COPY) and (not Assigned(DropTarget)) then
  2780. begin
  2781. dwEffect := DROPEFFECT_NONE
  2782. end
  2783. else
  2784. if (grfKeyState and (MK_CONTROL or MK_SHIFT) = 0) and (PreferredEffect = 0) then
  2785. begin
  2786. if FDragDrive <> '' then
  2787. begin
  2788. if ExeDrag and DriveInfo.IsFixedDrive(DriveInfo.GetDriveKey(Path)) and DriveInfo.IsFixedDrive(FDragDrive) then
  2789. begin
  2790. dwEffect := DROPEFFECT_LINK;
  2791. end
  2792. else
  2793. begin
  2794. if DragOnDriveIsMove and
  2795. (not DDOwnerIsSource or Assigned(DropTarget)) and
  2796. ((SameText(FDragDrive, DriveInfo.GetDriveKey(Path)) and (dwEffect = DROPEFFECT_COPY) and
  2797. (DragDropFilesEx.AvailableDropEffects and DROPEFFECT_MOVE <> 0))
  2798. or IsRecycleBin) then
  2799. begin
  2800. dwEffect := DROPEFFECT_MOVE;
  2801. end;
  2802. end;
  2803. end;
  2804. end;
  2805. inherited;
  2806. end;
  2807. procedure TDirView.PerformDragDropFileOperation(TargetPath: string; Effect: Integer);
  2808. var
  2809. Index: Integer;
  2810. SourcePath: string;
  2811. OldCursor: TCursor;
  2812. OldWatchForChanges: Boolean;
  2813. IsRecycleBin: Boolean;
  2814. SourceIsDirectory: Boolean;
  2815. Node: TTreeNode;
  2816. begin
  2817. if DragDropFilesEx.FileList.Count > 0 then
  2818. begin
  2819. if not DirectoryExists(TargetPath) then
  2820. begin
  2821. Reload(True);
  2822. DDError(DDPathNotFoundError);
  2823. end
  2824. else
  2825. begin
  2826. IsRecycleBin := Self.IsRecycleBin or
  2827. ((DropTarget <> nil) and ItemIsRecycleBin(DropTarget));
  2828. if not (DragDropFilesEx.FileNamesAreMapped and IsRecycleBin) then
  2829. begin
  2830. OldCursor := Screen.Cursor;
  2831. OldWatchForChanges := WatchForChanges;
  2832. SourceIsDirectory := True;
  2833. SourcePath := EmptyStr;
  2834. try
  2835. Screen.Cursor := crHourGlass;
  2836. WatchForChanges := False;
  2837. if Effect in [DROPEFFECT_COPY, DROPEFFECT_MOVE] then
  2838. begin
  2839. StopWatchThread;
  2840. if Assigned(DriveView) then
  2841. DriveView.StopWatchThread;
  2842. if (DropSourceControl <> Self) and
  2843. (DropSourceControl is TDirView) then
  2844. TDirView(DropSourceControl).StopWatchThread;
  2845. if DropFiles(
  2846. DragDropFilesEx, Effect, FFileOperator, TargetPath, IsRecycleBin,
  2847. ConfirmDelete, ConfirmOverwrite,
  2848. Self, OnDDFileOperation, SourcePath, SourceIsDirectory) then
  2849. begin
  2850. ReLoad2;
  2851. if Assigned(OnDDFileOperationExecuted) then
  2852. OnDDFileOperationExecuted(Self, Effect, SourcePath, TargetPath);
  2853. end;
  2854. end
  2855. else
  2856. if Effect = DROPEFFECT_LINK then
  2857. (* Create Link requested: *)
  2858. begin
  2859. StopWatchThread;
  2860. for Index := 0 to DragDropFilesEx.FileList.Count - 1 do
  2861. begin
  2862. if not DropLink(PFDDListItem(DragDropFilesEx.FileList[Index]), TargetPath) then
  2863. begin
  2864. DDError(DDCreateShortCutError);
  2865. end;
  2866. end;
  2867. ReLoad2;
  2868. end;
  2869. if Assigned(DropSourceControl) and
  2870. (DropSourceControl is TDirView) and
  2871. (DropSourceControl <> Self) and
  2872. (Effect = DROPEFFECT_MOVE) then
  2873. begin
  2874. TDirView(DropSourceControl).ValidateSelectedFiles;
  2875. end;
  2876. if Assigned(FDriveView) and SourceIsDirectory then
  2877. begin
  2878. try
  2879. FDriveView.ValidateDirectory(FDriveView.FindNodeToPath(TargetPath));
  2880. except
  2881. end;
  2882. if (Effect = DROPEFFECT_MOVE) or IsRecycleBin then
  2883. try
  2884. Node := FDriveView.TryFindNodeToPath(SourcePath);
  2885. // If the path is not even in the tree, do not bother.
  2886. // This is particularly for dragging from remote folder, when the source path in %TEMP% and
  2887. // calling ValidateDirectory would load whole TEMP (and typically also "C:\Users")
  2888. if Assigned(Node) then
  2889. begin
  2890. if Assigned(Node.Parent) then
  2891. Node := Node.Parent;
  2892. FDriveView.ValidateDirectory(Node);
  2893. end;
  2894. except
  2895. end;
  2896. end;
  2897. finally
  2898. FFileOperator.OperandFrom.Clear;
  2899. FFileOperator.OperandTo.Clear;
  2900. if Assigned(FDriveView) then
  2901. FDriveView.StartWatchThread;
  2902. Sleep(0);
  2903. WatchForChanges := OldWatchForChanges;
  2904. if (DropSourceControl <> Self) and (DropSourceControl is TDirView) then
  2905. TDirView(DropSourceControl).StartWatchThread;
  2906. Screen.Cursor := OldCursor;
  2907. end;
  2908. end;
  2909. end;
  2910. end;
  2911. end;
  2912. procedure TDirView.DDError(ErrorNo: TDDError);
  2913. begin
  2914. if Assigned(OnDDError) then OnDDError(Self, ErrorNo)
  2915. else
  2916. raise EDragDrop.Create(Format(SDragDropError, [Ord(ErrorNo)]));
  2917. end;
  2918. procedure TDirView.ClearCutState;
  2919. begin
  2920. // This is all far from perfect, as the clipboard can change for number of other reasons.
  2921. // We should better monitor the clipboard changes (the way we do in TImportSessionsDialog).
  2922. // But at least as long as the cutting is not our native feature, but can only happen indirectly via shell's menu,
  2923. // it's good enough.
  2924. if FAnyCut then
  2925. begin
  2926. var Item := GetNextItem(nil, sdAll, [isCut]);
  2927. while Assigned(Item) do
  2928. begin
  2929. Item.Cut := False;
  2930. Item := GetNextItem(Item, sdAll, [isCut]);
  2931. end;
  2932. FAnyCut := False;
  2933. end;
  2934. if Assigned(FDriveView) then
  2935. begin
  2936. FDriveView.EmptyClipboardIfCut;
  2937. end;
  2938. end;
  2939. procedure TDirView.EmptyClipboard;
  2940. begin
  2941. if Windows.OpenClipBoard(0) then
  2942. begin
  2943. Windows.EmptyClipBoard;
  2944. Windows.CloseClipBoard;
  2945. ClearCutState;
  2946. end;
  2947. end;
  2948. function TDirView.DoCopyToClipboard(Focused: Boolean; Cut: Boolean; Operation: TClipBoardOperation): Boolean;
  2949. var
  2950. Item: TListItem;
  2951. SaveCursor: TCursor;
  2952. begin
  2953. SaveCursor := Screen.Cursor;
  2954. Screen.Cursor := crHourGlass;
  2955. try
  2956. Result := False;
  2957. EmptyClipBoard;
  2958. DragDropFilesEx.FileList.Clear;
  2959. if OperateOnFocusedFile(Focused) or (SelCount > 0) then
  2960. begin
  2961. if OperateOnFocusedFile(Focused) then
  2962. begin
  2963. DragDropFilesEx.FileList.AddItem(nil, ItemFullFileName(ItemFocused));
  2964. end
  2965. else
  2966. begin
  2967. Item := GetNextItem(nil, sdAll, [isSelected]);
  2968. while Assigned(Item) do
  2969. begin
  2970. DragDropFilesEx.FileList.AddItem(nil, ItemFullFileName(Item));
  2971. Item.Cut := Cut;
  2972. Item := GetNextItem(Item, sdAll, [isSelected]);
  2973. end;
  2974. end;
  2975. Result := DragDropFilesEx.CopyToClipBoard;
  2976. end;
  2977. finally
  2978. Screen.Cursor := SaveCursor;
  2979. end;
  2980. end;
  2981. function TDirView.CopyToClipBoard(Focused: Boolean): Boolean;
  2982. begin
  2983. Result := DoCopyToClipboard(Focused, False, cboCopy);
  2984. end;
  2985. function TDirView.CutToClipBoard(Focused: Boolean): Boolean;
  2986. begin
  2987. Result := DoCopyToClipboard(Focused, True, cboCut);
  2988. end;
  2989. function TDirView.PasteFromClipBoard(TargetPath: string): Boolean;
  2990. var
  2991. Effect: LongInt;
  2992. begin
  2993. DragDropFilesEx.FileList.Clear;
  2994. Result := CanPasteFromClipBoard and DragDropFilesEx.GetFromClipBoard(Effect);
  2995. if Result then
  2996. begin
  2997. if TargetPath = '' then
  2998. TargetPath := PathName;
  2999. PerformDragDropFileOperation(TargetPath, Effect);
  3000. if Assigned(OnDDExecuted) then OnDDExecuted(Self, Effect);
  3001. end;
  3002. end;
  3003. function TDirView.DragCompleteFileList: Boolean;
  3004. begin
  3005. Result := inherited DragCompleteFileList and
  3006. (FDriveType <> DRIVE_REMOVABLE);
  3007. end;
  3008. function TDirView.NewColProperties: TCustomListViewColProperties;
  3009. begin
  3010. Result := TDirViewColProperties.Create(Self);
  3011. end;
  3012. function TDirView.SortAscendingByDefault(Index: Integer): Boolean;
  3013. begin
  3014. Result := not (TDirViewCol(Index) in [dvSize, dvChanged]);
  3015. end;
  3016. procedure TDirView.SetItemImageIndex(Item: TListItem; Index: Integer);
  3017. begin
  3018. Assert(Assigned(Item));
  3019. var PItem := PFileRec(Item.Data);
  3020. if Assigned(PItem) then
  3021. begin
  3022. PItem^.ImageIndex := Index;
  3023. PItem^.IconEmpty := (Index < 0);
  3024. end;
  3025. end;
  3026. procedure TDirView.SetItemCalculatedSize(Item: TListItem; ASize: Int64);
  3027. var
  3028. OldSize: Int64;
  3029. begin
  3030. Assert(Assigned(Item) and Assigned(Item.Data));
  3031. var PItem := PFileRec(Item.Data);
  3032. OldSize := PItem^.CalculatedSize;
  3033. PItem^.CalculatedSize := ASize;
  3034. ItemCalculatedSizeUpdated(Item, OldSize, ASize);
  3035. end;
  3036. // =================================================================
  3037. initialization
  3038. DaylightHack := (not IsWin7);
  3039. end.