DirView.pas 101 KB

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