DirView.pas 100 KB

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