DirView.pas 104 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552
  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. type
  1426. TSHGetFileInfoThread = class(TCompThread)
  1427. private
  1428. FPIDL: PItemIDList;
  1429. FFileAttributes: DWORD;
  1430. FFlags: UINT;
  1431. FFileInfo: TSHFileInfo;
  1432. protected
  1433. procedure Execute; override;
  1434. public
  1435. constructor Create(PIDL: PItemIDList; FileAttributes: DWORD; Flags: UINT);
  1436. property FileInfo: TSHFileInfo read FFileInfo;
  1437. end;
  1438. constructor TSHGetFileInfoThread.Create(PIDL: PItemIDList; FileAttributes: DWORD; Flags: UINT);
  1439. begin
  1440. inherited Create(True);
  1441. FPIDL := PIDL;
  1442. FFileAttributes := FileAttributes;
  1443. FFlags := Flags;
  1444. end;
  1445. procedure TSHGetFileInfoThread.Execute;
  1446. begin
  1447. SHGetFileInfo(PChar(FPIDL), FFileAttributes, FFileInfo, SizeOf(FFileInfo), FFlags);
  1448. end;
  1449. procedure TDirView.GetDisplayData(Item: TListItem; FetchIcon: Boolean);
  1450. var
  1451. FileInfo: TShFileInfo;
  1452. Index: Integer;
  1453. PExtItem: PInfoCache;
  1454. CacheItem: TInfoCache;
  1455. IsSpecialExt: Boolean;
  1456. ForceByName: Boolean;
  1457. Eaten: ULONG;
  1458. shAttr: ULONG;
  1459. FileIconForName, FullName: string;
  1460. Thread: TSHGetFileInfoThread;
  1461. begin
  1462. Assert(Assigned(Item) and Assigned(Item.Data));
  1463. with PFileRec(Item.Data)^ do
  1464. begin
  1465. IsSpecialExt := MatchesFileExt(FileExt, SpecialExtensions);
  1466. if FUseIconCache and not IsSpecialExt and not IsDirectory then
  1467. begin
  1468. CacheItem.FileExt := FileExt;
  1469. Index := FInfoCacheList.FindSequential(Addr(CacheItem), CompareInfoCacheItems);
  1470. if Index >= 0 then
  1471. begin
  1472. TypeName := PInfoCache(FInfoCacheList[Index])^.TypeName;
  1473. ImageIndex := PInfoCache(FInfoCacheList[Index])^.ImageIndex;
  1474. Empty := False;
  1475. IconEmpty := False;
  1476. end;
  1477. end;
  1478. FetchIcon := IconEmpty and (FetchIcon or not IsSpecialExt);
  1479. if Empty or FetchIcon then
  1480. begin
  1481. if FetchIcon then
  1482. begin
  1483. {Fetch the Item FQ-PIDL:}
  1484. if not Assigned(PIDL) and IsSpecialExt then
  1485. begin
  1486. try
  1487. ShAttr := 0;
  1488. FDesktopFolder.ParseDisplayName(ParentForm.Handle, nil,
  1489. PChar(FPath + '\' + FileName), Eaten, PIDL, ShAttr);
  1490. {Retrieve the shell display attributes for directories:}
  1491. if IsDirectory and Assigned(PIDL) then
  1492. begin
  1493. shAttr := SFGAO_DISPLAYATTRMASK;
  1494. try
  1495. if Assigned(ParentFolder) and
  1496. Succeeded(ParentFolder.GetAttributesOf(1, PIDL, shAttr)) then
  1497. begin
  1498. if (shAttr and SFGAO_SHARE) <> 0 then
  1499. Item.OverlayIndex := 0;
  1500. end;
  1501. except end;
  1502. end;
  1503. except end;
  1504. end;
  1505. if IsDirectory then
  1506. begin
  1507. if FDriveType = DRIVE_FIXED then
  1508. begin
  1509. try
  1510. {Retrieve icon and typename for the directory}
  1511. if Assigned(PIDL) then
  1512. begin
  1513. SHGetFileInfo(PChar(PIDL), 0, FileInfo, SizeOf(FileInfo),
  1514. SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_PIDL)
  1515. end
  1516. else
  1517. begin
  1518. SHGetFileInfo(PChar(FPath + '\' + FileName), 0, FileInfo, SizeOf(FileInfo),
  1519. SHGFI_TYPENAME or SHGFI_SYSICONINDEX);
  1520. end;
  1521. if (FileInfo.iIcon <= 0) or (FileInfo.iIcon > SmallImages.Count) then
  1522. begin
  1523. {Invalid icon returned: retry with access file attribute flag:}
  1524. SHGetFileInfo(PChar(fPath + '\' + FileName), FILE_ATTRIBUTE_DIRECTORY,
  1525. FileInfo, SizeOf(FileInfo),
  1526. SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
  1527. end;
  1528. TypeName := FileInfo.szTypeName;
  1529. if FetchIcon then
  1530. begin
  1531. ImageIndex := FileInfo.iIcon;
  1532. IconEmpty := False;
  1533. end;
  1534. {Capture exceptions generated by the shell}
  1535. except
  1536. ImageIndex := StdDirIcon;
  1537. IconEmpty := False;
  1538. end; {Except}
  1539. end
  1540. else
  1541. begin
  1542. TypeName := StdDirTypeName;
  1543. ImageIndex := StdDirIcon;
  1544. IconEmpty := False;
  1545. end;
  1546. end
  1547. else
  1548. begin
  1549. {Retrieve icon and typename for the file}
  1550. try
  1551. ForceByName := False;
  1552. FullName := FPath + '\' + FileName;
  1553. FileIconForName := FullName;
  1554. if Assigned(OnFileIconForName) then
  1555. begin
  1556. OnFileIconForName(Self, Item, FileIconForName);
  1557. ForceByName := (FileIconForName <> FullName);
  1558. end;
  1559. if (not ForceByName) and Assigned(PIDL) then
  1560. begin
  1561. // Files with PIDL are typically .exe files.
  1562. // It may take long to retrieve an icon from exe file.
  1563. Thread :=
  1564. TSHGetFileInfoThread.Create(
  1565. PIDL, FILE_ATTRIBUTE_NORMAL, SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX or SHGFI_PIDL);
  1566. Thread.Resume;
  1567. if Thread.WaitFor(MSecsPerSec div 4) then
  1568. begin
  1569. FileInfo := Thread.FileInfo;
  1570. Thread.Free;
  1571. end
  1572. else
  1573. begin
  1574. // There's a chance for memory leak, if thread is terminated
  1575. // between WaitFor() and this line
  1576. Thread.FreeOnTerminate := True;
  1577. FileInfo.szTypeName[0] := #0;
  1578. FileInfo.iIcon := DefaultExeIcon;
  1579. end;
  1580. end
  1581. else
  1582. begin
  1583. SHGetFileInfo(PChar(FileIconForName), FILE_ATTRIBUTE_NORMAL, FileInfo, SizeOf(FileInfo),
  1584. SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX);
  1585. end;
  1586. TypeName := FileInfo.szTypeName;
  1587. ImageIndex := FileInfo.iIcon;
  1588. IconEmpty := False;
  1589. {Capture exceptions generated by the shell}
  1590. except
  1591. ImageIndex := UnKnownFileIcon;
  1592. IconEmpty := False;
  1593. end; {Except}
  1594. end;
  1595. if (Length(TypeName) > 0) then
  1596. begin
  1597. {Fill FileInfoCache:}
  1598. if FUseIconCache and not IsSpecialExt and not IconEmpty and not IsDirectory then
  1599. begin
  1600. GetMem(PExtItem, SizeOf(TInfoCache));
  1601. PExtItem.FileExt := FileExt;
  1602. PExtItem.TypeName := TypeName;
  1603. PExtItem.ImageIndex := ImageIndex;
  1604. FInfoCacheList.Add(PExtItem);
  1605. end;
  1606. end
  1607. else TypeName := Format(STextFileExt, [FileExt]);
  1608. end {If FetchIcon}
  1609. else
  1610. begin
  1611. try
  1612. if IsDirectory then
  1613. shGetFileInfo(PChar(FPath), FILE_ATTRIBUTE_DIRECTORY, FileInfo, SizeOf(FileInfo),
  1614. SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES)
  1615. else
  1616. shGetFileInfo(PChar(FPath + '\' + FileName), FILE_ATTRIBUTE_NORMAL, FileInfo, SizeOf(FileInfo),
  1617. SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES);
  1618. TypeName := FileInfo.szTypeName;
  1619. except
  1620. {Capture exceptions generated by the shell}
  1621. TypeName := '';
  1622. end;
  1623. if IconEmpty then
  1624. begin
  1625. if FileExt = ExeExtension then ImageIndex := DefaultExeIcon
  1626. else ImageIndex := UnKnownFileIcon;
  1627. end;
  1628. end;
  1629. Empty := False;
  1630. end;
  1631. end;
  1632. end; {GetDisplayData}
  1633. function TDirView.GetDirOK: Boolean;
  1634. begin
  1635. Result := FDirOK;
  1636. end;
  1637. function TDirView.ItemFullFileName(Item: TListItem): string;
  1638. begin
  1639. if Assigned(Item) and Assigned(Item.Data) then
  1640. begin
  1641. if not IsRecycleBin then
  1642. begin
  1643. if PFileRec(Item.Data)^.IsParentDir then
  1644. begin
  1645. Result := ExcludeTrailingBackslash(ExtractFilePath(FPath));
  1646. end
  1647. else
  1648. begin
  1649. Result := FPath + '\' + PFileRec(Item.Data)^.FileName;
  1650. end;
  1651. end
  1652. else
  1653. Result := PFileRec(Item.Data)^.FileName;
  1654. end
  1655. else
  1656. Result := EmptyStr;
  1657. end; {ItemFullFileName}
  1658. function TDirView.ItemFileNameOnly(Item: TListItem): string;
  1659. begin
  1660. Assert(Assigned(Item) and Assigned(Item.Data));
  1661. Result := PFileRec(Item.Data)^.FileName;
  1662. SetLength(Result, Length(Result) - Length(ItemFileExt(Item)));
  1663. end; {ItemFileNameOnly}
  1664. function TDirView.ItemFileExt(Item: TListItem): string;
  1665. begin
  1666. Assert(Assigned(Item) and Assigned(Item.Data));
  1667. Result := ExtractFileExt(PFileRec(Item.Data)^.FileName);
  1668. end; {ItemFileExt}
  1669. function TDirView.DeleteSelectedFiles(AllowUndo: Boolean): Boolean;
  1670. const
  1671. MaxSel = 10;
  1672. var
  1673. ItemIndex: Integer;
  1674. Item, NextItem: TListItem;
  1675. FileOperator: TFileOperator;
  1676. UpdateEnabled: Boolean;
  1677. WatchDir: Boolean;
  1678. Updating: Boolean;
  1679. DirDeleted: Boolean;
  1680. begin
  1681. AllowUndo := AllowUndo and (not IsRecycleBin);
  1682. DirDeleted := False;
  1683. if Assigned(FDriveView) then
  1684. TDriveView(FDriveView).StopWatchThread;
  1685. WatchDir := WatchForChanges;
  1686. WatchForChanges := False;
  1687. UpdateEnabled := (SelCount < MaxSel);
  1688. if not UpdateEnabled then Items.BeginUpdate;
  1689. FileOperator := TFileOperator.Create(Self);
  1690. try
  1691. ItemIndex := Selected.Index;
  1692. FileOperator.Operation := foDelete;
  1693. FileOperator.Flags := [foNoConfirmMkDir];
  1694. FileOperator.ProgressTitle := coFileOperatorTitle;
  1695. CreateFileList(False, True, FileOperator.OperandFrom);
  1696. if not ConfirmDelete then
  1697. FileOperator.Flags := FileOperator.Flags + [foNoConfirmation];
  1698. if AllowUndo then
  1699. FileOperator.Flags := FileOperator.Flags + [foAllowUndo];
  1700. StopIconUpdateThread;
  1701. Result := FileOperator.Execute;
  1702. Result := Result and (not FileOperator.OperationAborted);
  1703. Sleep(0);
  1704. Updating := False;
  1705. Item := GetNextItem(nil, sdAll, [isSelected]);
  1706. while Assigned(Item) do
  1707. begin
  1708. NextItem := GetNextItem(Item, sdAll, [isSelected]);
  1709. case PFileRec(Item.Data)^.IsDirectory of
  1710. True:
  1711. if not DirExists(ItemFullFileName(Item)) then
  1712. begin
  1713. DirDeleted := True;
  1714. Item.Delete;
  1715. end;
  1716. False:
  1717. if not CheckFileExists(ItemFullFileName(Item)) then
  1718. begin
  1719. if (SelCount > 3) and (not Updating) then
  1720. begin
  1721. Items.BeginUpdate;
  1722. Updating := True;
  1723. end;
  1724. Item.Delete;
  1725. end;
  1726. end;
  1727. Item := NextItem;
  1728. end;
  1729. if Updating then
  1730. Items.EndUpdate;
  1731. finally
  1732. if not UpdateEnabled then
  1733. Items.EndUpdate;
  1734. FileOperator.Free;
  1735. end;
  1736. if Assigned(DriveView) then
  1737. with DriveView do
  1738. begin
  1739. if DirDeleted and Assigned(Selected) then
  1740. ValidateDirectory(Selected);
  1741. TDriveView(FDriveView).StartWatchThread;
  1742. end;
  1743. if UseIconUpdateThread then StartIconUpdateThread;
  1744. WatchForChanges := WatchDir;
  1745. if (not Assigned(Selected)) and (Items.Count > 0) then
  1746. Selected := Items[Min(ItemIndex, Pred(Items.Count))];
  1747. end; {DeleteSelectedFiles}
  1748. function StrCmpLogicalW(const sz1, sz2: UnicodeString): Integer; stdcall; external 'shlwapi.dll';
  1749. function CompareLogicalText(const S1, S2: string): Integer;
  1750. begin
  1751. Result := StrCmpLogicalW(PChar(S1), PChar(S2));
  1752. end;
  1753. function CompareFileType(I1, I2: TListItem; P1, P2: PFileRec): Integer;
  1754. var
  1755. Key1, Key2: string;
  1756. begin
  1757. if P1.Empty then TDirView(I1.ListView).GetDisplayData(I1, False);
  1758. if P2.Empty then TDirView(I2.ListView).GetDisplayData(I2, False);
  1759. if P1.IsDirectory then
  1760. begin
  1761. Key1 := P1.TypeName + ' ' + P1.DisplayName;
  1762. Key2 := P2.TypeName + ' ' + P2.DisplayName;
  1763. end
  1764. else
  1765. begin
  1766. Key1 := P1.TypeName + ' ' + P1.FileExt + ' ' + P1.DisplayName;
  1767. Key2 := P2.TypeName + ' ' + P2.FileExt + ' ' + P2.DisplayName;
  1768. end;
  1769. Result := CompareLogicalText(Key1, Key2);
  1770. end;
  1771. function CompareFileTime(P1, P2: PFileRec): Integer;
  1772. var
  1773. Time1, Time2: Int64;
  1774. begin
  1775. Time1 := Int64(P1.FileTime.dwHighDateTime) shl 32 + P1.FileTime.dwLowDateTime;
  1776. Time2 := Int64(P2.FileTime.dwHighDateTime) shl 32 + P2.FileTime.dwLowDateTime;
  1777. if Time1 < Time2 then Result := fLess
  1778. else
  1779. if Time1 > Time2 then Result := fGreater
  1780. else Result := fEqual; // fallback
  1781. end;
  1782. function CompareFile(I1, I2: TListItem; AOwner: TDirView): Integer; stdcall;
  1783. var
  1784. ConsiderDirection: Boolean;
  1785. P1, P2: PFileRec;
  1786. begin
  1787. ConsiderDirection := True;
  1788. if I1 = I2 then Result := fEqual
  1789. else
  1790. if I1 = nil then Result := fLess
  1791. else
  1792. if I2 = nil then Result := fGreater
  1793. else
  1794. begin
  1795. P1 := PFileRec(I1.Data);
  1796. P2 := PFileRec(I2.Data);
  1797. if P1.isParentDir then
  1798. begin
  1799. Result := fLess;
  1800. ConsiderDirection := False;
  1801. end
  1802. else
  1803. if P2.isParentDir then
  1804. begin
  1805. Result := fGreater;
  1806. ConsiderDirection := False;
  1807. end
  1808. else
  1809. {Directories should always appear "grouped":}
  1810. if P1.isDirectory <> P2.isDirectory then
  1811. begin
  1812. if P1.isDirectory then
  1813. begin
  1814. Result := fLess;
  1815. ConsiderDirection := False;
  1816. end
  1817. else
  1818. begin
  1819. Result := fGreater;
  1820. ConsiderDirection := False;
  1821. end;
  1822. end
  1823. else
  1824. begin
  1825. Result := fEqual;
  1826. case AOwner.DirColProperties.SortDirColumn of
  1827. dvName:
  1828. ; // fallback
  1829. dvSize:
  1830. if P1.Size < P2.Size then Result := fLess
  1831. else
  1832. if P1.Size > P2.Size then Result := fGreater
  1833. else ; // fallback
  1834. dvType:
  1835. Result := CompareFileType(I1, I2, P1, P2);
  1836. dvChanged:
  1837. Result := CompareFileTime(P1, P2);
  1838. dvAttr:
  1839. if P1.Attr < P2.Attr then Result := fLess
  1840. else
  1841. if P1.Attr > P2.Attr then Result := fGreater
  1842. else ; // fallback
  1843. dvExt:
  1844. if not P1.isDirectory then
  1845. begin
  1846. Result := CompareLogicalText(
  1847. P1.FileExt + ' ' + P1.DisplayName, P2.FileExt + ' ' + P2.DisplayName);
  1848. end
  1849. else ; //fallback
  1850. else
  1851. ; // fallback
  1852. end;
  1853. if Result = fEqual then
  1854. begin
  1855. Result := CompareLogicalText(P1.DisplayName, P2.DisplayName)
  1856. end;
  1857. end;
  1858. end;
  1859. if ConsiderDirection and (not AOwner.SortAscending) then
  1860. begin
  1861. Result := -Result;
  1862. end;
  1863. end;
  1864. procedure TDirView.SortItems;
  1865. begin
  1866. if HandleAllocated then
  1867. begin
  1868. StopIconUpdateThread;
  1869. try
  1870. CustomSortItems(@CompareFile);
  1871. finally
  1872. if (not Loading) and FUseIconUpdateThread then
  1873. StartIconUpdateThread;
  1874. end;
  1875. end
  1876. end;
  1877. procedure TDirView.ValidateFile(Item : TListItem);
  1878. var
  1879. Index: Integer;
  1880. begin
  1881. if Assigned(Item) and Assigned(Item.Data) then
  1882. begin
  1883. Index := Item.Index;
  1884. if not FileExists(ApiPath(ItemFullFileName(Items[Index]))) then
  1885. begin
  1886. Item.Delete;
  1887. end;
  1888. end;
  1889. end; {ValidateFile}
  1890. procedure TDirView.ValidateFile(FileName: TFileName);
  1891. var
  1892. FilePath: string;
  1893. begin
  1894. FilePath := ExcludeTrailingPathDelimiter(ExtractFilePath(FileName));
  1895. if IsRecycleBin then ValidateFile(FindFileItem(FileName))
  1896. else
  1897. if FilePath = Path then
  1898. ValidateFile(FindFileItem(ExtractFileName(FileName)));
  1899. end; {ValidateFile}
  1900. procedure TDirView.ValidateSelectedFiles;
  1901. var
  1902. FileList: TStrings;
  1903. i: Integer;
  1904. ToDelete: Boolean;
  1905. Updating: Boolean;
  1906. Updated: Boolean;
  1907. Item: TListItem;
  1908. begin
  1909. if SelCount > 50 then Reload2
  1910. else
  1911. begin
  1912. Updating := False;
  1913. Updated := False;
  1914. FileList := CustomCreateFileList(True, False, True, nil, True);
  1915. try
  1916. for i := 0 to FileList.Count - 1 do
  1917. begin
  1918. Item := TListItem(FileList.Objects[i]);
  1919. if ItemIsDirectory(Item) then
  1920. ToDelete := not DirectoryExists(ApiPath(FileList[i]))
  1921. else
  1922. ToDelete := not FileExists(ApiPath(FileList[i]));
  1923. if ToDelete then
  1924. begin
  1925. if (SelCount > 10) and (not Updating) then
  1926. begin
  1927. Items.BeginUpdate;
  1928. Updating := True;
  1929. end;
  1930. with PFileRec(Item.Data)^ do
  1931. begin
  1932. Dec(FFilesSize, Size);
  1933. // No need to decrease FFilesSelSize here as LVIF_STATE/deselect
  1934. // is called for item being deleted
  1935. end;
  1936. Item.Delete;
  1937. Updated := True;
  1938. end;
  1939. end;
  1940. finally
  1941. if Updating then
  1942. Items.EndUpdate;
  1943. if Updated then
  1944. UpdateStatusBar;
  1945. FileList.Free;
  1946. end;
  1947. end;
  1948. end; {ValidateSelectedFiles}
  1949. function TDirView.CreateFile(NewName: string): TListItem;
  1950. var
  1951. F: file;
  1952. SRec: SysUtils.TSearchRec;
  1953. begin
  1954. Result := nil;
  1955. {Neue Datei anlegen:}
  1956. NewName := Path + '\' + NewName;
  1957. {Ermitteln des neuen Dateinamens:}
  1958. if not FileExists(ApiPath(NewName)) then
  1959. begin
  1960. if FWatchForChanges then
  1961. StopWatchThread;
  1962. StopIconUpdateThread;
  1963. try
  1964. {Create the desired file as empty file:}
  1965. AssignFile(F, ApiPath(NewName));
  1966. Rewrite(F);
  1967. LastIOResult := IOResult;
  1968. if LastIOResult = 0 then
  1969. begin
  1970. CloseFile(F);
  1971. {Anlegen der Datei als TListItem:}
  1972. if FindFirst(ApiPath(NewName), faAnyFile, SRec) = 0 then
  1973. begin
  1974. Result := AddItem(SRec);
  1975. ItemFocused := FindFileItem(GetFileRec(Result.Index)^.FileName);
  1976. if Assigned(ItemFocused) then
  1977. ItemFocused.MakeVisible(False);
  1978. end;
  1979. FindClose(Srec);
  1980. end;
  1981. finally
  1982. if FUseIconUpdateThread then
  1983. StartIconUpdateThread;
  1984. if WatchForChanges then
  1985. StartWatchThread;
  1986. end;
  1987. end
  1988. else LastIOResult := 183;
  1989. end; {CreateFile}
  1990. procedure TDirView.CreateDirectory(DirName: string);
  1991. var
  1992. SRec: SysUtils.TSearchRec;
  1993. Item: TListItem;
  1994. begin
  1995. // keep absolute path as is
  1996. if Copy(DirName, 2, 1) <> ':' then
  1997. DirName := Path + '\' + DirName;
  1998. if WatchForChanges then StopWatchThread;
  1999. if Assigned(FDriveView) then
  2000. TDriveView(FDriveView).StopWatchThread;
  2001. StopIconUpdateThread;
  2002. try
  2003. {create the phyical directory:}
  2004. Win32Check(Windows.CreateDirectory(PChar(ApiPath(DirName)), nil));
  2005. if IncludeTrailingBackslash(ExtractFilePath(ExpandFileName(DirName))) =
  2006. IncludeTrailingBackslash(Path) then
  2007. begin
  2008. {Create the TListItem:}
  2009. if FindFirst(ApiPath(DirName), faAnyFile, SRec) = 0 then
  2010. begin
  2011. Item := AddItem(SRec);
  2012. ItemFocused := FindFileItem(GetFileRec(Item.Index)^.FileName);
  2013. SortItems;
  2014. if Assigned(ItemFocused) then
  2015. begin
  2016. ItemFocused.MakeVisible(False);
  2017. end;
  2018. end;
  2019. FindClose(SRec);
  2020. end;
  2021. finally
  2022. if FUseIconUpdateThread then
  2023. StartIconUpdateThread;
  2024. if WatchForChanges then StartWatchThread;
  2025. if Assigned(DriveView) then
  2026. with DriveView do
  2027. begin
  2028. if Assigned(Selected) then
  2029. ValidateDirectory(Selected);
  2030. TDriveView(FDriveView).StartWatchThread;
  2031. end;
  2032. end;
  2033. end; {CreateDirectory}
  2034. procedure TDirView.DisplayContextMenu(Where: TPoint);
  2035. var
  2036. FileList : TStringList;
  2037. Index: Integer;
  2038. Item: TListItem;
  2039. DefDir: string;
  2040. Verb: string;
  2041. PIDLArray: PPIDLArray;
  2042. Count: Integer;
  2043. DiffSelectedPath: Boolean;
  2044. WithEdit: Boolean;
  2045. PIDLRel: PItemIDList;
  2046. PIDLPath: PItemIDList;
  2047. Handled: Boolean;
  2048. begin
  2049. GetDir(0, DefDir);
  2050. ChDir(PathName);
  2051. Verb := EmptyStr;
  2052. StopWatchThread;
  2053. try
  2054. if Assigned(OnContextPopup) then
  2055. begin
  2056. Handled := False;
  2057. OnContextPopup(Self, ScreenToClient(Where), Handled);
  2058. if Handled then Abort;
  2059. end;
  2060. if (MarkedCount > 1) and
  2061. ((not Assigned(ItemFocused)) or ItemFocused.Selected) then
  2062. begin
  2063. if FIsRecycleBin then
  2064. begin
  2065. Count := 0;
  2066. GetMem(PIDLArray, SizeOf(PItemIDList) * SelCount);
  2067. try
  2068. FillChar(PIDLArray^, Sizeof(PItemIDList) * SelCount, #0);
  2069. for Index := Selected.Index to Items.Count - 1 do
  2070. if Items[Index].Selected then
  2071. begin
  2072. PIDL_GetRelative(PFileRec(Items[Index].Data)^.PIDL, PIDLPath, PIDLRel);
  2073. FreePIDL(PIDLPath);
  2074. PIDLArray^[Count] := PIDLRel;
  2075. Inc(Count);
  2076. end;
  2077. try
  2078. ShellDisplayContextMenu(ParentForm.Handle, Where, iRecycleFolder, Count,
  2079. PidlArray^[0], False, Verb, False);
  2080. finally
  2081. for Index := 0 to Count - 1 do
  2082. FreePIDL(PIDLArray[Index]);
  2083. end;
  2084. finally
  2085. FreeMem(PIDLArray, Count);
  2086. end;
  2087. end
  2088. else
  2089. begin
  2090. FileList := TStringList.Create;
  2091. CreateFileList(False, True, FileList);
  2092. for Index := 0 to FileList.Count - 1 do
  2093. FileList[Index] := ExtractFileName(FileList[Index]);
  2094. ShellDisplayContextMenu(ParentForm.Handle, Where, PathName,
  2095. FileList, Verb, False);
  2096. FileList.Destroy;
  2097. end;
  2098. {------------ Cut -----------}
  2099. if Verb = shcCut then
  2100. begin
  2101. LastClipBoardOperation := cboCut;
  2102. {Clear items previous marked as cut:}
  2103. Item := GetNextItem(nil, sdAll, [isCut]);
  2104. while Assigned(Item) do
  2105. begin
  2106. Item.Cut := False;
  2107. Item := GetNextItem(Item, sdAll, [isCut]);
  2108. end;
  2109. {Set property cut to TRUE for all selected items:}
  2110. Item := GetNextItem(nil, sdAll, [isSelected]);
  2111. while Assigned(Item) do
  2112. begin
  2113. Item.Cut := True;
  2114. Item := GetNextItem(Item, sdAll, [isSelected]);
  2115. end;
  2116. end
  2117. else
  2118. {----------- Copy -----------}
  2119. if Verb = shcCopy then LastClipBoardOperation := cboCopy
  2120. else
  2121. {----------- Paste ----------}
  2122. if Verb = shcPaste then
  2123. PasteFromClipBoard(ItemFullFileName(Selected))
  2124. else
  2125. if not FIsRecycleBin then Reload2;
  2126. end
  2127. else
  2128. if Assigned(ItemFocused) and Assigned(ItemFocused.Data) then
  2129. begin
  2130. Verb := EmptyStr;
  2131. WithEdit := not FisRecycleBin and CanEdit(ItemFocused);
  2132. LoadEnabled := True;
  2133. if FIsRecycleBin then
  2134. begin
  2135. PIDL_GetRelative(PFileRec(ItemFocused.Data)^.PIDL, PIDLPath, PIDLRel);
  2136. ShellDisplayContextMenu(ParentForm.Handle, Where,
  2137. iRecycleFolder, 1, PIDLRel, False, Verb, False);
  2138. FreePIDL(PIDLRel);
  2139. FreePIDL(PIDLPath);
  2140. end
  2141. else
  2142. begin
  2143. ShellDisplayContextMenu(ParentForm.Handle, Where,
  2144. ItemFullFileName(ItemFocused), WithEdit, Verb,
  2145. not PFileRec(ItemFocused.Data)^.isDirectory);
  2146. LoadEnabled := True;
  2147. end; {not FisRecycleBin}
  2148. {---------- Rename ----------}
  2149. if Verb = shcRename then ItemFocused.EditCaption
  2150. else
  2151. {------------ Cut -----------}
  2152. if Verb = shcCut then
  2153. begin
  2154. LastClipBoardOperation := cboCut;
  2155. Item := GetNextItem(nil, sdAll, [isCut]);
  2156. while Assigned(Item) do
  2157. begin
  2158. Item.Cut := False;
  2159. Item := GetNextItem(ITem, sdAll, [isCut]);
  2160. end;
  2161. ItemFocused.Cut := True;
  2162. end
  2163. else
  2164. {----------- Copy -----------}
  2165. if Verb = shcCopy then LastClipBoardOperation := cboCopy
  2166. else
  2167. {----------- Paste ----------}
  2168. if Verb = shcPaste then
  2169. begin
  2170. if PFileRec(ItemFocused.Data)^.IsDirectory then
  2171. PasteFromClipBoard(ItemFullFileName(ItemFocused));
  2172. end
  2173. else
  2174. if not FIsRecycleBin then Reload2;
  2175. end;
  2176. ChDir(DefDir);
  2177. if IsRecycleBin and (Verb <> shcCut) and (Verb <> shcProperties) and (SelCount > 0) then
  2178. begin
  2179. DiffSelectedPath := False;
  2180. for Index := Selected.Index to Items.Count - 1 do
  2181. if ExtractFilePath(PFileRec(Items[Index].Data)^.FileName) <> FPath + '\' then
  2182. begin
  2183. DiffSelectedPath := True;
  2184. Break;
  2185. end;
  2186. if DiffSelectedPath then
  2187. begin
  2188. StartFileDeleteThread;
  2189. Exit;
  2190. end;
  2191. end;
  2192. Sleep(250);
  2193. ValidateSelectedFiles;
  2194. finally
  2195. StartWatchThread;
  2196. end;
  2197. end;
  2198. procedure TDirView.GetDisplayInfo(ListItem: TListItem;
  2199. var DispInfo: TLVItem);
  2200. begin
  2201. Assert(Assigned(ListItem) and Assigned(ListItem.Data));
  2202. with PFileRec(ListItem.Data)^, DispInfo do
  2203. begin
  2204. {Fetch display data of current file:}
  2205. if Empty then
  2206. GetDisplayData(ListItem, IconEmpty and
  2207. (not FUseIconUpdateThread or
  2208. (ViewStyle <> vsReport)));
  2209. if IconEmpty and
  2210. (not FUseIconUpdateThread or
  2211. (ViewStyle <> vsReport)) and
  2212. ((DispInfo.Mask and LVIF_IMAGE) <> 0) then
  2213. GetDisplayData(ListItem, True);
  2214. {Set IconUpdatethread :}
  2215. if IconEmpty and Assigned(FIconUpdateThread) then
  2216. begin
  2217. if Assigned(TopItem) then
  2218. {Viewstyle is vsReport or vsList:}
  2219. FIconUpdateThread.Index := Self.TopItem.Index
  2220. else
  2221. {Viewstyle is vsIcon or vsSmallIcon:}
  2222. FIconUpdateThread.MaxIndex := ListItem.Index;
  2223. if FIconUpdateThread.Suspended and not FIsRecycleBin then
  2224. FIconUpdateThread.Resume;
  2225. end;
  2226. if (DispInfo.Mask and LVIF_TEXT) <> 0 then
  2227. begin
  2228. if iSubItem = 0 then StrPLCopy(pszText, DisplayName, cchTextMax)
  2229. else
  2230. if iSubItem < DirViewColumns then
  2231. begin
  2232. case TDirViewCol(iSubItem) of
  2233. dvSize: {Size: }
  2234. if not IsDirectory then
  2235. StrPLCopy(pszText, FormatPanelBytes(Size, FormatSizeBytes), cchTextMax);
  2236. dvType: {FileType: }
  2237. StrPLCopy(pszText, TypeName, cchTextMax);
  2238. dvChanged: {Date}
  2239. StrPLCopy(pszText, FormatFileTime(FileTime), cchTextMax);
  2240. dvAttr: {Attrs:}
  2241. StrPLCopy(pszText, GetAttrString(Attr), cchTextMax);
  2242. dvExt:
  2243. StrPLCopy(pszText, FileExt, cchTextMax);
  2244. end {Case}
  2245. end {SubItem}
  2246. else pszText[0] := #0;
  2247. end;
  2248. {Set display icon of current file:}
  2249. if (iSubItem = 0) and ((DispInfo.Mask and LVIF_IMAGE) <> 0) then
  2250. begin
  2251. iImage := PFileRec(ListItem.Data).ImageIndex;
  2252. Mask := Mask or LVIF_DI_SETITEM;
  2253. end;
  2254. end; {With PFileRec Do}
  2255. {Mask := Mask Or LVIF_DI_SETITEM; {<== causes flickering display and icons not to be updated on renaming the item}
  2256. end;
  2257. function TDirView.ItemColor(Item: TListItem): TColor;
  2258. begin
  2259. if PFileRec(Item.Data).Attr and FILE_ATTRIBUTE_COMPRESSED <> 0 then
  2260. Result := FCompressedColor
  2261. else
  2262. if DimmHiddenFiles and not Item.Selected and
  2263. (PFileRec(Item.Data).Attr and FILE_ATTRIBUTE_HIDDEN <> 0) then
  2264. Result := clGrayText
  2265. else
  2266. Result := clDefaultItemColor;
  2267. end;
  2268. procedure TDirView.StartFileDeleteThread;
  2269. var
  2270. Files: TStringList;
  2271. begin
  2272. Files := TStringList.Create;
  2273. try
  2274. CreateFileList(False, True, Files);
  2275. TFileDeleteThread.Create(Files, MaxWaitTimeOut, SignalFileDelete);
  2276. finally
  2277. Files.Free;
  2278. end;
  2279. end;
  2280. procedure TDirView.StartIconUpdateThread;
  2281. begin
  2282. if DirOK then
  2283. begin
  2284. if not Assigned(FIconUpdateThread) then
  2285. begin
  2286. if Items.Count > 0 then
  2287. FIconUpdateThread := TIconUpdateThread.Create(Self);
  2288. end
  2289. else
  2290. begin
  2291. Assert(not FIconUpdateThread.Terminated);
  2292. FIconUpdateThread.Index := 0;
  2293. if ViewStyle = vsReport then
  2294. FIconUpdateThread.Resume;
  2295. end;
  2296. end;
  2297. end; {StartIconUpdateThread}
  2298. procedure TDirView.StopIconUpdateThread;
  2299. var
  2300. Counter: Integer;
  2301. begin
  2302. if Assigned(FIconUpdateThread) then
  2303. begin
  2304. Counter := 0;
  2305. FIconUpdateThread.Terminate;
  2306. FIconUpdateThread.Priority := tpHigher;
  2307. if fIconUpdateThread.Suspended then
  2308. FIconUpdateThread.Resume;
  2309. Sleep(0);
  2310. try
  2311. {Wait until the thread has teminated to prevent AVs:}
  2312. while not FIUThreadFinished do
  2313. begin
  2314. Sleep(10);
  2315. // Not really sure why this is here, but definitelly, when recreating
  2316. // the dir view, it may cause recursion calls back to destryed dir view,
  2317. // causing AVs
  2318. // May not be necessary anymore after the recursion check in
  2319. // TDirView.CMRecreateWnd
  2320. if not (csRecreating in ControlState) then
  2321. Application.ProcessMessages;
  2322. Inc(Counter);
  2323. {Raise an exception after 2 second, if the thread has not terminated:}
  2324. if Counter = 200 then
  2325. begin
  2326. {MP}raise EIUThread.Create(SIconUpdateThreadTerminationError);
  2327. Break;
  2328. end;
  2329. end;
  2330. finally
  2331. FIconUpdateThread.Destroy;
  2332. FIconUpdateThread := nil;
  2333. end;
  2334. end;
  2335. end; {StopIconUpdateThread}
  2336. procedure TDirView.StopWatchThread;
  2337. begin
  2338. if Assigned(FDiscMonitor) then
  2339. begin
  2340. FDiscMonitor.Enabled := False;
  2341. end;
  2342. end; {StopWatchThread}
  2343. procedure TDirView.StartWatchThread;
  2344. begin
  2345. if (Length(Path) > 0) and WatchForChanges and DirOK then
  2346. begin
  2347. if not Assigned(FDiscMonitor) then
  2348. begin
  2349. FDiscMonitor := TDiscMonitor.Create(Self);
  2350. with FDiscMonitor do
  2351. begin
  2352. ChangeDelay := msThreadChangeDelay;
  2353. SubTree := False;
  2354. Filters := [moDirName, moFileName, moSize, moAttributes, moLastWrite];
  2355. SetDirectory(PathName);
  2356. OnChange := ChangeDetected;
  2357. OnInvalid := ChangeInvalid;
  2358. Open;
  2359. end;
  2360. end
  2361. else
  2362. begin
  2363. FDiscMonitor.SetDirectory(PathName);
  2364. FDiscMonitor.Enabled := True;
  2365. end;
  2366. end;
  2367. end; {StartWatchThread}
  2368. procedure TDirView.TimerOnTimer(Sender: TObject);
  2369. begin
  2370. if not Loading then
  2371. begin
  2372. // fix by MP: disable timer and reload directory before call to event
  2373. FChangeTimer.Enabled := False;
  2374. FChangeTimer.Interval := 0;
  2375. Reload2;
  2376. end;
  2377. end; {TimerOnTimer}
  2378. procedure TDirView.ChangeDetected(Sender: TObject; const Directory: string;
  2379. var SubdirsChanged: Boolean);
  2380. begin
  2381. // avoid prolonging the actual update with each change, as if continous change
  2382. // is occuring in current directory, the panel will never be updated
  2383. if not FChangeTimer.Enabled then
  2384. begin
  2385. FDirty := True;
  2386. FChangeTimer.Interval := FChangeInterval;
  2387. FChangeTimer.Enabled := True;
  2388. end;
  2389. end; {ChangeDetected}
  2390. procedure TDirView.ChangeInvalid(Sender: TObject; const Directory: string;
  2391. const ErrorStr: string);
  2392. begin
  2393. FDiscMonitor.Close;
  2394. end; {ChangeInvalid}
  2395. function TDirView.WatchThreadActive: Boolean;
  2396. begin
  2397. Result := WatchForChanges and Assigned(FDiscMonitor) and
  2398. FDiscMonitor.Active and FDiscMonitor.Enabled;
  2399. end; {WatchThreadActive}
  2400. procedure TDirView.SetChangeInterval(Value: Cardinal);
  2401. begin
  2402. if Value > 0 then
  2403. begin
  2404. FChangeInterval := Value;
  2405. FChangeTimer.Interval := Value;
  2406. end;
  2407. end; {SetChangeInterval}
  2408. procedure TDirView.SetDirColProperties(Value: TDirViewColProperties);
  2409. begin
  2410. if Value <> ColProperties then
  2411. ColProperties := Value;
  2412. end;
  2413. function TDirView.GetDirColProperties: TDirViewColProperties;
  2414. begin
  2415. Result := TDirViewColProperties(ColProperties);
  2416. end;
  2417. procedure TDirView.SetWatchForChanges(Value: Boolean);
  2418. begin
  2419. if WatchForChanges <> Value then
  2420. begin
  2421. FWatchForChanges := Value;
  2422. if not (csDesigning in ComponentState) then
  2423. begin
  2424. if Value then StartWatchThread
  2425. else StopWatchThread;
  2426. end;
  2427. end;
  2428. end; {SetWatchForChanges}
  2429. procedure TDirView.DisplayPropertiesMenu;
  2430. var
  2431. FileList: TStringList;
  2432. Index: Integer;
  2433. PIDLRel: PItemIDList;
  2434. PIDLPath: PItemIDList;
  2435. begin
  2436. if not Assigned(ItemFocused) then
  2437. ShellExecuteContextCommand(ParentForm.Handle, shcProperties, PathName)
  2438. else
  2439. if (not IsRecycleBin) and (MarkedCount > 1) and ItemFocused.Selected then
  2440. begin
  2441. FileList := TStringList.Create;
  2442. try
  2443. CreateFileList(False, True, FileList);
  2444. for Index := 0 to Pred(FileList.Count) do
  2445. FileList[Index] := ExtractFileName(FileList[Index]);
  2446. ShellExecuteContextCommand(ParentForm.Handle, shcProperties,
  2447. PathName, FileList);
  2448. finally
  2449. FileList.Free;
  2450. end;
  2451. end
  2452. else
  2453. if Assigned(ItemFocused.Data) then
  2454. begin
  2455. if IsRecycleBin then
  2456. begin
  2457. if Assigned(PFileRec(ItemFocused.Data)^.PIDL) then
  2458. begin
  2459. PIDL_GetRelative(PFileRec(ItemFocused.Data)^.PIDL, PIDLPath, PIDLRel);
  2460. ShellExecuteContextCommand(ParentForm.Handle, shcProperties, iRecycleFolder, 1, PIDLRel);
  2461. FreePIDL(PIDLRel);
  2462. FreePIDL(PIDLPath);
  2463. end;
  2464. end
  2465. else
  2466. ShellExecuteContextCommand(ParentForm.Handle, shcProperties,
  2467. ItemFullFileName(ItemFocused));
  2468. end;
  2469. end;
  2470. procedure TDirView.ExecuteFile(Item: TListItem);
  2471. var
  2472. DefDir: string;
  2473. FileName: string;
  2474. begin
  2475. if (UpperCase(PFileRec(Item.Data)^.FileExt) = 'LNK') or
  2476. PFileRec(Item.Data)^.IsDirectory then
  2477. begin
  2478. if PFileRec(Item.Data)^.IsDirectory then
  2479. begin
  2480. FileName := ItemFullFileName(Item);
  2481. if not DirExists(FileName) then
  2482. begin
  2483. Reload2;
  2484. if Assigned(FDriveView) and Assigned(FDriveView.Selected) then
  2485. with FDriveView do
  2486. ValidateDirectory(Selected);
  2487. Exit;
  2488. end;
  2489. end
  2490. else
  2491. FileName := ResolveFileShortCut(ItemFullFileName(Item), True);
  2492. if DirExists(FileName) then
  2493. begin
  2494. Path := FileName;
  2495. Exit;
  2496. end
  2497. else
  2498. if not FileExists(ApiPath(FileName)) then
  2499. begin
  2500. Exit;
  2501. end;
  2502. end;
  2503. GetDir(0, DefDir);
  2504. ChDir(PathName);
  2505. try
  2506. ShellExecuteContextCommand(ParentForm.Handle, shcDefault,
  2507. ItemFullFileName(Item));
  2508. finally
  2509. ChDir(DefDir);
  2510. end;
  2511. end;
  2512. procedure TDirView.ExecuteDrive(Drive: TDriveLetter);
  2513. var
  2514. APath: string;
  2515. begin
  2516. if FLastPath[Drive] <> '' then
  2517. begin
  2518. APath := FLastPath[Drive];
  2519. if not DirectoryExists(ApiPath(APath)) then
  2520. APath := Format('%s:', [Drive]);
  2521. end
  2522. else
  2523. begin
  2524. GetDir(Integer(Drive) - Integer('A') + 1, APath);
  2525. APath := ExcludeTrailingPathDelimiter(APath);
  2526. end;
  2527. if Path <> APath then
  2528. Path := APath;
  2529. end;
  2530. procedure TDirView.ExecuteHomeDirectory;
  2531. begin
  2532. Path := HomeDirectory;
  2533. end;
  2534. procedure TDirView.ExecuteParentDirectory;
  2535. begin
  2536. if Valid then
  2537. begin
  2538. if Assigned(DriveView) and Assigned(DriveView.Selected) then
  2539. begin
  2540. DriveView.Selected := DriveView.Selected.Parent
  2541. end
  2542. else
  2543. begin
  2544. Path := ExtractFilePath(Path);
  2545. end;
  2546. end;
  2547. end;
  2548. procedure TDirView.ExecuteRootDirectory;
  2549. begin
  2550. if Valid then
  2551. try
  2552. PathChanging(False);
  2553. FPath := ExtractFileDrive(Path);
  2554. Load(True);
  2555. finally
  2556. PathChanged;
  2557. end;
  2558. end;
  2559. procedure TDirView.Delete(Item: TListItem);
  2560. begin
  2561. if Assigned(Item) and Assigned(Item.Data) and not (csRecreating in ControlState) then
  2562. with PFileRec(Item.Data)^ do
  2563. begin
  2564. SetLength(FileName, 0);
  2565. SetLength(TypeName, 0);
  2566. SetLength(DisplayName, 0);
  2567. if Assigned(PIDL) then FreePIDL(PIDL);
  2568. Dispose(PFileRec(Item.Data));
  2569. Item.Data := nil;
  2570. end;
  2571. inherited Delete(Item);
  2572. end; {Delete}
  2573. procedure TDirView.InternalEdit(const HItem: TLVItem);
  2574. var
  2575. Item: TListItem;
  2576. Info: string;
  2577. NewCaption: string;
  2578. IsDirectory: Boolean;
  2579. begin
  2580. Item := GetItemFromHItem(HItem);
  2581. IsDirectory := DirExists(ItemFullFileName(Item));
  2582. NewCaption := HItem.pszText;
  2583. StopWatchThread;
  2584. if IsDirectory and Assigned(FDriveView) then
  2585. TDriveView(FDriveView).StopWatchThread;
  2586. with FFileOperator do
  2587. begin
  2588. Flags := [foAllowUndo, foNoConfirmation];
  2589. Operation := foRename;
  2590. OperandFrom.Clear;
  2591. OperandTo.Clear;
  2592. OperandFrom.Add(ItemFullFileName(Item));
  2593. OperandTo.Add(FPath + '\' + HItem.pszText);
  2594. end;
  2595. try
  2596. if FFileOperator.Execute then
  2597. begin
  2598. if IsDirectory and Assigned(FDriveView) then
  2599. with FDriveView do
  2600. if Assigned(Selected) then
  2601. ValidateDirectory(Selected);
  2602. with GetFileRec(Item.Index)^ do
  2603. begin
  2604. Empty := True;
  2605. IconEmpty := True;
  2606. FileName := NewCaption;
  2607. DisplayName := FileName;
  2608. FileExt := UpperCase(ExtractFileExt(HItem.pszText));
  2609. FileExt := Copy(FileExt, 2, Length(FileExt) - 1);
  2610. TypeName := EmptyStr;
  2611. if Assigned(PIDL) then
  2612. FreePIDL(PIDL);
  2613. end;
  2614. GetDisplayData(Item, True);
  2615. ResetItemImage(Item.Index);
  2616. UpdateItems(Item.Index, Item.Index);
  2617. if Assigned(OnEdited) then OnEdited(Self, Item, NewCaption);
  2618. if Item <> nil then Item.Caption := NewCaption;
  2619. SortItems;
  2620. if Assigned(ItemFocused) then ItemFocused.MakeVisible(False);
  2621. end
  2622. else
  2623. begin
  2624. Item.Caption := GetFileRec(Item.Index)^.FileName;
  2625. Item.Update;
  2626. if FileOrDirExists(IncludeTrailingPathDelimiter(FPath) + HItem.pszText) then
  2627. Info := SErrorRenameFileExists + HItem.pszText
  2628. else
  2629. Info := SErrorRenameFile + HItem.pszText;
  2630. MessageBeep(MB_ICONHAND);
  2631. if MessageDlg(FormatLastOSError(Info), mtError, [mbOK, mbAbort], 0) = mrOK then
  2632. RetryRename(HItem.pszText);
  2633. end;
  2634. finally
  2635. Sleep(0);
  2636. LoadEnabled := True;
  2637. if FWatchForChanges and (not WatchThreadActive) then
  2638. StartWatchThread;
  2639. if Assigned(FDriveView) then
  2640. TDriveView(FDriveView).StartWatchThread;
  2641. end;
  2642. end;
  2643. function TDirView.ItemFileName(Item: TListItem): string;
  2644. begin
  2645. if Assigned(Item) and Assigned(Item.Data) then
  2646. Result := ExtractFileName(PFileRec(Item.Data)^.FileName)
  2647. else
  2648. Result := '';
  2649. end;
  2650. function TDirView.ItemFileSize(Item: TListItem): Int64;
  2651. begin
  2652. Result := 0;
  2653. if Assigned(Item) and Assigned(Item.Data) then
  2654. with PFileRec(Item.Data)^ do
  2655. if Size >= 0 then Result := Size;
  2656. end;
  2657. function TDirView.ItemFileTime(Item: TListItem;
  2658. var Precision: TDateTimePrecision): TDateTime;
  2659. begin
  2660. Result := FileTimeToDateTime(PFileRec(Item.Data)^.FileTime);
  2661. Precision := tpMillisecond;
  2662. end;
  2663. function TDirView.ItemImageIndex(Item: TListItem;
  2664. Cache: Boolean): Integer;
  2665. begin
  2666. if Assigned(Item) and Assigned(Item.Data) then
  2667. begin
  2668. if PFileRec(Item.Data)^.IconEmpty then
  2669. begin
  2670. if Cache then Result := -1
  2671. else Result := UnknownFileIcon;
  2672. end
  2673. else
  2674. begin
  2675. if (not Cache) or MatchesFileExt(PFileRec(Item.Data)^.FileExt, SpecialExtensions) then
  2676. Result := PFileRec(Item.Data)^.ImageIndex
  2677. else
  2678. Result := -1
  2679. end;
  2680. end
  2681. else Result := -1;
  2682. end;
  2683. procedure TDirView.Notification(AComponent: TComponent; Operation: TOperation);
  2684. begin
  2685. inherited Notification(AComponent, Operation);
  2686. if (Operation = opRemove) and (AComponent = FDriveView) then
  2687. FDriveView := nil;
  2688. end; {Notification}
  2689. procedure TDirView.ReloadDirectory;
  2690. begin
  2691. Reload(True);
  2692. end;
  2693. procedure TDirView.ResetItemImage(Index: Integer);
  2694. var
  2695. LVI: TLVItem;
  2696. begin
  2697. with PFileRec(Items[Index].Data)^, LVI do
  2698. begin
  2699. {Update imageindex:}
  2700. Mask := LVIF_STATE or LVIF_DI_SETITEM or LVIF_IMAGE;
  2701. iItem := Index;
  2702. iSubItem := 0;
  2703. if ListView_GetItem(Handle, LVI) then
  2704. begin
  2705. iImage := I_IMAGECALLBACK;
  2706. Mask := Mask and (not LVIF_DI_SETITEM);
  2707. ListView_SetItem(Handle, LVI);
  2708. end;
  2709. end; {With}
  2710. end; {ResetItemImage}
  2711. { Drag&Drop handling }
  2712. procedure TDirView.SignalFileDelete(Sender: TObject; Files: TStringList);
  2713. {Called by TFileDeleteThread, when a file was deleted by the Drag&Drop target window:}
  2714. var
  2715. Index: Integer;
  2716. begin
  2717. if Files.Count > 0 then
  2718. for Index := 0 to Files.Count - 1 do
  2719. ValidateFile(Files[Index]);
  2720. end;
  2721. procedure TDirView.DDMenuPopup(Sender: TObject; AMenu: HMenu; DataObj: IDataObject;
  2722. AMinCustCmd: Integer; grfKeyState: Longint; pt: TPoint);
  2723. begin
  2724. if Assigned(FDriveView) then
  2725. begin
  2726. // When a change is detected while menu is popped up
  2727. // it loses focus (or something similar)
  2728. // preventing it from handling subsequent click.
  2729. // This typically happens when right-dragging from remote to local panel,
  2730. // what causes temp directory being created+deleted.
  2731. // This is HACK, we should implement some uniform watch disabling/enabling
  2732. TDriveView(FDriveView).SuspendChangeTimer;
  2733. end;
  2734. inherited;
  2735. end;
  2736. procedure TDirView.DDMenuDone(Sender: TObject; AMenu: HMenu);
  2737. begin
  2738. if not WatchThreadActive then
  2739. begin
  2740. FChangeTimer.Interval := Min(FChangeInterval * 2, 3000);
  2741. FChangeTimer.Enabled := True;
  2742. end;
  2743. if Assigned(FDriveView) then
  2744. begin
  2745. TDriveView(FDriveView).ResumeChangeTimer;
  2746. end;
  2747. inherited;
  2748. end;
  2749. procedure TDirView.DDDropHandlerSucceeded(Sender: TObject; grfKeyState: Longint;
  2750. Point: TPoint; dwEffect: Longint);
  2751. begin
  2752. // Not sure why is this here. There's no "disable" counterparty.
  2753. if not WatchThreadActive then
  2754. begin
  2755. FChangeTimer.Interval := FChangeInterval;
  2756. FChangeTimer.Enabled := True;
  2757. end;
  2758. inherited;
  2759. end;
  2760. procedure TDirView.AddToDragFileList(FileList: TFileList; Item: TListItem);
  2761. begin
  2762. Assert(Assigned(Item));
  2763. if IsRecycleBin then
  2764. begin
  2765. if Assigned(Item.Data) then
  2766. begin
  2767. if UpperCase(ExtractFileExt(PFileRec(Item.Data)^.DisplayName)) =
  2768. ('.' + PFileRec(Item.Data)^.FileExt) then
  2769. FileList.AddItemEx(PFileRec(Item.Data)^.PIDL,
  2770. ItemFullFileName(Item), PFileRec(Item.Data)^.DisplayName)
  2771. else
  2772. FileList.AddItemEx(PFileRec(Item.Data)^.PIDL,
  2773. ItemFullFileName(Item), PFileRec(Item.Data)^.DisplayName +
  2774. ExtractFileExt(PFileRec(Item.Data)^.FileName));
  2775. end;
  2776. end
  2777. else inherited;
  2778. end;
  2779. procedure TDirView.DDDragDetect(grfKeyState: Longint; DetectStart, Point: TPoint;
  2780. DragStatus: TDragDetectStatus);
  2781. var
  2782. WasWatchThreadActive: Boolean;
  2783. begin
  2784. if (DragStatus = ddsDrag) and (MarkedCount > 0) then
  2785. begin
  2786. WasWatchThreadActive := WatchThreadActive;
  2787. inherited;
  2788. if (LastDDResult = drMove) and (not WasWatchThreadActive) then
  2789. StartFileDeleteThread;
  2790. end;
  2791. end; {DDDragDetect}
  2792. procedure TDirView.DDChooseEffect(grfKeyState: Integer;
  2793. var dwEffect: Integer);
  2794. begin
  2795. if DragDropFilesEx.OwnerIsSource and
  2796. (dwEffect = DropEffect_Copy) and (not Assigned(DropTarget)) then
  2797. begin
  2798. dwEffect := DropEffect_None
  2799. end
  2800. else
  2801. if (grfKeyState and (MK_CONTROL or MK_SHIFT) = 0) then
  2802. begin
  2803. if ExeDrag and (Path[1] >= FirstFixedDrive) and
  2804. (DragDrive >= FirstFixedDrive) then
  2805. begin
  2806. dwEffect := DropEffect_Link
  2807. end
  2808. else
  2809. begin
  2810. if DragOnDriveIsMove and
  2811. (not DDOwnerIsSource or Assigned(DropTarget)) and
  2812. (((DragDrive = Upcase(Path[1])) and (dwEffect = DropEffect_Copy) and
  2813. (DragDropFilesEx.AvailableDropEffects and DropEffect_Move <> 0))
  2814. or IsRecycleBin) then
  2815. begin
  2816. dwEffect := DropEffect_Move;
  2817. end;
  2818. end;
  2819. end;
  2820. inherited;
  2821. end;
  2822. procedure TDirView.PerformDragDropFileOperation(TargetPath: string;
  2823. dwEffect: Integer; RenameOnCollision: Boolean);
  2824. var
  2825. Index: Integer;
  2826. SourcePath: string;
  2827. SourceFile: string;
  2828. OldCursor: TCursor;
  2829. OldWatchForChanges: Boolean;
  2830. DoFileOperation: Boolean;
  2831. IsRecycleBin: Boolean;
  2832. SourceIsDirectory: Boolean;
  2833. Node: TTreeNode;
  2834. begin
  2835. if DragDropFilesEx.FileList.Count > 0 then
  2836. begin
  2837. if not DirExists(TargetPath) then
  2838. begin
  2839. Reload(True);
  2840. DDError(DDPathNotFoundError);
  2841. end
  2842. else
  2843. begin
  2844. IsRecycleBin := Self.IsRecycleBin or
  2845. ((DropTarget <> nil) and ItemIsRecycleBin(DropTarget));
  2846. if not (DragDropFilesEx.FileNamesAreMapped and IsRecycleBin) then
  2847. begin
  2848. OldCursor := Screen.Cursor;
  2849. OldWatchForChanges := WatchForChanges;
  2850. SourceIsDirectory := True;
  2851. SourcePath := EmptyStr;
  2852. try
  2853. Screen.Cursor := crHourGlass;
  2854. WatchForChanges := False;
  2855. if (dwEffect in [DropEffect_Copy, DropEffect_Move]) then
  2856. begin
  2857. StopWatchThread;
  2858. if Assigned(DriveView) then
  2859. TDriveView(DriveView).StopWatchThread;
  2860. if (DropSourceControl <> Self) and
  2861. (DropSourceControl is TDirView) then
  2862. TDirView(DropSourceControl).StopWatchThread;
  2863. SourcePath := '';
  2864. {Set the source filenames:}
  2865. for Index := 0 to DragDropFilesEx.FileList.Count - 1 do
  2866. begin
  2867. FFileOperator.OperandFrom.Add(
  2868. TFDDListItem(DragDropFilesEx.FileList[Index]^).Name);
  2869. if DragDropFilesEx.FileNamesAreMapped then
  2870. FFileOperator.OperandTo.Add(IncludeTrailingPathDelimiter(TargetPath) +
  2871. TFDDListItem(DragDropFilesEx.FileList[Index]^).MappedName);
  2872. if SourcePath = '' then
  2873. begin
  2874. if DirExists(TFDDListItem(DragDropFilesEx.FileList[Index]^).Name) then
  2875. begin
  2876. SourcePath := TFDDListItem(DragDropFilesEx.FileList[Index]^).Name;
  2877. SourceIsDirectory := True;
  2878. end
  2879. else
  2880. begin
  2881. SourcePath := ExtractFilePath(TFDDListItem(DragDropFilesEx.FileList[Index]^).Name);
  2882. SourceIsDirectory := False;
  2883. end;
  2884. end;
  2885. end;
  2886. FFileOperator.Flags := [foAllowUndo, foNoConfirmMkDir];
  2887. if RenameOnCollision then
  2888. begin
  2889. FFileOperator.Flags := FFileOperator.Flags + [foRenameOnCollision];
  2890. FFileOperator.WantMappingHandle := True;
  2891. end
  2892. else FFileOperator.WantMappingHandle := False;
  2893. {Set the target directory or the target filenames:}
  2894. if DragDropFilesEx.FileNamesAreMapped and (not IsRecycleBin) then
  2895. begin
  2896. FFileOperator.Flags := FFileOperator.Flags + [foMultiDestFiles];
  2897. end
  2898. else
  2899. begin
  2900. FFileOperator.Flags := FFileOperator.Flags - [foMultiDestFiles];
  2901. FFileOperator.OperandTo.Clear;
  2902. FFileOperator.OperandTo.Add(TargetPath);
  2903. end;
  2904. {if the target directory is the recycle bin, then delete the selected files:}
  2905. if IsRecycleBin then
  2906. begin
  2907. FFileOperator.Operation := foDelete;
  2908. end
  2909. else
  2910. begin
  2911. case dwEffect of
  2912. DropEffect_Copy: FFileOperator.Operation := foCopy;
  2913. DropEffect_Move: FFileOperator.Operation := foMove;
  2914. end;
  2915. end;
  2916. if IsRecycleBin then
  2917. begin
  2918. if not ConfirmDelete then
  2919. FFileOperator.Flags := FFileOperator.Flags + [foNoConfirmation];
  2920. end
  2921. else
  2922. begin
  2923. if not ConfirmOverwrite then
  2924. FFileOperator.Flags := FFileOperator.Flags + [foNoConfirmation];
  2925. end;
  2926. DoFileOperation := True;
  2927. if Assigned(OnDDFileOperation) then
  2928. begin
  2929. OnDDFileOperation(Self, dwEffect, SourcePath, TargetPath,
  2930. DoFileOperation);
  2931. end;
  2932. if DoFileOperation and (FFileOperator.OperandFrom.Count > 0) then
  2933. begin
  2934. FFileOperator.Execute;
  2935. ReLoad2;
  2936. if DragDropFilesEx.FileNamesAreMapped then
  2937. FFileOperator.ClearUndo;
  2938. if Assigned(OnDDFileOperationExecuted) then
  2939. OnDDFileOperationExecuted(Self, dwEffect, SourcePath, TargetPath);
  2940. end;
  2941. end
  2942. else
  2943. if dwEffect = DropEffect_Link then
  2944. (* Create Link requested: *)
  2945. begin
  2946. StopWatchThread;
  2947. for Index := 0 to DragDropFilesEx.FileList.Count - 1 do
  2948. begin
  2949. SourceFile := TFDDListItem(DragDropFilesEx.FileList[Index]^).Name;
  2950. if Length(SourceFile) = 3 then
  2951. {Create a link to a drive:}
  2952. SourcePath := Copy(DriveInfo[SourceFile[1]].PrettyName, 4, 255) + '(' + SourceFile[1] + ')'
  2953. else
  2954. {Create a link to a file or directory:}
  2955. SourcePath := ExtractFileName(SourceFile);
  2956. if not CreateFileShortCut(SourceFile, IncludeTrailingPathDelimiter(TargetPath) +
  2957. ChangeFileExt(SourcePath,'.lnk'),
  2958. ExtractFileNameOnly(SourceFile)) then
  2959. DDError(DDCreateShortCutError);
  2960. end;
  2961. ReLoad2;
  2962. end;
  2963. if Assigned(DropSourceControl) and
  2964. (DropSourceControl is TDirView) and
  2965. (DropSourceControl <> Self) and
  2966. (dwEffect = DropEffect_Move) then
  2967. TDirView(DropSourceControl).ValidateSelectedFiles;
  2968. if Assigned(FDriveView) and SourceIsDirectory then
  2969. with TDriveView(FDriveView) do
  2970. begin
  2971. try
  2972. ValidateDirectory(FindNodeToPath(TargetPath));
  2973. except
  2974. end;
  2975. if (dwEffect = DropEffect_Move) or IsRecycleBin then
  2976. try
  2977. Node := FindNodeToPath(SourcePath);
  2978. if Assigned(Node) and Assigned(Node.Parent) then
  2979. Node := Node.Parent;
  2980. ValidateDirectory(Node);
  2981. except
  2982. end;
  2983. end;
  2984. finally
  2985. FFileOperator.OperandFrom.Clear;
  2986. FFileOperator.OperandTo.Clear;
  2987. if Assigned(FDriveView) then
  2988. TDriveView(FDriveView).StartWatchThread;
  2989. Sleep(0);
  2990. WatchForChanges := OldWatchForChanges;
  2991. if (DropSourceControl <> Self) and (DropSourceControl is TDirView) then
  2992. TDirView(DropSourceControl).StartWatchThread;
  2993. Screen.Cursor := OldCursor;
  2994. end;
  2995. end;
  2996. end;
  2997. end;
  2998. end; {PerformDragDropFileOperation}
  2999. procedure TDirView.DDError(ErrorNo: TDDError);
  3000. begin
  3001. if Assigned(OnDDError) then OnDDError(Self, ErrorNo)
  3002. else
  3003. raise EDragDrop.Create(Format(SDragDropError, [Ord(ErrorNo)]));
  3004. end; {DDError}
  3005. function TDirView.GetCanUndoCopyMove: Boolean;
  3006. begin
  3007. Result := Assigned(FFileOperator) and FFileOperator.CanUndo;
  3008. end; {CanUndoCopyMove}
  3009. function TDirView.UndoCopyMove : Boolean;
  3010. var
  3011. LastTarget: string;
  3012. LastSource: string;
  3013. begin
  3014. Result := False;
  3015. if FFileOperator.CanUndo then
  3016. begin
  3017. Lasttarget := FFileOperator.LastOperandTo[0];
  3018. LastSource := FFileOperator.LastOperandFrom[0];
  3019. if Assigned(FDriveView) then
  3020. TDriveView(FDriveView).StopAllWatchThreads;
  3021. Result := FFileOperator.UndoExecute;
  3022. if not WatchthreadActive then
  3023. Reload2;
  3024. if Assigned(FDriveView) then
  3025. with TDriveView(FDriveView) do
  3026. begin
  3027. ValidateDirectory(FindNodeToPath(ExtractFilePath(LastTarget)));
  3028. ValidateDirectory(FindNodeToPath(ExtractFilePath(LastSource)));
  3029. StartAllWatchThreads;
  3030. end;
  3031. end;
  3032. end; {UndoCopyMove}
  3033. procedure TDirView.EmptyClipboard;
  3034. var
  3035. Item: TListItem;
  3036. begin
  3037. if Windows.OpenClipBoard(0) then
  3038. begin
  3039. Windows.EmptyClipBoard;
  3040. Windows.CloseClipBoard;
  3041. if LastClipBoardOperation <> cboNone then
  3042. begin
  3043. Item := GetNextItem(nil, sdAll, [isCut]);
  3044. while Assigned(Item) do
  3045. begin
  3046. Item.Cut := False;
  3047. Item := GetNextItem(Item, sdAll, [isCut]);
  3048. end;
  3049. end;
  3050. LastClipBoardOperation := cboNone;
  3051. if Assigned(FDriveView) then
  3052. TDriveView(FDriveView).LastPathCut := '';
  3053. end;
  3054. end; {EmptyClipBoard}
  3055. function TDirView.CopyToClipBoard : Boolean;
  3056. var
  3057. Item: TListItem;
  3058. SaveCursor: TCursor;
  3059. begin
  3060. SaveCursor := Screen.Cursor;
  3061. Screen.Cursor := crHourGlass;
  3062. try
  3063. Result := False;
  3064. EmptyClipBoard;
  3065. DragDropFilesEx.FileList.Clear;
  3066. if SelCount > 0 then
  3067. begin
  3068. Item := GetNextItem(nil, sdAll, [isSelected]);
  3069. while Assigned(Item) do
  3070. begin
  3071. DragDropFilesEx.FileList.AddItem(nil, ItemFullFileName(Item));
  3072. Item := GetNextItem(Item, sdAll, [isSelected]);
  3073. end;
  3074. Result := DragDropFilesEx.CopyToClipBoard;
  3075. LastClipBoardOperation := cboCopy;
  3076. end;
  3077. finally
  3078. Screen.Cursor := SaveCursor;
  3079. end;
  3080. end; {CopyToClipBoard}
  3081. function TDirView.CutToClipBoard : Boolean;
  3082. var
  3083. Item: TListItem;
  3084. begin
  3085. Result := False;
  3086. EmptyClipBoard;
  3087. DragDropFilesEx.FileList.Clear;
  3088. if SelCount > 0 then
  3089. begin
  3090. Item := GetNextItem(nil, sdAll, [isSelected]);
  3091. while Assigned(Item) do
  3092. begin
  3093. DragDropFilesEx.FileList.AddItem(nil, ItemFullFileName(Item));
  3094. Item.Cut := True;
  3095. Item := GetNextItem(Item, sdAll, [isSelected]);
  3096. end;
  3097. Result := DragDropFilesEx.CopyToClipBoard;
  3098. LastClipBoardOperation := cboCut;
  3099. end;
  3100. end; {CutToClipBoard}
  3101. function TDirView.PasteFromClipBoard(TargetPath: string): Boolean;
  3102. begin
  3103. DragDropFilesEx.FileList.Clear;
  3104. Result := False;
  3105. if CanPasteFromClipBoard and {MP}DragDropFilesEx.GetFromClipBoard{/MP}
  3106. then
  3107. begin
  3108. if TargetPath = '' then
  3109. TargetPath := PathName;
  3110. case LastClipBoardOperation of
  3111. cboNone:
  3112. begin
  3113. PerformDragDropFileOperation(TargetPath, DropEffect_Copy, False);
  3114. if Assigned(OnDDExecuted) then OnDDExecuted(Self, DropEffect_Copy);
  3115. end;
  3116. cboCopy:
  3117. begin
  3118. PerformDragDropFileOperation(TargetPath, DropEffect_Copy,
  3119. ExcludeTrailingPathDelimiter(ExtractFilePath(TFDDListItem(DragDropFilesEx.FileList[0]^).Name)) = Path);
  3120. if Assigned(OnDDExecuted) then OnDDExecuted(Self, DropEffect_Copy);
  3121. end;
  3122. cboCut:
  3123. begin
  3124. PerformDragDropFileOperation(TargetPath, DropEffect_Move, False);
  3125. if Assigned(OnDDExecuted) then OnDDExecuted(Self, DropEffect_Move);
  3126. EmptyClipBoard;
  3127. end;
  3128. end;
  3129. Result := True;
  3130. end;
  3131. end; {PasteFromClipBoard}
  3132. function TDirView.DragCompleteFileList: Boolean;
  3133. begin
  3134. Result := inherited DragCompleteFileList and
  3135. (FDriveType <> DRIVE_REMOVABLE);
  3136. end;
  3137. function TDirView.DuplicateSelectedFiles: Boolean;
  3138. begin
  3139. Result := False;
  3140. if SelCount > 0 then
  3141. begin
  3142. Result := CopyToClipBoard;
  3143. if Result then
  3144. try
  3145. SelectNewFiles := True;
  3146. Selected := nil;
  3147. Result := PasteFromClipBoard();
  3148. finally
  3149. SelectNewFiles := False;
  3150. if Assigned(Selected) then
  3151. begin
  3152. ItemFocused := Selected;
  3153. Selected.MakeVisible(False);
  3154. if SelCount = 1 then
  3155. Selected.EditCaption;
  3156. end;
  3157. end;
  3158. end;
  3159. EmptyClipBoard;
  3160. end; {DuplicateFiles}
  3161. procedure TDirView.FetchAllDisplayData;
  3162. var
  3163. Index: Integer;
  3164. begin
  3165. for Index := 0 to Items.Count - 1 do
  3166. if Assigned(Items[Index]) and Assigned(Items[Index].Data) then
  3167. if PFileRec(Items[Index].Data)^.Empty then
  3168. GetDisplayData(Items[Index], False);
  3169. end; {FetchAllDisplayData}
  3170. function TDirView.NewColProperties: TCustomListViewColProperties;
  3171. begin
  3172. Result := TDirViewColProperties.Create(Self);
  3173. end;
  3174. function TDirView.SortAscendingByDefault(Index: Integer): Boolean;
  3175. begin
  3176. Result := not (TDirViewCol(Index) in [dvSize, dvChanged]);
  3177. end;
  3178. procedure TDirView.SetItemImageIndex(Item: TListItem; Index: Integer);
  3179. begin
  3180. Assert(Assigned(Item));
  3181. if Assigned(Item.Data) then
  3182. with PFileRec(Item.Data)^ do
  3183. begin
  3184. ImageIndex := Index;
  3185. IconEmpty := (ImageIndex < 0);
  3186. end;
  3187. end;
  3188. {=================================================================}
  3189. initialization
  3190. LastClipBoardOperation := cboNone;
  3191. LastIOResult := 0;
  3192. DaylightHack := (not IsWin7);
  3193. end.