DirView.pas 102 KB

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