DirView.pas 100 KB

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