DirView.pas 100 KB

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