DriveView.pas 78 KB

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