DirView.pas 101 KB

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