DriveView.pas 76 KB

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