DriveView.pas 75 KB

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