DriveView.pas 74 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639
  1. unit DriveView;
  2. {==================================================================
  3. Component TDriveView / Version 2.6, January 2000
  4. ==================================================================
  5. Description:
  6. ============
  7. Displays the the directory structure of all drives as treeview
  8. with shell icons. Complete drag&Drop support for files and
  9. directories.
  10. Author:
  11. =======
  12. (c) Ingo Eckel 1998, 1999
  13. Sodener Weg 38
  14. 65812 Bad Soden
  15. Germany
  16. Modifications (for WinSCP):
  17. ===========================
  18. (c) Martin Prikryl 2004
  19. V2.6:
  20. - Shows "shared"-symbol with directories
  21. - Delphi5 compatible
  22. For detailed documentation and history see TDriveView.htm.
  23. {==================================================================}
  24. interface
  25. { Define ENHVALIDATE to scan all existing directories on a detected filesystem change:}
  26. {.$DEFINE ENHVALIDATE}
  27. {Required compiler options for TDriveView:}
  28. {$A+,B-,X+,H+,P+}
  29. {$WARN SYMBOL_PLATFORM OFF}
  30. uses
  31. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ComObj,
  32. Dialogs, ComCtrls, ShellApi, CommCtrl, ExtCtrls, ActiveX, ShlObj,
  33. DirView, ShellDialogs, DragDrop, DragDropFilesEx, FileChanges, FileOperator,
  34. DiscMon, IEDriveInfo, IEListView, PIDL, BaseUtils, ListExt, CustomDirView,
  35. CustomDriveView, System.Generics.Collections;
  36. {$I ResStrings.pas}
  37. const
  38. msThreadChangeDelay = 50;
  39. ErrorNodeNA = '%s: Node not assigned';
  40. {Flags used by TDriveView.RefreshRootNodes:}
  41. dvdsFloppy = 8; {Include floppy drives}
  42. dvdsRereadAllways = 16; {Refresh drivestatus in any case}
  43. type
  44. EInvalidDirName = class(Exception);
  45. ENodeNotAssigned = class(Exception);
  46. TDriveStatus = class
  47. Scanned: Boolean; {Drive allready scanned?}
  48. Verified: Boolean; {Drive completly scanned?}
  49. RootNode: TTreeNode; {Rootnode to drive}
  50. RootNodeIndex: Integer;
  51. DiscMonitor: TDiscMonitor; {Monitor thread}
  52. ChangeTimer: TTimer; {Change timer for the monitor thread}
  53. DefaultDir: string; {Current directory}
  54. end;
  55. TScanDirInfo = record
  56. SearchNewDirs: Boolean;
  57. StartNode: TTreeNode;
  58. DriveType: Integer;
  59. end;
  60. PScanDirInfo = ^TScanDirInfo;
  61. TDriveView = class;
  62. TNodeData = class
  63. private
  64. FDirName: string;
  65. FShortName: string;
  66. FAttr: Integer;
  67. FScanned: Boolean;
  68. FData: Pointer;
  69. FIsRecycleBin: Boolean;
  70. FIconEmpty: Boolean;
  71. public
  72. shAttr: ULONG;
  73. PIDL: PItemIDList;
  74. ShellFolder: IShellFolder;
  75. constructor Create;
  76. destructor Destroy; override;
  77. property DirName: string read FDirName write FDirName;
  78. property ShortName: string read FShortName write FShortName;
  79. property Attr: Integer read FAttr write FAttr;
  80. property Scanned: Boolean read FScanned write FScanned;
  81. property Data: Pointer read FData write FData;
  82. property IsRecycleBin: Boolean read FIsRecycleBin;
  83. property IconEmpty: Boolean read FIconEmpty write FIconEmpty;
  84. end;
  85. TDriveTreeNode = class(TTreeNode)
  86. procedure Assign(Source: TPersistent); override;
  87. end;
  88. TDriveView = class(TCustomDriveView)
  89. private
  90. FDriveStatus: TObjectDictionary<string, TDriveStatus>;
  91. FConfirmDelete: Boolean;
  92. FConfirmOverwrite: Boolean;
  93. FWatchDirectory: Boolean;
  94. FDirectory: string;
  95. FFullDriveScan: Boolean;
  96. FShowVolLabel: Boolean;
  97. FVolDisplayStyle: TVolumeDisplayStyle;
  98. FChangeFlag: Boolean;
  99. FLastDir: string;
  100. FValidateFlag: Boolean;
  101. FCreating: Boolean;
  102. FForceRename: Boolean;
  103. FRenameNode: TTreeNode;
  104. FLastRenameName: string;
  105. FInternalWindowHandle: HWND;
  106. FPrevSelected: TTreeNode;
  107. FPrevSelectedIndex: Integer;
  108. FChangeTimerSuspended: Integer;
  109. FDesktop: IShellFolder;
  110. {Additional events:}
  111. FOnDisplayContextMenu: TNotifyEvent;
  112. FOnRefreshDrives: TNotifyEvent;
  113. {used components:}
  114. FDirView: TDirView;
  115. FFileOperator: TFileOperator;
  116. FChangeInterval: Cardinal;
  117. {Drag&drop:}
  118. FLastPathCut: string;
  119. {Drag&drop helper functions:}
  120. procedure SignalDirDelete(Sender: TObject; Files: TStringList);
  121. function CheckForSubDirs(Path: string): Boolean;
  122. function ReadSubDirs(Node: TTreeNode; DriveType: Integer): Boolean;
  123. {Callback-functions used by iteratesubtree:}
  124. function CallBackValidateDir(var Node: TTreeNode; Data: Pointer): Boolean;
  125. { Notification procedures used by component TDiscMonitor: }
  126. procedure ChangeDetected(Sender: TObject; const Directory: string;
  127. var SubdirsChanged: Boolean);
  128. procedure ChangeInvalid(Sender: TObject; const Directory: string; const ErrorStr: string);
  129. {Notification procedure used by component TTimer:}
  130. procedure ChangeTimerOnTimer(Sender: TObject);
  131. protected
  132. procedure SetSelected(Node: TTreeNode);
  133. procedure SetFullDriveScan(DoFullDriveScan: Boolean);
  134. procedure SetWatchDirectory(Value: Boolean);
  135. procedure SetShowVolLabel(ShowIt: Boolean);
  136. procedure SetDirView(Value: TDirView);
  137. procedure SetDirectory(Value: string); override;
  138. procedure GetNodeShellAttr(ParentNode: TTreeNode; NodeData: TNodeData; GetAttr: Boolean);
  139. function DoScanDir(FromNode: TTreeNode): Boolean;
  140. function AddChildNode(ParentNode: TTreeNode; SRec: TSearchRec): TTreeNode;
  141. procedure CreateWatchThread(Drive: string);
  142. function NodeWatched(Node: TTreeNode): Boolean;
  143. procedure TerminateWatchThread(Drive: string);
  144. function WatchThreadActive: Boolean; overload;
  145. function WatchThreadActive(Drive: string): Boolean; overload;
  146. procedure InternalWndProc(var Msg: TMessage);
  147. function DirAttrMask: Integer;
  148. function CreateDriveStatus: TDriveStatus;
  149. procedure ValidateDirectoryEx(Node: TTreeNode; Recurse: TRecursiveScan;
  150. NewDirs: Boolean); override;
  151. procedure RebuildTree; override;
  152. procedure SetLastPathCut(Path: string);
  153. function GetCanUndoCopyMove: Boolean; virtual;
  154. procedure CreateWnd; override;
  155. procedure DestroyWnd; override;
  156. procedure Edit(const Item: TTVItem); override;
  157. procedure WMUserRename(var Message: TMessage); message WM_USER_RENAME;
  158. function GetCustomDirView: TCustomDirView; override;
  159. procedure SetCustomDirView(Value: TCustomDirView); override;
  160. function NodePath(Node: TTreeNode): string; override;
  161. function NodeIsRecycleBin(Node: TTreeNode): Boolean; override;
  162. function NodePathExists(Node: TTreeNode): Boolean; override;
  163. function NodeColor(Node: TTreeNode): TColor; override;
  164. function FindPathNode(Path: string): TTreeNode; override;
  165. function CreateNode: TTreeNode; override;
  166. function DDSourceEffects: TDropEffectSet; override;
  167. procedure DDChooseEffect(KeyState: Integer; var Effect: Integer; PreferredEffect: Integer); override;
  168. function DragCompleteFileList: Boolean; override;
  169. function DDExecute: TDragResult; override;
  170. public
  171. property Images;
  172. property StateImages;
  173. property Items stored False;
  174. property Selected Write SetSelected stored False;
  175. property DragImageList: TDragImageList read FDragImageList;
  176. property CanUndoCopyMove: Boolean read GetCanUndoCopyMove;
  177. property DDFileOperator: TFileOperator read FFileOperator;
  178. property LastPathCut: string read FLastPathCut write SetLastPathCut;
  179. function UndoCopyMove: Boolean; dynamic;
  180. procedure EmptyClipboard; dynamic;
  181. function CopyToClipBoard(Node: TTreeNode): Boolean; dynamic;
  182. function CutToClipBoard(Node: TTreeNode): Boolean; dynamic;
  183. function CanPasteFromClipBoard: Boolean; dynamic;
  184. function PasteFromClipBoard(TargetPath: string = ''): Boolean; dynamic;
  185. procedure PerformDragDropFileOperation(Node: TTreeNode; Effect: Integer); override;
  186. {Drive handling:}
  187. function GetDriveStatus(Drive: string): TDriveStatus;
  188. function GetDriveTypetoNode(Node: TTreeNode): Integer; {Returns DRIVE_CDROM etc..}
  189. function GetDriveToNode(Node: TTreeNode): string;
  190. function GetDriveText(Drive: string): string;
  191. procedure ScanDrive(Drive: string);
  192. procedure RefreshRootNodes(dsFlags: Integer);
  193. function GetDrives: TStrings;
  194. {Node handling:}
  195. procedure SetImageIndex(Node: TTreeNode); virtual;
  196. function FindNodeToPath(Path: string): TTreeNode;
  197. function RootNode(Node: TTreeNode): TTreeNode;
  198. function GetDirName(Node: TTreeNode): string;
  199. function GetDisplayName(Node: TTreeNode): string;
  200. function NodePathName(Node: TTreeNode): string; override;
  201. function GetFQPIDL(Node: TTreeNode): PItemIDList;
  202. constructor Create(AOwner: TComponent); override;
  203. destructor Destroy; override;
  204. {Menu-handling:}
  205. procedure DisplayContextMenu(Node: TTreeNode; Point: TPoint); override;
  206. procedure DisplayPropertiesMenu(Node: TTreeNode); override;
  207. {Watchthread handling:}
  208. procedure StartWatchThread;
  209. procedure StopWatchThread;
  210. procedure SuspendChangeTimer;
  211. procedure ResumeChangeTimer;
  212. procedure StartAllWatchThreads;
  213. procedure StopAllWatchThreads;
  214. procedure ValidateCurrentDirectoryIfNotMonitoring;
  215. (* Modified Events: *)
  216. procedure GetImageIndex(Node: TTreeNode); override;
  217. function CanEdit(Node: TTreeNode): Boolean; override;
  218. function CanChange(Node: TTreeNode): Boolean; override;
  219. function CanExpand(Node: TTreeNode): Boolean; override;
  220. procedure Delete(Node: TTreeNode); override;
  221. procedure Loaded; override;
  222. procedure KeyPress(var Key: Char); override;
  223. procedure Change(Node: TTreeNode); override;
  224. published
  225. {Additional properties:}
  226. {Current selected directory:}
  227. property Directory;
  228. {Confirm deleting directories:}
  229. property ConfirmDelete: Boolean read FConfirmDelete write FConfirmDelete default True;
  230. {Confirm overwriting directories:}
  231. property ConfirmOverwrite: Boolean read FConfirmOverwrite write FConfirmOverwrite default True;
  232. {Scan all directories in method ScanDrive:}
  233. property FullDriveScan: Boolean read FFullDriveScan write SetFullDriveScan default False;
  234. {Enable automatic update on filesystem changes:}
  235. property WatchDirectory: Boolean read FWatchDirectory write SetWatchDirectory default False;
  236. {Linked component TDirView:}
  237. property DirView: TDirView read FDirView write SetDirView;
  238. {Show the volume labels of drives:}
  239. property ShowVolLabel: Boolean read FShowVolLabel write SetShowVolLabel default True;
  240. {Additional events:}
  241. property OnDisplayContextMenu: TNotifyEvent read FOnDisplayContextMenu
  242. write FOnDisplayContextMenu;
  243. property OnRefreshDrives: TNotifyEvent read FOnRefreshDrives
  244. write FOnRefreshDrives;
  245. property OnBusy;
  246. property DDLinkOnExeDrag;
  247. property TargetPopUpMenu;
  248. property OnDDDragEnter;
  249. property OnDDDragLeave;
  250. property OnDDDragOver;
  251. property OnDDDrop;
  252. property OnDDQueryContinueDrag;
  253. property OnDDGiveFeedback;
  254. property OnDDDragDetect;
  255. property OnDDProcessDropped;
  256. property OnDDError;
  257. property OnDDExecuted;
  258. property OnDDFileOperation;
  259. property OnDDFileOperationExecuted;
  260. property Align;
  261. property Anchors;
  262. property AutoExpand;
  263. property BiDiMode;
  264. property BorderStyle;
  265. property BorderWidth;
  266. property ChangeDelay;
  267. property Color;
  268. property Ctl3D;
  269. property Constraints;
  270. property DoubleBuffered;
  271. {Delphi's drag&drop is not compatible with the OLE windows drag&drop:}
  272. property DragKind;
  273. property DragCursor;
  274. property DragMode Default dmAutomatic;
  275. property OnDragDrop;
  276. property OnDragOver;
  277. property Enabled;
  278. property Font;
  279. property HideSelection;
  280. property HotTrack;
  281. property Indent;
  282. property ParentBiDiMode;
  283. property ParentColor;
  284. property ParentCtl3D;
  285. property ParentDoubleBuffered;
  286. property ParentFont;
  287. property ParentShowHint;
  288. property PopupMenu;
  289. property ReadOnly;
  290. property RightClickSelect;
  291. property RowSelect;
  292. property ShowButtons;
  293. property ShowHint;
  294. property ShowLines;
  295. property TabOrder;
  296. property TabStop default True;
  297. property ToolTips;
  298. property Visible;
  299. property OnChange;
  300. property OnChanging;
  301. property OnClick;
  302. property OnCollapsing;
  303. property OnCollapsed;
  304. property OnCompare;
  305. property OnDblClick;
  306. property OnDeletion;
  307. property OnEdited;
  308. property OnEditing;
  309. property OnEndDock;
  310. property OnEndDrag;
  311. property OnEnter;
  312. property OnExit;
  313. property OnExpanding;
  314. property OnExpanded;
  315. property OnGetImageIndex;
  316. property OnGetSelectedIndex;
  317. property OnKeyDown;
  318. property OnKeyPress;
  319. property OnKeyUp;
  320. property OnMouseDown;
  321. property OnMouseMove;
  322. property OnMouseUp;
  323. property OnStartDock;
  324. property OnStartDrag;
  325. end;
  326. procedure Register;
  327. implementation
  328. uses
  329. CompThread, PasTools, UITypes, Types, OperationWithTimeout, System.Generics.Defaults;
  330. resourcestring
  331. SErrorInvalidDirName = 'New name contains invalid characters %s';
  332. type
  333. PInt = ^Integer;
  334. procedure Register;
  335. begin
  336. RegisterComponents('DriveDir', [TDriveView]);
  337. end; {Register}
  338. constructor TNodeData.Create;
  339. begin
  340. inherited;
  341. FAttr := 0;
  342. FScanned := False;
  343. FDirName := '';
  344. FShortName := '';
  345. FIsRecycleBin := False;
  346. FIconEmpty := True;
  347. shAttr := 0;
  348. PIDL := nil;
  349. ShellFolder := nil;
  350. end; {TNodeData.Create}
  351. destructor TNodeData.Destroy;
  352. begin
  353. SetLength(FDirName, 0);
  354. if Assigned(PIDL) then
  355. FreePIDL(PIDL);
  356. inherited;
  357. end; {TNodeData.Destroy}
  358. { TDriveTreeNode }
  359. procedure TDriveTreeNode.Assign(Source: TPersistent);
  360. var
  361. SourceData: TNodeData;
  362. NewData: TNodeData;
  363. begin
  364. inherited Assign(Source);
  365. if not Deleting and (Source is TTreeNode) then
  366. begin
  367. SourceData := TNodeData(TTreeNode(Source).Data);
  368. NewData := TNodeData.Create();
  369. NewData.DirName := SourceData.DirName;
  370. NewData.ShortName := SourceData.ShortName;
  371. NewData.Attr := SourceData.Attr;
  372. NewData.Scanned := SourceData.Scanned;
  373. NewData.Data := SourceData.Data;
  374. NewData.FIsRecycleBin := SourceData.FIsRecycleBin;
  375. NewData.IconEmpty := SourceData.IconEmpty;
  376. TTreeNode(Source).Data := NewData;
  377. end;
  378. end;
  379. { TDriveView }
  380. constructor TDriveView.Create(AOwner: TComponent);
  381. var
  382. Drive: TRealDrive;
  383. begin
  384. inherited;
  385. FCreating := True;
  386. FDriveStatus := TObjectDictionary<string, TDriveStatus>.Create([doOwnsValues]);
  387. FChangeInterval := MSecsPerSec;
  388. for Drive := FirstDrive to LastDrive do
  389. begin
  390. FDriveStatus.Add(Drive, CreateDriveStatus);
  391. end;
  392. FFileOperator := TFileOperator.Create(Self);
  393. FFileOperator.ProgressTitle := coFileOperatorTitle;
  394. FFileOperator.Flags := [foAllowUndo, foNoConfirmMkDir];
  395. FShowVolLabel := True;
  396. FChangeFlag := False;
  397. FLastDir := EmptyStr;
  398. FValidateFlag := False;
  399. FConfirmDelete := True;
  400. FDirectory := EmptyStr;
  401. FForceRename := False;
  402. FLastRenameName := '';
  403. FRenameNode := nil;
  404. FPrevSelected := nil;
  405. FPrevSelectedIndex := -1;
  406. FChangeTimerSuspended := 0;
  407. FConfirmOverwrite := True;
  408. FLastPathCut := '';
  409. FStartPos.X := -1;
  410. FStartPos.Y := -1;
  411. FDragPos := FStartPos;
  412. FInternalWindowHandle := Classes.AllocateHWnd(InternalWndProc);
  413. with FDragDropFilesEx do
  414. begin
  415. ShellExtensions.DragDropHandler := True;
  416. end;
  417. end; {Create}
  418. destructor TDriveView.Destroy;
  419. var
  420. DriveStatus: TDriveStatus;
  421. begin
  422. Classes.DeallocateHWnd(FInternalWindowHandle);
  423. for DriveStatus in FDriveStatus.Values do
  424. begin
  425. with DriveStatus do
  426. begin
  427. if Assigned(DiscMonitor) then
  428. DiscMonitor.Free;
  429. if Assigned(ChangeTimer) then
  430. ChangeTimer.Free;
  431. end;
  432. end;
  433. FDriveStatus.Free;
  434. if Assigned(FFileOperator) then
  435. FFileOperator.Free;
  436. inherited Destroy;
  437. end; {Destroy}
  438. function TDriveView.CreateDriveStatus: TDriveStatus;
  439. begin
  440. Result := TDriveStatus.Create;
  441. with Result do
  442. begin
  443. Scanned := False;
  444. Verified := False;
  445. RootNode := nil;
  446. RootNodeIndex := -1;
  447. DiscMonitor := nil;
  448. DefaultDir := EmptyStr;
  449. {ChangeTimer: }
  450. ChangeTimer := TTimer.Create(Self);
  451. ChangeTimer.Interval := 0;
  452. ChangeTimer.Enabled := False;
  453. ChangeTimer.OnTimer := ChangeTimerOnTimer;
  454. end;
  455. end;
  456. type
  457. PDevBroadcastHdr = ^TDevBroadcastHdr;
  458. TDevBroadcastHdr = record
  459. dbch_size: DWORD;
  460. dbch_devicetype: DWORD;
  461. dbch_reserved: DWORD;
  462. end;
  463. PDevBroadcastVolume = ^TDevBroadcastVolume;
  464. TDevBroadcastVolume = record
  465. dbcv_size: DWORD;
  466. dbcv_devicetype: DWORD;
  467. dbcv_reserved: DWORD;
  468. dbcv_unitmask: DWORD;
  469. dbcv_flags: WORD;
  470. end;
  471. const
  472. DBT_CONFIGCHANGED = $0018;
  473. DBT_DEVICEARRIVAL = $8000;
  474. DBT_DEVICEREMOVEPENDING = $8003;
  475. DBT_DEVICEREMOVECOMPLETE = $8004;
  476. DBT_DEVTYP_VOLUME = $00000002;
  477. procedure TDriveView.InternalWndProc(var Msg: TMessage);
  478. var
  479. UnitMask: DWORD;
  480. Drive: Char;
  481. begin
  482. with Msg do
  483. begin
  484. if Msg = WM_DEVICECHANGE then
  485. begin
  486. if (wParam = DBT_CONFIGCHANGED) or
  487. (wParam = DBT_DEVICEARRIVAL) or
  488. (wParam = DBT_DEVICEREMOVECOMPLETE) then
  489. begin
  490. // Delay refreshing drives for a sec.
  491. // Particularly with CD/DVD drives, if we query display name
  492. // immediately after receiving DBT_DEVICEARRIVAL, we do not get media label.
  493. // Actually one sec does not help usually, but we do not want to wait any longer,
  494. // because we want to add USB drives asap.
  495. SetTimer(FInternalWindowHandle, 1, MSecsPerSec, nil);
  496. end
  497. else
  498. if wParam = DBT_DEVICEREMOVEPENDING then
  499. begin
  500. if PDevBroadcastHdr(lParam)^.dbch_devicetype = DBT_DEVTYP_VOLUME then
  501. begin
  502. UnitMask := PDevBroadcastVolume(lParam)^.dbcv_unitmask;
  503. Drive := FirstDrive;
  504. while UnitMask > 0 do
  505. begin
  506. if UnitMask and $01 <> 0 then
  507. begin
  508. // Disable disk monitor to release the handle to the drive.
  509. // It may happen that the dirve is not removed in the end. In this case we do not currently resume the
  510. // monitoring. We can watch for DBT_DEVICEQUERYREMOVEFAILED to resume the monitoring.
  511. // But currently we implement this for VeraCrypt, which does not send this notification.
  512. with GetDriveStatus(Drive) do
  513. begin
  514. if Assigned(DiscMonitor) then
  515. begin
  516. DiscMonitor.Enabled := False;
  517. DiscMonitor.Free;
  518. DiscMonitor := nil;
  519. end;
  520. end;
  521. end;
  522. UnitMask := UnitMask shr 1;
  523. Drive := Chr(Ord(Drive) + 1);
  524. end;
  525. end;
  526. end;
  527. end
  528. else
  529. if Msg = WM_TIMER then
  530. begin
  531. KillTimer(FInternalWindowHandle, 1);
  532. try
  533. //DriveInfo.Load;
  534. RefreshRootNodes(dsAll or dvdsRereadAllways);
  535. if Assigned(OnRefreshDrives) then
  536. OnRefreshDrives(Self);
  537. except
  538. Application.HandleException(Self);
  539. end;
  540. end;
  541. Result := DefWindowProc(FInternalWindowHandle, Msg, wParam, lParam);
  542. end;
  543. end;
  544. procedure TDriveView.CreateWnd;
  545. var
  546. DriveStatus: TDriveStatus;
  547. begin
  548. inherited;
  549. if Assigned(PopupMenu) then
  550. PopupMenu.Autopopup := False;
  551. OLECheck(SHGetDesktopFolder(FDesktop));
  552. FDragDropFilesEx.SourceEffects := [deCopy, deMove, deLink];
  553. FDragDropFilesEx.TargetEffects := [deCopy, deMove, deLink];
  554. if FPrevSelectedIndex >= 0 then
  555. begin
  556. FPrevSelected := Items[FPrevSelectedIndex];
  557. FPrevSelectedIndex := -1;
  558. end;
  559. for DriveStatus in FDriveStatus.Values do
  560. with DriveStatus do
  561. begin
  562. if RootNodeIndex >= 0 then
  563. begin
  564. RootNode := Items[RootNodeIndex];
  565. RootNodeIndex := -1;
  566. end;
  567. end;
  568. end; {CreateWnd}
  569. procedure TDriveView.DestroyWnd;
  570. var
  571. DriveStatus: TDriveStatus;
  572. begin
  573. if CreateWndRestores and (Items.Count > 0) and (csRecreating in ControlState) then
  574. begin
  575. FPrevSelectedIndex := -1;
  576. if Assigned(FPrevSelected) then
  577. begin
  578. FPrevSelectedIndex := FPrevSelected.AbsoluteIndex;
  579. FPrevSelected := nil;
  580. end;
  581. for DriveStatus in FDriveStatus.Values do
  582. with DriveStatus do
  583. begin
  584. RootNodeIndex := -1;
  585. if Assigned(RootNode) then
  586. begin
  587. RootNodeIndex := RootNode.AbsoluteIndex;
  588. RootNode := nil;
  589. end;
  590. end;
  591. end;
  592. inherited;
  593. end;
  594. function TDriveView.GetFQPIDL(Node: TTreeNode): PItemIDList;
  595. var
  596. Eaten: ULONG;
  597. shAttr: ULONG;
  598. begin
  599. Result := nil;
  600. if Assigned(Node) then
  601. begin
  602. shAttr := 0;
  603. FDesktop.ParseDisplayName(FParentForm.Handle, nil, PChar(NodePathName(Node)), Eaten,
  604. Result, shAttr);
  605. end;
  606. end; {GetFQPIDL}
  607. function TDriveView.NodeColor(Node: TTreeNode): TColor;
  608. begin
  609. Result := clDefaultItemColor;
  610. with TNodeData(Node.Data) do
  611. if not Node.Selected then
  612. begin
  613. {Colored display of compressed directories:}
  614. if (Attr and FILE_ATTRIBUTE_COMPRESSED) <> 0 then
  615. begin
  616. if SupportsDarkMode and DarkMode then Result := clSkyBlue
  617. else Result := clBlue;
  618. end
  619. else
  620. {Dimmed display, if hidden-atrribut set:}
  621. if FDimmHiddenDirs and ((Attr and FILE_ATTRIBUTE_HIDDEN) <> 0) then
  622. Result := clGrayText
  623. end;
  624. end;
  625. function TDriveView.GetCustomDirView: TCustomDirView;
  626. begin
  627. Result := DirView;
  628. end;
  629. procedure TDriveView.SetCustomDirView(Value: TCustomDirView);
  630. begin
  631. DirView := Value as TDirView;
  632. end;
  633. function TDriveView.NodePath(Node: TTreeNode): string;
  634. var
  635. ParentNode: TTreeNode;
  636. begin
  637. if not Assigned(Node) then
  638. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDirPath']));
  639. Result := GetDirName(Node);
  640. ParentNode := Node.Parent;
  641. while (ParentNode <> nil) and (ParentNode.Level >= 0) do
  642. begin
  643. if ParentNode.Level > 0 then
  644. Result := GetDirName(ParentNode) + '\' + Result
  645. else
  646. Result := GetDirName(ParentNode) + Result;
  647. ParentNode := ParentNode.Parent;
  648. end;
  649. if IsRootPath(Result) then
  650. Result := ExcludeTrailingBackslash(Result);
  651. end;
  652. {NodePathName: Returns the complete path to Node with trailing backslash on rootnodes:
  653. C:\ ,C:\WINDOWS, C:\WINDOWS\SYSTEM }
  654. function TDriveView.NodePathName(Node: TTreeNode): string;
  655. begin
  656. Result := NodePath(Node);
  657. if IsRootPath(Result) then
  658. Result := IncludeTrailingBackslash(Result);
  659. end; {NodePathName}
  660. function TDriveView.NodeIsRecycleBin(Node: TTreeNode): Boolean;
  661. begin
  662. Result := TNodeData(Node.Data).IsRecycleBin;
  663. end;
  664. function TDriveView.NodePathExists(Node: TTreeNode): Boolean;
  665. begin
  666. Result := DirectoryExists(NodePathName(Node));
  667. end;
  668. function TDriveView.CanEdit(Node: TTreeNode): Boolean;
  669. begin
  670. Result := inherited CanEdit(Node) or FForceRename;
  671. if Result then
  672. begin
  673. Result := Assigned(Node.Parent) and
  674. (not TNodeData(Node.Data).IsRecycleBin) and
  675. (not ReadOnly) and
  676. (FDragDropFilesEx.DragDetectStatus <> ddsDrag) and
  677. ((TNodeData(Node.Data).Attr and (faReadOnly or faSysFile)) = 0) and
  678. (UpperCase(Node.Text) = UpperCase(GetDirName(Node)));
  679. end;
  680. FForceRename := False;
  681. end; {CanEdit}
  682. procedure TDriveView.Edit(const Item: TTVItem);
  683. var
  684. NewDirName: string;
  685. SRec: TSearchRec;
  686. Node: TTreeNode;
  687. Info: string;
  688. i: Integer;
  689. begin
  690. Node := GetNodeFromHItem(Item);
  691. if (Length(Item.pszText) > 0) and (Item.pszText <> Node.Text) then
  692. begin
  693. if StrContains(coInvalidDosChars, Item.pszText) then
  694. begin
  695. Info := coInvalidDosChars;
  696. for i := Length(Info) downto 1 do
  697. System.Insert(Space, Info, i);
  698. if Assigned(OnEdited) then
  699. begin
  700. NewDirName := Node.Text;
  701. OnEdited(Self, Node, NewDirName);
  702. end;
  703. if Length(Item.pszText) > 0 then
  704. raise EInvalidDirName.CreateFmt(SErrorInvalidDirName, [Info]);
  705. Exit;
  706. end;
  707. StopWatchThread;
  708. if Assigned(DirView) then
  709. DirView.StopWatchThread;
  710. with FFileOperator do
  711. begin
  712. Flags := [foAllowUndo, foNoConfirmation];
  713. Operation := foRename;
  714. OperandFrom.Clear;
  715. OperandTo.Clear;
  716. OperandFrom.Add(NodePath(Node));
  717. OperandTo.Add(IncludeTrailingBackslash(NodePath(Node.Parent)) + Item.pszText);
  718. end;
  719. try
  720. if FFileOperator.Execute then
  721. begin
  722. Node.Text := Item.pszText;
  723. TNodeData(Node.Data).DirName := Item.pszText;
  724. if FindFirst(ApiPath(IncludeTrailingBackslash(NodePath(Node.Parent)) + Item.pszText),
  725. faAnyFile, SRec) = 0 then
  726. begin
  727. TNodeData(Node.Data).ShortName := string(SRec.FindData.cAlternateFileName);
  728. end;
  729. FindClose(SRec);
  730. SortChildren(Node.Parent, False);
  731. inherited;
  732. end
  733. else
  734. begin
  735. if FileOrDirExists(IncludeTrailingBackslash(NodePath(Node.Parent)) + Item.pszText) then
  736. Info := SErrorRenameFileExists + Item.pszText
  737. else
  738. Info := SErrorRenameFile + Item.pszText;
  739. MessageBeep(MB_ICONHAND);
  740. if MessageDlg(FormatLastOSError(Info), mtError, [mbOK, mbAbort], 0) = mrOK then
  741. begin
  742. FLastRenameName := Item.pszText;
  743. FRenameNode := Node;
  744. PostMessage(Self.Handle, WM_USER_RENAME, 0, 0);
  745. end;
  746. end;
  747. finally
  748. StartWatchThread;
  749. if Assigned(DirView) then
  750. begin
  751. DirView.Reload2;
  752. DirView.StartWatchThread;
  753. end;
  754. end;
  755. end;
  756. end; {Edit}
  757. procedure TDriveView.WMUserRename(var Message: TMessage);
  758. begin
  759. if Assigned(FRenameNode) then
  760. begin
  761. FForceRename := True;
  762. TreeView_EditLabel(Handle, FRenameNode.ItemID);
  763. SetWindowText(TreeView_GetEditControl(Self.Handle), PChar(FLastRenameName));
  764. FRenameNode := nil;
  765. end;
  766. end; {WMUserRename}
  767. function TDriveView.CanExpand(Node: TTreeNode): Boolean;
  768. var
  769. SubNode: TTreeNode;
  770. Drive: string;
  771. SaveCursor: TCursor;
  772. begin
  773. Result := inherited CanExpand(Node);
  774. Drive := GetDriveToNode(Node);
  775. if Node.HasChildren then
  776. begin
  777. if (Node.Level = 0) and
  778. (not GetDriveStatus(Drive).Scanned) and
  779. DriveInfo.IsFixedDrive(Drive) then
  780. begin
  781. SubNode := Node.GetFirstChild;
  782. if not Assigned(SubNode) then
  783. begin
  784. ScanDrive(Drive);
  785. SubNode := Node.GetFirstChild;
  786. Node.HasChildren := Assigned(SubNode);
  787. Result := Node.HasChildren;
  788. if not Assigned(GetDriveStatus(Drive).DiscMonitor) then
  789. CreateWatchThread(Drive);
  790. end;
  791. end
  792. else
  793. begin
  794. SaveCursor := Screen.Cursor;
  795. Screen.Cursor := crHourGlass;
  796. try
  797. if (not TNodeData(Node.Data).Scanned) and DoScanDir(Node) then
  798. begin
  799. ReadSubDirs(Node, DriveInfo.Get(Drive).DriveType);
  800. end;
  801. finally
  802. Screen.Cursor := SaveCursor;
  803. end;
  804. end;
  805. end;
  806. end; {CanExpand}
  807. procedure TDriveView.GetImageIndex(Node: TTreeNode);
  808. begin
  809. if TNodeData(Node.Data).IconEmpty then
  810. SetImageIndex(Node);
  811. inherited;
  812. end; {GetImageIndex}
  813. procedure TDriveView.Loaded;
  814. begin
  815. inherited;
  816. {Create the drive nodes:}
  817. RefreshRootNodes(dsDisplayName or dvdsFloppy);
  818. {Set the initial directory:}
  819. if (Length(FDirectory) > 0) and DirectoryExists(FDirectory) then
  820. Directory := FDirectory;
  821. FCreating := False;
  822. end; {Loaded}
  823. function TDriveView.CreateNode: TTreeNode;
  824. begin
  825. Result := TDriveTreeNode.Create(Items);
  826. end;
  827. procedure TDriveView.Delete(Node: TTreeNode);
  828. var
  829. NodeData: TNodeData;
  830. begin
  831. if Node = FPrevSelected then
  832. FPrevSelected := nil;
  833. NodeData := nil;
  834. if Assigned(Node) and Assigned(Node.Data) then
  835. NodeData := TNodeData(Node.Data);
  836. Node.Data := nil;
  837. inherited;
  838. if Assigned(NodeData) and not (csRecreating in ControlState) then
  839. begin
  840. NodeData.Destroy;
  841. end;
  842. end; {OnDelete}
  843. procedure TDriveView.KeyPress(var Key: Char);
  844. begin
  845. inherited;
  846. if Assigned(Selected) then
  847. begin
  848. if Pos(Key, coInvalidDosChars) <> 0 then
  849. begin
  850. Beep;
  851. Key := #0;
  852. end;
  853. end;
  854. end; {KeyPress}
  855. function TDriveView.CanChange(Node: TTreeNode): Boolean;
  856. var
  857. Path: string;
  858. Drive: string;
  859. begin
  860. Result := inherited CanChange(Node);
  861. if not Reading and not (csRecreating in ControlState) then
  862. begin
  863. if Result and Assigned(Node) then
  864. begin
  865. Path := NodePathName(Node);
  866. if Path <> FLastDir then
  867. begin
  868. Drive := DriveInfo.GetDriveKey(Path);
  869. DriveInfo.ReadDriveStatus(Drive, dsSize or dsImageIndex);
  870. if not DriveInfo.Get(Drive).DriveReady then
  871. begin
  872. MessageDlg(Format(SDriveNotReady, [Drive]), mtError, [mbOK], 0);
  873. Result := False;
  874. end
  875. else
  876. try
  877. CheckCanOpenDirectory(Path);
  878. except
  879. Application.HandleException(Self);
  880. Result := False;
  881. end;
  882. end;
  883. end;
  884. if Result and (csDestroying in ComponentState) then
  885. begin
  886. Result := False;
  887. end;
  888. if Result and
  889. (not FCanChange) and
  890. Assigned(Node) and
  891. Assigned(Node.Data) and
  892. Assigned(Selected) and
  893. Assigned(Selected.Data) then
  894. begin
  895. DropTarget := Node;
  896. Result := False;
  897. end
  898. else
  899. begin
  900. DropTarget := nil;
  901. end;
  902. end;
  903. end; {CanChange}
  904. procedure TDriveView.Change(Node: TTreeNode);
  905. var
  906. Drive: string;
  907. OldSerial: DWORD;
  908. NewDir: string;
  909. LastDrive: string;
  910. begin
  911. if not Reading and not (csRecreating in ControlState) then
  912. begin
  913. if Assigned(Node) then
  914. begin
  915. NewDir := NodePathName(Node);
  916. if NewDir <> FLastDir then
  917. begin
  918. Drive := DriveInfo.GetDriveKey(NewDir);
  919. if Length(FLastDir) > 0 then
  920. LastDrive := DriveInfo.GetDriveKey(FLastDir)
  921. else
  922. LastDrive := '';
  923. FChangeFlag := True;
  924. FLastDir := NewDir;
  925. OldSerial := DriveInfo.Get(Drive).DriveSerial;
  926. DriveInfo.ReadDriveStatus(Drive, dsSize or dsImageIndex);
  927. with DriveInfo.Get(Drive) do
  928. begin
  929. if Assigned(FDirView) and (FDirView.Path <> NewDir) then
  930. FDirView.Path := NewDir;
  931. if DriveReady then
  932. begin
  933. if not DirectoryExists(NewDir) then
  934. begin
  935. ValidateDirectory(GetDriveStatus(Drive).RootNode);
  936. Exit;
  937. end;
  938. GetDriveStatus(Drive).DefaultDir := IncludeTrailingBackslash(NewDir);
  939. if LastDrive <> Drive then
  940. begin
  941. if (LastDrive <> '') and
  942. (DriveInfo.Get(LastDrive).DriveType = DRIVE_REMOVABLE) then
  943. begin
  944. TerminateWatchThread(LastDrive);
  945. end;
  946. {Drive serial has changed or is missing: allways reread the drive:}
  947. if (DriveSerial <> OldSerial) or (DriveSerial = 0) then
  948. begin
  949. if TNodeData(GetDriveStatus(Drive).RootNode.Data).Scanned then
  950. ScanDrive(Drive);
  951. end;
  952. end;
  953. StartWatchThread;
  954. end
  955. else {Drive not ready:}
  956. begin
  957. GetDriveStatus(Drive).RootNode.DeleteChildren;
  958. GetDriveStatus(Drive).DefaultDir := EmptyStr;
  959. end;
  960. end;
  961. end;
  962. if (not Assigned(FPrevSelected)) or (not FPrevSelected.HasAsParent(Node)) then
  963. Node.Expand(False);
  964. FPrevSelected := Node;
  965. ValidateCurrentDirectoryIfNotMonitoring;
  966. end;
  967. end;
  968. inherited;
  969. end; {Change}
  970. procedure TDriveView.SetImageIndex(Node: TTreeNode);
  971. var
  972. FileInfo: TShFileInfo;
  973. Drive, NodePath: string;
  974. begin
  975. if Assigned(Node) and TNodeData(Node.Data).IconEmpty then
  976. begin
  977. NodePath := NodePathName(Node);
  978. Drive := DriveInfo.GetDriveKey(NodePath);
  979. if Node.Level = 0 then
  980. begin
  981. with DriveInfo.Get(Drive) do
  982. begin
  983. if ImageIndex = 0 then
  984. begin
  985. DriveInfo.ReadDriveStatus(Drive, dsImageIndex);
  986. Node.ImageIndex := DriveInfo.Get(Drive).ImageIndex;
  987. end
  988. else Node.ImageIndex := ImageIndex;
  989. Node.SelectedIndex := Node.ImageIndex;
  990. end;
  991. end
  992. else
  993. begin
  994. if DriveInfo.Get(Drive).DriveType = DRIVE_REMOTE then
  995. begin
  996. Node.ImageIndex := StdDirIcon;
  997. Node.SelectedIndex := StdDirSelIcon;
  998. end
  999. else
  1000. begin
  1001. try
  1002. SHGetFileInfo(PChar(NodePath), 0, FileInfo, SizeOf(FileInfo),
  1003. SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  1004. if (FileInfo.iIcon < Images.Count) and (FileInfo.iIcon > 0) then
  1005. begin
  1006. Node.ImageIndex := FileInfo.iIcon;
  1007. SHGetFileInfo(PChar(NodePath), 0, FileInfo, SizeOf(FileInfo),
  1008. SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_OPENICON);
  1009. Node.SelectedIndex := FileInfo.iIcon;
  1010. end
  1011. else
  1012. begin
  1013. Node.ImageIndex := StdDirIcon;
  1014. Node.SelectedIndex := StdDirSelIcon;
  1015. end;
  1016. except
  1017. Node.ImageIndex := StdDirIcon;
  1018. Node.SelectedIndex := StdDirSelIcon;
  1019. end;
  1020. end;
  1021. end;
  1022. end; {IconEmpty}
  1023. TNodeData(Node.Data).IconEmpty := False;
  1024. end; {SetImageIndex}
  1025. function TDriveView.GetDriveText(Drive: string): string;
  1026. begin
  1027. if FShowVolLabel and (Length(DriveInfo.GetPrettyName(Drive)) > 0) then
  1028. begin
  1029. case FVolDisplayStyle of
  1030. doPrettyName: Result := DriveInfo.GetPrettyName(Drive);
  1031. doDisplayName: Result := DriveInfo.GetDisplayName(Drive);
  1032. end; {Case}
  1033. end
  1034. else
  1035. begin
  1036. Result := DriveInfo.GetSimpleName(Drive);
  1037. end;
  1038. end; {GetDriveText}
  1039. procedure TDriveView.GetNodeShellAttr(ParentNode: TTreeNode; NodeData: TNodeData; GetAttr: Boolean);
  1040. var
  1041. ParentFolder: IShellFolder;
  1042. ParentData: TNodeData;
  1043. begin
  1044. NodeData.shAttr := 0;
  1045. if GetAttr then
  1046. begin
  1047. if Assigned(ParentNode) then
  1048. begin
  1049. ParentData := TNodeData(ParentNode.Data);
  1050. if not Assigned(ParentData) then
  1051. begin
  1052. Assert(False);
  1053. ParentFolder := nil;
  1054. end
  1055. else
  1056. begin
  1057. if not Assigned(ParentData.ShellFolder) then
  1058. begin
  1059. GetNodeShellAttr(ParentNode.Parent, ParentData, GetAttr);
  1060. end;
  1061. ParentFolder := ParentData.ShellFolder;
  1062. end;
  1063. end
  1064. else
  1065. begin
  1066. ParentFolder := FDesktop;
  1067. end;
  1068. if Assigned(ParentFolder) and Assigned(NodeData) then
  1069. begin
  1070. if not Assigned(NodeData.PIDL) then
  1071. NodeData.PIDL := PIDL_GetFromParentFolder(ParentFolder, PChar(NodeData.DirName));
  1072. if Assigned(NodeData.PIDL) then
  1073. begin
  1074. NodeData.shAttr := SFGAO_CONTENTSMASK;
  1075. // Previously we would also make use of SFGAO_SHARE to display a share overlay.
  1076. // But for directories, Windows File Explorer does not display the overlay anymore (probably since Vista).
  1077. // And for drives (where Explorer does display the overlay), it did not work ever since we use "desktop"
  1078. // (and not "workspace" as before) to resolve drive interface (see Bug 1717).
  1079. if not Succeeded(ShellFolderGetAttributesOfWithTimeout(ParentFolder, 1, NodeData.PIDL, NodeData.shAttr, MSecsPerSec)) then
  1080. begin
  1081. NodeData.shAttr := 0;
  1082. end;
  1083. if not Assigned(NodeData.ShellFolder) then
  1084. begin
  1085. ParentFolder.BindToObject(NodeData.PIDL, nil, IID_IShellFolder, Pointer(NodeData.ShellFolder));
  1086. end;
  1087. end
  1088. end;
  1089. end;
  1090. if NodeData.shAttr = 0 then
  1091. begin
  1092. // If we cannot resolve attrs, we do not want to assume that the folder has no subfolders,
  1093. // as that will make us scan the folder.
  1094. NodeData.shAttr := SFGAO_HASSUBFOLDER;
  1095. end;
  1096. end; {GetNodeAttr}
  1097. function CompareDrive(List: TStringList; Index1, Index2: Integer): Integer;
  1098. var
  1099. Drive1, Drive2: string;
  1100. RealDrive1, RealDrive2: Boolean;
  1101. begin
  1102. Drive1 := List[Index1];
  1103. Drive2 := List[Index2];
  1104. RealDrive1 := DriveInfo.IsRealDrive(Drive1);
  1105. RealDrive2 := DriveInfo.IsRealDrive(Drive2);
  1106. if RealDrive1 = RealDrive2 then
  1107. begin
  1108. Result := CompareText(Drive1, Drive2);
  1109. end
  1110. else
  1111. if RealDrive1 and (not RealDrive2) then
  1112. begin
  1113. Result := -1;
  1114. end
  1115. else
  1116. begin
  1117. Result := 1;
  1118. end;
  1119. end;
  1120. function TDriveView.GetDrives: TStrings;
  1121. var
  1122. DriveStatusPair: TPair<string, TDriveStatus>;
  1123. Drives: TStringList;
  1124. begin
  1125. Drives := TStringList.Create;
  1126. { We could iterate only .Keys here, but that crashes IDE for some reason }
  1127. for DriveStatusPair in FDriveStatus do
  1128. begin
  1129. Drives.Add(DriveStatusPair.Key);
  1130. end;
  1131. Drives.CustomSort(CompareDrive);
  1132. Result := Drives;
  1133. end;
  1134. procedure TDriveView.RefreshRootNodes(dsFlags: Integer);
  1135. var
  1136. Drives: TStrings;
  1137. NewText: string;
  1138. SaveCursor: TCursor;
  1139. WasValid: Boolean;
  1140. NodeData: TNodeData;
  1141. NewDrive: Char;
  1142. DriveStatus: TDriveStatus;
  1143. NextDriveNode: TTreeNode;
  1144. Index: Integer;
  1145. Drive: string;
  1146. GetAttr: Boolean;
  1147. begin
  1148. SaveCursor := Screen.Cursor;
  1149. Screen.Cursor := crHourGlass;
  1150. Drives := nil;
  1151. try
  1152. Drives := GetDrives;
  1153. NextDriveNode := nil;
  1154. for Index := Drives.Count - 1 downto 0 do
  1155. begin
  1156. Drive := Drives[Index];
  1157. DriveStatus := GetDriveStatus(Drive);
  1158. if ((dsFlags and dvdsFloppy) <> 0) or DriveInfo.IsFixedDrive(Drive) then
  1159. begin
  1160. with DriveInfo.Get(Drive) do
  1161. begin
  1162. WasValid := Assigned(DriveStatus.RootNode);
  1163. end;
  1164. if ((dsFlags and dvdsReReadAllways) = 0) and
  1165. (Length(DriveInfo.Get(Drive).DisplayName) > 0) then
  1166. dsFlags := dsFlags and (not dsDisplayName);
  1167. DriveInfo.ReadDriveStatus(Drive, dsFlags);
  1168. with DriveInfo.Get(Drive), DriveStatus do
  1169. begin
  1170. if Valid then
  1171. begin
  1172. if not WasValid then
  1173. {New drive has arrived: insert new rootnode:}
  1174. begin
  1175. { Create root directory node }
  1176. NodeData := TNodeData.Create;
  1177. NodeData.DirName := DriveInfo.GetDriveRoot(Drive);
  1178. NodeData.ShortName := NodeData.DirName;
  1179. {Get the shared attributes:}
  1180. GetAttr :=
  1181. DriveInfo.IsFixedDrive(Drive) and (DriveType <> DRIVE_REMOVABLE) and
  1182. ((DriveType <> DRIVE_REMOTE) or GetNetWorkConnected(Drive));
  1183. GetNodeShellAttr(nil, NodeData, GetAttr);
  1184. if Assigned(NextDriveNode) then
  1185. RootNode := Items.InsertObject(NextDriveNode, '', NodeData)
  1186. else
  1187. RootNode := Items.AddObject(nil, '', NodeData);
  1188. RootNode.Text := GetDisplayName(RootNode);
  1189. RootNode.HasChildren := True;
  1190. Scanned := False;
  1191. Verified := False;
  1192. end
  1193. else
  1194. if RootNode.ImageIndex <> DriveInfo.Get(Drive).ImageIndex then
  1195. begin {WasValid = True}
  1196. RootNode.ImageIndex := DriveInfo.Get(Drive).ImageIndex;
  1197. RootNode.SelectedIndex := DriveInfo.Get(Drive).ImageIndex;
  1198. end;
  1199. if Assigned(RootNode) then
  1200. begin
  1201. NewText := GetDisplayName(RootNode);
  1202. if RootNode.Text <> NewText then
  1203. RootNode.Text := NewText;
  1204. end;
  1205. end
  1206. else
  1207. if WasValid then
  1208. {Drive has been removed => delete rootnode:}
  1209. begin
  1210. if (Directory <> '') and (Directory[1] = Drive) then
  1211. begin
  1212. if DriveInfo.IsRealDrive(Drive) then NewDrive := Drive[1]
  1213. else NewDrive := FirstFixedDrive;
  1214. repeat
  1215. if NewDrive < FirstFixedDrive then NewDrive := FirstFixedDrive
  1216. else
  1217. if NewDrive = FirstFixedDrive then NewDrive := LastDrive
  1218. else Dec(NewDrive);
  1219. DriveInfo.ReadDriveStatus(NewDrive, dsSize or dsImageIndex);
  1220. if NewDrive = Drive then
  1221. begin
  1222. Break;
  1223. end;
  1224. if DriveInfo.Get(NewDrive).Valid and DriveInfo.Get(NewDrive).DriveReady and Assigned(GetDriveStatus(NewDrive).RootNode) then
  1225. begin
  1226. Directory := NodePathName(GetDriveStatus(NewDrive).RootNode);
  1227. break;
  1228. end;
  1229. until False;
  1230. if not Assigned(Selected) then
  1231. begin
  1232. Directory := NodePathName(GetDriveStatus(FirstFixedDrive).RootNode);
  1233. end;
  1234. end;
  1235. Scanned := False;
  1236. Verified := False;
  1237. RootNode.Delete;
  1238. RootNode := nil;
  1239. end;
  1240. end;
  1241. end;
  1242. if Assigned(DriveStatus.RootNode) then
  1243. NextDriveNode := DriveStatus.RootNode;
  1244. end;
  1245. finally
  1246. Screen.Cursor := SaveCursor;
  1247. Drives.Free;
  1248. end;
  1249. end; {RefreshRootNodes}
  1250. function TDriveView.AddChildNode(ParentNode: TTreeNode; SRec: TSearchRec): TTreeNode;
  1251. var
  1252. NewNode: TTreeNode;
  1253. NodeData: TNodeData;
  1254. GetAttr: Boolean;
  1255. begin
  1256. NodeData := TNodeData.Create;
  1257. NodeData.Attr := SRec.Attr;
  1258. NodeData.DirName := SRec.Name;
  1259. NodeData.ShortName := SRec.FindData.cAlternateFileName;
  1260. NodeData.FIsRecycleBin :=
  1261. (SRec.Attr and faSysFile <> 0) and
  1262. (ParentNode.Level = 0) and
  1263. (SameText(SRec.Name, 'RECYCLED') or
  1264. SameText(SRec.Name, 'RECYCLER') or
  1265. SameText(SRec.Name, '$RECYCLE.BIN'));
  1266. { query content attributes ("has subfolder") only if tree view is visible }
  1267. { to avoid unnecessary scan of subfolders (which may take some time) }
  1268. { if tree view is not visible anyway }
  1269. GetAttr :=
  1270. Visible and
  1271. (GetDriveTypeToNode(ParentNode) <> DRIVE_REMOTE);
  1272. GetNodeShellAttr(ParentNode, NodeData, GetAttr);
  1273. NewNode := Self.Items.AddChildObject(ParentNode, '', NodeData);
  1274. NewNode.Text := GetDisplayName(NewNode);
  1275. Result := NewNode;
  1276. end; {AddChildNode}
  1277. function TDriveView.GetDriveStatus(Drive: string): TDriveStatus;
  1278. begin
  1279. if not FDriveStatus.TryGetValue(Drive, Result) then
  1280. begin
  1281. Result := CreateDriveStatus;
  1282. FDriveStatus.Add(Drive, Result);
  1283. RefreshRootNodes(dsAll or dvdsRereadAllways);
  1284. if Assigned(OnRefreshDrives) then
  1285. OnRefreshDrives(Self);
  1286. end;
  1287. end; {GetDriveStatus}
  1288. function TDriveView.DoScanDir(FromNode: TTreeNode): Boolean;
  1289. begin
  1290. Result := not TNodeData(FromNode.Data).IsRecycleBin;
  1291. end; {DoScanDir}
  1292. function TDriveView.DirAttrMask: Integer;
  1293. begin
  1294. Result := faDirectory or faSysFile;
  1295. if ShowHiddenDirs then
  1296. Result := Result or faHidden;
  1297. end;
  1298. procedure TDriveView.ScanDrive(Drive: string);
  1299. var
  1300. DosError: Integer;
  1301. RootNode: TTreeNode;
  1302. SaveCursor: TCursor;
  1303. procedure ScanPath(const Path: string; ParentNode: TTreeNode);
  1304. var
  1305. SRec: TSearchRec;
  1306. SubNode: TTreeNode;
  1307. begin
  1308. if not DoScanDir(ParentNode) then
  1309. Exit;
  1310. DosError := FindFirst(ApiPath(Path), DirAttrMask, Srec);
  1311. while DosError = 0 do
  1312. begin
  1313. if (SRec.Name <> '.') and
  1314. (SRec.Name <> '..') and
  1315. (SRec.Attr and faDirectory <> 0) then
  1316. begin
  1317. if (SRec.Attr And faDirectory) <> 0 then
  1318. begin { Scan subdirectory }
  1319. SubNode := AddChildNode(ParentNode, SRec);
  1320. TNodeData(SubNode.Data).Scanned := True;
  1321. ScanPath(ExtractFilePath(Path) + SRec.Name + '\*.*', SubNode);
  1322. if not FContinue then
  1323. Break;
  1324. end;
  1325. end;
  1326. DosError := FindNext(SRec);
  1327. end;
  1328. FindClose(Srec);
  1329. if (Items.Count mod 10) = 0 then
  1330. Application.ProcessMessages;
  1331. if not FContinue then
  1332. Exit;
  1333. end; {ScanPath}
  1334. begin {ScanDrive}
  1335. with Self.Items do
  1336. begin
  1337. FContinue := True;
  1338. if not FFullDriveScan then
  1339. begin
  1340. ValidateDirectory(FindNodeToPath(DriveInfo.GetDriveRoot(Drive)));
  1341. GetDriveStatus(Drive).Scanned := True;
  1342. GetDriveStatus(Drive).Verified := False;
  1343. end
  1344. else
  1345. begin
  1346. SaveCursor := Screen.Cursor;
  1347. Screen.Cursor := crHourGlass;
  1348. Items.BeginUpdate;
  1349. try
  1350. RootNode := GetDriveStatus(Drive).RootNode;
  1351. if not Assigned(RootNode) then Exit;
  1352. iF RootNode.HasChildren then
  1353. RootNode.DeleteChildren;
  1354. ScanPath(DriveInfo.GetDriveRoot(Drive) + '*.*', RootNode); { scan subdirectories of rootdir}
  1355. TNodeData(RootNode.Data).Scanned := True;
  1356. GetDriveStatus(Drive).Scanned := True;
  1357. GetDriveStatus(Drive).Verified := True;
  1358. finally
  1359. SortChildren(GetDriveStatus(Drive).RootNode, True);
  1360. EndUpdate;
  1361. end;
  1362. RootNode.Expand(False);
  1363. Screen.Cursor := SaveCursor;
  1364. end;
  1365. end;
  1366. end; {ScanDrive}
  1367. function TDriveView.FindNodeToPath(Path: string): TTreeNode;
  1368. function SearchSubDirs(ParentNode: TTreeNode; Path: string): TTreeNode; forward;
  1369. function DoSearchSubDirs(ParentNode: TTreeNode; Path: string): TTreeNode;
  1370. var
  1371. i: Integer;
  1372. Node: TTreeNode;
  1373. Dir: string;
  1374. begin
  1375. {Extract first directory from path:}
  1376. i := Pos('\', Path);
  1377. if i = 0 then
  1378. i := Length(Path);
  1379. Dir := System.Copy(Path, 1, i);
  1380. System.Delete(Path, 1, i);
  1381. if Dir[Length(Dir)] = '\' then
  1382. SetLength(Dir, Pred(Length(Dir)));
  1383. Node := ParentNode.GetFirstChild;
  1384. if not Assigned(Node) then
  1385. begin
  1386. ValidateDirectoryEx(ParentNode, rsRecursiveExisting, True);
  1387. Node := ParentNode.GetFirstChild;
  1388. end;
  1389. Result := nil;
  1390. while Assigned(Node) do
  1391. begin
  1392. if (UpperCase(GetDirName(Node)) = Dir) or (TNodeData(Node.Data).ShortName = Dir) then
  1393. begin
  1394. if Length(Path) > 0 then
  1395. begin
  1396. Result := SearchSubDirs(Node, Path)
  1397. end
  1398. else
  1399. begin
  1400. Result := Node;
  1401. end;
  1402. Exit;
  1403. end;
  1404. Node := ParentNode.GetNextChild(Node);
  1405. end;
  1406. end;
  1407. function SearchSubDirs(ParentNode: TTreeNode; Path: string): TTreeNode;
  1408. begin
  1409. Result := nil;
  1410. if Length(Path) > 0 then
  1411. begin
  1412. if not TNodeData(ParentNode.Data).Scanned then
  1413. begin
  1414. ReadSubDirs(ParentNode, GetDriveTypetoNode(ParentNode));
  1415. end;
  1416. // Factored out of DoSearchSubDirs is remnant of Bug 956 superceded by Bug 1320
  1417. Result := DoSearchSubDirs(ParentNode, Path);
  1418. end;
  1419. end; {SearchSubDirs}
  1420. var
  1421. Drive: string;
  1422. P: Integer;
  1423. begin {FindNodeToPath}
  1424. Result := nil;
  1425. if Length(Path) < 3 then
  1426. Exit;
  1427. // Particularly when used by TDirView to delegate browsing to
  1428. // hidden drive view, the handle may not be created
  1429. HandleNeeded;
  1430. Drive := DriveInfo.GetDriveKey(Path);
  1431. if Assigned(GetDriveStatus(Drive).RootNode) then
  1432. begin
  1433. if DriveInfo.IsRealDrive(Drive) then
  1434. begin
  1435. System.Delete(Path, 1, 3);
  1436. end
  1437. else
  1438. if IsUncPath(Path) then
  1439. begin
  1440. System.Delete(Path, 1, 2);
  1441. P := Pos('\', Path);
  1442. if P = 0 then
  1443. begin
  1444. Path := '';
  1445. end
  1446. else
  1447. begin
  1448. System.Delete(Path, 1, P);
  1449. P := Pos('\', Path);
  1450. if P = 0 then
  1451. begin
  1452. Path := '';
  1453. end
  1454. else
  1455. begin
  1456. System.Delete(Path, 1, P);
  1457. end;
  1458. end;
  1459. end
  1460. else
  1461. begin
  1462. raise EConvertError.Create(Format(ErrorInvalidDrive, [Path]))
  1463. end;
  1464. if Length(Path) > 0 then
  1465. begin
  1466. if not GetDriveStatus(Drive).Scanned then
  1467. begin
  1468. ScanDrive(Drive);
  1469. end;
  1470. Result := SearchSubDirs(GetDriveStatus(Drive).RootNode, UpperCase(Path));
  1471. end
  1472. else Result := GetDriveStatus(Drive).RootNode;
  1473. end;
  1474. end; {FindNodetoPath}
  1475. function TDriveView.CheckForSubDirs(Path: string): Boolean;
  1476. var
  1477. DosError: Integer;
  1478. SRec: TSearchRec;
  1479. begin
  1480. Result := False;
  1481. DosError := FindFirst(ApiPath(IncludeTrailingBackslash(Path) + '*.'), DirAttrMask, SRec);
  1482. while DosError = 0 do
  1483. begin
  1484. if (SRec.Name <> '.' ) and
  1485. (SRec.Name <> '..') and
  1486. (SRec.Attr and faDirectory <> 0) then
  1487. begin
  1488. Result := True;
  1489. Break;
  1490. end;
  1491. DosError := FindNext(SRec);
  1492. end;
  1493. FindClose(SRec);
  1494. end; {CheckForSubDirs}
  1495. function TDriveView.ReadSubDirs(Node: TTreeNode; DriveType: Integer): Boolean;
  1496. var
  1497. DosError: Integer;
  1498. SRec: TSearchRec;
  1499. NewNode: TTreeNode;
  1500. begin
  1501. Result := False;
  1502. DosError := FindFirst(ApiPath(IncludeTrailingBackslash(NodePath(Node)) + '*.*'), DirAttrMask, SRec);
  1503. while DosError = 0 do
  1504. begin
  1505. if (SRec.Name <> '.' ) and
  1506. (SRec.Name <> '..') and
  1507. (SRec.Attr and faDirectory <> 0) then
  1508. begin
  1509. NewNode := AddChildNode(Node, SRec);
  1510. if DoScanDir(NewNode) then
  1511. begin
  1512. // We have seen the SFGAO_HASSUBFOLDER to be absent on C: drive $Recycle.Bin
  1513. NewNode.HasChildren := Bool(TNodeData(NewNode.Data).shAttr and SFGAO_HASSUBFOLDER);
  1514. TNodeData(NewNode.Data).Scanned := not NewNode.HasChildren;
  1515. end
  1516. else
  1517. begin
  1518. NewNode.HasChildren := False;
  1519. TNodeData(NewNode.Data).Scanned := True;
  1520. end;
  1521. Result := True;
  1522. end;
  1523. DosError := FindNext(SRec);
  1524. end; {While DosError = 0}
  1525. FindClose(Srec);
  1526. TNodeData(Node.Data).Scanned := True;
  1527. if Result then SortChildren(Node, False)
  1528. else Node.HasChildren := False;
  1529. Application.ProcessMessages;
  1530. end; {ReadSubDirs}
  1531. function TDriveView.CallBackValidateDir(var Node: TTreeNode; Data: Pointer): Boolean;
  1532. var
  1533. WorkNode: TTreeNode;
  1534. DelNode: TTreeNode;
  1535. NewNode: TTreeNode;
  1536. SRec: TSearchRec;
  1537. SrecList: TStringList;
  1538. SubDirList: TStringList;
  1539. DosError: Integer;
  1540. Index: Integer;
  1541. NewDirFound: Boolean;
  1542. ParentDir: string;
  1543. NodeData: TNodeData;
  1544. ScanDirInfo: PScanDirInfo;
  1545. begin {CallBackValidateDir}
  1546. Result := True;
  1547. if (not Assigned(Node)) or (not Assigned(Node.Data)) then
  1548. Exit;
  1549. NewDirFound := False;
  1550. ScanDirInfo := PScanDirInfo(Data);
  1551. {Check, if directory still exists: (but not with root directory) }
  1552. if Assigned(Node.Parent) and (ScanDirInfo^.StartNode = Node) then
  1553. if not DirectoryExists(NodePathName(Node)) then
  1554. begin
  1555. WorkNode := Node.Parent;
  1556. if Selected = Node then
  1557. Selected := WorkNode;
  1558. if DropTarget = Node then
  1559. DropTarget := nil;
  1560. Node.Delete;
  1561. Node := nil;
  1562. Exit;
  1563. end;
  1564. WorkNode := Node.GetFirstChild;
  1565. NodeData := TNodeData(Node.Data);
  1566. if NodeData.Scanned and Assigned(WorkNode) then
  1567. {if node was already scanned: check wether the existing subnodes are still alive
  1568. and add all new subdirectories as subnodes:}
  1569. begin
  1570. if DoScanDir(Node) then
  1571. begin
  1572. ParentDir := IncludeTrailingBackslash(NodePath(Node));
  1573. {Build list of existing subnodes:}
  1574. SubDirList := TStringList.Create;
  1575. SubDirList.CaseSensitive := True; // We want to reflect changes in subfolder name case
  1576. while Assigned(WorkNode) do
  1577. begin
  1578. SubDirList.Add(TNodeData(WorkNode.Data).DirName);
  1579. WorkNode := Node.GetNextChild(WorkNode);
  1580. end;
  1581. {Sorting not required, because the subnodes are already sorted!}
  1582. SRecList := TStringList.Create;
  1583. SRecList.CaseSensitive := True;
  1584. DosError := FindFirst(ApiPath(ParentDir + '*.*'), DirAttrMask, SRec);
  1585. while DosError = 0 do
  1586. begin
  1587. if (Srec.Name <> '.' ) and
  1588. (Srec.Name <> '..') and
  1589. (Srec.Attr and faDirectory <> 0) then
  1590. begin
  1591. SrecList.Add(Srec.Name);
  1592. if not SubDirList.Find(Srec.Name, Index) then
  1593. {Subnode does not exists: add it:}
  1594. begin
  1595. NewNode := AddChildNode(Node, SRec);
  1596. NewNode.HasChildren := CheckForSubDirs(ParentDir + Srec.Name);
  1597. TNodeData(NewNode.Data).Scanned := Not NewNode.HasChildren;
  1598. NewDirFound := True;
  1599. end;
  1600. end;
  1601. DosError := FindNext(Srec);
  1602. end;
  1603. FindClose(Srec);
  1604. Sreclist.Sort;
  1605. {Remove not existing subnodes:}
  1606. WorkNode := Node.GetFirstChild;
  1607. while Assigned(WorkNode) do
  1608. begin
  1609. if not Assigned(WorkNode.Data) or
  1610. not SrecList.Find(TNodeData(WorkNode.Data).DirName, Index) then
  1611. begin
  1612. DelNode := WorkNode;
  1613. WorkNode := Node.GetNextChild(WorkNode);
  1614. DelNode.Delete;
  1615. end
  1616. else
  1617. begin
  1618. if (SrecList[Index] <> TNodeData(WorkNode.Data).DirName) then
  1619. begin
  1620. {Case of directory letters has changed:}
  1621. TNodeData(WorkNode.Data).DirName := SrecList[Index];
  1622. TNodeData(WorkNode.Data).ShortName := ExtractShortPathName(NodePathName(WorkNode));
  1623. WorkNode.Text := SrecList[Index];
  1624. end;
  1625. SrecList.Delete(Index);
  1626. WorkNode := Node.GetNextChild(WorkNode);
  1627. end;
  1628. end;
  1629. SrecList.Free;
  1630. SubDirList.Free;
  1631. {Sort subnodes:}
  1632. if NewDirFound then
  1633. SortChildren(Node, False);
  1634. end;
  1635. end
  1636. else
  1637. {Node was not already scanned:}
  1638. if (ScanDirInfo^.SearchNewDirs or
  1639. NodeData.Scanned or
  1640. (Node = ScanDirInfo^.StartNode)) and
  1641. DoScanDir(Node) then
  1642. begin
  1643. ReadSubDirs(Node, ScanDirInfo^.DriveType);
  1644. end;
  1645. end; {CallBackValidateDir}
  1646. procedure TDriveView.RebuildTree;
  1647. var
  1648. Drive: string;
  1649. begin
  1650. for Drive in FDriveStatus.Keys do
  1651. with GetDriveStatus(Drive) do
  1652. if Assigned(RootNode) and Scanned then
  1653. ValidateDirectory(RootNode);
  1654. end;
  1655. procedure TDriveView.ValidateCurrentDirectoryIfNotMonitoring;
  1656. begin
  1657. if Assigned(Selected) and
  1658. not Assigned(GetDriveStatus(GetDriveToNode(Selected)).DiscMonitor) then
  1659. begin
  1660. ValidateDirectory(Selected);
  1661. end;
  1662. end;
  1663. procedure TDriveView.ValidateDirectoryEx(Node: TTreeNode; Recurse: TRecursiveScan;
  1664. NewDirs: Boolean);
  1665. var
  1666. Info: PScanDirInfo;
  1667. SelDir: string;
  1668. SaveCursor: TCursor;
  1669. RestartWatchThread: Boolean;
  1670. SaveCanChange: Boolean;
  1671. CurrentPath: string;
  1672. Drive: string;
  1673. begin
  1674. if Assigned(Node) and Assigned(Node.Data) and
  1675. (not FValidateFlag) and DoScanDir(Node) then
  1676. begin
  1677. SelDir := Directory;
  1678. SaveCursor := Screen.Cursor;
  1679. if Self.Focused and (Screen.Cursor <> crHourGlass) then
  1680. Screen.Cursor := crHourGlass;
  1681. CurrentPath := NodePath(Node);
  1682. Drive := DriveInfo.GetDriveKey(CurrentPath);
  1683. if Node.Level = 0 then
  1684. GetDriveStatus(Drive).ChangeTimer.Enabled := False;
  1685. RestartWatchThread := WatchThreadActive;
  1686. try
  1687. if WatchThreadActive then
  1688. StopWatchThread;
  1689. FValidateFlag := True;
  1690. New(Info);
  1691. Info^.StartNode := Node;
  1692. Info^.SearchNewDirs := NewDirs;
  1693. Info^.DriveType := DriveInfo.Get(Drive).DriveType;
  1694. SaveCanChange := FCanChange;
  1695. FCanChange := True;
  1696. FChangeFlag := False;
  1697. IterateSubTree(Node, CallBackValidateDir, Recurse, coScanStartNode, Info);
  1698. FValidateFlag := False;
  1699. if (not Assigned(Selected)) and (Length(SelDir) > 0) then
  1700. Directory := ExtractFileDrive(SelDir);
  1701. if (SelDir <> Directory) and (not FChangeFlag) then
  1702. Change(Selected);
  1703. FCanChange := SaveCanChange;
  1704. Dispose(Info);
  1705. finally
  1706. if RestartWatchThread and FWatchDirectory and not WatchThreadActive then
  1707. StartWatchThread;
  1708. if Screen.Cursor <> SaveCursor then
  1709. Screen.Cursor := SaveCursor;
  1710. end;
  1711. end;
  1712. end; {ValidateDirectoryEx}
  1713. function TDriveView.GetDriveTypeToNode(Node: TTreeNode): Integer;
  1714. begin
  1715. Assert(Assigned(Node));
  1716. Result := DriveInfo.Get(GetDriveToNode(Node)).DriveType;
  1717. end; {GetDriveTypeToNode}
  1718. procedure TDriveView.CreateWatchThread(Drive: string);
  1719. begin
  1720. if csDesigning in ComponentState then
  1721. Exit;
  1722. if (not Assigned(GetDriveStatus(Drive).DiscMonitor)) and
  1723. FWatchDirectory and
  1724. (DriveInfo.Get(Drive).DriveType <> DRIVE_REMOTE) then
  1725. begin
  1726. with GetDriveStatus(Drive) do
  1727. begin
  1728. DiscMonitor := TDiscMonitor.Create(Self);
  1729. DiscMonitor.ChangeDelay := msThreadChangeDelay;
  1730. DiscMonitor.SubTree := True;
  1731. DiscMonitor.Filters := [moDirName];
  1732. DiscMonitor.OnChange := ChangeDetected;
  1733. DiscMonitor.OnInvalid := ChangeInvalid;
  1734. DiscMonitor.SetDirectory(DriveInfo.GetDriveRoot(Drive));
  1735. DiscMonitor.Open;
  1736. end;
  1737. end;
  1738. end; {CreateWatchThread}
  1739. procedure TDriveView.SetWatchDirectory(Value: Boolean);
  1740. begin
  1741. if FWatchDirectory <> Value then
  1742. begin
  1743. FWatchDirectory := Value;
  1744. if (not (csDesigning in ComponentState)) and Value then
  1745. StartAllWatchThreads
  1746. else
  1747. StopAllWatchThreads;
  1748. end;
  1749. end; {SetAutoScan}
  1750. procedure TDriveView.SetDirView(Value: TDirView);
  1751. begin
  1752. if Assigned(FDirView) then
  1753. FDirView.DriveView := nil;
  1754. FDirView := Value;
  1755. if Assigned(FDirView) then
  1756. FDirView.DriveView := Self;
  1757. end; {SetDirView}
  1758. function TDriveView.NodeWatched(Node: TTreeNode): Boolean;
  1759. var
  1760. Drive: string;
  1761. begin
  1762. Drive := GetDriveToNode(Node);
  1763. Result := WatchThreadActive(Drive);
  1764. end; {NodeWatched}
  1765. procedure TDriveView.ChangeInvalid(Sender: TObject; const Directory: string;
  1766. const ErrorStr: string);
  1767. var
  1768. Dir: string;
  1769. begin
  1770. Dir := (Sender as TDiscMonitor).Directories[0];
  1771. with GetDriveStatus(DriveInfo.GetDriveKey(Dir)) do
  1772. begin
  1773. DiscMonitor.Close;
  1774. end;
  1775. end; {DirWatchChangeInvalid}
  1776. procedure TDriveView.ChangeDetected(Sender: TObject; const Directory: string;
  1777. var SubdirsChanged: Boolean);
  1778. var
  1779. DirChanged: string;
  1780. begin
  1781. if Sender is TDiscMonitor then
  1782. begin
  1783. DirChanged := (Sender as TDiscMonitor).Directories[0];
  1784. if Length(DirChanged) > 0 then
  1785. begin
  1786. with GetDriveStatus(DriveInfo.GetDriveKey(DirChanged)) do
  1787. begin
  1788. ChangeTimer.Interval := 0;
  1789. ChangeTimer.Interval := FChangeInterval;
  1790. ChangeTimer.Enabled := True;
  1791. end;
  1792. end;
  1793. end;
  1794. end; {DirWatchChangeDetected}
  1795. procedure TDriveView.ChangeTimerOnTimer(Sender: TObject);
  1796. var
  1797. DriveStatus: TDriveStatus;
  1798. begin
  1799. if (FChangeTimerSuspended = 0) and (Sender is TTimer) then
  1800. begin
  1801. for DriveStatus in FDriveStatus.Values do
  1802. begin
  1803. if DriveStatus.ChangeTimer = Sender then
  1804. begin
  1805. with DriveStatus.ChangeTimer do
  1806. begin
  1807. Interval := 0;
  1808. Enabled := False;
  1809. end;
  1810. if Assigned(DriveStatus.RootNode) then
  1811. begin
  1812. {Check also collapsed (invisible) subdirectories:}
  1813. ValidateDirectory(DriveStatus.RootNode);
  1814. end;
  1815. end;
  1816. end;
  1817. end;
  1818. end; {ChangeTimerOnTimer}
  1819. procedure TDriveView.StartWatchThread;
  1820. var
  1821. Drive: string;
  1822. begin
  1823. if (csDesigning in ComponentState) or
  1824. not Assigned(Selected) or
  1825. not fWatchDirectory then Exit;
  1826. Drive := GetDriveToNode(Selected);
  1827. with GetDriveStatus(Drive) do
  1828. begin
  1829. if not Assigned(DiscMonitor) then
  1830. CreateWatchThread(Drive);
  1831. if Assigned(DiscMonitor) and not DiscMonitor.Enabled then
  1832. DiscMonitor.Enabled := True;
  1833. end;
  1834. end; {StartWatchThread}
  1835. procedure TDriveView.StopWatchThread;
  1836. begin
  1837. if Assigned(Selected) then
  1838. with GetDriveStatus(GetDriveToNode(Selected)) do
  1839. if Assigned(DiscMonitor) then
  1840. DiscMonitor.Enabled := False;
  1841. end; {StopWatchThread}
  1842. procedure TDriveView.SuspendChangeTimer;
  1843. begin
  1844. Inc(FChangeTimerSuspended);
  1845. end;
  1846. procedure TDriveView.ResumeChangeTimer;
  1847. begin
  1848. Assert(FChangeTimerSuspended > 0);
  1849. Dec(FChangeTimerSuspended);
  1850. end;
  1851. procedure TDriveView.TerminateWatchThread(Drive: string);
  1852. begin
  1853. with GetDriveStatus(Drive) do
  1854. if Assigned(DiscMonitor) then
  1855. begin
  1856. DiscMonitor.Free;
  1857. DiscMonitor := nil;
  1858. end;
  1859. end; {StopWatchThread}
  1860. procedure TDriveView.StartAllWatchThreads;
  1861. var
  1862. DriveStatusPair: TPair<string, TDriveStatus>;
  1863. Drive: string;
  1864. begin
  1865. if (csDesigning in ComponentState) or (not FWatchDirectory) then
  1866. Exit;
  1867. for DriveStatusPair in FDriveStatus do
  1868. with DriveStatusPair.Value do
  1869. if Scanned then
  1870. begin
  1871. if not Assigned(DiscMonitor) then
  1872. CreateWatchThread(DriveStatusPair.Key);
  1873. if Assigned(DiscMonitor) and (not DiscMonitor.Active) then
  1874. DiscMonitor.Open;
  1875. end;
  1876. if Assigned(Selected) then
  1877. begin
  1878. Drive := GetDriveToNode(Selected);
  1879. if not DriveInfo.IsFixedDrive(Drive) then
  1880. begin
  1881. StartWatchThread;
  1882. end;
  1883. end;
  1884. end; {StartAllWatchThreads}
  1885. procedure TDriveView.StopAllWatchThreads;
  1886. var
  1887. DriveStatusPair: TPair<string, TDriveStatus>;
  1888. begin
  1889. if (csDesigning in ComponentState) or (not FWatchDirectory) then
  1890. Exit;
  1891. for DriveStatusPair in FDriveStatus do
  1892. with DriveStatusPair.Value do
  1893. begin
  1894. if Assigned(DiscMonitor) then
  1895. DiscMonitor.Close;
  1896. end;
  1897. end; {StopAllWatchThreads}
  1898. function TDriveView.WatchThreadActive(Drive: string): Boolean;
  1899. begin
  1900. Result := FWatchDirectory and
  1901. Assigned(GetDriveStatus(Drive).DiscMonitor) and
  1902. GetDriveStatus(Drive).DiscMonitor.Active and
  1903. GetDriveStatus(Drive).DiscMonitor.Enabled;
  1904. end; {WatchThreadActive}
  1905. function TDriveView.WatchThreadActive: Boolean;
  1906. var
  1907. Drive: string;
  1908. begin
  1909. if not Assigned(Selected) then
  1910. begin
  1911. Result := False;
  1912. Exit;
  1913. end;
  1914. Drive := GetDriveToNode(Selected);
  1915. Result := WatchThreadActive(Drive);
  1916. end; {WatchThreadActive}
  1917. procedure TDriveView.SetFullDriveScan(DoFullDriveScan: Boolean);
  1918. begin
  1919. FFullDriveScan := DoFullDriveScan;
  1920. end; {SetAutoScan}
  1921. function TDriveView.FindPathNode(Path: string): TTreeNode;
  1922. begin
  1923. {Find existing path or parent path of not existing path:}
  1924. repeat
  1925. Result := FindNodeToPath(Path);
  1926. if not Assigned(Result) then
  1927. Path := ExtractFilePath(ExcludeTrailingBackslash(Path));
  1928. until Assigned(Result) or (Length(Path) < 3);
  1929. end;
  1930. procedure TDriveView.SetDirectory(Value: string);
  1931. begin
  1932. Value := IncludeTrailingBackslash(Value);
  1933. FDirectory := Value;
  1934. inherited;
  1935. if Assigned(Selected) and (Selected.Level = 0) then
  1936. begin
  1937. if not GetDriveStatus(GetDriveToNode(Selected)).Scanned then
  1938. ScanDrive(GetDriveToNode(Selected));
  1939. end;
  1940. end; {SetDirectory}
  1941. function TDriveView.GetDirName(Node: TTreeNode): string;
  1942. begin
  1943. if Assigned(Node) and Assigned(Node.Data) then
  1944. Result := TNodeData(Node.Data).DirName
  1945. else
  1946. Result := '';
  1947. end; {GetDirName}
  1948. {GetDrive: returns the drive of the Node.}
  1949. function TDriveView.GetDriveToNode(Node: TTreeNode): string;
  1950. var
  1951. Path: string;
  1952. begin
  1953. if (not Assigned (Node)) or (not Assigned(Node.Data)) then
  1954. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDrive']));
  1955. Path := NodePath(Node);
  1956. Result := DriveInfo.GetDriveKey(Path);
  1957. end; {GetDrive}
  1958. {RootNode: returns the rootnode to the Node:}
  1959. function TDriveView.RootNode(Node: TTreeNode): TTreeNode;
  1960. begin
  1961. Result := Node;
  1962. if not Assigned(Node) then
  1963. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['RootNode']));
  1964. while Assigned(Result.Parent) do
  1965. Result := Result.Parent;
  1966. end; {RootNode}
  1967. function TDriveView.GetDisplayName(Node: TTreeNode): string;
  1968. begin
  1969. Result := '';
  1970. if (not Assigned(Node)) or (not Assigned(Node.Data)) then
  1971. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDisplayName']));
  1972. if Node.Level = 0 then Result := GetDriveText(GetDriveToNode(Node))
  1973. else
  1974. begin
  1975. Result := GetDirName(Node);
  1976. end;
  1977. end; {GetDisplayName}
  1978. procedure TDriveView.SetShowVolLabel(ShowIt: Boolean);
  1979. begin
  1980. if ShowIt = FShowVolLabel then
  1981. Exit;
  1982. FShowVolLabel := ShowIt;
  1983. RefreshRootNodes(dvdsFloppy);
  1984. end; {SetShowVolLabel}
  1985. procedure TDriveView.DisplayContextMenu(Node: TTreeNode; Point: TPoint);
  1986. var
  1987. Verb: string;
  1988. DirWatched: Boolean;
  1989. begin
  1990. DirWatched := NodeWatched(Node) and WatchThreadActive;
  1991. Assert(Node <> nil);
  1992. if Node <> Selected then
  1993. DropTarget := Node;
  1994. Verb := EmptyStr;
  1995. if Assigned(FOnDisplayContextMenu) then
  1996. FOnDisplayContextMenu(Self);
  1997. ShellDisplayContextMenu(FParentForm.Handle, Point, NodePathName(Node),
  1998. CanEdit(Node), Verb, False);
  1999. if Verb = shcRename then Node.EditText
  2000. else
  2001. if Verb = shcCut then
  2002. begin
  2003. LastClipBoardOperation := cboCut;
  2004. LastPathCut := NodePathName(Node);
  2005. end
  2006. else
  2007. if Verb = shcCopy then LastClipBoardOperation := cboCopy
  2008. else
  2009. if Verb = shcPaste then
  2010. PasteFromClipBoard(NodePathName(Node));
  2011. DropTarget := nil;
  2012. if not DirWatched then
  2013. ValidateDirectory(Node);
  2014. end; {DisplayContextMenu (2)}
  2015. procedure TDriveView.DisplayPropertiesMenu(Node: TTreeNode);
  2016. begin
  2017. Assert(Assigned(Node));
  2018. ShellExecuteContextCommand(FParentForm.Handle, shcProperties, NodePathName(Node));
  2019. end; {ContextMenu}
  2020. procedure TDriveView.SetSelected(Node: TTreeNode);
  2021. begin
  2022. if Node <> Selected then
  2023. begin
  2024. FChangeFlag := False;
  2025. FCanChange := True;
  2026. inherited Selected := Node;
  2027. if not FChangeFlag then
  2028. Change(Selected);
  2029. end;
  2030. end; {SetSelected}
  2031. {Called by TFileDeleteThread, when a file deletion was detected by the D&D receiving application:}
  2032. procedure TDriveView.SignalDirDelete(Sender: TObject; Files: TStringList);
  2033. begin
  2034. if Files.Count > 0 then
  2035. ValidateDirectory(FindNodeToPath(Files[0]));
  2036. end; {SignalDirDelete}
  2037. function TDriveView.DDSourceEffects: TDropEffectSet;
  2038. begin
  2039. if FDragNode.Level = 0 then
  2040. Result := [deLink]
  2041. else
  2042. Result := [deLink, deCopy, deMove];
  2043. end;
  2044. procedure TDriveView.DDChooseEffect(KeyState: Integer; var Effect: Integer; PreferredEffect: Integer);
  2045. begin
  2046. if DropTarget = nil then Effect := DROPEFFECT_NONE
  2047. else
  2048. if (KeyState and (MK_CONTROL or MK_SHIFT) = 0) and (PreferredEffect = 0) then
  2049. begin
  2050. if FDragDrive <> '' then
  2051. begin
  2052. if FExeDrag and DriveInfo.IsFixedDrive(GetDriveToNode(DropTarget)) and DriveInfo.IsFixedDrive(FDragDrive) then
  2053. begin
  2054. Effect := DROPEFFECT_LINK;
  2055. end
  2056. else
  2057. if (Effect = DROPEFFECT_COPY) and
  2058. (SameText(FDragDrive, GetDriveToNode(DropTarget)) and
  2059. (FDragDropFilesEx.AvailableDropEffects and DROPEFFECT_MOVE <> 0)) then
  2060. begin
  2061. Effect := DROPEFFECT_MOVE;
  2062. end;
  2063. end;
  2064. end;
  2065. inherited;
  2066. end;
  2067. function TDriveView.DragCompleteFileList: Boolean;
  2068. begin
  2069. Result := (GetDriveTypeToNode(FDragNode) <> DRIVE_REMOVABLE);
  2070. end;
  2071. function TDriveView.DDExecute: TDragResult;
  2072. var
  2073. WatchThreadOK: Boolean;
  2074. DragParentPath: string;
  2075. DragPath: string;
  2076. begin
  2077. WatchThreadOK := WatchThreadActive;
  2078. Result := FDragDropFilesEx.Execute(nil);
  2079. if (Result = drMove) and (not WatchThreadOK) then
  2080. begin
  2081. DragPath := NodePathName(FDragNode);
  2082. if Assigned(FDragNode.Parent) then
  2083. DragParentPath := NodePathName(FDragNode.Parent)
  2084. else
  2085. DragParentPath := DragPath;
  2086. if (FDragNode.Level > 0) or (DragParentPath <> NodePathName(Selected.Parent)) then
  2087. begin
  2088. FDragNode := FindNodeToPath(DragPath);
  2089. if Assigned(FDragNode) then
  2090. begin
  2091. FDragFileList.Clear;
  2092. FDragFileList.Add(DragPath);
  2093. TFileDeleteThread.Create(FDragFileList, MaxWaitTimeOut, SignalDirDelete);
  2094. end;
  2095. end;
  2096. end;
  2097. end;
  2098. procedure TDriveView.PerformDragDropFileOperation(Node: TTreeNode; Effect: Integer);
  2099. var
  2100. Index: Integer;
  2101. SourcePath: string;
  2102. SourceParentPath: string;
  2103. SourceIsDirectory: Boolean;
  2104. SaveCursor: TCursor;
  2105. TargetNode: TTreeNode;
  2106. TargetPath: string;
  2107. IsRecycleBin: Boolean;
  2108. begin
  2109. TargetPath := NodePathName(Node);
  2110. IsRecycleBin := NodeIsRecycleBin(Node);
  2111. if FDragDropFilesEx.FileList.Count = 0 then
  2112. Exit;
  2113. SaveCursor := Screen.Cursor;
  2114. Screen.Cursor := crHourGlass;
  2115. SourcePath := EmptyStr;
  2116. try
  2117. if (Effect = DROPEFFECT_COPY) or (Effect = DROPEFFECT_MOVE) then
  2118. begin
  2119. StopAllWatchThreads;
  2120. if Assigned(FDirView) then
  2121. FDirView.StopWatchThread;
  2122. if Assigned(DropSourceControl) and
  2123. (DropSourceControl is TDirView) and
  2124. (DropSourceControl <> FDirView) then
  2125. begin
  2126. TDirView(DropSourceControl).StopWatchThread;
  2127. end;
  2128. if DropFiles(
  2129. DragDropFilesEx, Effect, FFileOperator, TargetPath, false, IsRecycleBin, ConfirmDelete, ConfirmOverwrite, False,
  2130. Self, OnDDFileOperation, SourcePath, SourceIsDirectory) then
  2131. begin
  2132. if Assigned(FOnDDFileOperationExecuted) then
  2133. FOnDDFileOperationExecuted(Self, Effect, SourcePath, TargetPath);
  2134. end;
  2135. ClearDragFileList(FDragDropFilesEx.FileList);
  2136. SourceParentPath := ExtractFilePath(ExcludeTrailingBackslash(SourcePath));
  2137. end
  2138. else
  2139. if Effect = DROPEFFECT_LINK then
  2140. { Create Link requested: }
  2141. begin
  2142. for Index := 0 to FDragDropFilesEx.FileList.Count - 1 do
  2143. begin
  2144. if not DropLink(PFDDListItem(FDragDropFilesEx.FileList[Index]), TargetPath) then
  2145. begin
  2146. DDError(DDCreateShortCutError);
  2147. end;
  2148. end;
  2149. end;
  2150. if Effect = DROPEFFECT_MOVE then
  2151. Items.BeginUpdate;
  2152. {Update source directory, if move-operation was performed:}
  2153. if ((Effect = DROPEFFECT_MOVE) or IsRecycleBin) then
  2154. begin
  2155. ValidateDirectory(FindNodeToPath(SourceParentPath));
  2156. end;
  2157. {Update subdirectories of target directory:}
  2158. TargetNode := FindNodeToPath(TargetPath);
  2159. if Assigned(TargetNode) then
  2160. ValidateDirectory(TargetNode)
  2161. else
  2162. ValidateDirectory(GetDriveStatus(DriveInfo.GetDriveKey(TargetPath)).RootNode);
  2163. if Effect = DROPEFFECT_MOVE then
  2164. Items.EndUpdate;
  2165. {Update linked component TDirView:}
  2166. if Assigned(FDirView) and (not FDirView.WatchThreadActive) then
  2167. begin
  2168. case Effect of
  2169. DROPEFFECT_COPY,
  2170. DROPEFFECT_LINK:
  2171. if (IncludeTrailingBackslash(TargetPath) = IncludeTrailingBackslash(DirView.Path)) then
  2172. FDirView.Reload2;
  2173. DROPEFFECT_MOVE:
  2174. if (IncludeTrailingBackslash(TargetPath) = IncludeTrailingBackslash(DirView.Path)) or
  2175. (IncludeTrailingBackslash(SourceParentPath) = IncludeTrailingBackslash(DirView.Path)) then
  2176. begin
  2177. if FDirView <> DropSourceControl then FDirView.Reload2;
  2178. end;
  2179. end; {Case}
  2180. end;
  2181. {Update the DropSource control, if files are moved and it is a TDirView:}
  2182. if (Effect = DROPEFFECT_MOVE) and (DropSourceControl is TDirView) then
  2183. begin
  2184. TDirView(DropSourceControl).ValidateSelectedFiles;
  2185. end;
  2186. finally
  2187. FFileOperator.OperandFrom.Clear;
  2188. FFileOperator.OperandTo.Clear;
  2189. StartAllWatchThreads;
  2190. if Assigned(FDirView) and (not FDirView.WatchThreadActive) then
  2191. FDirView.StartWatchThread;
  2192. if Assigned(DropSourceControl) and (DropSourceControl is TDirView) and
  2193. (not TDirView(DropSourceControl).WatchThreadActive) then
  2194. TDirView(DropSourceControl).StartWatchThread;
  2195. Screen.Cursor := SaveCursor;
  2196. end;
  2197. end; {PerformDragDropFileOperation}
  2198. function TDriveView.GetCanUndoCopyMove: Boolean;
  2199. begin
  2200. Result := Assigned(FFileOperator) and FFileOperator.CanUndo;
  2201. end; {CanUndoCopyMove}
  2202. function TDriveView.UndoCopyMove: Boolean;
  2203. var
  2204. LastTarget: string;
  2205. LastSource: string;
  2206. begin
  2207. Result := False;
  2208. if FFileOperator.CanUndo then
  2209. begin
  2210. Lasttarget := FFileOperator.LastOperandTo[0];
  2211. LastSource := FFileOperator.LastOperandFrom[0];
  2212. StopAllWatchThreads;
  2213. Result := FFileOperator.UndoExecute;
  2214. ValidateDirectory(FindNodeToPath(ExtractFilePath(LastTarget)));
  2215. ValidateDirectory(FindNodeToPath(ExtractFilePath(LastSource)));
  2216. StartAllWatchThreads;
  2217. if Assigned(FDirView) then
  2218. with FDirView do
  2219. if not WatchThreadActive then
  2220. begin
  2221. if (IncludeTrailingBackslash(ExtractFilePath(LastTarget)) = IncludeTrailingBackslash(Path)) or
  2222. (IncludeTrailingBackslash(ExtractFilePath(LastSource)) = IncludeTrailingBackslash(Path)) then
  2223. Reload2;
  2224. end;
  2225. end;
  2226. end; {UndoCopyMove}
  2227. {Clipboard operations:}
  2228. procedure TDriveView.SetLastPathCut(Path: string);
  2229. var
  2230. Node: TTreeNode;
  2231. begin
  2232. if FLastPathCut <> Path then
  2233. begin
  2234. Node := FindNodeToPath(FLastPathCut);
  2235. if Assigned(Node) then
  2236. begin
  2237. FLastPathCut := Path;
  2238. Node.Cut := False;
  2239. end;
  2240. Node := FindNodeToPath(Path);
  2241. if Assigned(Node) then
  2242. begin
  2243. FLastPathCut := Path;
  2244. Node.Cut := True;
  2245. end;
  2246. end;
  2247. end; {SetLastNodeCut}
  2248. procedure TDriveView.EmptyClipboard;
  2249. begin
  2250. if Windows.OpenClipBoard(0) then
  2251. begin
  2252. Windows.EmptyClipBoard;
  2253. Windows.CloseClipBoard;
  2254. LastPathCut := '';
  2255. LastClipBoardOperation := cboNone;
  2256. if Assigned(FDirView) then
  2257. FDirView.EmptyClipboard;
  2258. end;
  2259. end; {EmptyClipBoard}
  2260. function TDriveView.CopyToClipBoard(Node: TTreeNode): Boolean;
  2261. begin
  2262. Result := Assigned(Selected);
  2263. if Result then
  2264. begin
  2265. EmptyClipBoard;
  2266. ClearDragFileList(FDragDropFilesEx.FileList);
  2267. AddToDragFileList(FDragDropFilesEx.FileList, Selected);
  2268. Result := FDragDropFilesEx.CopyToClipBoard;
  2269. LastClipBoardOperation := cboCopy;
  2270. end;
  2271. end; {CopyToClipBoard}
  2272. function TDriveView.CutToClipBoard(Node: TTreeNode): Boolean;
  2273. begin
  2274. Result := Assigned(Node) and (Node.Level > 0) and CopyToClipBoard(Node);
  2275. if Result then
  2276. begin
  2277. LastPathCut := NodePathName(Node);
  2278. LastClipBoardOperation := cboCut;
  2279. end;
  2280. end; {CutToClipBoard}
  2281. function TDriveView.CanPasteFromClipBoard: Boolean;
  2282. begin
  2283. Result := False;
  2284. if Assigned(Selected) and Windows.OpenClipboard(0) then
  2285. begin
  2286. Result := IsClipboardFormatAvailable(CF_HDROP);
  2287. Windows.CloseClipBoard;
  2288. end;
  2289. end; {CanPasteFromClipBoard}
  2290. function TDriveView.PasteFromClipBoard(TargetPath: String = ''): Boolean;
  2291. begin
  2292. ClearDragFileList(FDragDropFilesEx.FileList);
  2293. Result := False;
  2294. if CanPasteFromClipBoard and {MP}FDragDropFilesEx.GetFromClipBoard{/MP}
  2295. then
  2296. begin
  2297. if TargetPath = '' then
  2298. TargetPath := NodePathName(Selected);
  2299. case LastClipBoardOperation of
  2300. cboCopy,
  2301. cboNone:
  2302. begin
  2303. PerformDragDropFileOperation(Selected, DROPEFFECT_COPY);
  2304. if Assigned(FOnDDExecuted) then
  2305. FOnDDExecuted(Self, DROPEFFECT_COPY);
  2306. end;
  2307. cboCut:
  2308. begin
  2309. PerformDragDropFileOperation(Selected, DROPEFFECT_MOVE);
  2310. if Assigned(FOnDDExecuted) then
  2311. FOnDDExecuted(Self, DROPEFFECT_MOVE);
  2312. EmptyClipBoard;
  2313. end;
  2314. end;
  2315. Result := True;
  2316. end;
  2317. end; {PasteFromClipBoard}
  2318. end.