DirView.pas 101 KB

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