DriveView.pas 78 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758
  1. unit DriveView;
  2. {==================================================================
  3. Component TDriveView / Version 2.6, January 2000
  4. ==================================================================
  5. Description:
  6. ============
  7. Displays the the directory structure of all drives as treeview
  8. with shell icons. Complete drag&Drop support for files and
  9. directories.
  10. Author:
  11. =======
  12. (c) Ingo Eckel 1998, 1999
  13. Sodener Weg 38
  14. 65812 Bad Soden
  15. Germany
  16. Modifications (for WinSCP):
  17. ===========================
  18. (c) Martin Prikryl 2004
  19. V2.6:
  20. - Shows "shared"-symbol with directories
  21. - Delphi5 compatible
  22. For detailed documentation and history see TDriveView.htm.
  23. {==================================================================}
  24. interface
  25. { Define ENHVALIDATE to scan all existing directories on a detected filesystem change:}
  26. {.$DEFINE ENHVALIDATE}
  27. {Required compiler options for TDriveView:}
  28. {$A+,B-,X+,H+,P+}
  29. {$WARN SYMBOL_PLATFORM OFF}
  30. uses
  31. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ComObj,
  32. Dialogs, ComCtrls, ShellApi, CommCtrl, ExtCtrls, ActiveX, ShlObj,
  33. DirView, ShellDialogs, DragDrop, DragDropFilesEx, FileChanges, FileOperator,
  34. DiscMon, IEDriveInfo, IEListView, PIDL, BaseUtils, ListExt, CustomDirView,
  35. CustomDriveView, System.Generics.Collections;
  36. {$I ResStrings.pas}
  37. const
  38. msThreadChangeDelay = 50;
  39. ErrorNodeNA = '%s: Node not assigned';
  40. {Flags used by TDriveView.RefreshRootNodes:}
  41. dvdsFloppy = 8; {Include floppy drives}
  42. dvdsRereadAllways = 16; {Refresh drivestatus in any case}
  43. type
  44. EInvalidDirName = class(Exception);
  45. ENodeNotAssigned = class(Exception);
  46. TDriveStatus = class
  47. Scanned: Boolean; {Drive allready scanned?}
  48. Verified: Boolean; {Drive completly scanned?}
  49. RootNode: TTreeNode; {Rootnode to drive}
  50. RootNodeIndex: Integer;
  51. DiscMonitor: TDiscMonitor; {Monitor thread}
  52. ChangeTimer: TTimer; {Change timer for the monitor thread}
  53. DefaultDir: string; {Current directory}
  54. end;
  55. TScanDirInfo = record
  56. SearchNewDirs: Boolean;
  57. StartNode: TTreeNode;
  58. DriveType: Integer;
  59. end;
  60. PScanDirInfo = ^TScanDirInfo;
  61. TDriveView = class;
  62. TNodeData = class
  63. private
  64. FDirName: string;
  65. FShortName: string;
  66. FAttr: Integer;
  67. FScanned: Boolean;
  68. FData: Pointer;
  69. FIsRecycleBin: Boolean;
  70. FIconEmpty: Boolean;
  71. public
  72. shAttr: ULONG;
  73. PIDL: PItemIDList;
  74. ShellFolder: IShellFolder;
  75. constructor Create;
  76. destructor Destroy; override;
  77. property DirName: string read FDirName write FDirName;
  78. property ShortName: string read FShortName write FShortName;
  79. property Attr: Integer read FAttr write FAttr;
  80. property Scanned: Boolean read FScanned write FScanned;
  81. property Data: Pointer read FData write FData;
  82. property IsRecycleBin: Boolean read FIsRecycleBin;
  83. property IconEmpty: Boolean read FIconEmpty write FIconEmpty;
  84. end;
  85. TDriveTreeNode = class(TTreeNode)
  86. procedure Assign(Source: TPersistent); override;
  87. end;
  88. TDriveView = class(TCustomDriveView)
  89. private
  90. FDriveStatus: TObjectDictionary<string, TDriveStatus>;
  91. FConfirmDelete: Boolean;
  92. FConfirmOverwrite: Boolean;
  93. FWatchDirectory: Boolean;
  94. FDirectory: string;
  95. FFullDriveScan: Boolean;
  96. FShowVolLabel: Boolean;
  97. FVolDisplayStyle: TVolumeDisplayStyle;
  98. FChangeFlag: Boolean;
  99. FLastDir: string;
  100. FValidateFlag: Boolean;
  101. FCreating: Boolean;
  102. FForceRename: Boolean;
  103. FRenameNode: TTreeNode;
  104. FLastRenameName: string;
  105. FInternalWindowHandle: HWND;
  106. FPrevSelected: TTreeNode;
  107. FPrevSelectedIndex: Integer;
  108. FChangeTimerSuspended: Integer;
  109. FDesktop: IShellFolder;
  110. {Additional events:}
  111. FOnDisplayContextMenu: TNotifyEvent;
  112. FOnRefreshDrives: TNotifyEvent;
  113. {used components:}
  114. FDirView: TDirView;
  115. FFileOperator: TFileOperator;
  116. FChangeInterval: Cardinal;
  117. {Drag&drop:}
  118. FLastPathCut: string;
  119. {Drag&drop helper functions:}
  120. procedure SignalDirDelete(Sender: TObject; Files: TStringList);
  121. function CheckForSubDirs(Path: string): Boolean;
  122. function ReadSubDirs(Node: TTreeNode; DriveType: Integer): Boolean;
  123. {Callback-functions used by iteratesubtree:}
  124. function CallBackValidateDir(var Node: TTreeNode; Data: Pointer): Boolean;
  125. { Notification procedures used by component TDiscMonitor: }
  126. procedure ChangeDetected(Sender: TObject; const Directory: string;
  127. var SubdirsChanged: Boolean);
  128. procedure ChangeInvalid(Sender: TObject; const Directory: string; const ErrorStr: string);
  129. {Notification procedure used by component TTimer:}
  130. procedure ChangeTimerOnTimer(Sender: TObject);
  131. protected
  132. procedure SetSelected(Node: TTreeNode);
  133. procedure SetFullDriveScan(DoFullDriveScan: Boolean);
  134. procedure SetWatchDirectory(Value: Boolean);
  135. procedure SetShowVolLabel(ShowIt: Boolean);
  136. procedure SetDirView(Value: TDirView);
  137. procedure SetDirectory(Value: string); override;
  138. procedure GetNodeShellAttr(ParentNode: TTreeNode; NodeData: TNodeData; GetAttr: Boolean);
  139. function DoScanDir(FromNode: TTreeNode): Boolean;
  140. function AddChildNode(ParentNode: TTreeNode; SRec: TSearchRec): TTreeNode;
  141. procedure CreateWatchThread(Drive: string);
  142. function NodeWatched(Node: TTreeNode): Boolean;
  143. procedure TerminateWatchThread(Drive: string);
  144. function WatchThreadActive: Boolean; overload;
  145. function WatchThreadActive(Drive: string): Boolean; overload;
  146. procedure InternalWndProc(var Msg: TMessage);
  147. function DirAttrMask: Integer;
  148. function CreateDriveStatus: TDriveStatus;
  149. procedure ValidateDirectoryEx(Node: TTreeNode; Recurse: TRecursiveScan;
  150. NewDirs: Boolean); override;
  151. procedure RebuildTree; override;
  152. procedure SetLastPathCut(Path: string);
  153. function GetCanUndoCopyMove: Boolean; virtual;
  154. procedure CreateWnd; override;
  155. procedure DestroyWnd; override;
  156. procedure Edit(const Item: TTVItem); override;
  157. procedure WMUserRename(var Message: TMessage); message WM_USER_RENAME;
  158. function GetCustomDirView: TCustomDirView; override;
  159. procedure SetCustomDirView(Value: TCustomDirView); override;
  160. function NodePath(Node: TTreeNode): string; override;
  161. function NodeIsRecycleBin(Node: TTreeNode): Boolean; override;
  162. function NodePathExists(Node: TTreeNode): Boolean; override;
  163. function NodeColor(Node: TTreeNode): TColor; override;
  164. function FindPathNode(Path: string): TTreeNode; override;
  165. function CreateNode: TTreeNode; override;
  166. function DDSourceEffects: TDropEffectSet; override;
  167. procedure DDChooseEffect(KeyState: Integer; var Effect: Integer; PreferredEffect: Integer); override;
  168. function DragCompleteFileList: Boolean; override;
  169. function DDExecute: TDragResult; override;
  170. public
  171. property Images;
  172. property StateImages;
  173. property Items stored False;
  174. property Selected Write SetSelected stored False;
  175. property DragImageList: TDragImageList read FDragImageList;
  176. property CanUndoCopyMove: Boolean read GetCanUndoCopyMove;
  177. property DDFileOperator: TFileOperator read FFileOperator;
  178. property LastPathCut: string read FLastPathCut write SetLastPathCut;
  179. function UndoCopyMove: Boolean; dynamic;
  180. procedure EmptyClipboard; dynamic;
  181. function CopyToClipBoard(Node: TTreeNode): Boolean; dynamic;
  182. function CutToClipBoard(Node: TTreeNode): Boolean; dynamic;
  183. function CanPasteFromClipBoard: Boolean; dynamic;
  184. function PasteFromClipBoard(TargetPath: string = ''): Boolean; dynamic;
  185. procedure PerformDragDropFileOperation(Node: TTreeNode; Effect: Integer); override;
  186. {Drive handling:}
  187. function GetDriveStatus(Drive: string): TDriveStatus;
  188. function GetDriveTypetoNode(Node: TTreeNode): Integer; {Returns DRIVE_CDROM etc..}
  189. function GetDriveToNode(Node: TTreeNode): string;
  190. function GetDriveText(Drive: string): string;
  191. procedure ScanDrive(Drive: string);
  192. procedure RefreshRootNodes(dsFlags: Integer);
  193. function GetDrives: TStrings;
  194. {Node handling:}
  195. procedure SetImageIndex(Node: TTreeNode); virtual;
  196. function FindNodeToPath(Path: string): TTreeNode;
  197. function RootNode(Node: TTreeNode): TTreeNode;
  198. function GetDirName(Node: TTreeNode): string;
  199. function GetDisplayName(Node: TTreeNode): string;
  200. function NodePathName(Node: TTreeNode): string; override;
  201. function GetFQPIDL(Node: TTreeNode): PItemIDList;
  202. {Directory update:}
  203. function CreateDirectory(ParentNode: TTreeNode; NewName: string): TTreeNode; dynamic;
  204. function DeleteDirectory(Node: TTreeNode; AllowUndo: Boolean): Boolean; dynamic;
  205. constructor Create(AOwner: TComponent); override;
  206. destructor Destroy; override;
  207. {Menu-handling:}
  208. procedure DisplayContextMenu(Node: TTreeNode; Point: TPoint); override;
  209. procedure DisplayPropertiesMenu(Node: TTreeNode); override;
  210. {Watchthread handling:}
  211. procedure StartWatchThread;
  212. procedure StopWatchThread;
  213. procedure SuspendChangeTimer;
  214. procedure ResumeChangeTimer;
  215. procedure StartAllWatchThreads;
  216. procedure StopAllWatchThreads;
  217. procedure ValidateCurrentDirectoryIfNotMonitoring;
  218. (* Modified Events: *)
  219. procedure GetImageIndex(Node: TTreeNode); override;
  220. function CanEdit(Node: TTreeNode): Boolean; override;
  221. function CanChange(Node: TTreeNode): Boolean; override;
  222. function CanExpand(Node: TTreeNode): Boolean; override;
  223. procedure Delete(Node: TTreeNode); override;
  224. procedure Loaded; override;
  225. procedure KeyPress(var Key: Char); override;
  226. procedure Change(Node: TTreeNode); override;
  227. published
  228. {Additional properties:}
  229. {Current selected directory:}
  230. property Directory;
  231. {Confirm deleting directories:}
  232. property ConfirmDelete: Boolean read FConfirmDelete write FConfirmDelete default True;
  233. {Confirm overwriting directories:}
  234. property ConfirmOverwrite: Boolean read FConfirmOverwrite write FConfirmOverwrite default True;
  235. {Scan all directories in method ScanDrive:}
  236. property FullDriveScan: Boolean read FFullDriveScan write SetFullDriveScan default False;
  237. {Enable automatic update on filesystem changes:}
  238. property WatchDirectory: Boolean read FWatchDirectory write SetWatchDirectory default False;
  239. {Linked component TDirView:}
  240. property DirView: TDirView read FDirView write SetDirView;
  241. {Show the volume labels of drives:}
  242. property ShowVolLabel: Boolean read FShowVolLabel write SetShowVolLabel default True;
  243. {Additional events:}
  244. property OnDisplayContextMenu: TNotifyEvent read FOnDisplayContextMenu
  245. write FOnDisplayContextMenu;
  246. property OnRefreshDrives: TNotifyEvent read FOnRefreshDrives
  247. write FOnRefreshDrives;
  248. property OnBusy;
  249. property DDLinkOnExeDrag;
  250. property TargetPopUpMenu;
  251. property OnDDDragEnter;
  252. property OnDDDragLeave;
  253. property OnDDDragOver;
  254. property OnDDDrop;
  255. property OnDDQueryContinueDrag;
  256. property OnDDGiveFeedback;
  257. property OnDDDragDetect;
  258. property OnDDProcessDropped;
  259. property OnDDError;
  260. property OnDDExecuted;
  261. property OnDDFileOperation;
  262. property OnDDFileOperationExecuted;
  263. property Align;
  264. property Anchors;
  265. property AutoExpand;
  266. property BiDiMode;
  267. property BorderStyle;
  268. property BorderWidth;
  269. property ChangeDelay;
  270. property Color;
  271. property Ctl3D;
  272. property Constraints;
  273. property DoubleBuffered;
  274. {Delphi's drag&drop is not compatible with the OLE windows drag&drop:}
  275. property DragKind;
  276. property DragCursor;
  277. property DragMode Default dmAutomatic;
  278. property OnDragDrop;
  279. property OnDragOver;
  280. property Enabled;
  281. property Font;
  282. property HideSelection;
  283. property HotTrack;
  284. property Indent;
  285. property ParentBiDiMode;
  286. property ParentColor;
  287. property ParentCtl3D;
  288. property ParentDoubleBuffered;
  289. property ParentFont;
  290. property ParentShowHint;
  291. property PopupMenu;
  292. property ReadOnly;
  293. property RightClickSelect;
  294. property RowSelect;
  295. property ShowButtons;
  296. property ShowHint;
  297. property ShowLines;
  298. property TabOrder;
  299. property TabStop default True;
  300. property ToolTips;
  301. property Visible;
  302. property OnChange;
  303. property OnChanging;
  304. property OnClick;
  305. property OnCollapsing;
  306. property OnCollapsed;
  307. property OnCompare;
  308. property OnDblClick;
  309. property OnDeletion;
  310. property OnEdited;
  311. property OnEditing;
  312. property OnEndDock;
  313. property OnEndDrag;
  314. property OnEnter;
  315. property OnExit;
  316. property OnExpanding;
  317. property OnExpanded;
  318. property OnGetImageIndex;
  319. property OnGetSelectedIndex;
  320. property OnKeyDown;
  321. property OnKeyPress;
  322. property OnKeyUp;
  323. property OnMouseDown;
  324. property OnMouseMove;
  325. property OnMouseUp;
  326. property OnStartDock;
  327. property OnStartDrag;
  328. end;
  329. procedure Register;
  330. implementation
  331. uses
  332. CompThread, PasTools, UITypes, Types, OperationWithTimeout, System.Generics.Defaults;
  333. resourcestring
  334. SErrorInvalidDirName = 'New name contains invalid characters %s';
  335. type
  336. PInt = ^Integer;
  337. procedure Register;
  338. begin
  339. RegisterComponents('DriveDir', [TDriveView]);
  340. end; {Register}
  341. constructor TNodeData.Create;
  342. begin
  343. inherited;
  344. FAttr := 0;
  345. FScanned := False;
  346. FDirName := '';
  347. FShortName := '';
  348. FIsRecycleBin := False;
  349. FIconEmpty := True;
  350. shAttr := 0;
  351. PIDL := nil;
  352. ShellFolder := nil;
  353. end; {TNodeData.Create}
  354. destructor TNodeData.Destroy;
  355. begin
  356. SetLength(FDirName, 0);
  357. if Assigned(PIDL) then
  358. FreePIDL(PIDL);
  359. inherited;
  360. end; {TNodeData.Destroy}
  361. { TDriveTreeNode }
  362. procedure TDriveTreeNode.Assign(Source: TPersistent);
  363. var
  364. SourceData: TNodeData;
  365. NewData: TNodeData;
  366. begin
  367. inherited Assign(Source);
  368. if not Deleting and (Source is TTreeNode) then
  369. begin
  370. SourceData := TNodeData(TTreeNode(Source).Data);
  371. NewData := TNodeData.Create();
  372. NewData.DirName := SourceData.DirName;
  373. NewData.ShortName := SourceData.ShortName;
  374. NewData.Attr := SourceData.Attr;
  375. NewData.Scanned := SourceData.Scanned;
  376. NewData.Data := SourceData.Data;
  377. NewData.FIsRecycleBin := SourceData.FIsRecycleBin;
  378. NewData.IconEmpty := SourceData.IconEmpty;
  379. TTreeNode(Source).Data := NewData;
  380. end;
  381. end;
  382. { TDriveView }
  383. constructor TDriveView.Create(AOwner: TComponent);
  384. var
  385. Drive: TRealDrive;
  386. begin
  387. inherited;
  388. FCreating := True;
  389. FDriveStatus := TObjectDictionary<string, TDriveStatus>.Create([doOwnsValues]);
  390. FChangeInterval := MSecsPerSec;
  391. for Drive := FirstDrive to LastDrive do
  392. begin
  393. FDriveStatus.Add(Drive, CreateDriveStatus);
  394. end;
  395. FFileOperator := TFileOperator.Create(Self);
  396. FFileOperator.ProgressTitle := coFileOperatorTitle;
  397. FFileOperator.Flags := [foAllowUndo, foNoConfirmMkDir];
  398. FShowVolLabel := True;
  399. FChangeFlag := False;
  400. FLastDir := EmptyStr;
  401. FValidateFlag := False;
  402. FConfirmDelete := True;
  403. FDirectory := EmptyStr;
  404. FForceRename := False;
  405. FLastRenameName := '';
  406. FRenameNode := nil;
  407. FPrevSelected := nil;
  408. FPrevSelectedIndex := -1;
  409. FChangeTimerSuspended := 0;
  410. FConfirmOverwrite := True;
  411. FLastPathCut := '';
  412. FStartPos.X := -1;
  413. FStartPos.Y := -1;
  414. FDragPos := FStartPos;
  415. FInternalWindowHandle := Classes.AllocateHWnd(InternalWndProc);
  416. with FDragDropFilesEx do
  417. begin
  418. ShellExtensions.DragDropHandler := True;
  419. end;
  420. end; {Create}
  421. destructor TDriveView.Destroy;
  422. var
  423. DriveStatus: TDriveStatus;
  424. begin
  425. Classes.DeallocateHWnd(FInternalWindowHandle);
  426. for DriveStatus in FDriveStatus.Values do
  427. begin
  428. with DriveStatus do
  429. begin
  430. if Assigned(DiscMonitor) then
  431. DiscMonitor.Free;
  432. if Assigned(ChangeTimer) then
  433. ChangeTimer.Free;
  434. end;
  435. end;
  436. FDriveStatus.Free;
  437. if Assigned(FFileOperator) then
  438. FFileOperator.Free;
  439. inherited Destroy;
  440. end; {Destroy}
  441. function TDriveView.CreateDriveStatus: TDriveStatus;
  442. begin
  443. Result := TDriveStatus.Create;
  444. with Result do
  445. begin
  446. Scanned := False;
  447. Verified := False;
  448. RootNode := nil;
  449. RootNodeIndex := -1;
  450. DiscMonitor := nil;
  451. DefaultDir := EmptyStr;
  452. {ChangeTimer: }
  453. ChangeTimer := TTimer.Create(Self);
  454. ChangeTimer.Interval := 0;
  455. ChangeTimer.Enabled := False;
  456. ChangeTimer.OnTimer := ChangeTimerOnTimer;
  457. end;
  458. end;
  459. type
  460. PDevBroadcastHdr = ^TDevBroadcastHdr;
  461. TDevBroadcastHdr = record
  462. dbch_size: DWORD;
  463. dbch_devicetype: DWORD;
  464. dbch_reserved: DWORD;
  465. end;
  466. PDevBroadcastVolume = ^TDevBroadcastVolume;
  467. TDevBroadcastVolume = record
  468. dbcv_size: DWORD;
  469. dbcv_devicetype: DWORD;
  470. dbcv_reserved: DWORD;
  471. dbcv_unitmask: DWORD;
  472. dbcv_flags: WORD;
  473. end;
  474. const
  475. DBT_CONFIGCHANGED = $0018;
  476. DBT_DEVICEARRIVAL = $8000;
  477. DBT_DEVICEREMOVEPENDING = $8003;
  478. DBT_DEVICEREMOVECOMPLETE = $8004;
  479. DBT_DEVTYP_VOLUME = $00000002;
  480. procedure TDriveView.InternalWndProc(var Msg: TMessage);
  481. var
  482. UnitMask: DWORD;
  483. Drive: Char;
  484. begin
  485. with Msg do
  486. begin
  487. if Msg = WM_DEVICECHANGE then
  488. begin
  489. if (wParam = DBT_CONFIGCHANGED) or
  490. (wParam = DBT_DEVICEARRIVAL) or
  491. (wParam = DBT_DEVICEREMOVECOMPLETE) then
  492. begin
  493. // Delay refreshing drives for a sec.
  494. // Particularly with CD/DVD drives, if we query display name
  495. // immediately after receiving DBT_DEVICEARRIVAL, we do not get media label.
  496. // Actually one sec does not help usually, but we do not want to wait any longer,
  497. // because we want to add USB drives asap.
  498. SetTimer(FInternalWindowHandle, 1, MSecsPerSec, nil);
  499. end
  500. else
  501. if wParam = DBT_DEVICEREMOVEPENDING then
  502. begin
  503. if PDevBroadcastHdr(lParam)^.dbch_devicetype = DBT_DEVTYP_VOLUME then
  504. begin
  505. UnitMask := PDevBroadcastVolume(lParam)^.dbcv_unitmask;
  506. Drive := FirstDrive;
  507. while UnitMask > 0 do
  508. begin
  509. if UnitMask and $01 <> 0 then
  510. begin
  511. // Disable disk monitor to release the handle to the drive.
  512. // It may happen that the dirve is not removed in the end. In this case we do not currently resume the
  513. // monitoring. We can watch for DBT_DEVICEQUERYREMOVEFAILED to resume the monitoring.
  514. // But currently we implement this for VeraCrypt, which does not send this notification.
  515. with GetDriveStatus(Drive) do
  516. begin
  517. if Assigned(DiscMonitor) then
  518. begin
  519. DiscMonitor.Enabled := False;
  520. DiscMonitor.Free;
  521. DiscMonitor := nil;
  522. end;
  523. end;
  524. end;
  525. UnitMask := UnitMask shr 1;
  526. Drive := Chr(Ord(Drive) + 1);
  527. end;
  528. end;
  529. end;
  530. end
  531. else
  532. if Msg = WM_TIMER then
  533. begin
  534. KillTimer(FInternalWindowHandle, 1);
  535. try
  536. //DriveInfo.Load;
  537. RefreshRootNodes(dsAll or dvdsRereadAllways);
  538. if Assigned(OnRefreshDrives) then
  539. OnRefreshDrives(Self);
  540. except
  541. Application.HandleException(Self);
  542. end;
  543. end;
  544. Result := DefWindowProc(FInternalWindowHandle, Msg, wParam, lParam);
  545. end;
  546. end;
  547. procedure TDriveView.CreateWnd;
  548. var
  549. DriveStatus: TDriveStatus;
  550. begin
  551. inherited;
  552. if Assigned(PopupMenu) then
  553. PopupMenu.Autopopup := False;
  554. OLECheck(SHGetDesktopFolder(FDesktop));
  555. FDragDropFilesEx.SourceEffects := [deCopy, deMove, deLink];
  556. FDragDropFilesEx.TargetEffects := [deCopy, deMove, deLink];
  557. if FPrevSelectedIndex >= 0 then
  558. begin
  559. FPrevSelected := Items[FPrevSelectedIndex];
  560. FPrevSelectedIndex := -1;
  561. end;
  562. for DriveStatus in FDriveStatus.Values do
  563. with DriveStatus do
  564. begin
  565. if RootNodeIndex >= 0 then
  566. begin
  567. RootNode := Items[RootNodeIndex];
  568. RootNodeIndex := -1;
  569. end;
  570. end;
  571. end; {CreateWnd}
  572. procedure TDriveView.DestroyWnd;
  573. var
  574. DriveStatus: TDriveStatus;
  575. begin
  576. if CreateWndRestores and (Items.Count > 0) and (csRecreating in ControlState) then
  577. begin
  578. FPrevSelectedIndex := -1;
  579. if Assigned(FPrevSelected) then
  580. begin
  581. FPrevSelectedIndex := FPrevSelected.AbsoluteIndex;
  582. FPrevSelected := nil;
  583. end;
  584. for DriveStatus in FDriveStatus.Values do
  585. with DriveStatus do
  586. begin
  587. RootNodeIndex := -1;
  588. if Assigned(RootNode) then
  589. begin
  590. RootNodeIndex := RootNode.AbsoluteIndex;
  591. RootNode := nil;
  592. end;
  593. end;
  594. end;
  595. inherited;
  596. end;
  597. function TDriveView.GetFQPIDL(Node: TTreeNode): PItemIDList;
  598. var
  599. Eaten: ULONG;
  600. shAttr: ULONG;
  601. begin
  602. Result := nil;
  603. if Assigned(Node) then
  604. begin
  605. shAttr := 0;
  606. FDesktop.ParseDisplayName(FParentForm.Handle, nil, PChar(NodePathName(Node)), Eaten,
  607. Result, shAttr);
  608. end;
  609. end; {GetFQPIDL}
  610. function TDriveView.NodeColor(Node: TTreeNode): TColor;
  611. begin
  612. Result := clDefaultItemColor;
  613. with TNodeData(Node.Data) do
  614. if not Node.Selected then
  615. begin
  616. {Colored display of compressed directories:}
  617. if (Attr and FILE_ATTRIBUTE_COMPRESSED) <> 0 then
  618. begin
  619. if SupportsDarkMode and DarkMode then Result := clSkyBlue
  620. else Result := clBlue;
  621. end
  622. else
  623. {Dimmed display, if hidden-atrribut set:}
  624. if FDimmHiddenDirs and ((Attr and FILE_ATTRIBUTE_HIDDEN) <> 0) then
  625. Result := clGrayText
  626. end;
  627. end;
  628. function TDriveView.GetCustomDirView: TCustomDirView;
  629. begin
  630. Result := DirView;
  631. end;
  632. procedure TDriveView.SetCustomDirView(Value: TCustomDirView);
  633. begin
  634. DirView := Value as TDirView;
  635. end;
  636. function TDriveView.NodePath(Node: TTreeNode): string;
  637. var
  638. ParentNode: TTreeNode;
  639. begin
  640. if not Assigned(Node) then
  641. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDirPath']));
  642. Result := GetDirName(Node);
  643. ParentNode := Node.Parent;
  644. while (ParentNode <> nil) and (ParentNode.Level >= 0) do
  645. begin
  646. if ParentNode.Level > 0 then
  647. Result := GetDirName(ParentNode) + '\' + Result
  648. else
  649. Result := GetDirName(ParentNode) + Result;
  650. ParentNode := ParentNode.Parent;
  651. end;
  652. if IsRootPath(Result) then
  653. Result := ExcludeTrailingBackslash(Result);
  654. end;
  655. {NodePathName: Returns the complete path to Node with trailing backslash on rootnodes:
  656. C:\ ,C:\WINDOWS, C:\WINDOWS\SYSTEM }
  657. function TDriveView.NodePathName(Node: TTreeNode): string;
  658. begin
  659. Result := NodePath(Node);
  660. if IsRootPath(Result) then
  661. Result := IncludeTrailingBackslash(Result);
  662. end; {NodePathName}
  663. function TDriveView.NodeIsRecycleBin(Node: TTreeNode): Boolean;
  664. begin
  665. Result := TNodeData(Node.Data).IsRecycleBin;
  666. end;
  667. function TDriveView.NodePathExists(Node: TTreeNode): Boolean;
  668. begin
  669. Result := DirectoryExists(NodePathName(Node));
  670. end;
  671. function TDriveView.CanEdit(Node: TTreeNode): Boolean;
  672. begin
  673. Result := inherited CanEdit(Node) or FForceRename;
  674. if Result then
  675. begin
  676. Result := Assigned(Node.Parent) and
  677. (not TNodeData(Node.Data).IsRecycleBin) and
  678. (not ReadOnly) and
  679. (FDragDropFilesEx.DragDetectStatus <> ddsDrag) and
  680. ((TNodeData(Node.Data).Attr and (faReadOnly or faSysFile)) = 0) and
  681. (UpperCase(Node.Text) = UpperCase(GetDirName(Node)));
  682. end;
  683. FForceRename := False;
  684. end; {CanEdit}
  685. procedure TDriveView.Edit(const Item: TTVItem);
  686. var
  687. NewDirName: string;
  688. SRec: TSearchRec;
  689. Node: TTreeNode;
  690. Info: string;
  691. i: Integer;
  692. begin
  693. Node := GetNodeFromHItem(Item);
  694. if (Length(Item.pszText) > 0) and (Item.pszText <> Node.Text) then
  695. begin
  696. if StrContains(coInvalidDosChars, Item.pszText) then
  697. begin
  698. Info := coInvalidDosChars;
  699. for i := Length(Info) downto 1 do
  700. System.Insert(Space, Info, i);
  701. if Assigned(OnEdited) then
  702. begin
  703. NewDirName := Node.Text;
  704. OnEdited(Self, Node, NewDirName);
  705. end;
  706. if Length(Item.pszText) > 0 then
  707. raise EInvalidDirName.CreateFmt(SErrorInvalidDirName, [Info]);
  708. Exit;
  709. end;
  710. StopWatchThread;
  711. if Assigned(DirView) then
  712. DirView.StopWatchThread;
  713. with FFileOperator do
  714. begin
  715. Flags := [foAllowUndo, foNoConfirmation];
  716. Operation := foRename;
  717. OperandFrom.Clear;
  718. OperandTo.Clear;
  719. OperandFrom.Add(NodePath(Node));
  720. OperandTo.Add(IncludeTrailingBackslash(NodePath(Node.Parent)) + Item.pszText);
  721. end;
  722. try
  723. if FFileOperator.Execute then
  724. begin
  725. Node.Text := Item.pszText;
  726. TNodeData(Node.Data).DirName := Item.pszText;
  727. if FindFirst(ApiPath(IncludeTrailingBackslash(NodePath(Node.Parent)) + Item.pszText),
  728. faAnyFile, SRec) = 0 then
  729. begin
  730. TNodeData(Node.Data).ShortName := string(SRec.FindData.cAlternateFileName);
  731. end;
  732. FindClose(SRec);
  733. SortChildren(Node.Parent, False);
  734. inherited;
  735. end
  736. else
  737. begin
  738. if FileOrDirExists(IncludeTrailingBackslash(NodePath(Node.Parent)) + Item.pszText) then
  739. Info := SErrorRenameFileExists + Item.pszText
  740. else
  741. Info := SErrorRenameFile + Item.pszText;
  742. MessageBeep(MB_ICONHAND);
  743. if MessageDlg(FormatLastOSError(Info), mtError, [mbOK, mbAbort], 0) = mrOK then
  744. begin
  745. FLastRenameName := Item.pszText;
  746. FRenameNode := Node;
  747. PostMessage(Self.Handle, WM_USER_RENAME, 0, 0);
  748. end;
  749. end;
  750. finally
  751. StartWatchThread;
  752. if Assigned(DirView) then
  753. begin
  754. DirView.Reload2;
  755. DirView.StartWatchThread;
  756. end;
  757. end;
  758. end;
  759. end; {Edit}
  760. procedure TDriveView.WMUserRename(var Message: TMessage);
  761. begin
  762. if Assigned(FRenameNode) then
  763. begin
  764. FForceRename := True;
  765. TreeView_EditLabel(Handle, FRenameNode.ItemID);
  766. SetWindowText(TreeView_GetEditControl(Self.Handle), PChar(FLastRenameName));
  767. FRenameNode := nil;
  768. end;
  769. end; {WMUserRename}
  770. function TDriveView.CanExpand(Node: TTreeNode): Boolean;
  771. var
  772. SubNode: TTreeNode;
  773. Drive: string;
  774. SaveCursor: TCursor;
  775. begin
  776. Result := inherited CanExpand(Node);
  777. Drive := GetDriveToNode(Node);
  778. if Node.HasChildren then
  779. begin
  780. if (Node.Level = 0) and
  781. (not GetDriveStatus(Drive).Scanned) and
  782. DriveInfo.IsFixedDrive(Drive) then
  783. begin
  784. SubNode := Node.GetFirstChild;
  785. if not Assigned(SubNode) then
  786. begin
  787. ScanDrive(Drive);
  788. SubNode := Node.GetFirstChild;
  789. Node.HasChildren := Assigned(SubNode);
  790. Result := Node.HasChildren;
  791. if not Assigned(GetDriveStatus(Drive).DiscMonitor) then
  792. CreateWatchThread(Drive);
  793. end;
  794. end
  795. else
  796. begin
  797. SaveCursor := Screen.Cursor;
  798. Screen.Cursor := crHourGlass;
  799. try
  800. if (not TNodeData(Node.Data).Scanned) and DoScanDir(Node) then
  801. begin
  802. ReadSubDirs(Node, DriveInfo.Get(Drive).DriveType);
  803. end;
  804. finally
  805. Screen.Cursor := SaveCursor;
  806. end;
  807. end;
  808. end;
  809. end; {CanExpand}
  810. procedure TDriveView.GetImageIndex(Node: TTreeNode);
  811. begin
  812. if TNodeData(Node.Data).IconEmpty then
  813. SetImageIndex(Node);
  814. inherited;
  815. end; {GetImageIndex}
  816. procedure TDriveView.Loaded;
  817. begin
  818. inherited;
  819. {Create the drive nodes:}
  820. RefreshRootNodes(dsDisplayName or dvdsFloppy);
  821. {Set the initial directory:}
  822. if (Length(FDirectory) > 0) and DirectoryExists(FDirectory) then
  823. Directory := FDirectory;
  824. FCreating := False;
  825. end; {Loaded}
  826. function TDriveView.CreateNode: TTreeNode;
  827. begin
  828. Result := TDriveTreeNode.Create(Items);
  829. end;
  830. procedure TDriveView.Delete(Node: TTreeNode);
  831. var
  832. NodeData: TNodeData;
  833. begin
  834. if Node = FPrevSelected then
  835. FPrevSelected := nil;
  836. NodeData := nil;
  837. if Assigned(Node) and Assigned(Node.Data) then
  838. NodeData := TNodeData(Node.Data);
  839. Node.Data := nil;
  840. inherited;
  841. if Assigned(NodeData) and not (csRecreating in ControlState) then
  842. begin
  843. NodeData.Destroy;
  844. end;
  845. end; {OnDelete}
  846. procedure TDriveView.KeyPress(var Key: Char);
  847. begin
  848. inherited;
  849. if Assigned(Selected) then
  850. begin
  851. if Pos(Key, coInvalidDosChars) <> 0 then
  852. begin
  853. Beep;
  854. Key := #0;
  855. end;
  856. end;
  857. end; {KeyPress}
  858. function TDriveView.CanChange(Node: TTreeNode): Boolean;
  859. var
  860. Path: string;
  861. Drive: string;
  862. begin
  863. Result := inherited CanChange(Node);
  864. if not Reading and not (csRecreating in ControlState) then
  865. begin
  866. if Result and Assigned(Node) then
  867. begin
  868. Path := NodePathName(Node);
  869. if Path <> FLastDir then
  870. begin
  871. Drive := DriveInfo.GetDriveKey(Path);
  872. DriveInfo.ReadDriveStatus(Drive, dsSize or dsImageIndex);
  873. if not DriveInfo.Get(Drive).DriveReady then
  874. begin
  875. MessageDlg(Format(SDriveNotReady, [Drive]), mtError, [mbOK], 0);
  876. Result := False;
  877. end
  878. else
  879. if not DirectoryExists(ApiPath(Path)) then
  880. begin
  881. MessageDlg(Format(SDirNotExists, [Path]), mtError, [mbOK], 0);
  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. var
  1411. Read: Boolean;
  1412. begin
  1413. Result := nil;
  1414. if Length(Path) > 0 then
  1415. begin
  1416. Read := False;
  1417. if not TNodeData(ParentNode.Data).Scanned then
  1418. begin
  1419. ReadSubDirs(ParentNode, GetDriveTypetoNode(ParentNode));
  1420. Read := True;
  1421. end;
  1422. Result := DoSearchSubDirs(ParentNode, Path);
  1423. // reread subfolders, just in case the directory we look for was just created
  1424. // (as can happen when navigating to new remote directory with synchronized
  1425. // browsing enabled and opting to create the non-existing local directory)
  1426. if (not Assigned(Result)) and (not Read) then
  1427. begin
  1428. ValidateDirectoryEx(ParentNode, rsNoRecursive, True);
  1429. Result := DoSearchSubDirs(ParentNode, Path);
  1430. end;
  1431. end;
  1432. end; {SearchSubDirs}
  1433. var
  1434. Drive: string;
  1435. P: Integer;
  1436. begin {FindNodeToPath}
  1437. Result := nil;
  1438. if Length(Path) < 3 then
  1439. Exit;
  1440. // Particularly when used by TDirView to delegate browsing to
  1441. // hidden drive view, the handle may not be created
  1442. HandleNeeded;
  1443. Drive := DriveInfo.GetDriveKey(Path);
  1444. if Assigned(GetDriveStatus(Drive).RootNode) then
  1445. begin
  1446. if DriveInfo.IsRealDrive(Drive) then
  1447. begin
  1448. System.Delete(Path, 1, 3);
  1449. end
  1450. else
  1451. if IsUncPath(Path) then
  1452. begin
  1453. System.Delete(Path, 1, 2);
  1454. P := Pos('\', Path);
  1455. if P = 0 then
  1456. begin
  1457. Path := '';
  1458. end
  1459. else
  1460. begin
  1461. System.Delete(Path, 1, P);
  1462. P := Pos('\', Path);
  1463. if P = 0 then
  1464. begin
  1465. Path := '';
  1466. end
  1467. else
  1468. begin
  1469. System.Delete(Path, 1, P);
  1470. end;
  1471. end;
  1472. end
  1473. else
  1474. begin
  1475. raise EConvertError.Create(Format(ErrorInvalidDrive, [Path]))
  1476. end;
  1477. if Length(Path) > 0 then
  1478. begin
  1479. if not GetDriveStatus(Drive).Scanned then
  1480. begin
  1481. ScanDrive(Drive);
  1482. end;
  1483. Result := SearchSubDirs(GetDriveStatus(Drive).RootNode, UpperCase(Path));
  1484. end
  1485. else Result := GetDriveStatus(Drive).RootNode;
  1486. end;
  1487. end; {FindNodetoPath}
  1488. function TDriveView.CheckForSubDirs(Path: string): Boolean;
  1489. var
  1490. DosError: Integer;
  1491. SRec: TSearchRec;
  1492. begin
  1493. Result := False;
  1494. DosError := FindFirst(ApiPath(IncludeTrailingBackslash(Path) + '*.'), 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. Result := True;
  1502. Break;
  1503. end;
  1504. DosError := FindNext(SRec);
  1505. end;
  1506. FindClose(SRec);
  1507. end; {CheckForSubDirs}
  1508. function TDriveView.ReadSubDirs(Node: TTreeNode; DriveType: Integer): Boolean;
  1509. var
  1510. DosError: Integer;
  1511. SRec: TSearchRec;
  1512. NewNode: TTreeNode;
  1513. begin
  1514. Result := False;
  1515. DosError := FindFirst(ApiPath(IncludeTrailingBackslash(NodePath(Node)) + '*.*'), DirAttrMask, SRec);
  1516. while DosError = 0 do
  1517. begin
  1518. if (SRec.Name <> '.' ) and
  1519. (SRec.Name <> '..') and
  1520. (SRec.Attr and faDirectory <> 0) then
  1521. begin
  1522. NewNode := AddChildNode(Node, SRec);
  1523. if DoScanDir(NewNode) then
  1524. begin
  1525. // We have seen the SFGAO_HASSUBFOLDER to be absent on C: drive $Recycle.Bin
  1526. NewNode.HasChildren := Bool(TNodeData(NewNode.Data).shAttr and SFGAO_HASSUBFOLDER);
  1527. TNodeData(NewNode.Data).Scanned := not NewNode.HasChildren;
  1528. end
  1529. else
  1530. begin
  1531. NewNode.HasChildren := False;
  1532. TNodeData(NewNode.Data).Scanned := True;
  1533. end;
  1534. Result := True;
  1535. end;
  1536. DosError := FindNext(SRec);
  1537. end; {While DosError = 0}
  1538. FindClose(Srec);
  1539. TNodeData(Node.Data).Scanned := True;
  1540. if Result then SortChildren(Node, False)
  1541. else Node.HasChildren := False;
  1542. Application.ProcessMessages;
  1543. end; {ReadSubDirs}
  1544. function TDriveView.CallBackValidateDir(var Node: TTreeNode; Data: Pointer): Boolean;
  1545. var
  1546. WorkNode: TTreeNode;
  1547. DelNode: TTreeNode;
  1548. NewNode: TTreeNode;
  1549. SRec: TSearchRec;
  1550. SrecList: TStringList;
  1551. SubDirList: TStringList;
  1552. DosError: Integer;
  1553. Index: Integer;
  1554. NewDirFound: Boolean;
  1555. ParentDir: string;
  1556. NodeData: TNodeData;
  1557. ScanDirInfo: PScanDirInfo;
  1558. begin {CallBackValidateDir}
  1559. Result := True;
  1560. if (not Assigned(Node)) or (not Assigned(Node.Data)) then
  1561. Exit;
  1562. NewDirFound := False;
  1563. ScanDirInfo := PScanDirInfo(Data);
  1564. {Check, if directory still exists: (but not with root directory) }
  1565. if Assigned(Node.Parent) and (ScanDirInfo^.StartNode = Node) then
  1566. if not DirectoryExists(NodePathName(Node)) then
  1567. begin
  1568. WorkNode := Node.Parent;
  1569. if Selected = Node then
  1570. Selected := WorkNode;
  1571. if DropTarget = Node then
  1572. DropTarget := nil;
  1573. Node.Delete;
  1574. Node := nil;
  1575. Exit;
  1576. end;
  1577. WorkNode := Node.GetFirstChild;
  1578. NodeData := TNodeData(Node.Data);
  1579. if NodeData.Scanned and Assigned(WorkNode) then
  1580. {if node was already scanned: check wether the existing subnodes are still alive
  1581. and add all new subdirectories as subnodes:}
  1582. begin
  1583. if DoScanDir(Node) then
  1584. begin
  1585. ParentDir := IncludeTrailingBackslash(NodePath(Node));
  1586. {Build list of existing subnodes:}
  1587. SubDirList := TStringList.Create;
  1588. while Assigned(WorkNode) do
  1589. begin
  1590. SubDirList.Add(TNodeData(WorkNode.Data).DirName);
  1591. WorkNode := Node.GetNextChild(WorkNode);
  1592. end;
  1593. {Sorting not required, because the subnodes are already sorted!}
  1594. SRecList := TStringList.Create;
  1595. DosError := FindFirst(ApiPath(ParentDir + '*.*'), DirAttrMask, SRec);
  1596. while DosError = 0 do
  1597. begin
  1598. if (Srec.Name <> '.' ) and
  1599. (Srec.Name <> '..') and
  1600. (Srec.Attr and faDirectory <> 0) then
  1601. begin
  1602. SrecList.Add(Srec.Name);
  1603. if not SubDirList.Find(Srec.Name, Index) then
  1604. {Subnode does not exists: add it:}
  1605. begin
  1606. NewNode := AddChildNode(Node, SRec);
  1607. NewNode.HasChildren := CheckForSubDirs(ParentDir + Srec.Name);
  1608. TNodeData(NewNode.Data).Scanned := Not NewNode.HasChildren;
  1609. NewDirFound := True;
  1610. end;
  1611. end;
  1612. DosError := FindNext(Srec);
  1613. end;
  1614. FindClose(Srec);
  1615. Sreclist.Sort;
  1616. {Remove not existing subnodes:}
  1617. WorkNode := Node.GetFirstChild;
  1618. while Assigned(WorkNode) do
  1619. begin
  1620. if not Assigned(WorkNode.Data) or
  1621. not SrecList.Find(TNodeData(WorkNode.Data).DirName, Index) then
  1622. begin
  1623. DelNode := WorkNode;
  1624. WorkNode := Node.GetNextChild(WorkNode);
  1625. DelNode.Delete;
  1626. end
  1627. else
  1628. begin
  1629. if (SrecList[Index] <> TNodeData(WorkNode.Data).DirName) then
  1630. begin
  1631. {Case of directory letters has changed:}
  1632. TNodeData(WorkNode.Data).DirName := SrecList[Index];
  1633. TNodeData(WorkNode.Data).ShortName := ExtractShortPathName(NodePathName(WorkNode));
  1634. WorkNode.Text := SrecList[Index];
  1635. end;
  1636. SrecList.Delete(Index);
  1637. WorkNode := Node.GetNextChild(WorkNode);
  1638. end;
  1639. end;
  1640. SrecList.Free;
  1641. SubDirList.Free;
  1642. {Sort subnodes:}
  1643. if NewDirFound then
  1644. SortChildren(Node, False);
  1645. end;
  1646. end
  1647. else
  1648. {Node was not already scanned:}
  1649. if (ScanDirInfo^.SearchNewDirs or
  1650. NodeData.Scanned or
  1651. (Node = ScanDirInfo^.StartNode)) and
  1652. DoScanDir(Node) then
  1653. begin
  1654. ReadSubDirs(Node, ScanDirInfo^.DriveType);
  1655. end;
  1656. end; {CallBackValidateDir}
  1657. procedure TDriveView.RebuildTree;
  1658. var
  1659. Drive: string;
  1660. begin
  1661. for Drive in FDriveStatus.Keys do
  1662. with GetDriveStatus(Drive) do
  1663. if Assigned(RootNode) and Scanned then
  1664. ValidateDirectory(RootNode);
  1665. end;
  1666. procedure TDriveView.ValidateCurrentDirectoryIfNotMonitoring;
  1667. begin
  1668. if Assigned(Selected) and
  1669. not Assigned(GetDriveStatus(GetDriveToNode(Selected)).DiscMonitor) then
  1670. begin
  1671. ValidateDirectory(Selected);
  1672. end;
  1673. end;
  1674. procedure TDriveView.ValidateDirectoryEx(Node: TTreeNode; Recurse: TRecursiveScan;
  1675. NewDirs: Boolean);
  1676. var
  1677. Info: PScanDirInfo;
  1678. SelDir: string;
  1679. SaveCursor: TCursor;
  1680. RestartWatchThread: Boolean;
  1681. SaveCanChange: Boolean;
  1682. CurrentPath: string;
  1683. Drive: string;
  1684. begin
  1685. if Assigned(Node) and Assigned(Node.Data) and
  1686. (not FValidateFlag) and DoScanDir(Node) then
  1687. begin
  1688. SelDir := Directory;
  1689. SaveCursor := Screen.Cursor;
  1690. if Self.Focused and (Screen.Cursor <> crHourGlass) then
  1691. Screen.Cursor := crHourGlass;
  1692. CurrentPath := NodePath(Node);
  1693. Drive := DriveInfo.GetDriveKey(CurrentPath);
  1694. if Node.Level = 0 then
  1695. GetDriveStatus(Drive).ChangeTimer.Enabled := False;
  1696. RestartWatchThread := WatchThreadActive;
  1697. try
  1698. if WatchThreadActive then
  1699. StopWatchThread;
  1700. FValidateFlag := True;
  1701. New(Info);
  1702. Info^.StartNode := Node;
  1703. Info^.SearchNewDirs := NewDirs;
  1704. Info^.DriveType := DriveInfo.Get(Drive).DriveType;
  1705. SaveCanChange := FCanChange;
  1706. FCanChange := True;
  1707. FChangeFlag := False;
  1708. IterateSubTree(Node, CallBackValidateDir, Recurse, coScanStartNode, Info);
  1709. FValidateFlag := False;
  1710. if (not Assigned(Selected)) and (Length(SelDir) > 0) then
  1711. Directory := ExtractFileDrive(SelDir);
  1712. if (SelDir <> Directory) and (not FChangeFlag) then
  1713. Change(Selected);
  1714. FCanChange := SaveCanChange;
  1715. Dispose(Info);
  1716. finally
  1717. if RestartWatchThread and FWatchDirectory and not WatchThreadActive then
  1718. StartWatchThread;
  1719. if Screen.Cursor <> SaveCursor then
  1720. Screen.Cursor := SaveCursor;
  1721. end;
  1722. end;
  1723. end; {ValidateDirectoryEx}
  1724. function TDriveView.GetDriveTypeToNode(Node: TTreeNode): Integer;
  1725. begin
  1726. Assert(Assigned(Node));
  1727. Result := DriveInfo.Get(GetDriveToNode(Node)).DriveType;
  1728. end; {GetDriveTypeToNode}
  1729. function TDriveView.CreateDirectory(ParentNode: TTreeNode; NewName: string): TTreeNode;
  1730. var
  1731. SRec: TSearchRec;
  1732. begin
  1733. Assert(Assigned(ParentNode));
  1734. Result := nil;
  1735. if not TNodeData(ParentNode.Data).Scanned then
  1736. ValidateDirectory(ParentNode);
  1737. StopWatchThread;
  1738. try
  1739. if Assigned(FDirView) then
  1740. FDirView.StopWatchThread;
  1741. {create phyical directory:}
  1742. LastIOResult := 0;
  1743. if not Windows.CreateDirectory(PChar(NodePath(ParentNode) + '\' + NewName), nil) then
  1744. LastIOResult := GetLastError;
  1745. if LastIOResult = 0 then
  1746. begin
  1747. {Create treenode:}
  1748. FindFirst(ApiPath(NodePath(ParentNode) + '\' + NewName), faAnyFile, SRec);
  1749. Result := AddChildNode(ParentNode, Srec);
  1750. FindClose(Srec);
  1751. TNodeData(Result.Data).Scanned := True;
  1752. SortChildren(ParentNode, False);
  1753. ParentNode.Expand(False);
  1754. end;
  1755. finally
  1756. StartWatchThread;
  1757. if Assigned(FDirView) then
  1758. begin
  1759. FDirView.StartWatchThread;
  1760. FDirView.Reload2;
  1761. end;
  1762. end;
  1763. end; {CreateDirectory}
  1764. function TDriveView.DeleteDirectory(Node: TTreeNode; AllowUndo: Boolean): Boolean;
  1765. var
  1766. DelDir: string;
  1767. OperatorResult: Boolean;
  1768. FileOperator: TFileOperator;
  1769. SaveCursor: TCursor;
  1770. begin
  1771. Assert(Assigned(Node));
  1772. Result := False;
  1773. if Assigned(Node) and (Node.Level > 0) then
  1774. begin
  1775. SaveCursor := Screen.Cursor;
  1776. Screen.Cursor := crHourGlass;
  1777. FileOperator := TFileOperator.Create(Self);
  1778. DelDir := NodePathName(Node);
  1779. FileOperator.OperandFrom.Add(DelDir);
  1780. FileOperator.Operation := foDelete;
  1781. if AllowUndo then
  1782. FileOperator.Flags := FileOperator.Flags + [foAllowUndo]
  1783. else
  1784. FileOperator.Flags := FileOperator.Flags - [foAllowUndo];
  1785. if not ConfirmDelete then
  1786. FileOperator.Flags := FileOperator.Flags + [foNoConfirmation];
  1787. try
  1788. if DirectoryExists(DelDir) then
  1789. begin
  1790. StopWatchThread;
  1791. OperatorResult := FileOperator.Execute;
  1792. if OperatorResult and (not FileOperator.OperationAborted) and
  1793. (not DirectoryExists(DelDir)) then
  1794. begin
  1795. Node.Delete
  1796. end
  1797. else
  1798. begin
  1799. Result := False;
  1800. if not AllowUndo then
  1801. begin
  1802. {WinNT4-Bug: FindFirst still returns the directories search record, even if the
  1803. directory was deleted:}
  1804. ChDir(DelDir);
  1805. if IOResult <> 0 then
  1806. Node.Delete;
  1807. end;
  1808. end;
  1809. end
  1810. else
  1811. begin
  1812. Node.Delete;
  1813. Result := True;
  1814. end;
  1815. finally
  1816. StartWatchThread;
  1817. if Assigned(DirView) and Assigned(Selected) then
  1818. DirView.Path := NodePathName(Selected);
  1819. FileOperator.Free;
  1820. Screen.Cursor := SaveCursor;
  1821. end;
  1822. end;
  1823. end; {DeleteDirectory}
  1824. procedure TDriveView.CreateWatchThread(Drive: string);
  1825. begin
  1826. if csDesigning in ComponentState then
  1827. Exit;
  1828. if (not Assigned(GetDriveStatus(Drive).DiscMonitor)) and
  1829. FWatchDirectory and
  1830. (DriveInfo.Get(Drive).DriveType <> DRIVE_REMOTE) then
  1831. begin
  1832. with GetDriveStatus(Drive) do
  1833. begin
  1834. DiscMonitor := TDiscMonitor.Create(Self);
  1835. DiscMonitor.ChangeDelay := msThreadChangeDelay;
  1836. DiscMonitor.SubTree := True;
  1837. DiscMonitor.Filters := [moDirName];
  1838. DiscMonitor.OnChange := ChangeDetected;
  1839. DiscMonitor.OnInvalid := ChangeInvalid;
  1840. DiscMonitor.SetDirectory(DriveInfo.GetDriveRoot(Drive));
  1841. DiscMonitor.Open;
  1842. end;
  1843. end;
  1844. end; {CreateWatchThread}
  1845. procedure TDriveView.SetWatchDirectory(Value: Boolean);
  1846. begin
  1847. if FWatchDirectory <> Value then
  1848. begin
  1849. FWatchDirectory := Value;
  1850. if (not (csDesigning in ComponentState)) and Value then
  1851. StartAllWatchThreads
  1852. else
  1853. StopAllWatchThreads;
  1854. end;
  1855. end; {SetAutoScan}
  1856. procedure TDriveView.SetDirView(Value: TDirView);
  1857. begin
  1858. if Assigned(FDirView) then
  1859. FDirView.DriveView := nil;
  1860. FDirView := Value;
  1861. if Assigned(FDirView) then
  1862. FDirView.DriveView := Self;
  1863. end; {SetDirView}
  1864. function TDriveView.NodeWatched(Node: TTreeNode): Boolean;
  1865. var
  1866. Drive: string;
  1867. begin
  1868. Drive := GetDriveToNode(Node);
  1869. Result := WatchThreadActive(Drive);
  1870. end; {NodeWatched}
  1871. procedure TDriveView.ChangeInvalid(Sender: TObject; const Directory: string;
  1872. const ErrorStr: string);
  1873. var
  1874. Dir: string;
  1875. begin
  1876. Dir := (Sender as TDiscMonitor).Directories[0];
  1877. with GetDriveStatus(DriveInfo.GetDriveKey(Dir)) do
  1878. begin
  1879. DiscMonitor.Close;
  1880. end;
  1881. end; {DirWatchChangeInvalid}
  1882. procedure TDriveView.ChangeDetected(Sender: TObject; const Directory: string;
  1883. var SubdirsChanged: Boolean);
  1884. var
  1885. DirChanged: string;
  1886. begin
  1887. if Sender is TDiscMonitor then
  1888. begin
  1889. DirChanged := (Sender as TDiscMonitor).Directories[0];
  1890. if Length(DirChanged) > 0 then
  1891. begin
  1892. with GetDriveStatus(DriveInfo.GetDriveKey(DirChanged)) do
  1893. begin
  1894. ChangeTimer.Interval := 0;
  1895. ChangeTimer.Interval := FChangeInterval;
  1896. ChangeTimer.Enabled := True;
  1897. end;
  1898. end;
  1899. end;
  1900. end; {DirWatchChangeDetected}
  1901. procedure TDriveView.ChangeTimerOnTimer(Sender: TObject);
  1902. var
  1903. DriveStatus: TDriveStatus;
  1904. begin
  1905. if (FChangeTimerSuspended = 0) and (Sender is TTimer) then
  1906. begin
  1907. for DriveStatus in FDriveStatus.Values do
  1908. begin
  1909. if DriveStatus.ChangeTimer = Sender then
  1910. begin
  1911. with DriveStatus.ChangeTimer do
  1912. begin
  1913. Interval := 0;
  1914. Enabled := False;
  1915. end;
  1916. if Assigned(DriveStatus.RootNode) then
  1917. begin
  1918. {Check also collapsed (invisible) subdirectories:}
  1919. ValidateDirectory(DriveStatus.RootNode);
  1920. end;
  1921. end;
  1922. end;
  1923. end;
  1924. end; {ChangeTimerOnTimer}
  1925. procedure TDriveView.StartWatchThread;
  1926. var
  1927. Drive: string;
  1928. begin
  1929. if (csDesigning in ComponentState) or
  1930. not Assigned(Selected) or
  1931. not fWatchDirectory then Exit;
  1932. Drive := GetDriveToNode(Selected);
  1933. with GetDriveStatus(Drive) do
  1934. begin
  1935. if not Assigned(DiscMonitor) then
  1936. CreateWatchThread(Drive);
  1937. if Assigned(DiscMonitor) and not DiscMonitor.Enabled then
  1938. DiscMonitor.Enabled := True;
  1939. end;
  1940. end; {StartWatchThread}
  1941. procedure TDriveView.StopWatchThread;
  1942. begin
  1943. if Assigned(Selected) then
  1944. with GetDriveStatus(GetDriveToNode(Selected)) do
  1945. if Assigned(DiscMonitor) then
  1946. DiscMonitor.Enabled := False;
  1947. end; {StopWatchThread}
  1948. procedure TDriveView.SuspendChangeTimer;
  1949. begin
  1950. Inc(FChangeTimerSuspended);
  1951. end;
  1952. procedure TDriveView.ResumeChangeTimer;
  1953. begin
  1954. Assert(FChangeTimerSuspended > 0);
  1955. Dec(FChangeTimerSuspended);
  1956. end;
  1957. procedure TDriveView.TerminateWatchThread(Drive: string);
  1958. begin
  1959. with GetDriveStatus(Drive) do
  1960. if Assigned(DiscMonitor) then
  1961. begin
  1962. DiscMonitor.Free;
  1963. DiscMonitor := nil;
  1964. end;
  1965. end; {StopWatchThread}
  1966. procedure TDriveView.StartAllWatchThreads;
  1967. var
  1968. DriveStatusPair: TPair<string, TDriveStatus>;
  1969. Drive: string;
  1970. begin
  1971. if (csDesigning in ComponentState) or (not FWatchDirectory) then
  1972. Exit;
  1973. for DriveStatusPair in FDriveStatus do
  1974. with DriveStatusPair.Value do
  1975. if Scanned then
  1976. begin
  1977. if not Assigned(DiscMonitor) then
  1978. CreateWatchThread(DriveStatusPair.Key);
  1979. if Assigned(DiscMonitor) and (not DiscMonitor.Active) then
  1980. DiscMonitor.Open;
  1981. end;
  1982. if Assigned(Selected) then
  1983. begin
  1984. Drive := GetDriveToNode(Selected);
  1985. if not DriveInfo.IsFixedDrive(Drive) then
  1986. begin
  1987. StartWatchThread;
  1988. end;
  1989. end;
  1990. end; {StartAllWatchThreads}
  1991. procedure TDriveView.StopAllWatchThreads;
  1992. var
  1993. DriveStatusPair: TPair<string, TDriveStatus>;
  1994. begin
  1995. if (csDesigning in ComponentState) or (not FWatchDirectory) then
  1996. Exit;
  1997. for DriveStatusPair in FDriveStatus do
  1998. with DriveStatusPair.Value do
  1999. begin
  2000. if Assigned(DiscMonitor) then
  2001. DiscMonitor.Close;
  2002. end;
  2003. end; {StopAllWatchThreads}
  2004. function TDriveView.WatchThreadActive(Drive: string): Boolean;
  2005. begin
  2006. Result := FWatchDirectory and
  2007. Assigned(GetDriveStatus(Drive).DiscMonitor) and
  2008. GetDriveStatus(Drive).DiscMonitor.Active and
  2009. GetDriveStatus(Drive).DiscMonitor.Enabled;
  2010. end; {WatchThreadActive}
  2011. function TDriveView.WatchThreadActive: Boolean;
  2012. var
  2013. Drive: string;
  2014. begin
  2015. if not Assigned(Selected) then
  2016. begin
  2017. Result := False;
  2018. Exit;
  2019. end;
  2020. Drive := GetDriveToNode(Selected);
  2021. Result := WatchThreadActive(Drive);
  2022. end; {WatchThreadActive}
  2023. procedure TDriveView.SetFullDriveScan(DoFullDriveScan: Boolean);
  2024. begin
  2025. FFullDriveScan := DoFullDriveScan;
  2026. end; {SetAutoScan}
  2027. function TDriveView.FindPathNode(Path: string): TTreeNode;
  2028. begin
  2029. {Find existing path or parent path of not existing path:}
  2030. repeat
  2031. Result := FindNodeToPath(Path);
  2032. if not Assigned(Result) then
  2033. Path := ExtractFilePath(ExcludeTrailingBackslash(Path));
  2034. until Assigned(Result) or (Length(Path) < 3);
  2035. end;
  2036. procedure TDriveView.SetDirectory(Value: string);
  2037. begin
  2038. Value := IncludeTrailingBackslash(Value);
  2039. FDirectory := Value;
  2040. inherited;
  2041. if Assigned(Selected) and (Selected.Level = 0) then
  2042. begin
  2043. if not GetDriveStatus(GetDriveToNode(Selected)).Scanned then
  2044. ScanDrive(GetDriveToNode(Selected));
  2045. end;
  2046. end; {SetDirectory}
  2047. function TDriveView.GetDirName(Node: TTreeNode): string;
  2048. begin
  2049. if Assigned(Node) and Assigned(Node.Data) then
  2050. Result := TNodeData(Node.Data).DirName
  2051. else
  2052. Result := '';
  2053. end; {GetDirName}
  2054. {GetDrive: returns the drive of the Node.}
  2055. function TDriveView.GetDriveToNode(Node: TTreeNode): string;
  2056. var
  2057. Path: string;
  2058. begin
  2059. if (not Assigned (Node)) or (not Assigned(Node.Data)) then
  2060. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDrive']));
  2061. Path := NodePath(Node);
  2062. Result := DriveInfo.GetDriveKey(Path);
  2063. end; {GetDrive}
  2064. {RootNode: returns the rootnode to the Node:}
  2065. function TDriveView.RootNode(Node: TTreeNode): TTreeNode;
  2066. begin
  2067. Result := Node;
  2068. if not Assigned(Node) then
  2069. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['RootNode']));
  2070. while Assigned(Result.Parent) do
  2071. Result := Result.Parent;
  2072. end; {RootNode}
  2073. function TDriveView.GetDisplayName(Node: TTreeNode): string;
  2074. begin
  2075. Result := '';
  2076. if (not Assigned(Node)) or (not Assigned(Node.Data)) then
  2077. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDisplayName']));
  2078. if Node.Level = 0 then Result := GetDriveText(GetDriveToNode(Node))
  2079. else
  2080. begin
  2081. Result := GetDirName(Node);
  2082. end;
  2083. end; {GetDisplayName}
  2084. procedure TDriveView.SetShowVolLabel(ShowIt: Boolean);
  2085. begin
  2086. if ShowIt = FShowVolLabel then
  2087. Exit;
  2088. FShowVolLabel := ShowIt;
  2089. RefreshRootNodes(dvdsFloppy);
  2090. end; {SetShowVolLabel}
  2091. procedure TDriveView.DisplayContextMenu(Node: TTreeNode; Point: TPoint);
  2092. var
  2093. Verb: string;
  2094. DirWatched: Boolean;
  2095. begin
  2096. DirWatched := NodeWatched(Node) and WatchThreadActive;
  2097. Assert(Node <> nil);
  2098. if Node <> Selected then
  2099. DropTarget := Node;
  2100. Verb := EmptyStr;
  2101. if Assigned(FOnDisplayContextMenu) then
  2102. FOnDisplayContextMenu(Self);
  2103. ShellDisplayContextMenu(FParentForm.Handle, Point, NodePathName(Node),
  2104. CanEdit(Node), Verb, False);
  2105. if Verb = shcRename then Node.EditText
  2106. else
  2107. if Verb = shcCut then
  2108. begin
  2109. LastClipBoardOperation := cboCut;
  2110. LastPathCut := NodePathName(Node);
  2111. end
  2112. else
  2113. if Verb = shcCopy then LastClipBoardOperation := cboCopy
  2114. else
  2115. if Verb = shcPaste then
  2116. PasteFromClipBoard(NodePathName(Node));
  2117. DropTarget := nil;
  2118. if not DirWatched then
  2119. ValidateDirectory(Node);
  2120. end; {DisplayContextMenu (2)}
  2121. procedure TDriveView.DisplayPropertiesMenu(Node: TTreeNode);
  2122. begin
  2123. Assert(Assigned(Node));
  2124. ShellExecuteContextCommand(FParentForm.Handle, shcProperties, NodePathName(Node));
  2125. end; {ContextMenu}
  2126. procedure TDriveView.SetSelected(Node: TTreeNode);
  2127. begin
  2128. if Node <> Selected then
  2129. begin
  2130. FChangeFlag := False;
  2131. FCanChange := True;
  2132. inherited Selected := Node;
  2133. if not FChangeFlag then
  2134. Change(Selected);
  2135. end;
  2136. end; {SetSelected}
  2137. {Called by TFileDeleteThread, when a file deletion was detected by the D&D receiving application:}
  2138. procedure TDriveView.SignalDirDelete(Sender: TObject; Files: TStringList);
  2139. begin
  2140. if Files.Count > 0 then
  2141. ValidateDirectory(FindNodeToPath(Files[0]));
  2142. end; {SignalDirDelete}
  2143. function TDriveView.DDSourceEffects: TDropEffectSet;
  2144. begin
  2145. if FDragNode.Level = 0 then
  2146. Result := [deLink]
  2147. else
  2148. Result := [deLink, deCopy, deMove];
  2149. end;
  2150. procedure TDriveView.DDChooseEffect(KeyState: Integer; var Effect: Integer; PreferredEffect: Integer);
  2151. begin
  2152. if DropTarget = nil then Effect := DROPEFFECT_NONE
  2153. else
  2154. if (KeyState and (MK_CONTROL or MK_SHIFT) = 0) and (PreferredEffect = 0) then
  2155. begin
  2156. if FDragDrive <> '' then
  2157. begin
  2158. if FExeDrag and DriveInfo.IsFixedDrive(GetDriveToNode(DropTarget)) and DriveInfo.IsFixedDrive(FDragDrive) then
  2159. begin
  2160. Effect := DROPEFFECT_LINK;
  2161. end
  2162. else
  2163. if (Effect = DROPEFFECT_COPY) and
  2164. (SameText(FDragDrive, GetDriveToNode(DropTarget)) and
  2165. (FDragDropFilesEx.AvailableDropEffects and DROPEFFECT_MOVE <> 0)) then
  2166. begin
  2167. Effect := DROPEFFECT_MOVE;
  2168. end;
  2169. end;
  2170. end;
  2171. inherited;
  2172. end;
  2173. function TDriveView.DragCompleteFileList: Boolean;
  2174. begin
  2175. Result := (GetDriveTypeToNode(FDragNode) <> DRIVE_REMOVABLE);
  2176. end;
  2177. function TDriveView.DDExecute: TDragResult;
  2178. var
  2179. WatchThreadOK: Boolean;
  2180. DragParentPath: string;
  2181. DragPath: string;
  2182. begin
  2183. WatchThreadOK := WatchThreadActive;
  2184. Result := FDragDropFilesEx.Execute(nil);
  2185. if (Result = drMove) and (not WatchThreadOK) then
  2186. begin
  2187. DragPath := NodePathName(FDragNode);
  2188. if Assigned(FDragNode.Parent) then
  2189. DragParentPath := NodePathName(FDragNode.Parent)
  2190. else
  2191. DragParentPath := DragPath;
  2192. if (FDragNode.Level > 0) or (DragParentPath <> NodePathName(Selected.Parent)) then
  2193. begin
  2194. FDragNode := FindNodeToPath(DragPath);
  2195. if Assigned(FDragNode) then
  2196. begin
  2197. FDragFileList.Clear;
  2198. FDragFileList.Add(DragPath);
  2199. TFileDeleteThread.Create(FDragFileList, MaxWaitTimeOut, SignalDirDelete);
  2200. end;
  2201. end;
  2202. end;
  2203. end;
  2204. procedure TDriveView.PerformDragDropFileOperation(Node: TTreeNode; Effect: Integer);
  2205. var
  2206. Index: Integer;
  2207. SourcePath: string;
  2208. SourceParentPath: string;
  2209. SourceIsDirectory: Boolean;
  2210. SaveCursor: TCursor;
  2211. TargetNode: TTreeNode;
  2212. TargetPath: string;
  2213. IsRecycleBin: Boolean;
  2214. begin
  2215. TargetPath := NodePathName(Node);
  2216. IsRecycleBin := NodeIsRecycleBin(Node);
  2217. if FDragDropFilesEx.FileList.Count = 0 then
  2218. Exit;
  2219. SaveCursor := Screen.Cursor;
  2220. Screen.Cursor := crHourGlass;
  2221. SourcePath := EmptyStr;
  2222. try
  2223. if (Effect = DROPEFFECT_COPY) or (Effect = DROPEFFECT_MOVE) then
  2224. begin
  2225. StopAllWatchThreads;
  2226. if Assigned(FDirView) then
  2227. FDirView.StopWatchThread;
  2228. if Assigned(DropSourceControl) and
  2229. (DropSourceControl is TDirView) and
  2230. (DropSourceControl <> FDirView) then
  2231. begin
  2232. TDirView(DropSourceControl).StopWatchThread;
  2233. end;
  2234. if DropFiles(
  2235. DragDropFilesEx, Effect, FFileOperator, TargetPath, false, IsRecycleBin, ConfirmDelete, ConfirmOverwrite, False,
  2236. Self, OnDDFileOperation, SourcePath, SourceIsDirectory) then
  2237. begin
  2238. if Assigned(FOnDDFileOperationExecuted) then
  2239. FOnDDFileOperationExecuted(Self, Effect, SourcePath, TargetPath);
  2240. end;
  2241. ClearDragFileList(FDragDropFilesEx.FileList);
  2242. SourceParentPath := ExtractFilePath(ExcludeTrailingBackslash(SourcePath));
  2243. end
  2244. else
  2245. if Effect = DROPEFFECT_LINK then
  2246. { Create Link requested: }
  2247. begin
  2248. for Index := 0 to FDragDropFilesEx.FileList.Count - 1 do
  2249. begin
  2250. if not DropLink(PFDDListItem(FDragDropFilesEx.FileList[Index]), TargetPath) then
  2251. begin
  2252. DDError(DDCreateShortCutError);
  2253. end;
  2254. end;
  2255. end;
  2256. if Effect = DROPEFFECT_MOVE then
  2257. Items.BeginUpdate;
  2258. {Update source directory, if move-operation was performed:}
  2259. if ((Effect = DROPEFFECT_MOVE) or IsRecycleBin) then
  2260. begin
  2261. ValidateDirectory(FindNodeToPath(SourceParentPath));
  2262. end;
  2263. {Update subdirectories of target directory:}
  2264. TargetNode := FindNodeToPath(TargetPath);
  2265. if Assigned(TargetNode) then
  2266. ValidateDirectory(TargetNode)
  2267. else
  2268. ValidateDirectory(GetDriveStatus(DriveInfo.GetDriveKey(TargetPath)).RootNode);
  2269. if Effect = DROPEFFECT_MOVE then
  2270. Items.EndUpdate;
  2271. {Update linked component TDirView:}
  2272. if Assigned(FDirView) and (not FDirView.WatchThreadActive) then
  2273. begin
  2274. case Effect of
  2275. DROPEFFECT_COPY,
  2276. DROPEFFECT_LINK:
  2277. if (IncludeTrailingBackslash(TargetPath) = IncludeTrailingBackslash(DirView.Path)) then
  2278. FDirView.Reload2;
  2279. DROPEFFECT_MOVE:
  2280. if (IncludeTrailingBackslash(TargetPath) = IncludeTrailingBackslash(DirView.Path)) or
  2281. (IncludeTrailingBackslash(SourceParentPath) = IncludeTrailingBackslash(DirView.Path)) then
  2282. begin
  2283. if FDirView <> DropSourceControl then FDirView.Reload2;
  2284. end;
  2285. end; {Case}
  2286. end;
  2287. {Update the DropSource control, if files are moved and it is a TDirView:}
  2288. if (Effect = DROPEFFECT_MOVE) and (DropSourceControl is TDirView) then
  2289. begin
  2290. TDirView(DropSourceControl).ValidateSelectedFiles;
  2291. end;
  2292. finally
  2293. FFileOperator.OperandFrom.Clear;
  2294. FFileOperator.OperandTo.Clear;
  2295. StartAllWatchThreads;
  2296. if Assigned(FDirView) and (not FDirView.WatchThreadActive) then
  2297. FDirView.StartWatchThread;
  2298. if Assigned(DropSourceControl) and (DropSourceControl is TDirView) and
  2299. (not TDirView(DropSourceControl).WatchThreadActive) then
  2300. TDirView(DropSourceControl).StartWatchThread;
  2301. Screen.Cursor := SaveCursor;
  2302. end;
  2303. end; {PerformDragDropFileOperation}
  2304. function TDriveView.GetCanUndoCopyMove: Boolean;
  2305. begin
  2306. Result := Assigned(FFileOperator) and FFileOperator.CanUndo;
  2307. end; {CanUndoCopyMove}
  2308. function TDriveView.UndoCopyMove: Boolean;
  2309. var
  2310. LastTarget: string;
  2311. LastSource: string;
  2312. begin
  2313. Result := False;
  2314. if FFileOperator.CanUndo then
  2315. begin
  2316. Lasttarget := FFileOperator.LastOperandTo[0];
  2317. LastSource := FFileOperator.LastOperandFrom[0];
  2318. StopAllWatchThreads;
  2319. Result := FFileOperator.UndoExecute;
  2320. ValidateDirectory(FindNodeToPath(ExtractFilePath(LastTarget)));
  2321. ValidateDirectory(FindNodeToPath(ExtractFilePath(LastSource)));
  2322. StartAllWatchThreads;
  2323. if Assigned(FDirView) then
  2324. with FDirView do
  2325. if not WatchThreadActive then
  2326. begin
  2327. if (IncludeTrailingBackslash(ExtractFilePath(LastTarget)) = IncludeTrailingBackslash(Path)) or
  2328. (IncludeTrailingBackslash(ExtractFilePath(LastSource)) = IncludeTrailingBackslash(Path)) then
  2329. Reload2;
  2330. end;
  2331. end;
  2332. end; {UndoCopyMove}
  2333. {Clipboard operations:}
  2334. procedure TDriveView.SetLastPathCut(Path: string);
  2335. var
  2336. Node: TTreeNode;
  2337. begin
  2338. if FLastPathCut <> Path then
  2339. begin
  2340. Node := FindNodeToPath(FLastPathCut);
  2341. if Assigned(Node) then
  2342. begin
  2343. FLastPathCut := Path;
  2344. Node.Cut := False;
  2345. end;
  2346. Node := FindNodeToPath(Path);
  2347. if Assigned(Node) then
  2348. begin
  2349. FLastPathCut := Path;
  2350. Node.Cut := True;
  2351. end;
  2352. end;
  2353. end; {SetLastNodeCut}
  2354. procedure TDriveView.EmptyClipboard;
  2355. begin
  2356. if Windows.OpenClipBoard(0) then
  2357. begin
  2358. Windows.EmptyClipBoard;
  2359. Windows.CloseClipBoard;
  2360. LastPathCut := '';
  2361. LastClipBoardOperation := cboNone;
  2362. if Assigned(FDirView) then
  2363. FDirView.EmptyClipboard;
  2364. end;
  2365. end; {EmptyClipBoard}
  2366. function TDriveView.CopyToClipBoard(Node: TTreeNode): Boolean;
  2367. begin
  2368. Result := Assigned(Selected);
  2369. if Result then
  2370. begin
  2371. EmptyClipBoard;
  2372. ClearDragFileList(FDragDropFilesEx.FileList);
  2373. AddToDragFileList(FDragDropFilesEx.FileList, Selected);
  2374. Result := FDragDropFilesEx.CopyToClipBoard;
  2375. LastClipBoardOperation := cboCopy;
  2376. end;
  2377. end; {CopyToClipBoard}
  2378. function TDriveView.CutToClipBoard(Node: TTreeNode): Boolean;
  2379. begin
  2380. Result := Assigned(Node) and (Node.Level > 0) and CopyToClipBoard(Node);
  2381. if Result then
  2382. begin
  2383. LastPathCut := NodePathName(Node);
  2384. LastClipBoardOperation := cboCut;
  2385. end;
  2386. end; {CutToClipBoard}
  2387. function TDriveView.CanPasteFromClipBoard: Boolean;
  2388. begin
  2389. Result := False;
  2390. if Assigned(Selected) and Windows.OpenClipboard(0) then
  2391. begin
  2392. Result := IsClipboardFormatAvailable(CF_HDROP);
  2393. Windows.CloseClipBoard;
  2394. end;
  2395. end; {CanPasteFromClipBoard}
  2396. function TDriveView.PasteFromClipBoard(TargetPath: String = ''): Boolean;
  2397. begin
  2398. ClearDragFileList(FDragDropFilesEx.FileList);
  2399. Result := False;
  2400. if CanPasteFromClipBoard and {MP}FDragDropFilesEx.GetFromClipBoard{/MP}
  2401. then
  2402. begin
  2403. if TargetPath = '' then
  2404. TargetPath := NodePathName(Selected);
  2405. case LastClipBoardOperation of
  2406. cboCopy,
  2407. cboNone:
  2408. begin
  2409. PerformDragDropFileOperation(Selected, DROPEFFECT_COPY);
  2410. if Assigned(FOnDDExecuted) then
  2411. FOnDDExecuted(Self, DROPEFFECT_COPY);
  2412. end;
  2413. cboCut:
  2414. begin
  2415. PerformDragDropFileOperation(Selected, DROPEFFECT_MOVE);
  2416. if Assigned(FOnDDExecuted) then
  2417. FOnDDExecuted(Self, DROPEFFECT_MOVE);
  2418. EmptyClipBoard;
  2419. end;
  2420. end;
  2421. Result := True;
  2422. end;
  2423. end; {PasteFromClipBoard}
  2424. end.