DriveView.pas 75 KB

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