DirView.pas 102 KB

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