DriveView.pas 78 KB

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