DirView.pas 103 KB

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