DriveView.pas 75 KB

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