DriveView.pas 78 KB

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