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