DirView.pas 101 KB

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