DirView.pas 102 KB

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