DirView.pas 101 KB

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