DirView.pas 102 KB

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