DirView.pas 101 KB

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