DirView.pas 102 KB

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