DirView.pas 102 KB

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