DriveView.pas 77 KB

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