DriveView.pas 75 KB

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