DriveView.pas 77 KB

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