DirView.pas 100 KB

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