DirView.pas 102 KB

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