DirView.pas 101 KB

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