DirView.pas 100 KB

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