DirView.pas 107 KB

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