DirView.pas 103 KB

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