DirView.pas 100 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429
  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.ProgressTitle := coFileOperatorTitle;
  738. FFileOperator.Flags := [foAllowUndo, foNoConfirmMkDir];
  739. FDirOK := True;
  740. FPath := '';
  741. FDiscMonitor := nil;
  742. {ChangeTimer: }
  743. if FChangeInterval = 0 then FChangeInterval := MSecsPerSec;
  744. FChangeTimer := TTimer.Create(Self);
  745. FChangeTimer.Interval := FChangeInterval;
  746. FChangeTimer.Enabled := False;
  747. FChangeTimer.OnTimer := TimerOnTimer;
  748. {Drag&drop:}
  749. FConfirmOverwrite := True;
  750. DDLinkOnExeDrag := True;
  751. with DragDropFilesEx do
  752. begin
  753. SourceEffects := DragSourceEffects;
  754. TargetEffects := [deCopy, deMove, deLink];
  755. ShellExtensions.DragDropHandler := True;
  756. ShellExtensions.DropHandler := True;
  757. end;
  758. FLastPath := nil;
  759. end; {Create}
  760. destructor TDirView.Destroy;
  761. begin
  762. if Assigned(PIDLRecycle) then FreePIDL(PIDLRecycle);
  763. FLastPath.Free;
  764. FInfoCacheList.Free;
  765. FFileOperator.Free;
  766. FChangeTimer.Free;
  767. inherited Destroy;
  768. FPath := '';
  769. end; {Destroy}
  770. procedure TDirView.WMDestroy(var Msg: TWMDestroy);
  771. begin
  772. Selected := nil;
  773. ClearItems;
  774. TerminateThreads;
  775. inherited;
  776. end; {WMDestroy}
  777. procedure TDirView.CMRecreateWnd(var Message: TMessage);
  778. begin
  779. // see comment in TDirView.StopIconUpdateThread
  780. if not (csRecreating in ControlState) then
  781. begin
  782. inherited;
  783. end;
  784. end;
  785. procedure TDirView.TerminateThreads;
  786. begin
  787. StopIconUpdateThread;
  788. StopWatchThread;
  789. if Assigned(FDiscMonitor) then
  790. begin
  791. FDiscMonitor.Free;
  792. FDiscMonitor := nil;
  793. end;
  794. end; {TerminateThreads}
  795. function TDirView.GetHomeDirectory: string;
  796. begin
  797. if FHomeDirectory <> '' then Result := FHomeDirectory
  798. else
  799. begin
  800. Result := UserDocumentDirectory;
  801. // in rare case the CSIDL_PERSONAL cannot be resolved
  802. if Result = '' then
  803. begin
  804. Result := DriveInfo.AnyValidPath;
  805. end;
  806. end;
  807. end; { GetHomeDirectory }
  808. function TDirView.GetIsRoot: Boolean;
  809. begin
  810. Result := IsRootPath(Path);
  811. end;
  812. function TDirView.GetPath: string;
  813. begin
  814. Result := FPath;
  815. end;
  816. procedure TDirView.PathChanged;
  817. var
  818. Expanded: string;
  819. begin
  820. inherited;
  821. // make sure to use PathName as Path maybe just X: what
  822. // ExpandFileName resolves to current working directory
  823. // on the drive, not to root path
  824. Expanded := ExpandFileName(PathName);
  825. if not Assigned(FLastPath) then
  826. begin
  827. FLastPath := TDictionary<string, string>.Create;
  828. end;
  829. FLastPath.AddOrSetValue(DriveInfo.GetDriveKey(Expanded), Expanded);
  830. end;
  831. procedure TDirView.SetPath(Value: string);
  832. begin
  833. // do checks before passing directory to drive view, because
  834. // it would truncate non-existing directory to first superior existing
  835. Value := ReplaceStr(Value, '/', '\');
  836. CheckCanOpenDirectory(Value);
  837. if Assigned(FDriveView) and
  838. (FDriveView.Directory <> Value) then
  839. begin
  840. FDriveView.Directory := Value;
  841. end
  842. else
  843. if FPath <> Value then
  844. try
  845. while ExcludeTrailingPathDelimiter(Value) <> Value do
  846. begin
  847. Value := ExcludeTrailingPathDelimiter(Value);
  848. end;
  849. PathChanging(not FNotRelative);
  850. FPath := Value;
  851. Load(True);
  852. finally
  853. PathChanged;
  854. end;
  855. end;
  856. procedure TDirView.SetLoadEnabled(Value: Boolean);
  857. begin
  858. if Value <> LoadEnabled then
  859. begin
  860. FLoadEnabled := Enabled;
  861. if LoadEnabled and Dirty then
  862. begin
  863. if Items.Count > 100 then Reload2
  864. else Reload(True);
  865. end;
  866. end;
  867. end; {SetLoadEnabled}
  868. function TDirView.GetPathName: string;
  869. begin
  870. if IsRoot then Result := IncludeTrailingBackslash(Path)
  871. else Result := Path;
  872. end; {GetPathName}
  873. function TDirView.GetFileRec(Index: Integer): PFileRec;
  874. begin
  875. if Index > Pred(Items.Count) then Result := nil
  876. else Result := Items[index].Data;
  877. end; {GetFileRec}
  878. function TDirView.HiddenCount: Integer;
  879. begin
  880. Result := FHiddenCount;
  881. end;
  882. function TDirView.FilteredCount: Integer;
  883. begin
  884. Result := FFilteredCount;
  885. end;
  886. function TDirView.AddItem(SRec: SysUtils.TSearchRec): TListItem;
  887. var
  888. PItem: PFileRec;
  889. Item: TListItem;
  890. begin
  891. Item := TListItem.Create(Items);
  892. New(PItem);
  893. with PItem^ do
  894. begin
  895. // must be set as soon as possible, at least before Caption is set,
  896. // because if come column is "autosized" setting Caption invokes some callbacks
  897. Item.Data := PItem;
  898. FileName := SRec.Name;
  899. FileExt := UpperCase(ExtractFileExt(Srec.Name));
  900. FileExt := Copy(FileExt, 2, Length(FileExt) - 1);
  901. DisplayName := FileName;
  902. {$WARNINGS OFF}
  903. Attr := SRec.FindData.dwFileAttributes;
  904. {$WARNINGS ON}
  905. IsParentDir := False;
  906. IsDirectory := ((Attr and SysUtils.faDirectory) <> 0);
  907. IsRecycleBin := IsDirectory and (Length(Path) = 2) and
  908. Bool(Attr and SysUtils.faSysFile) and
  909. ((UpperCase(FileName) = 'RECYCLED') or (UpperCase(FileName) = 'RECYCLER'));
  910. if not IsDirectory then Size := SizeFromSRec(SRec)
  911. else Size := -1;
  912. {$WARNINGS OFF}
  913. FileTime := SRec.FindData.ftLastWriteTime;
  914. {$WARNINGS ON}
  915. Empty := True;
  916. IconEmpty := True;
  917. if Size > 0 then Inc(FFilesSize, Size);
  918. PIDL := nil;
  919. // Need to add before assigning to .Caption and .OverlayIndex,
  920. // as the setters these call back to owning view.
  921. // Assignment is redundant
  922. Item := Items.AddItem(Item);
  923. if not Self.IsRecycleBin then Item.Caption := SRec.Name;
  924. if FileExt = 'LNK' then Item.OverlayIndex := 1;
  925. end;
  926. if SelectNewFiles then Item.Selected := True;
  927. Result := Item;
  928. end; {AddItem}
  929. procedure TDirView.AddParentDirItem;
  930. var
  931. PItem: PFileRec;
  932. Item: TListItem;
  933. SRec: SysUtils.TSearchRec;
  934. begin
  935. FHasParentDir := True;
  936. Item := Items.Add;
  937. New(PItem);
  938. if FindFirst(ApiPath(FPath), faAnyFile, SRec) = 0 then
  939. FindClose(SRec);
  940. with PItem^ do
  941. begin
  942. Item.Data := PItem;
  943. FileName := '..';
  944. FileExt := '';
  945. DisplayName := '..';
  946. Attr := SRec.Attr;
  947. IsDirectory := True;
  948. IsRecycleBin := False;
  949. IsParentDir := True;
  950. Size := -1;
  951. Item.Caption := '..';
  952. {$WARNINGS OFF}
  953. FileTime := SRec.FindData.ftLastWriteTime;
  954. {$WARNINGS ON}
  955. Empty := True;
  956. IconEmpty := False;
  957. PIDL := nil;
  958. ImageIndex := StdDirIcon;
  959. TypeName := SParentDir;
  960. Empty := False;
  961. end;
  962. end; {AddParentDirItem}
  963. procedure TDirView.LoadFromRecycleBin(Dir: string);
  964. var
  965. PIDLRecycleLocal: PItemIDList;
  966. PCurrList: PItemIDList;
  967. FQPIDL: PItemIDList;
  968. EnumList: IEnumIDList;
  969. Fetched: ULONG;
  970. SRec: SysUtils.TSearchRec;
  971. DisplayName: string;
  972. FullPath: string;
  973. NewItem: TListItem;
  974. FileRec: PFileRec;
  975. FileInfo: TSHFileInfo;
  976. DosError: Integer;
  977. begin
  978. if not Assigned(iRecycleFolder) then
  979. begin
  980. PIDLRecycleLocal := nil;
  981. try
  982. OLECheck(SHGetSpecialFolderLocation(Self.Handle,
  983. CSIDL_BITBUCKET, PIDLRecycleLocal));
  984. PIDLRecycle := PIDL_Concatenate(nil, PIDLRecycleLocal);
  985. if not SUCCEEDED(FDesktopFolder.BindToObject(PIDLRecycle, nil,
  986. IID_IShellFolder, Pointer(iRecycleFolder))) then Exit;
  987. finally
  988. if Assigned(PIDLRecycleLocal) then
  989. FreePIDL(PIDLRecycleLocal);
  990. end;
  991. end;
  992. FParentFolder := iRecycleFolder;
  993. if AddParentDir then AddParentDirItem;
  994. FHiddenCount := 0;
  995. FFilteredCount := 0;
  996. if SUCCEEDED(iRecycleFolder.EnumObjects(Self.Handle,
  997. SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN, EnumList)) then
  998. begin
  999. while (EnumList.Next(1, PCurrList, Fetched) = S_OK) and not AbortLoading do
  1000. begin
  1001. if Assigned(PCurrList) then
  1002. try
  1003. FQPIDL := PIDL_Concatenate(PIDLRecycle, PCurrList);
  1004. {Physical filename:}
  1005. SetLength(FullPath, MAX_PATH);
  1006. if shGetPathFromIDList(FQPIDL, PChar(FullPath)) then
  1007. SetLength(FullPath, StrLen(PChar(FullPath)));
  1008. {Filesize, attributes and -date:}
  1009. DosError := FindFirst(ApiPath(FullPath), faAnyFile, SRec);
  1010. FindClose(Srec);
  1011. SRec.Name := ExtractFilePath(FullPath) + SRec.Name;
  1012. {Displayname:}
  1013. GetShellDisplayName(iRecycleFolder, PCurrList, SHGDN_FORPARSING, DisplayName);
  1014. if (DosError = 0) and
  1015. (((SRec.Attr and faDirectory) <> 0) or
  1016. FileMatches(DisplayName, SRec)) then
  1017. begin
  1018. {Filetype and icon:}
  1019. SHGetFileInfo(PChar(FQPIDL), 0, FileInfo, SizeOf(FileInfo),
  1020. SHGFI_PIDL or SHGFI_TYPENAME or SHGFI_SYSICONINDEX);
  1021. NewItem := AddItem(Srec);
  1022. NewItem.Caption := DisplayName;
  1023. FileRec := NewItem.Data;
  1024. FileRec^.Empty := False;
  1025. FileRec^.IconEmpty := False;
  1026. FileRec^.DisplayName := DisplayName;
  1027. FileRec^.PIDL := FQPIDL;
  1028. FileRec^.TypeName := FileInfo.szTypeName;
  1029. if FileRec^.Typename = EmptyStr then
  1030. FileRec^.TypeName := Format(STextFileExt, [FileRec.FileExt]);
  1031. FileRec^.ImageIndex := FileInfo.iIcon;
  1032. end
  1033. else
  1034. begin
  1035. FreePIDL(FQPIDL);
  1036. end;
  1037. FreePIDL(PCurrList);
  1038. except
  1039. if Assigned(PCurrList) then
  1040. try
  1041. FreePIDL(PCurrList);
  1042. except
  1043. end;
  1044. end;
  1045. end; {While EnumList ...}
  1046. end;
  1047. end; {LoadFromRecycleBin}
  1048. function TDirView.GetShellFolder(Dir: string): iShellFolder;
  1049. var
  1050. Eaten: ULONG;
  1051. Attr: ULONG;
  1052. NewPIDL: PItemIDList;
  1053. begin
  1054. Result := nil;
  1055. if not Assigned(FDesktopFolder) then
  1056. SHGetDesktopFolder(FDesktopFolder);
  1057. if Assigned(FDesktopFolder) then
  1058. begin
  1059. Attr := 0;
  1060. if Succeeded(FDesktopFolder.ParseDisplayName(
  1061. ParentForm.Handle, nil, PChar(Dir), Eaten, NewPIDL, Attr)) then
  1062. begin
  1063. try
  1064. assert(Assigned(NewPIDL));
  1065. FDesktopFolder.BindToObject(NewPIDL, nil, IID_IShellFolder, Pointer(Result));
  1066. Assert(Assigned(Result));
  1067. finally
  1068. FreePIDL(NewPIDL);
  1069. end;
  1070. end;
  1071. end;
  1072. end; {GetShellFolder}
  1073. function TDirView.ItemIsDirectory(Item: TListItem): Boolean;
  1074. begin
  1075. Result :=
  1076. (Assigned(Item) and Assigned(Item.Data) and
  1077. PFileRec(Item.Data)^.IsDirectory);
  1078. end;
  1079. function TDirView.ItemIsFile(Item: TListItem): Boolean;
  1080. begin
  1081. Result :=
  1082. (Assigned(Item) and Assigned(Item.Data) and
  1083. (not PFileRec(Item.Data)^.IsParentDir));
  1084. end;
  1085. function TDirView.ItemIsParentDirectory(Item: TListItem): Boolean;
  1086. begin
  1087. Result :=
  1088. (Assigned(Item) and Assigned(Item.Data) and
  1089. PFileRec(Item.Data)^.IsParentDir);
  1090. end;
  1091. function TDirView.ItemIsRecycleBin(Item: TListItem): Boolean;
  1092. begin
  1093. Result := (Assigned(Item) and Assigned(Item.Data) and
  1094. PFileRec(Item.Data)^.IsRecycleBin);
  1095. end;
  1096. function TDirView.ItemMatchesFilter(Item: TListItem; const Filter: TFileFilter): Boolean;
  1097. var
  1098. FileRec: PFileRec;
  1099. begin
  1100. Assert(Assigned(Item) and Assigned(Item.Data));
  1101. FileRec := PFileRec(Item.Data);
  1102. Result :=
  1103. ((Filter.Masks = '') or
  1104. FileNameMatchesMasks(FileRec^.FileName, FileRec^.IsDirectory,
  1105. FileRec^.Size, FileTimeToDateTime(FileRec^.FileTime), Filter.Masks, False) or
  1106. (FileRec^.IsDirectory and Filter.Directories and
  1107. FileNameMatchesMasks(FileRec^.FileName, False,
  1108. FileRec^.Size, FileTimeToDateTime(FileRec^.FileTime), Filter.Masks, False)));
  1109. end;
  1110. function TDirView.FileMatches(FileName: string; const SearchRec: TSearchRec): Boolean;
  1111. var
  1112. Directory: Boolean;
  1113. FileSize: Int64;
  1114. begin
  1115. Result := (ShowHiddenFiles or ((SearchRec.Attr and SysUtils.faHidden) = 0));
  1116. if not Result then
  1117. begin
  1118. Inc(FHiddenCount);
  1119. end
  1120. else
  1121. if Mask <> '' then
  1122. begin
  1123. Directory := ((SearchRec.Attr and faDirectory) <> 0);
  1124. if Directory then FileSize := 0
  1125. else FileSize := SizeFromSRec(SearchRec);
  1126. Result :=
  1127. FileNameMatchesMasks(
  1128. FileName,
  1129. Directory,
  1130. FileSize,
  1131. FileTimeToDateTime(SearchRec.FindData.ftLastWriteTime),
  1132. Mask, True);
  1133. if not Result then
  1134. begin
  1135. Inc(FFilteredCount);
  1136. end;
  1137. end;
  1138. end;
  1139. function TDirView.ItemOverlayIndexes(Item: TListItem): Word;
  1140. begin
  1141. Result := inherited ItemOverlayIndexes(Item);
  1142. if Assigned(Item) and Assigned(Item.Data) then
  1143. begin
  1144. if PFileRec(Item.Data)^.IsParentDir then
  1145. Inc(Result, oiDirUp);
  1146. end;
  1147. end;
  1148. procedure TDirView.Load(DoFocusSomething: Boolean);
  1149. begin
  1150. try
  1151. StopIconUpdateThread;
  1152. StopWatchThread;
  1153. FChangeTimer.Enabled := False;
  1154. FChangeTimer.Interval := 0;
  1155. inherited;
  1156. finally
  1157. if DirOK and not AbortLoading then
  1158. begin
  1159. if FUseIconUpdateThread and (not IsRecycleBin) then
  1160. StartIconUpdateThread;
  1161. StartWatchThread;
  1162. end;
  1163. end;
  1164. end;
  1165. procedure TDirView.LoadFiles;
  1166. var
  1167. SRec: SysUtils.TSearchRec;
  1168. DosError: Integer;
  1169. DirsCount: Integer;
  1170. SelTreeNode: TTreeNode;
  1171. Node: TTreeNode;
  1172. Drive: string;
  1173. begin
  1174. FHiddenCount := 0;
  1175. FFilteredCount := 0;
  1176. try
  1177. if Length(FPath) > 0 then
  1178. begin
  1179. Drive := DriveInfo.GetDriveKey(FPath);
  1180. DriveInfo.ReadDriveStatus(Drive, dsSize);
  1181. FDriveType := DriveInfo.Get(Drive).DriveType;
  1182. FDirOK := DriveInfo.Get(Drive).DriveReady and DirectoryExists(FPath);
  1183. end
  1184. else
  1185. begin
  1186. FDriveType := DRIVE_UNKNOWN;
  1187. FDirOK := False;
  1188. end;
  1189. if DirOK then
  1190. begin
  1191. if Assigned(FDriveView) then
  1192. SelTreeNode := TDriveView(FDriveView).FindNodeToPath(FPath)
  1193. else SelTreeNode := nil;
  1194. if Assigned(FDriveView) and Assigned(SelTreeNode) then
  1195. FIsRecycleBin := TNodeData(SelTreeNode.Data).IsRecycleBin
  1196. else
  1197. FIsRecycleBin :=
  1198. (Uppercase(Copy(FPath, 2, 10)) = ':\RECYCLED') or
  1199. (Uppercase(Copy(FPath, 2, 10)) = ':\RECYCLER');
  1200. if not Assigned(FDesktopFolder) then
  1201. SHGetDesktopFolder(FDesktopFolder);
  1202. if IsRecycleBin then LoadFromRecycleBin(Path)
  1203. else
  1204. begin
  1205. FParentFolder := GetShellFolder(PathName);
  1206. DosError := SysUtils.FindFirst(ApiPath(IncludeTrailingPathDelimiter(FPath) + '*.*'),
  1207. FileAttr, SRec);
  1208. while (DosError = 0) and (not AbortLoading) do
  1209. begin
  1210. if (SRec.Attr and faDirectory) = 0 then
  1211. begin
  1212. if FileMatches(SRec.Name, SRec) then
  1213. begin
  1214. AddItem(SRec);
  1215. end;
  1216. end;
  1217. DosError := FindNext(SRec);
  1218. end;
  1219. SysUtils.FindClose(SRec);
  1220. if AddParentDir and (not IsRoot) then
  1221. begin
  1222. AddParentDirItem;
  1223. end;
  1224. {Search for directories:}
  1225. DirsCount := 0;
  1226. DosError := SysUtils.FindFirst(ApiPath(IncludeTrailingPathDelimiter(FPath) + '*.*'),
  1227. DirAttrMask, SRec);
  1228. while (DosError = 0) and (not AbortLoading) do
  1229. begin
  1230. if (SRec.Name <> '.') and (SRec.Name <> '..') and
  1231. ((Srec.Attr and faDirectory) <> 0) then
  1232. begin
  1233. Inc(DirsCount);
  1234. if FileMatches(SRec.Name, SRec) then
  1235. begin
  1236. AddItem(Srec);
  1237. end;
  1238. end;
  1239. DosError := FindNext(SRec);
  1240. end;
  1241. SysUtils.FindClose(SRec);
  1242. {Update TDriveView's subdir indicator:}
  1243. if Assigned(FDriveView) and (FDriveType = DRIVE_REMOTE) then
  1244. with TDriveView(FDriveView) do
  1245. begin
  1246. Node := FindNodeToPath(PathName);
  1247. if Assigned(Node) and Assigned(Node.Data) and
  1248. not TNodeData(Node.Data).Scanned then
  1249. begin
  1250. if DirsCount = 0 then
  1251. begin
  1252. Node.HasChildren := False;
  1253. TNodeData(Node.Data).Scanned := True;
  1254. end;
  1255. end;
  1256. end;
  1257. end; {not isRecycleBin}
  1258. end
  1259. else FIsRecycleBin := False;
  1260. finally
  1261. //if Assigned(Animate) then Animate.Free;
  1262. FInfoCacheList.Sort(CompareInfoCacheItems);
  1263. end; {Finally}
  1264. end;
  1265. procedure TDirView.Reload2;
  1266. type
  1267. PEFileRec = ^TEFileRec;
  1268. TEFileRec = record
  1269. iSize: Int64;
  1270. iAttr: Integer;
  1271. iFileTime: TFileTime;
  1272. iIndex: Integer;
  1273. end;
  1274. var
  1275. Index: Integer;
  1276. EItems: TStringList;
  1277. FItems: TStringList;
  1278. NewItems: TStringList;
  1279. Srec: SysUtils.TSearchRec;
  1280. DosError: Integer;
  1281. PSrec: ^SysUtils.TSearchRec;
  1282. Dummy: Integer;
  1283. ItemIndex: Integer;
  1284. AnyUpdate: Boolean;
  1285. PUpdate: Boolean;
  1286. PEFile: PEFileRec;
  1287. SaveCursor: TCursor;
  1288. FSize: Int64;
  1289. FocusedIsVisible: Boolean;
  1290. R: TRect;
  1291. begin
  1292. if (not Loading) and LoadEnabled then
  1293. begin
  1294. if IsRecycleBin then Reload(True)
  1295. else
  1296. begin
  1297. if not DirectoryExists(Path) then
  1298. begin
  1299. ClearItems;
  1300. FDirOK := False;
  1301. FDirty := False;
  1302. end
  1303. else
  1304. begin
  1305. if Assigned(ItemFocused) then
  1306. begin
  1307. R := ItemFocused.DisplayRect(drBounds);
  1308. // btw, we use vsReport only, nothing else was tested
  1309. Assert(ViewStyle = vsReport);
  1310. case ViewStyle of
  1311. vsReport:
  1312. FocusedIsVisible := (TopItem.Index <= ItemFocused.Index) and
  1313. (ItemFocused.Index < TopItem.Index + VisibleRowCount);
  1314. vsList:
  1315. // do not know how to implement that
  1316. FocusedIsVisible := False;
  1317. else // vsIcon and vsSmallIcon
  1318. FocusedIsVisible :=
  1319. IntersectRect(R,
  1320. Classes.Rect(ViewOrigin, Point(ViewOrigin.X + ClientWidth, ViewOrigin.Y + ClientHeight)),
  1321. ItemFocused.DisplayRect(drBounds));
  1322. end;
  1323. end
  1324. else FocusedIsVisible := False; // shut up
  1325. SaveCursor := Screen.Cursor;
  1326. Screen.Cursor := crHourGlass;
  1327. FChangeTimer.Enabled := False;
  1328. FChangeTimer.Interval := 0;
  1329. EItems := TStringlist.Create;
  1330. EItems.CaseSensitive := True; // We want to reflect changes in file name case
  1331. FItems := TStringlist.Create;
  1332. FItems.CaseSensitive := True;
  1333. NewItems := TStringlist.Create;
  1334. PUpdate := False;
  1335. AnyUpdate := False;
  1336. FHiddenCount := 0;
  1337. FFilteredCount := 0;
  1338. try
  1339. {Store existing files and directories:}
  1340. for Index := 0 to Items.Count - 1 do
  1341. begin
  1342. New(PEFile);
  1343. with PFileRec(Items[Index].Data)^ do
  1344. begin
  1345. PEFile^.iSize := Size;
  1346. PEFile^.iAttr := Attr;
  1347. PEFile^.iFileTime := FileTime;
  1348. PEFile^.iIndex := Index;
  1349. end;
  1350. EItems.AddObject(PFileRec(Items[Index].Data)^.FileName, Pointer(PEFile));
  1351. end;
  1352. EItems.Sort;
  1353. DosError := SysUtils.FindFirst(ApiPath(IncludeTrailingPathDelimiter(FPath) + '*.*'),
  1354. FileAttr, SRec);
  1355. while DosError = 0 do
  1356. begin
  1357. if (SRec.Attr and faDirectory) = 0 then
  1358. begin
  1359. if FileMatches(SRec.Name, SRec) then
  1360. begin
  1361. ItemIndex := -1;
  1362. if not EItems.Find(SRec.Name, ItemIndex) then
  1363. begin
  1364. New(PSrec);
  1365. PSRec^ := SRec;
  1366. NewItems.AddObject(SRec.Name, Pointer(PSrec));
  1367. FItems.Add(Srec.Name);
  1368. end
  1369. else
  1370. begin
  1371. FSize := SizeFromSRec(SRec);
  1372. with PEFileRec(EItems.Objects[ItemIndex])^ do
  1373. {$WARNINGS OFF}
  1374. if (iSize <> FSize) or (iAttr <> SRec.Attr) or
  1375. not CompareMem(@iFileTime, @SRec.FindData.ftLastWriteTime,
  1376. SizeOf(iFileTime)) Then
  1377. {$WARNINGS ON}
  1378. begin
  1379. with PFileRec(Items[iIndex].Data)^ do
  1380. begin
  1381. Dec(FFilesSize, Size);
  1382. Inc(FFilesSize, FSize);
  1383. if Items[iIndex].Selected then
  1384. begin
  1385. Dec(FFilesSelSize, Size);
  1386. Inc(FFilesSelSize, FSize);
  1387. end;
  1388. Size := FSize;
  1389. Attr := SRec.Attr;
  1390. {$WARNINGS OFF}
  1391. FileTime := SRec.FindData.ftLastWriteTime;
  1392. {$WARNINGS ON}
  1393. end;
  1394. // alternative to TListItem.Update (which causes flicker)
  1395. R := Items[iIndex].DisplayRect(drBounds);
  1396. InvalidateRect(Handle, @R, True);
  1397. AnyUpdate := True;
  1398. end;
  1399. FItems.Add(Srec.Name);
  1400. end;
  1401. end;
  1402. end;
  1403. DosError := FindNext(Srec);
  1404. end;
  1405. SysUtils.FindClose(Srec);
  1406. {Search new directories:}
  1407. DosError := SysUtils.FindFirst(ApiPath(FPath + '\*.*'), DirAttrMask, SRec);
  1408. while DosError = 0 do
  1409. begin
  1410. if (Srec.Attr and faDirectory) <> 0 then
  1411. begin
  1412. if (SRec.Name <> '.') and (SRec.Name <> '..') then
  1413. begin
  1414. if not EItems.Find(SRec.Name, ItemIndex) then
  1415. begin
  1416. if FileMatches(SRec.Name, SRec) then
  1417. begin
  1418. New(PSrec);
  1419. PSrec^ := SRec;
  1420. NewItems.AddObject(Srec.Name, Pointer(PSrec));
  1421. FItems.Add(SRec.Name);
  1422. end;
  1423. end
  1424. else
  1425. begin
  1426. FItems.Add(SRec.Name);
  1427. end;
  1428. end
  1429. else
  1430. begin
  1431. FItems.Add(SRec.Name);
  1432. end;
  1433. end;
  1434. DosError := FindNext(SRec);
  1435. end;
  1436. SysUtils.FindClose(SRec);
  1437. {Check wether displayed Items still exists:}
  1438. FItems.Sort;
  1439. for Index := Items.Count - 1 downto 0 do
  1440. begin
  1441. if not FItems.Find(PFileRec(Items[Index].Data)^.FileName, Dummy) then
  1442. begin
  1443. if not PUpdate then
  1444. begin
  1445. PUpdate := True;
  1446. Items.BeginUpdate;
  1447. end;
  1448. AnyUpdate := True;
  1449. with PFileRec(Items[Index].Data)^ do
  1450. begin
  1451. Dec(FFilesSize, Size);
  1452. // No need to decrease FFilesSelSize here as LVIF_STATE/deselect
  1453. // is called for item being deleted
  1454. end;
  1455. Items[Index].Delete;
  1456. end;
  1457. end;
  1458. finally
  1459. try
  1460. for Index := 0 to EItems.Count - 1 do
  1461. Dispose(PEFileRec(EItems.Objects[Index]));
  1462. EItems.Free;
  1463. FItems.Free;
  1464. for Index := 0 to NewItems.Count - 1 do
  1465. begin
  1466. if not PUpdate then
  1467. begin
  1468. PUpdate := True;
  1469. Items.BeginUpdate;
  1470. end;
  1471. AnyUpdate := True;
  1472. PSrec := Pointer(NewItems.Objects[Index]);
  1473. AddItem(PSrec^);
  1474. Dispose(PSrec);
  1475. end;
  1476. NewItems.Free;
  1477. // if we are sorted by name and there were only updates to existing
  1478. // items, there is no need for sorting
  1479. if PUpdate or
  1480. (AnyUpdate and (DirColProperties.SortDirColumn <> dvName)) then
  1481. begin
  1482. SortItems;
  1483. end;
  1484. if PUpdate then
  1485. Items.EndUpdate;
  1486. finally
  1487. FDirOK := True;
  1488. FDirty := false;
  1489. if FUseIconUpdateThread and (not FisRecycleBin) then
  1490. StartIconUpdateThread;
  1491. StartWatchThread;
  1492. // make focused item visible, only if it was before
  1493. if FocusedIsVisible and Assigned(ItemFocused) then
  1494. ItemFocused.MakeVisible(False);
  1495. DoUpdateStatusBar;
  1496. Screen.Cursor := SaveCursor;
  1497. end;
  1498. end; {Finally}
  1499. end;
  1500. if Assigned(FDriveView) then
  1501. begin
  1502. TDriveView(FDriveView).ValidateCurrentDirectoryIfNotMonitoring;
  1503. end;
  1504. end;
  1505. end;
  1506. end; {Reload2}
  1507. procedure TDirView.PerformItemDragDropOperation(Item: TListItem; Effect: Integer; Paste: Boolean);
  1508. var
  1509. TargetPath: string;
  1510. RenameOnCollision: Boolean;
  1511. begin
  1512. TargetPath := '';
  1513. RenameOnCollision := False;
  1514. if Assigned(Item) then
  1515. begin
  1516. if Assigned(Item.Data) then
  1517. begin
  1518. if ItemIsParentDirectory(Item) then
  1519. TargetPath := ExcludeTrailingPathDelimiter(ExtractFilePath(Path))
  1520. else
  1521. TargetPath := IncludeTrailingPathDelimiter(PathName) + ItemFileName(Item);
  1522. end;
  1523. end
  1524. else
  1525. begin
  1526. TargetPath := PathName;
  1527. RenameOnCollision := DDOwnerIsSource and (Effect = DROPEFFECT_COPY);
  1528. end;
  1529. if TargetPath <> '' then
  1530. PerformDragDropFileOperation(TargetPath, Effect, RenameOnCollision, Paste);
  1531. end;
  1532. procedure TDirView.ReLoad(CacheIcons: Boolean);
  1533. begin
  1534. if not FLoadEnabled then FDirty := True
  1535. else inherited;
  1536. end; {ReLoad}
  1537. procedure TDirView.ClearIconCache;
  1538. begin
  1539. if Assigned(FInfoCacheList) then
  1540. FInfoCacheList.Clear;
  1541. end; {ClearIconCache}
  1542. function TDirView.FormatFileTime(FileTime: TFileTime): string;
  1543. begin
  1544. Result := FormatDateTime(DateTimeFormatStr,
  1545. FileTimeToDateTime(FileTime));
  1546. end; {FormatFileTime}
  1547. function TDirView.GetAttrString(Attr: Integer): string;
  1548. const
  1549. Attrs: array[1..5] of Integer =
  1550. (FILE_ATTRIBUTE_COMPRESSED, FILE_ATTRIBUTE_ARCHIVE,
  1551. FILE_ATTRIBUTE_SYSTEM, FILE_ATTRIBUTE_HIDDEN,
  1552. FILE_ATTRIBUTE_READONLY);
  1553. AttrChars: array[1..5] of Char = ('c', 'a', 's', 'h', 'r');
  1554. var
  1555. Index: Integer;
  1556. LowBound: Integer;
  1557. begin
  1558. Result := '';
  1559. if Attr <> 0 then
  1560. begin
  1561. LowBound := Low(Attrs);
  1562. for Index := LowBound to High(Attrs) do
  1563. if (Attr and Attrs[Index] <> 0) then
  1564. Result := Result + AttrChars[Index]
  1565. else
  1566. Result := Result;
  1567. end;
  1568. end; {GetAttrString}
  1569. function TDirView.GetFileInfo(
  1570. pszPath: LPCWSTR; dwFileAttributes: DWORD; var psfi: TSHFileInfoW; cbFileInfo, uFlags: UINT): DWORD_PTR;
  1571. begin
  1572. if TimeoutShellIconRetrieval then
  1573. begin
  1574. Result := SHGetFileInfoWithTimeout(pszPath, dwFileAttributes, psfi, cbFileInfo, uFlags, MSecsPerSec div 4);
  1575. end
  1576. else
  1577. begin
  1578. Result := SHGetFileInfo(pszPath, dwFileAttributes, psfi, cbFileInfo, uFlags);
  1579. end;
  1580. end;
  1581. procedure TDirView.GetDisplayData(Item: TListItem; FetchIcon: Boolean);
  1582. var
  1583. FileInfo: TShFileInfo;
  1584. Index: Integer;
  1585. PExtItem: PInfoCache;
  1586. CacheItem: TInfoCache;
  1587. IsSpecialExt: Boolean;
  1588. ForceByName: Boolean;
  1589. Eaten: ULONG;
  1590. shAttr: ULONG;
  1591. FileIconForName, FullName: string;
  1592. begin
  1593. Assert(Assigned(Item) and Assigned(Item.Data));
  1594. with PFileRec(Item.Data)^ do
  1595. begin
  1596. IsSpecialExt := MatchesFileExt(FileExt, SpecialExtensions);
  1597. if FUseIconCache and not IsSpecialExt and not IsDirectory then
  1598. begin
  1599. CacheItem.FileExt := FileExt;
  1600. Index := FInfoCacheList.FindSequential(Addr(CacheItem), CompareInfoCacheItems);
  1601. if Index >= 0 then
  1602. begin
  1603. TypeName := PInfoCache(FInfoCacheList[Index])^.TypeName;
  1604. ImageIndex := PInfoCache(FInfoCacheList[Index])^.ImageIndex;
  1605. Empty := False;
  1606. IconEmpty := False;
  1607. end;
  1608. end;
  1609. FetchIcon := IconEmpty and (FetchIcon or not IsSpecialExt);
  1610. if Empty or FetchIcon then
  1611. begin
  1612. if FetchIcon then
  1613. begin
  1614. {Fetch the Item FQ-PIDL:}
  1615. if not Assigned(PIDL) and IsSpecialExt then
  1616. begin
  1617. try
  1618. ShAttr := 0;
  1619. FDesktopFolder.ParseDisplayName(ParentForm.Handle, nil,
  1620. PChar(FPath + '\' + FileName), Eaten, PIDL, ShAttr);
  1621. except
  1622. end;
  1623. end;
  1624. if IsDirectory then
  1625. begin
  1626. if FDriveType = DRIVE_FIXED then
  1627. begin
  1628. try
  1629. {Retrieve icon and typename for the directory}
  1630. if Assigned(PIDL) then
  1631. begin
  1632. SHGetFileInfo(PChar(PIDL), 0, FileInfo, SizeOf(FileInfo),
  1633. SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_PIDL)
  1634. end
  1635. else
  1636. begin
  1637. SHGetFileInfo(PChar(FPath + '\' + FileName), 0, FileInfo, SizeOf(FileInfo),
  1638. SHGFI_TYPENAME or SHGFI_SYSICONINDEX);
  1639. end;
  1640. if (FileInfo.iIcon <= 0) or (FileInfo.iIcon > SmallImages.Count) then
  1641. begin
  1642. {Invalid icon returned: retry with access file attribute flag:}
  1643. SHGetFileInfo(PChar(FPath + '\' + FileName), FILE_ATTRIBUTE_DIRECTORY,
  1644. FileInfo, SizeOf(FileInfo),
  1645. SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
  1646. end;
  1647. TypeName := FileInfo.szTypeName;
  1648. if FetchIcon then
  1649. begin
  1650. ImageIndex := FileInfo.iIcon;
  1651. IconEmpty := False;
  1652. end;
  1653. {Capture exceptions generated by the shell}
  1654. except
  1655. ImageIndex := StdDirIcon;
  1656. IconEmpty := False;
  1657. end; {Except}
  1658. end
  1659. else
  1660. begin
  1661. TypeName := StdDirTypeName;
  1662. ImageIndex := StdDirIcon;
  1663. IconEmpty := False;
  1664. end;
  1665. end
  1666. else
  1667. begin
  1668. {Retrieve icon and typename for the file}
  1669. try
  1670. ForceByName := False;
  1671. FullName := FPath + '\' + FileName;
  1672. FileIconForName := FullName;
  1673. if Assigned(OnFileIconForName) then
  1674. begin
  1675. OnFileIconForName(Self, Item, FileIconForName);
  1676. ForceByName := (FileIconForName <> FullName);
  1677. end;
  1678. if (not ForceByName) and Assigned(PIDL) then
  1679. begin
  1680. // Files with PIDL are typically .exe files.
  1681. // It may take long to retrieve an icon from exe file.
  1682. // We typically do not get here, now that we have UseIconUpdateThread enabled.
  1683. if GetFileInfo(
  1684. PChar(PIDL), FILE_ATTRIBUTE_NORMAL, FileInfo, SizeOf(FileInfo),
  1685. SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX or SHGFI_PIDL) = 0 then
  1686. begin
  1687. FileInfo.szTypeName[0] := #0;
  1688. FileInfo.iIcon := DefaultExeIcon;
  1689. end;
  1690. end
  1691. else
  1692. begin
  1693. GetFileInfo(PChar(FileIconForName), FILE_ATTRIBUTE_NORMAL, FileInfo, SizeOf(FileInfo),
  1694. SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX);
  1695. end;
  1696. TypeName := FileInfo.szTypeName;
  1697. ImageIndex := FileInfo.iIcon;
  1698. IconEmpty := False;
  1699. {Capture exceptions generated by the shell}
  1700. except
  1701. ImageIndex := UnKnownFileIcon;
  1702. IconEmpty := False;
  1703. end; {Except}
  1704. end;
  1705. if (Length(TypeName) > 0) then
  1706. begin
  1707. {Fill FileInfoCache:}
  1708. if FUseIconCache and not IsSpecialExt and not IconEmpty and not IsDirectory then
  1709. begin
  1710. GetMem(PExtItem, SizeOf(TInfoCache));
  1711. PExtItem.FileExt := FileExt;
  1712. PExtItem.TypeName := TypeName;
  1713. PExtItem.ImageIndex := ImageIndex;
  1714. FInfoCacheList.Add(PExtItem);
  1715. end;
  1716. end
  1717. else TypeName := Format(STextFileExt, [FileExt]);
  1718. end {If FetchIcon}
  1719. else
  1720. begin
  1721. try
  1722. if IsDirectory then
  1723. SHGetFileInfo(PChar(FPath + '\' + FileName), FILE_ATTRIBUTE_DIRECTORY, FileInfo, SizeOf(FileInfo),
  1724. SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES)
  1725. else
  1726. SHGetFileInfo(PChar(FPath + '\' + FileName), FILE_ATTRIBUTE_NORMAL, FileInfo, SizeOf(FileInfo),
  1727. SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES);
  1728. TypeName := FileInfo.szTypeName;
  1729. except
  1730. {Capture exceptions generated by the shell}
  1731. TypeName := '';
  1732. end;
  1733. if IconEmpty then
  1734. begin
  1735. if FileExt = ExeExtension then ImageIndex := DefaultExeIcon
  1736. else ImageIndex := UnKnownFileIcon;
  1737. end;
  1738. end;
  1739. Empty := False;
  1740. end;
  1741. end;
  1742. end; {GetDisplayData}
  1743. function TDirView.GetDirOK: Boolean;
  1744. begin
  1745. Result := FDirOK;
  1746. end;
  1747. function TDirView.ItemFullFileName(Item: TListItem): string;
  1748. begin
  1749. if Assigned(Item) and Assigned(Item.Data) then
  1750. begin
  1751. if not IsRecycleBin then
  1752. begin
  1753. if PFileRec(Item.Data)^.IsParentDir then
  1754. begin
  1755. Result := ExcludeTrailingBackslash(ExtractFilePath(FPath));
  1756. end
  1757. else
  1758. begin
  1759. Result := FPath + '\' + PFileRec(Item.Data)^.FileName;
  1760. end;
  1761. end
  1762. else
  1763. Result := PFileRec(Item.Data)^.FileName;
  1764. end
  1765. else
  1766. Result := EmptyStr;
  1767. end; {ItemFullFileName}
  1768. function TDirView.ItemFileNameOnly(Item: TListItem): string;
  1769. begin
  1770. Assert(Assigned(Item) and Assigned(Item.Data));
  1771. Result := PFileRec(Item.Data)^.FileName;
  1772. SetLength(Result, Length(Result) - Length(ItemFileExt(Item)));
  1773. end; {ItemFileNameOnly}
  1774. function TDirView.ItemFileExt(Item: TListItem): string;
  1775. begin
  1776. Assert(Assigned(Item) and Assigned(Item.Data));
  1777. Result := ExtractFileExt(PFileRec(Item.Data)^.FileName);
  1778. end; {ItemFileExt}
  1779. function CompareFileType(I1, I2: TListItem; P1, P2: PFileRec): Integer;
  1780. var
  1781. Key1, Key2: string;
  1782. begin
  1783. if P1.Empty then TDirView(I1.ListView).GetDisplayData(I1, False);
  1784. if P2.Empty then TDirView(I2.ListView).GetDisplayData(I2, False);
  1785. if P1.IsDirectory then
  1786. begin
  1787. Key1 := P1.TypeName + ' ' + P1.DisplayName;
  1788. Key2 := P2.TypeName + ' ' + P2.DisplayName;
  1789. end
  1790. else
  1791. begin
  1792. Key1 := P1.TypeName + ' ' + P1.FileExt + ' ' + P1.DisplayName;
  1793. Key2 := P2.TypeName + ' ' + P2.FileExt + ' ' + P2.DisplayName;
  1794. end;
  1795. Result := CompareLogicalTextPas(Key1, Key2, TDirView(I1.ListView).NaturalOrderNumericalSorting);
  1796. end;
  1797. function CompareFileTime(P1, P2: PFileRec): Integer;
  1798. var
  1799. Time1, Time2: Int64;
  1800. begin
  1801. Time1 := Int64(P1.FileTime.dwHighDateTime) shl 32 + P1.FileTime.dwLowDateTime;
  1802. Time2 := Int64(P2.FileTime.dwHighDateTime) shl 32 + P2.FileTime.dwLowDateTime;
  1803. if Time1 < Time2 then Result := fLess
  1804. else
  1805. if Time1 > Time2 then Result := fGreater
  1806. else Result := fEqual; // fallback
  1807. end;
  1808. function CompareFile(I1, I2: TListItem; AOwner: TDirView): Integer; stdcall;
  1809. var
  1810. ConsiderDirection: Boolean;
  1811. P1, P2: PFileRec;
  1812. begin
  1813. ConsiderDirection := True;
  1814. if I1 = I2 then Result := fEqual
  1815. else
  1816. if I1 = nil then Result := fLess
  1817. else
  1818. if I2 = nil then Result := fGreater
  1819. else
  1820. begin
  1821. P1 := PFileRec(I1.Data);
  1822. P2 := PFileRec(I2.Data);
  1823. if P1.isParentDir then
  1824. begin
  1825. Result := fLess;
  1826. ConsiderDirection := False;
  1827. end
  1828. else
  1829. if P2.isParentDir then
  1830. begin
  1831. Result := fGreater;
  1832. ConsiderDirection := False;
  1833. end
  1834. else
  1835. {Directories should always appear "grouped":}
  1836. if P1.isDirectory <> P2.isDirectory then
  1837. begin
  1838. if P1.isDirectory then
  1839. begin
  1840. Result := fLess;
  1841. ConsiderDirection := False;
  1842. end
  1843. else
  1844. begin
  1845. Result := fGreater;
  1846. ConsiderDirection := False;
  1847. end;
  1848. end
  1849. else
  1850. begin
  1851. Result := fEqual;
  1852. case AOwner.DirColProperties.SortDirColumn of
  1853. dvName:
  1854. ; // fallback
  1855. dvSize:
  1856. if P1.Size < P2.Size then Result := fLess
  1857. else
  1858. if P1.Size > P2.Size then Result := fGreater
  1859. else ; // fallback
  1860. dvType:
  1861. Result := CompareFileType(I1, I2, P1, P2);
  1862. dvChanged:
  1863. Result := CompareFileTime(P1, P2);
  1864. dvAttr:
  1865. if P1.Attr < P2.Attr then Result := fLess
  1866. else
  1867. if P1.Attr > P2.Attr then Result := fGreater
  1868. else ; // fallback
  1869. dvExt:
  1870. if not P1.isDirectory then
  1871. begin
  1872. Result := CompareLogicalTextPas(
  1873. P1.FileExt + ' ' + P1.DisplayName, P2.FileExt + ' ' + P2.DisplayName,
  1874. AOwner.NaturalOrderNumericalSorting);
  1875. end
  1876. else ; //fallback
  1877. else
  1878. ; // fallback
  1879. end;
  1880. if Result = fEqual then
  1881. begin
  1882. Result := CompareLogicalTextPas(P1.DisplayName, P2.DisplayName, AOwner.NaturalOrderNumericalSorting)
  1883. end;
  1884. end;
  1885. end;
  1886. if ConsiderDirection and (not AOwner.SortAscending) then
  1887. begin
  1888. Result := -Result;
  1889. end;
  1890. end;
  1891. procedure TDirView.SortItems;
  1892. begin
  1893. if HandleAllocated then
  1894. begin
  1895. StopIconUpdateThread;
  1896. try
  1897. CustomSortItems(@CompareFile);
  1898. finally
  1899. if (not Loading) and FUseIconUpdateThread then
  1900. StartIconUpdateThread;
  1901. end;
  1902. end
  1903. end;
  1904. procedure TDirView.ValidateFile(Item : TListItem);
  1905. var
  1906. Index: Integer;
  1907. begin
  1908. if Assigned(Item) and Assigned(Item.Data) then
  1909. begin
  1910. Index := Item.Index;
  1911. if not FileExists(ApiPath(ItemFullFileName(Items[Index]))) then
  1912. begin
  1913. Item.Delete;
  1914. end;
  1915. end;
  1916. end; {ValidateFile}
  1917. procedure TDirView.ValidateFile(FileName: TFileName);
  1918. var
  1919. FilePath: string;
  1920. begin
  1921. FilePath := ExcludeTrailingPathDelimiter(ExtractFilePath(FileName));
  1922. if IsRecycleBin then ValidateFile(FindFileItem(FileName))
  1923. else
  1924. if FilePath = Path then
  1925. ValidateFile(FindFileItem(ExtractFileName(FileName)));
  1926. end; {ValidateFile}
  1927. procedure TDirView.ValidateSelectedFiles;
  1928. var
  1929. FileList: TStrings;
  1930. i: Integer;
  1931. ToDelete: Boolean;
  1932. Updating: Boolean;
  1933. Updated: Boolean;
  1934. Item: TListItem;
  1935. begin
  1936. if SelCount > 50 then Reload2
  1937. else
  1938. begin
  1939. Updating := False;
  1940. Updated := False;
  1941. FileList := CustomCreateFileList(True, False, True, nil, True);
  1942. try
  1943. for i := 0 to FileList.Count - 1 do
  1944. begin
  1945. Item := TListItem(FileList.Objects[i]);
  1946. if ItemIsDirectory(Item) then
  1947. ToDelete := not DirectoryExists(ApiPath(FileList[i]))
  1948. else
  1949. ToDelete := not FileExists(ApiPath(FileList[i]));
  1950. if ToDelete then
  1951. begin
  1952. if (SelCount > 10) and (not Updating) then
  1953. begin
  1954. Items.BeginUpdate;
  1955. Updating := True;
  1956. end;
  1957. with PFileRec(Item.Data)^ do
  1958. begin
  1959. Dec(FFilesSize, Size);
  1960. // No need to decrease FFilesSelSize here as LVIF_STATE/deselect
  1961. // is called for item being deleted
  1962. end;
  1963. Item.Delete;
  1964. Updated := True;
  1965. end;
  1966. end;
  1967. finally
  1968. if Updating then
  1969. Items.EndUpdate;
  1970. if Updated then
  1971. DoUpdateStatusBar;
  1972. FileList.Free;
  1973. end;
  1974. end;
  1975. end; {ValidateSelectedFiles}
  1976. procedure TDirView.CreateDirectory(DirName: string);
  1977. var
  1978. SRec: SysUtils.TSearchRec;
  1979. Item: TListItem;
  1980. begin
  1981. // keep absolute path as is
  1982. if ExtractFileDrive(DirName) = '' then
  1983. DirName := Path + '\' + DirName;
  1984. if WatchForChanges then StopWatchThread;
  1985. if Assigned(FDriveView) then
  1986. TDriveView(FDriveView).StopWatchThread;
  1987. StopIconUpdateThread;
  1988. try
  1989. {create the physical directory:}
  1990. Win32Check(Windows.CreateDirectory(PChar(ApiPath(DirName)), nil));
  1991. if IncludeTrailingBackslash(ExtractFilePath(ExpandFileName(DirName))) =
  1992. IncludeTrailingBackslash(Path) then
  1993. begin
  1994. {Create the TListItem:}
  1995. if FindFirst(ApiPath(DirName), faAnyFile, SRec) = 0 then
  1996. begin
  1997. Item := AddItem(SRec);
  1998. ItemFocused := FindFileItem(GetFileRec(Item.Index)^.FileName);
  1999. SortItems;
  2000. if Assigned(ItemFocused) then
  2001. begin
  2002. ItemFocused.MakeVisible(False);
  2003. end;
  2004. end;
  2005. FindClose(SRec);
  2006. end;
  2007. finally
  2008. if FUseIconUpdateThread then
  2009. StartIconUpdateThread;
  2010. if WatchForChanges then StartWatchThread;
  2011. if Assigned(DriveView) then
  2012. with DriveView do
  2013. begin
  2014. if Assigned(Selected) then
  2015. ValidateDirectory(Selected);
  2016. TDriveView(FDriveView).StartWatchThread;
  2017. end;
  2018. end;
  2019. end; {CreateDirectory}
  2020. procedure TDirView.DisplayContextMenu(Where: TPoint);
  2021. var
  2022. FileList: TStringList;
  2023. Index: Integer;
  2024. Item: TListItem;
  2025. DefDir: string;
  2026. Verb: string;
  2027. PIDLArray: PPIDLArray;
  2028. Count: Integer;
  2029. DiffSelectedPath: Boolean;
  2030. WithEdit: Boolean;
  2031. PIDLRel: PItemIDList;
  2032. PIDLPath: PItemIDList;
  2033. Handled: Boolean;
  2034. begin
  2035. GetDir(0, DefDir);
  2036. ChDir(PathName);
  2037. Verb := EmptyStr;
  2038. StopWatchThread;
  2039. try
  2040. try
  2041. if Assigned(OnContextPopup) then
  2042. begin
  2043. Handled := False;
  2044. OnContextPopup(Self, ScreenToClient(Where), Handled);
  2045. if Handled then Abort;
  2046. end;
  2047. if (MarkedCount > 1) and
  2048. ((not Assigned(ItemFocused)) or ItemFocused.Selected) then
  2049. begin
  2050. if FIsRecycleBin then
  2051. begin
  2052. Count := 0;
  2053. GetMem(PIDLArray, SizeOf(PItemIDList) * SelCount);
  2054. try
  2055. FillChar(PIDLArray^, Sizeof(PItemIDList) * SelCount, #0);
  2056. for Index := Selected.Index to Items.Count - 1 do
  2057. if Items[Index].Selected then
  2058. begin
  2059. PIDL_GetRelative(PFileRec(Items[Index].Data)^.PIDL, PIDLPath, PIDLRel);
  2060. FreePIDL(PIDLPath);
  2061. PIDLArray^[Count] := PIDLRel;
  2062. Inc(Count);
  2063. end;
  2064. try
  2065. ShellDisplayContextMenu(ParentForm.Handle, Where, iRecycleFolder, Count,
  2066. PidlArray^[0], False, Verb, False);
  2067. finally
  2068. for Index := 0 to Count - 1 do
  2069. FreePIDL(PIDLArray[Index]);
  2070. end;
  2071. finally
  2072. FreeMem(PIDLArray, Count);
  2073. end;
  2074. end
  2075. else
  2076. begin
  2077. FileList := TStringList.Create;
  2078. CreateFileList(False, True, FileList);
  2079. for Index := 0 to FileList.Count - 1 do
  2080. FileList[Index] := ExtractFileName(FileList[Index]);
  2081. ShellDisplayContextMenu(ParentForm.Handle, Where, PathName,
  2082. FileList, Verb, False);
  2083. FileList.Destroy;
  2084. end;
  2085. {------------ Cut -----------}
  2086. if Verb = shcCut then
  2087. begin
  2088. LastClipBoardOperation := cboCut;
  2089. {Clear items previous marked as cut:}
  2090. Item := GetNextItem(nil, sdAll, [isCut]);
  2091. while Assigned(Item) do
  2092. begin
  2093. Item.Cut := False;
  2094. Item := GetNextItem(Item, sdAll, [isCut]);
  2095. end;
  2096. {Set property cut to TRUE for all selected items:}
  2097. Item := GetNextItem(nil, sdAll, [isSelected]);
  2098. while Assigned(Item) do
  2099. begin
  2100. Item.Cut := True;
  2101. Item := GetNextItem(Item, sdAll, [isSelected]);
  2102. end;
  2103. end
  2104. else
  2105. {----------- Copy -----------}
  2106. if Verb = shcCopy then LastClipBoardOperation := cboCopy
  2107. else
  2108. {----------- Paste ----------}
  2109. if Verb = shcPaste then
  2110. PasteFromClipBoard(ItemFullFileName(Selected))
  2111. else
  2112. if not FIsRecycleBin then Reload2;
  2113. end
  2114. else
  2115. if Assigned(ItemFocused) and Assigned(ItemFocused.Data) then
  2116. begin
  2117. Verb := EmptyStr;
  2118. WithEdit := not FisRecycleBin and CanEdit(ItemFocused);
  2119. LoadEnabled := True;
  2120. if FIsRecycleBin then
  2121. begin
  2122. PIDL_GetRelative(PFileRec(ItemFocused.Data)^.PIDL, PIDLPath, PIDLRel);
  2123. ShellDisplayContextMenu(ParentForm.Handle, Where,
  2124. iRecycleFolder, 1, PIDLRel, False, Verb, False);
  2125. FreePIDL(PIDLRel);
  2126. FreePIDL(PIDLPath);
  2127. end
  2128. else
  2129. begin
  2130. ShellDisplayContextMenu(ParentForm.Handle, Where,
  2131. ItemFullFileName(ItemFocused), WithEdit, Verb,
  2132. not PFileRec(ItemFocused.Data)^.isDirectory);
  2133. LoadEnabled := True;
  2134. end; {not FisRecycleBin}
  2135. {---------- Rename ----------}
  2136. if Verb = shcRename then ItemFocused.EditCaption
  2137. else
  2138. {------------ Cut -----------}
  2139. if Verb = shcCut then
  2140. begin
  2141. LastClipBoardOperation := cboCut;
  2142. Item := GetNextItem(nil, sdAll, [isCut]);
  2143. while Assigned(Item) do
  2144. begin
  2145. Item.Cut := False;
  2146. Item := GetNextItem(ITem, sdAll, [isCut]);
  2147. end;
  2148. ItemFocused.Cut := True;
  2149. end
  2150. else
  2151. {----------- Copy -----------}
  2152. if Verb = shcCopy then LastClipBoardOperation := cboCopy
  2153. else
  2154. {----------- Paste ----------}
  2155. if Verb = shcPaste then
  2156. begin
  2157. if PFileRec(ItemFocused.Data)^.IsDirectory then
  2158. PasteFromClipBoard(ItemFullFileName(ItemFocused));
  2159. end
  2160. else
  2161. if not FIsRecycleBin then Reload2;
  2162. end;
  2163. finally
  2164. ChDir(DefDir);
  2165. end;
  2166. if IsRecycleBin and (Verb <> shcCut) and (Verb <> shcProperties) and (SelCount > 0) then
  2167. begin
  2168. DiffSelectedPath := False;
  2169. for Index := Selected.Index to Items.Count - 1 do
  2170. if ExtractFilePath(PFileRec(Items[Index].Data)^.FileName) <> FPath + '\' then
  2171. begin
  2172. DiffSelectedPath := True;
  2173. Break;
  2174. end;
  2175. if DiffSelectedPath then
  2176. begin
  2177. StartFileDeleteThread;
  2178. Exit;
  2179. end;
  2180. end;
  2181. Sleep(250);
  2182. ValidateSelectedFiles;
  2183. finally
  2184. StartWatchThread;
  2185. end;
  2186. end;
  2187. procedure TDirView.GetDisplayInfo(ListItem: TListItem;
  2188. var DispInfo: TLVItem);
  2189. var
  2190. Value: string;
  2191. begin
  2192. Assert(Assigned(ListItem) and Assigned(ListItem.Data));
  2193. with PFileRec(ListItem.Data)^, DispInfo do
  2194. begin
  2195. {Fetch display data of current file:}
  2196. if Empty then
  2197. GetDisplayData(ListItem, IconEmpty and
  2198. (not FUseIconUpdateThread or
  2199. (ViewStyle <> vsReport)));
  2200. if IconEmpty and
  2201. (not FUseIconUpdateThread or
  2202. (ViewStyle <> vsReport)) and
  2203. ((DispInfo.Mask and LVIF_IMAGE) <> 0) then
  2204. GetDisplayData(ListItem, True);
  2205. {Set IconUpdatethread :}
  2206. if IconEmpty and Assigned(FIconUpdateThread) then
  2207. begin
  2208. if Assigned(TopItem) then
  2209. {Viewstyle is vsReport or vsList:}
  2210. FIconUpdateThread.Index := Self.TopItem.Index
  2211. else
  2212. {Viewstyle is vsIcon or vsSmallIcon:}
  2213. FIconUpdateThread.MaxIndex := ListItem.Index;
  2214. if FIconUpdateThread.Suspended and not FIsRecycleBin then
  2215. FIconUpdateThread.Resume;
  2216. end;
  2217. if (DispInfo.Mask and LVIF_TEXT) <> 0 then
  2218. begin
  2219. Value := '';
  2220. if iSubItem = 0 then Value := DisplayName
  2221. else
  2222. if iSubItem < DirViewColumns then
  2223. begin
  2224. case TDirViewCol(iSubItem) of
  2225. dvSize: {Size: }
  2226. if not IsDirectory then Value := FormatPanelBytes(Size, FormatSizeBytes);
  2227. dvType: {FileType: }
  2228. Value := TypeName;
  2229. dvChanged: {Date}
  2230. Value := FormatFileTime(FileTime);
  2231. dvAttr: {Attrs:}
  2232. Value := GetAttrString(Attr);
  2233. dvExt:
  2234. Value := FileExt;
  2235. end {Case}
  2236. end; {SubItem}
  2237. StrPLCopy(pszText, Value, cchTextMax - 1);
  2238. end;
  2239. {Set display icon of current file:}
  2240. if (iSubItem = 0) and ((DispInfo.Mask and LVIF_IMAGE) <> 0) then
  2241. begin
  2242. iImage := PFileRec(ListItem.Data).ImageIndex;
  2243. Mask := Mask or LVIF_DI_SETITEM;
  2244. end;
  2245. end; {With PFileRec Do}
  2246. {Mask := Mask Or LVIF_DI_SETITEM; {<== causes flickering display and icons not to be updated on renaming the item}
  2247. end;
  2248. function TDirView.ItemColor(Item: TListItem): TColor;
  2249. begin
  2250. if PFileRec(Item.Data).Attr and FILE_ATTRIBUTE_COMPRESSED <> 0 then
  2251. begin
  2252. if SupportsDarkMode and DarkMode then Result := clSkyBlue
  2253. else Result := clBlue;
  2254. end
  2255. else
  2256. if DimmHiddenFiles and not Item.Selected and
  2257. (PFileRec(Item.Data).Attr and FILE_ATTRIBUTE_HIDDEN <> 0) then
  2258. Result := clGrayText
  2259. else
  2260. Result := clDefaultItemColor;
  2261. end;
  2262. procedure TDirView.StartFileDeleteThread;
  2263. var
  2264. Files: TStringList;
  2265. begin
  2266. Files := TStringList.Create;
  2267. try
  2268. CreateFileList(False, True, Files);
  2269. TFileDeleteThread.Create(Files, MaxWaitTimeOut, SignalFileDelete);
  2270. finally
  2271. Files.Free;
  2272. end;
  2273. end;
  2274. procedure TDirView.StartIconUpdateThread;
  2275. begin
  2276. if DirOK then
  2277. begin
  2278. if not Assigned(FIconUpdateThread) then
  2279. begin
  2280. if Items.Count > 0 then
  2281. FIconUpdateThread := TIconUpdateThread.Create(Self);
  2282. end
  2283. else
  2284. begin
  2285. Assert(not FIconUpdateThread.Terminated);
  2286. FIconUpdateThread.Index := 0;
  2287. if ViewStyle = vsReport then
  2288. FIconUpdateThread.Resume;
  2289. end;
  2290. end;
  2291. end; {StartIconUpdateThread}
  2292. procedure TDirView.StopIconUpdateThread;
  2293. begin
  2294. if Assigned(FIconUpdateThread) then
  2295. begin
  2296. FIconUpdateThread.Terminate;
  2297. FIconUpdateThread.Priority := tpHigher;
  2298. if FIconUpdateThread.Suspended then
  2299. FIconUpdateThread.Resume;
  2300. if not FIconUpdateThread.WaitFor(MSecsPerSec div 4) then
  2301. begin
  2302. // This prevents Destroy from waiting for (stalled) thread
  2303. FIconUpdateThread.Suspend;
  2304. end;
  2305. FIconUpdateThread.Destroy;
  2306. FIconUpdateThread := nil;
  2307. end;
  2308. end; {StopIconUpdateThread}
  2309. procedure TDirView.StopWatchThread;
  2310. begin
  2311. if Assigned(FDiscMonitor) then
  2312. begin
  2313. FDiscMonitor.Enabled := False;
  2314. end;
  2315. end; {StopWatchThread}
  2316. procedure TDirView.StartWatchThread;
  2317. begin
  2318. if (Length(Path) > 0) and WatchForChanges and DirOK then
  2319. begin
  2320. if not Assigned(FDiscMonitor) then
  2321. begin
  2322. FDiscMonitor := TDiscMonitor.Create(Self);
  2323. with FDiscMonitor do
  2324. begin
  2325. ChangeDelay := msThreadChangeDelay;
  2326. SubTree := False;
  2327. Filters := [moDirName, moFileName, moSize, moAttributes, moLastWrite];
  2328. SetDirectory(PathName);
  2329. OnChange := ChangeDetected;
  2330. OnInvalid := ChangeInvalid;
  2331. Open;
  2332. end;
  2333. end
  2334. else
  2335. begin
  2336. FDiscMonitor.SetDirectory(PathName);
  2337. FDiscMonitor.Enabled := True;
  2338. end;
  2339. end;
  2340. end; {StartWatchThread}
  2341. procedure TDirView.TimerOnTimer(Sender: TObject);
  2342. begin
  2343. if not Loading then
  2344. begin
  2345. // fix by MP: disable timer and reload directory before call to event
  2346. FChangeTimer.Enabled := False;
  2347. FChangeTimer.Interval := 0;
  2348. Reload2;
  2349. end;
  2350. end; {TimerOnTimer}
  2351. procedure TDirView.ChangeDetected(Sender: TObject; const Directory: string;
  2352. var SubdirsChanged: Boolean);
  2353. begin
  2354. // avoid prolonging the actual update with each change, as if continous change
  2355. // is occuring in current directory, the panel will never be updated
  2356. if not FChangeTimer.Enabled then
  2357. begin
  2358. FDirty := True;
  2359. FChangeTimer.Interval := FChangeInterval;
  2360. FChangeTimer.Enabled := True;
  2361. end;
  2362. end; {ChangeDetected}
  2363. procedure TDirView.ChangeInvalid(Sender: TObject; const Directory: string;
  2364. const ErrorStr: string);
  2365. begin
  2366. FDiscMonitor.Close;
  2367. end; {ChangeInvalid}
  2368. function TDirView.WatchThreadActive: Boolean;
  2369. begin
  2370. Result := WatchForChanges and Assigned(FDiscMonitor) and
  2371. FDiscMonitor.Active and FDiscMonitor.Enabled;
  2372. end; {WatchThreadActive}
  2373. procedure TDirView.SetChangeInterval(Value: Cardinal);
  2374. begin
  2375. if Value > 0 then
  2376. begin
  2377. FChangeInterval := Value;
  2378. FChangeTimer.Interval := Value;
  2379. end;
  2380. end; {SetChangeInterval}
  2381. procedure TDirView.SetDirColProperties(Value: TDirViewColProperties);
  2382. begin
  2383. if Value <> ColProperties then
  2384. ColProperties := Value;
  2385. end;
  2386. function TDirView.GetDirColProperties: TDirViewColProperties;
  2387. begin
  2388. Result := TDirViewColProperties(ColProperties);
  2389. end;
  2390. procedure TDirView.SetWatchForChanges(Value: Boolean);
  2391. begin
  2392. if WatchForChanges <> Value then
  2393. begin
  2394. FWatchForChanges := Value;
  2395. if not (csDesigning in ComponentState) then
  2396. begin
  2397. if Value then StartWatchThread
  2398. else StopWatchThread;
  2399. end;
  2400. end;
  2401. end; {SetWatchForChanges}
  2402. procedure TDirView.DisplayPropertiesMenu;
  2403. var
  2404. FileList: TStringList;
  2405. Index: Integer;
  2406. PIDLRel: PItemIDList;
  2407. PIDLPath: PItemIDList;
  2408. begin
  2409. if not Assigned(ItemFocused) then
  2410. ShellExecuteContextCommand(ParentForm.Handle, shcProperties, PathName)
  2411. else
  2412. if (not IsRecycleBin) and (MarkedCount > 1) and ItemFocused.Selected then
  2413. begin
  2414. FileList := TStringList.Create;
  2415. try
  2416. CreateFileList(False, True, FileList);
  2417. for Index := 0 to Pred(FileList.Count) do
  2418. FileList[Index] := ExtractFileName(FileList[Index]);
  2419. ShellExecuteContextCommand(ParentForm.Handle, shcProperties,
  2420. PathName, FileList);
  2421. finally
  2422. FileList.Free;
  2423. end;
  2424. end
  2425. else
  2426. if Assigned(ItemFocused.Data) then
  2427. begin
  2428. if IsRecycleBin then
  2429. begin
  2430. if Assigned(PFileRec(ItemFocused.Data)^.PIDL) then
  2431. begin
  2432. PIDL_GetRelative(PFileRec(ItemFocused.Data)^.PIDL, PIDLPath, PIDLRel);
  2433. ShellExecuteContextCommand(ParentForm.Handle, shcProperties, iRecycleFolder, 1, PIDLRel);
  2434. FreePIDL(PIDLRel);
  2435. FreePIDL(PIDLPath);
  2436. end;
  2437. end
  2438. else
  2439. ShellExecuteContextCommand(ParentForm.Handle, shcProperties,
  2440. ItemFullFileName(ItemFocused));
  2441. end;
  2442. end;
  2443. procedure TDirView.ExecuteFile(Item: TListItem);
  2444. var
  2445. DefDir: string;
  2446. FileName: string;
  2447. begin
  2448. if (UpperCase(PFileRec(Item.Data)^.FileExt) = 'LNK') or
  2449. PFileRec(Item.Data)^.IsDirectory then
  2450. begin
  2451. if PFileRec(Item.Data)^.IsDirectory then
  2452. begin
  2453. FileName := ItemFullFileName(Item);
  2454. if not DirectoryExistsFix(FileName) then
  2455. begin
  2456. Reload2;
  2457. if Assigned(FDriveView) and Assigned(FDriveView.Selected) then
  2458. with FDriveView do
  2459. ValidateDirectory(Selected);
  2460. Exit;
  2461. end;
  2462. end
  2463. else
  2464. FileName := ResolveFileShortCut(ItemFullFileName(Item), True);
  2465. if DirectoryExistsFix(FileName) then
  2466. begin
  2467. Path := FileName;
  2468. Exit;
  2469. end
  2470. else
  2471. if not FileExistsFix(ApiPath(FileName)) then
  2472. begin
  2473. Exit;
  2474. end;
  2475. end;
  2476. GetDir(0, DefDir);
  2477. ChDir(PathName);
  2478. try
  2479. ShellExecuteContextCommand(ParentForm.Handle, shcDefault,
  2480. ItemFullFileName(Item));
  2481. finally
  2482. ChDir(DefDir);
  2483. end;
  2484. end;
  2485. procedure TDirView.ExecuteDrive(Drive: string);
  2486. var
  2487. APath: string;
  2488. begin
  2489. if Assigned(FLastPath) and FLastPath.ContainsKey(Drive) then
  2490. begin
  2491. APath := FLastPath[Drive];
  2492. if not DirectoryExists(ApiPath(APath)) then
  2493. begin
  2494. if DriveInfo.IsRealDrive(Drive) then
  2495. APath := Format('%s:', [Drive])
  2496. else
  2497. APath := Drive;
  2498. end;
  2499. end
  2500. else
  2501. begin
  2502. if DriveInfo.IsRealDrive(Drive) then
  2503. begin
  2504. GetDir(Integer(Drive[1]) - Integer('A') + 1, APath);
  2505. APath := ExcludeTrailingPathDelimiter(APath);
  2506. end
  2507. else
  2508. begin
  2509. APath := Drive;
  2510. end;
  2511. end;
  2512. if Path <> APath then
  2513. Path := APath;
  2514. end;
  2515. procedure TDirView.ExecuteHomeDirectory;
  2516. begin
  2517. Path := HomeDirectory;
  2518. end;
  2519. procedure TDirView.ExecuteParentDirectory;
  2520. begin
  2521. if Valid then
  2522. begin
  2523. if Assigned(DriveView) and Assigned(DriveView.Selected) then
  2524. begin
  2525. DriveView.Selected := DriveView.Selected.Parent
  2526. end
  2527. else
  2528. begin
  2529. Path := ExtractFilePath(Path);
  2530. end;
  2531. end;
  2532. end;
  2533. procedure TDirView.ExecuteRootDirectory;
  2534. begin
  2535. if Valid then
  2536. begin
  2537. FNotRelative := True;
  2538. try
  2539. Path := ExtractFileDrive(Path);
  2540. finally
  2541. FNotRelative := False;
  2542. end;
  2543. end;
  2544. end;
  2545. procedure TDirView.Delete(Item: TListItem);
  2546. begin
  2547. if Assigned(Item) and Assigned(Item.Data) and not (csRecreating in ControlState) then
  2548. with PFileRec(Item.Data)^ do
  2549. begin
  2550. SetLength(FileName, 0);
  2551. SetLength(TypeName, 0);
  2552. SetLength(DisplayName, 0);
  2553. if Assigned(PIDL) then FreePIDL(PIDL);
  2554. Dispose(PFileRec(Item.Data));
  2555. Item.Data := nil;
  2556. end;
  2557. inherited Delete(Item);
  2558. end; {Delete}
  2559. procedure TDirView.InternalEdit(const HItem: TLVItem);
  2560. var
  2561. Item: TListItem;
  2562. Info: string;
  2563. NewCaption: string;
  2564. IsDirectory: Boolean;
  2565. begin
  2566. Item := GetItemFromHItem(HItem);
  2567. IsDirectory := DirectoryExists(ItemFullFileName(Item));
  2568. NewCaption := HItem.pszText;
  2569. StopWatchThread;
  2570. if IsDirectory and Assigned(FDriveView) then
  2571. TDriveView(FDriveView).StopWatchThread;
  2572. with FFileOperator do
  2573. begin
  2574. Flags := [foAllowUndo, foNoConfirmation];
  2575. Operation := foRename;
  2576. OperandFrom.Clear;
  2577. OperandTo.Clear;
  2578. OperandFrom.Add(ItemFullFileName(Item));
  2579. OperandTo.Add(FPath + '\' + HItem.pszText);
  2580. end;
  2581. try
  2582. if FFileOperator.Execute then
  2583. begin
  2584. if IsDirectory and Assigned(FDriveView) then
  2585. with FDriveView do
  2586. if Assigned(Selected) then
  2587. ValidateDirectory(Selected);
  2588. with GetFileRec(Item.Index)^ do
  2589. begin
  2590. Empty := True;
  2591. IconEmpty := True;
  2592. FileName := NewCaption;
  2593. DisplayName := FileName;
  2594. FileExt := UpperCase(ExtractFileExt(HItem.pszText));
  2595. FileExt := Copy(FileExt, 2, Length(FileExt) - 1);
  2596. TypeName := EmptyStr;
  2597. if Assigned(PIDL) then
  2598. FreePIDL(PIDL);
  2599. end;
  2600. GetDisplayData(Item, True);
  2601. ResetItemImage(Item.Index);
  2602. UpdateItems(Item.Index, Item.Index);
  2603. if Assigned(OnEdited) then OnEdited(Self, Item, NewCaption);
  2604. if Item <> nil then Item.Caption := NewCaption;
  2605. SortItems;
  2606. if Assigned(ItemFocused) then ItemFocused.MakeVisible(False);
  2607. end
  2608. else
  2609. begin
  2610. Item.Caption := GetFileRec(Item.Index)^.FileName;
  2611. Item.Update;
  2612. if FileOrDirExists(IncludeTrailingPathDelimiter(FPath) + HItem.pszText) then
  2613. Info := SErrorRenameFileExists + HItem.pszText
  2614. else
  2615. Info := SErrorRenameFile + HItem.pszText;
  2616. MessageBeep(MB_ICONHAND);
  2617. if MessageDlg(FormatLastOSError(Info), mtError, [mbOK, mbAbort], 0) = mrOK then
  2618. RetryRename(HItem.pszText);
  2619. end;
  2620. finally
  2621. Sleep(0);
  2622. LoadEnabled := True;
  2623. if FWatchForChanges and (not WatchThreadActive) then
  2624. StartWatchThread;
  2625. if Assigned(FDriveView) then
  2626. TDriveView(FDriveView).StartWatchThread;
  2627. end;
  2628. end;
  2629. function TDirView.ItemFileName(Item: TListItem): string;
  2630. begin
  2631. if Assigned(Item) and Assigned(Item.Data) then
  2632. Result := ExtractFileName(PFileRec(Item.Data)^.FileName)
  2633. else
  2634. Result := '';
  2635. end;
  2636. function TDirView.ItemFileSize(Item: TListItem): Int64;
  2637. begin
  2638. Result := 0;
  2639. if Assigned(Item) and Assigned(Item.Data) then
  2640. with PFileRec(Item.Data)^ do
  2641. if Size >= 0 then Result := Size;
  2642. end;
  2643. function TDirView.ItemFileTime(Item: TListItem;
  2644. var Precision: TDateTimePrecision): TDateTime;
  2645. begin
  2646. Result := FileTimeToDateTime(PFileRec(Item.Data)^.FileTime);
  2647. Precision := tpMillisecond;
  2648. end;
  2649. function TDirView.ItemImageIndex(Item: TListItem;
  2650. Cache: Boolean): Integer;
  2651. begin
  2652. if Assigned(Item) and Assigned(Item.Data) then
  2653. begin
  2654. if PFileRec(Item.Data)^.IconEmpty then
  2655. begin
  2656. if Cache then Result := -1
  2657. else Result := UnknownFileIcon;
  2658. end
  2659. else
  2660. begin
  2661. if (not Cache) or MatchesFileExt(PFileRec(Item.Data)^.FileExt, SpecialExtensions) then
  2662. Result := PFileRec(Item.Data)^.ImageIndex
  2663. else
  2664. Result := -1
  2665. end;
  2666. end
  2667. else Result := -1;
  2668. end;
  2669. procedure TDirView.Notification(AComponent: TComponent; Operation: TOperation);
  2670. begin
  2671. inherited Notification(AComponent, Operation);
  2672. if (Operation = opRemove) and (AComponent = FDriveView) then
  2673. FDriveView := nil;
  2674. end; {Notification}
  2675. procedure TDirView.ReloadDirectory;
  2676. begin
  2677. Reload(True);
  2678. end;
  2679. procedure TDirView.ResetItemImage(Index: Integer);
  2680. var
  2681. LVI: TLVItem;
  2682. begin
  2683. with PFileRec(Items[Index].Data)^, LVI do
  2684. begin
  2685. {Update imageindex:}
  2686. Mask := LVIF_STATE or LVIF_DI_SETITEM or LVIF_IMAGE;
  2687. iItem := Index;
  2688. iSubItem := 0;
  2689. if ListView_GetItem(Handle, LVI) then
  2690. begin
  2691. iImage := I_IMAGECALLBACK;
  2692. Mask := Mask and (not LVIF_DI_SETITEM);
  2693. ListView_SetItem(Handle, LVI);
  2694. end;
  2695. end; {With}
  2696. end; {ResetItemImage}
  2697. { Drag&Drop handling }
  2698. procedure TDirView.SignalFileDelete(Sender: TObject; Files: TStringList);
  2699. {Called by TFileDeleteThread, when a file was deleted by the Drag&Drop target window:}
  2700. var
  2701. Index: Integer;
  2702. begin
  2703. if Files.Count > 0 then
  2704. for Index := 0 to Files.Count - 1 do
  2705. ValidateFile(Files[Index]);
  2706. end;
  2707. procedure TDirView.DDMenuPopup(Sender: TObject; AMenu: HMenu; DataObj: IDataObject;
  2708. AMinCustCmd: Integer; grfKeyState: Longint; pt: TPoint);
  2709. begin
  2710. if Assigned(FDriveView) then
  2711. begin
  2712. // When a change is detected while menu is popped up
  2713. // it loses focus (or something similar)
  2714. // preventing it from handling subsequent click.
  2715. // This typically happens when right-dragging from remote to local panel,
  2716. // what causes temp directory being created+deleted.
  2717. // This is HACK, we should implement some uniform watch disabling/enabling
  2718. TDriveView(FDriveView).SuspendChangeTimer;
  2719. end;
  2720. inherited;
  2721. end;
  2722. procedure TDirView.DDMenuDone(Sender: TObject; AMenu: HMenu);
  2723. begin
  2724. if not WatchThreadActive then
  2725. begin
  2726. FChangeTimer.Interval := Min(FChangeInterval * 2, 3000);
  2727. FChangeTimer.Enabled := True;
  2728. end;
  2729. if Assigned(FDriveView) then
  2730. begin
  2731. TDriveView(FDriveView).ResumeChangeTimer;
  2732. end;
  2733. inherited;
  2734. end;
  2735. procedure TDirView.DDDropHandlerSucceeded(Sender: TObject; grfKeyState: Longint;
  2736. Point: TPoint; dwEffect: Longint);
  2737. begin
  2738. // Not sure why is this here. There's no "disable" counterparty.
  2739. if not WatchThreadActive then
  2740. begin
  2741. FChangeTimer.Interval := FChangeInterval;
  2742. FChangeTimer.Enabled := True;
  2743. end;
  2744. inherited;
  2745. end;
  2746. procedure TDirView.AddToDragFileList(FileList: TFileList; Item: TListItem);
  2747. begin
  2748. Assert(Assigned(Item));
  2749. if IsRecycleBin then
  2750. begin
  2751. if Assigned(Item.Data) then
  2752. begin
  2753. if UpperCase(ExtractFileExt(PFileRec(Item.Data)^.DisplayName)) =
  2754. ('.' + PFileRec(Item.Data)^.FileExt) then
  2755. FileList.AddItemEx(PFileRec(Item.Data)^.PIDL,
  2756. ItemFullFileName(Item), PFileRec(Item.Data)^.DisplayName)
  2757. else
  2758. FileList.AddItemEx(PFileRec(Item.Data)^.PIDL,
  2759. ItemFullFileName(Item), PFileRec(Item.Data)^.DisplayName +
  2760. ExtractFileExt(PFileRec(Item.Data)^.FileName));
  2761. end;
  2762. end
  2763. else inherited;
  2764. end;
  2765. procedure TDirView.DDDragDetect(grfKeyState: Longint; DetectStart, Point: TPoint;
  2766. DragStatus: TDragDetectStatus);
  2767. var
  2768. WasWatchThreadActive: Boolean;
  2769. begin
  2770. if (DragStatus = ddsDrag) and (MarkedCount > 0) then
  2771. begin
  2772. WasWatchThreadActive := WatchThreadActive;
  2773. inherited;
  2774. if (LastDDResult = drMove) and (not WasWatchThreadActive) then
  2775. StartFileDeleteThread;
  2776. end;
  2777. end; {DDDragDetect}
  2778. procedure TDirView.DDChooseEffect(grfKeyState: Integer; var dwEffect: Integer; PreferredEffect: Integer);
  2779. begin
  2780. if DragDropFilesEx.OwnerIsSource and
  2781. (dwEffect = DROPEFFECT_COPY) and (not Assigned(DropTarget)) then
  2782. begin
  2783. dwEffect := DROPEFFECT_NONE
  2784. end
  2785. else
  2786. if (grfKeyState and (MK_CONTROL or MK_SHIFT) = 0) and (PreferredEffect = 0) then
  2787. begin
  2788. if FDragDrive <> '' then
  2789. begin
  2790. if ExeDrag and DriveInfo.IsFixedDrive(DriveInfo.GetDriveKey(Path)) and DriveInfo.IsFixedDrive(FDragDrive) then
  2791. begin
  2792. dwEffect := DROPEFFECT_LINK;
  2793. end
  2794. else
  2795. begin
  2796. if DragOnDriveIsMove and
  2797. (not DDOwnerIsSource or Assigned(DropTarget)) and
  2798. ((SameText(FDragDrive, DriveInfo.GetDriveKey(Path)) and (dwEffect = DROPEFFECT_COPY) and
  2799. (DragDropFilesEx.AvailableDropEffects and DROPEFFECT_MOVE <> 0))
  2800. or IsRecycleBin) then
  2801. begin
  2802. dwEffect := DROPEFFECT_MOVE;
  2803. end;
  2804. end;
  2805. end;
  2806. end;
  2807. inherited;
  2808. end;
  2809. procedure TDirView.PerformDragDropFileOperation(TargetPath: string;
  2810. Effect: Integer; RenameOnCollision: Boolean; Paste: Boolean);
  2811. var
  2812. Index: Integer;
  2813. SourcePath: string;
  2814. OldCursor: TCursor;
  2815. OldWatchForChanges: Boolean;
  2816. IsRecycleBin: Boolean;
  2817. SourceIsDirectory: Boolean;
  2818. Node: TTreeNode;
  2819. begin
  2820. if DragDropFilesEx.FileList.Count > 0 then
  2821. begin
  2822. if not DirectoryExists(TargetPath) then
  2823. begin
  2824. Reload(True);
  2825. DDError(DDPathNotFoundError);
  2826. end
  2827. else
  2828. begin
  2829. IsRecycleBin := Self.IsRecycleBin or
  2830. ((DropTarget <> nil) and ItemIsRecycleBin(DropTarget));
  2831. if not (DragDropFilesEx.FileNamesAreMapped and IsRecycleBin) then
  2832. begin
  2833. OldCursor := Screen.Cursor;
  2834. OldWatchForChanges := WatchForChanges;
  2835. SourceIsDirectory := True;
  2836. SourcePath := EmptyStr;
  2837. try
  2838. Screen.Cursor := crHourGlass;
  2839. WatchForChanges := False;
  2840. if Effect in [DROPEFFECT_COPY, DROPEFFECT_MOVE] then
  2841. begin
  2842. StopWatchThread;
  2843. if Assigned(DriveView) then
  2844. TDriveView(DriveView).StopWatchThread;
  2845. if (DropSourceControl <> Self) and
  2846. (DropSourceControl is TDirView) then
  2847. TDirView(DropSourceControl).StopWatchThread;
  2848. if DropFiles(
  2849. DragDropFilesEx, Effect, FFileOperator, TargetPath, RenameOnCollision, IsRecycleBin,
  2850. ConfirmDelete, ConfirmOverwrite, Paste,
  2851. Self, OnDDFileOperation, SourcePath, SourceIsDirectory) then
  2852. begin
  2853. ReLoad2;
  2854. if Assigned(OnDDFileOperationExecuted) then
  2855. OnDDFileOperationExecuted(Self, Effect, SourcePath, TargetPath);
  2856. end;
  2857. end
  2858. else
  2859. if Effect = DROPEFFECT_LINK then
  2860. (* Create Link requested: *)
  2861. begin
  2862. StopWatchThread;
  2863. for Index := 0 to DragDropFilesEx.FileList.Count - 1 do
  2864. begin
  2865. if not DropLink(PFDDListItem(DragDropFilesEx.FileList[Index]), TargetPath) then
  2866. begin
  2867. DDError(DDCreateShortCutError);
  2868. end;
  2869. end;
  2870. ReLoad2;
  2871. end;
  2872. if Assigned(DropSourceControl) and
  2873. (DropSourceControl is TDirView) and
  2874. (DropSourceControl <> Self) and
  2875. (Effect = DROPEFFECT_MOVE) then
  2876. begin
  2877. TDirView(DropSourceControl).ValidateSelectedFiles;
  2878. end;
  2879. if Assigned(FDriveView) and SourceIsDirectory then
  2880. begin
  2881. with TDriveView(FDriveView) do
  2882. begin
  2883. try
  2884. ValidateDirectory(FindNodeToPath(TargetPath));
  2885. except
  2886. end;
  2887. if (Effect = DROPEFFECT_MOVE) or IsRecycleBin then
  2888. try
  2889. Node := FindNodeToPath(SourcePath);
  2890. if Assigned(Node) and Assigned(Node.Parent) then
  2891. Node := Node.Parent;
  2892. ValidateDirectory(Node);
  2893. except
  2894. end;
  2895. end;
  2896. end;
  2897. finally
  2898. FFileOperator.OperandFrom.Clear;
  2899. FFileOperator.OperandTo.Clear;
  2900. if Assigned(FDriveView) then
  2901. TDriveView(FDriveView).StartWatchThread;
  2902. Sleep(0);
  2903. WatchForChanges := OldWatchForChanges;
  2904. if (DropSourceControl <> Self) and (DropSourceControl is TDirView) then
  2905. TDirView(DropSourceControl).StartWatchThread;
  2906. Screen.Cursor := OldCursor;
  2907. end;
  2908. end;
  2909. end;
  2910. end;
  2911. end; {PerformDragDropFileOperation}
  2912. procedure TDirView.DDError(ErrorNo: TDDError);
  2913. begin
  2914. if Assigned(OnDDError) then OnDDError(Self, ErrorNo)
  2915. else
  2916. raise EDragDrop.Create(Format(SDragDropError, [Ord(ErrorNo)]));
  2917. end; {DDError}
  2918. function TDirView.GetCanUndoCopyMove: Boolean;
  2919. begin
  2920. Result := Assigned(FFileOperator) and FFileOperator.CanUndo;
  2921. end; {CanUndoCopyMove}
  2922. function TDirView.UndoCopyMove : Boolean;
  2923. var
  2924. LastTarget: string;
  2925. LastSource: string;
  2926. begin
  2927. Result := False;
  2928. if FFileOperator.CanUndo then
  2929. begin
  2930. Lasttarget := FFileOperator.LastOperandTo[0];
  2931. LastSource := FFileOperator.LastOperandFrom[0];
  2932. if Assigned(FDriveView) then
  2933. TDriveView(FDriveView).StopAllWatchThreads;
  2934. Result := FFileOperator.UndoExecute;
  2935. if not WatchthreadActive then
  2936. Reload2;
  2937. if Assigned(FDriveView) then
  2938. with TDriveView(FDriveView) do
  2939. begin
  2940. ValidateDirectory(FindNodeToPath(ExtractFilePath(LastTarget)));
  2941. ValidateDirectory(FindNodeToPath(ExtractFilePath(LastSource)));
  2942. StartAllWatchThreads;
  2943. end;
  2944. end;
  2945. end; {UndoCopyMove}
  2946. procedure TDirView.EmptyClipboard;
  2947. var
  2948. Item: TListItem;
  2949. begin
  2950. if Windows.OpenClipBoard(0) then
  2951. begin
  2952. Windows.EmptyClipBoard;
  2953. Windows.CloseClipBoard;
  2954. if LastClipBoardOperation <> cboNone then
  2955. begin
  2956. Item := GetNextItem(nil, sdAll, [isCut]);
  2957. while Assigned(Item) do
  2958. begin
  2959. Item.Cut := False;
  2960. Item := GetNextItem(Item, sdAll, [isCut]);
  2961. end;
  2962. end;
  2963. LastClipBoardOperation := cboNone;
  2964. if Assigned(FDriveView) then
  2965. TDriveView(FDriveView).LastPathCut := '';
  2966. end;
  2967. end; {EmptyClipBoard}
  2968. function TDirView.DoCopyToClipboard(Focused: Boolean; Cut: Boolean; Operation: TClipBoardOperation): Boolean;
  2969. var
  2970. Item: TListItem;
  2971. SaveCursor: TCursor;
  2972. begin
  2973. SaveCursor := Screen.Cursor;
  2974. Screen.Cursor := crHourGlass;
  2975. try
  2976. Result := False;
  2977. EmptyClipBoard;
  2978. DragDropFilesEx.FileList.Clear;
  2979. if OperateOnFocusedFile(Focused) or (SelCount > 0) then
  2980. begin
  2981. if OperateOnFocusedFile(Focused) then
  2982. begin
  2983. DragDropFilesEx.FileList.AddItem(nil, ItemFullFileName(ItemFocused));
  2984. end
  2985. else
  2986. begin
  2987. Item := GetNextItem(nil, sdAll, [isSelected]);
  2988. while Assigned(Item) do
  2989. begin
  2990. DragDropFilesEx.FileList.AddItem(nil, ItemFullFileName(Item));
  2991. Item.Cut := Cut;
  2992. Item := GetNextItem(Item, sdAll, [isSelected]);
  2993. end;
  2994. end;
  2995. Result := DragDropFilesEx.CopyToClipBoard;
  2996. LastClipBoardOperation := Operation;
  2997. end;
  2998. finally
  2999. Screen.Cursor := SaveCursor;
  3000. end;
  3001. end; {DoCopyToClipBoard}
  3002. function TDirView.CopyToClipBoard(Focused: Boolean): Boolean;
  3003. begin
  3004. Result := DoCopyToClipboard(Focused, False, cboCopy);
  3005. end;
  3006. function TDirView.CutToClipBoard(Focused: Boolean): Boolean;
  3007. begin
  3008. Result := DoCopyToClipboard(Focused, True, cboCut);
  3009. end;
  3010. function TDirView.PasteFromClipBoard(TargetPath: string): Boolean;
  3011. begin
  3012. DragDropFilesEx.FileList.Clear;
  3013. Result := False;
  3014. if CanPasteFromClipBoard and {MP}DragDropFilesEx.GetFromClipBoard{/MP}
  3015. then
  3016. begin
  3017. if TargetPath = '' then
  3018. TargetPath := PathName;
  3019. case LastClipBoardOperation of
  3020. cboNone:
  3021. begin
  3022. PerformDragDropFileOperation(TargetPath, DROPEFFECT_COPY, False, True);
  3023. if Assigned(OnDDExecuted) then OnDDExecuted(Self, DROPEFFECT_COPY);
  3024. end;
  3025. cboCopy:
  3026. begin
  3027. PerformDragDropFileOperation(TargetPath, DROPEFFECT_COPY,
  3028. ExcludeTrailingPathDelimiter(ExtractFilePath(TFDDListItem(DragDropFilesEx.FileList[0]^).Name)) = Path, True);
  3029. if Assigned(OnDDExecuted) then OnDDExecuted(Self, DROPEFFECT_COPY);
  3030. end;
  3031. cboCut:
  3032. begin
  3033. PerformDragDropFileOperation(TargetPath, DROPEFFECT_MOVE, False, True);
  3034. if Assigned(OnDDExecuted) then OnDDExecuted(Self, DROPEFFECT_MOVE);
  3035. EmptyClipBoard;
  3036. end;
  3037. end;
  3038. Result := True;
  3039. end;
  3040. end; {PasteFromClipBoard}
  3041. function TDirView.DragCompleteFileList: Boolean;
  3042. begin
  3043. Result := inherited DragCompleteFileList and
  3044. (FDriveType <> DRIVE_REMOVABLE);
  3045. end;
  3046. function TDirView.DuplicateSelectedFiles: Boolean;
  3047. begin
  3048. Result := False;
  3049. if SelCount > 0 then
  3050. begin
  3051. Result := CopyToClipBoard(False);
  3052. if Result then
  3053. try
  3054. SelectNewFiles := True;
  3055. Selected := nil;
  3056. Result := PasteFromClipBoard();
  3057. finally
  3058. SelectNewFiles := False;
  3059. if Assigned(Selected) then
  3060. begin
  3061. ItemFocused := Selected;
  3062. Selected.MakeVisible(False);
  3063. if SelCount = 1 then
  3064. Selected.EditCaption;
  3065. end;
  3066. end;
  3067. end;
  3068. EmptyClipBoard;
  3069. end; {DuplicateFiles}
  3070. function TDirView.NewColProperties: TCustomListViewColProperties;
  3071. begin
  3072. Result := TDirViewColProperties.Create(Self);
  3073. end;
  3074. function TDirView.SortAscendingByDefault(Index: Integer): Boolean;
  3075. begin
  3076. Result := not (TDirViewCol(Index) in [dvSize, dvChanged]);
  3077. end;
  3078. procedure TDirView.SetItemImageIndex(Item: TListItem; Index: Integer);
  3079. begin
  3080. Assert(Assigned(Item));
  3081. if Assigned(Item.Data) then
  3082. with PFileRec(Item.Data)^ do
  3083. begin
  3084. ImageIndex := Index;
  3085. IconEmpty := (ImageIndex < 0);
  3086. end;
  3087. end;
  3088. {=================================================================}
  3089. initialization
  3090. LastClipBoardOperation := cboNone;
  3091. DaylightHack := (not IsWin7);
  3092. end.