DirView.pas 101 KB

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