DirView.pas 103 KB

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