DriveView.pas 75 KB

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