DirView.pas 102 KB

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