DriveView.pas 78 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760
  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. type
  1542. PSearchRec = ^TSearchRec;
  1543. var
  1544. WorkNode: TTreeNode;
  1545. DelNode: TTreeNode;
  1546. NewNode: TTreeNode;
  1547. SRec: TSearchRec;
  1548. SrecList: TStringList;
  1549. SubDirList: TStringList;
  1550. DosError: Integer;
  1551. Index: Integer;
  1552. NewDirFound: Boolean;
  1553. ParentDir: string;
  1554. NodeData: TNodeData;
  1555. ScanDirInfo: PScanDirInfo;
  1556. begin {CallBackValidateDir}
  1557. Result := True;
  1558. if (not Assigned(Node)) or (not Assigned(Node.Data)) then
  1559. Exit;
  1560. NewDirFound := False;
  1561. ScanDirInfo := PScanDirInfo(Data);
  1562. {Check, if directory still exists: (but not with root directory) }
  1563. if Assigned(Node.Parent) and (ScanDirInfo^.StartNode = Node) then
  1564. if not DirectoryExists(NodePathName(Node)) then
  1565. begin
  1566. WorkNode := Node.Parent;
  1567. if Selected = Node then
  1568. Selected := WorkNode;
  1569. if DropTarget = Node then
  1570. DropTarget := nil;
  1571. Node.Delete;
  1572. Node := nil;
  1573. Exit;
  1574. end;
  1575. WorkNode := Node.GetFirstChild;
  1576. NodeData := TNodeData(Node.Data);
  1577. if NodeData.Scanned and Assigned(WorkNode) then
  1578. {if node was already scanned: check wether the existing subnodes are still alive
  1579. and add all new subdirectories as subnodes:}
  1580. begin
  1581. if DoScanDir(Node) then
  1582. begin
  1583. ParentDir := IncludeTrailingBackslash(NodePath(Node));
  1584. {Build list of existing subnodes:}
  1585. SubDirList := TStringList.Create;
  1586. while Assigned(WorkNode) do
  1587. begin
  1588. SubDirList.Add(TNodeData(WorkNode.Data).DirName);
  1589. WorkNode := Node.GetNextChild(WorkNode);
  1590. end;
  1591. {Sorting not required, because the subnodes are already sorted!}
  1592. SRecList := TStringList.Create;
  1593. DosError := FindFirst(ApiPath(ParentDir + '*.*'), DirAttrMask, SRec);
  1594. while DosError = 0 do
  1595. begin
  1596. if (Srec.Name <> '.' ) and
  1597. (Srec.Name <> '..') and
  1598. (Srec.Attr and faDirectory <> 0) then
  1599. begin
  1600. SrecList.Add(Srec.Name);
  1601. if not SubDirList.Find(Srec.Name, Index) then
  1602. {Subnode does not exists: add it:}
  1603. begin
  1604. NewNode := AddChildNode(Node, SRec);
  1605. NewNode.HasChildren := CheckForSubDirs(ParentDir + Srec.Name);
  1606. TNodeData(NewNode.Data).Scanned := Not NewNode.HasChildren;
  1607. NewDirFound := True;
  1608. end;
  1609. end;
  1610. DosError := FindNext(Srec);
  1611. end;
  1612. FindClose(Srec);
  1613. Sreclist.Sort;
  1614. {Remove not existing subnodes:}
  1615. WorkNode := Node.GetFirstChild;
  1616. while Assigned(WorkNode) do
  1617. begin
  1618. if not Assigned(WorkNode.Data) or
  1619. not SrecList.Find(TNodeData(WorkNode.Data).DirName, Index) then
  1620. begin
  1621. DelNode := WorkNode;
  1622. WorkNode := Node.GetNextChild(WorkNode);
  1623. DelNode.Delete;
  1624. end
  1625. else
  1626. begin
  1627. if (SrecList[Index] <> TNodeData(WorkNode.Data).DirName) then
  1628. begin
  1629. {Case of directory letters has changed:}
  1630. TNodeData(WorkNode.Data).DirName := SrecList[Index];
  1631. TNodeData(WorkNode.Data).ShortName := ExtractShortPathName(NodePathName(WorkNode));
  1632. WorkNode.Text := SrecList[Index];
  1633. end;
  1634. SrecList.Delete(Index);
  1635. WorkNode := Node.GetNextChild(WorkNode);
  1636. end;
  1637. end;
  1638. SrecList.Free;
  1639. SubDirList.Free;
  1640. {Sort subnodes:}
  1641. if NewDirFound then
  1642. SortChildren(Node, False);
  1643. end;
  1644. end
  1645. else
  1646. {Node was not already scanned:}
  1647. if (ScanDirInfo^.SearchNewDirs or
  1648. NodeData.Scanned or
  1649. (Node = ScanDirInfo^.StartNode)) and
  1650. DoScanDir(Node) then
  1651. begin
  1652. ReadSubDirs(Node, ScanDirInfo^.DriveType);
  1653. end;
  1654. end; {CallBackValidateDir}
  1655. procedure TDriveView.RebuildTree;
  1656. var
  1657. Drive: string;
  1658. begin
  1659. for Drive in FDriveStatus.Keys do
  1660. with GetDriveStatus(Drive) do
  1661. if Assigned(RootNode) and Scanned then
  1662. ValidateDirectory(RootNode);
  1663. end;
  1664. procedure TDriveView.ValidateCurrentDirectoryIfNotMonitoring;
  1665. begin
  1666. if Assigned(Selected) and
  1667. not Assigned(GetDriveStatus(GetDriveToNode(Selected)).DiscMonitor) then
  1668. begin
  1669. ValidateDirectory(Selected);
  1670. end;
  1671. end;
  1672. procedure TDriveView.ValidateDirectoryEx(Node: TTreeNode; Recurse: TRecursiveScan;
  1673. NewDirs: Boolean);
  1674. var
  1675. Info: PScanDirInfo;
  1676. SelDir: string;
  1677. SaveCursor: TCursor;
  1678. RestartWatchThread: Boolean;
  1679. SaveCanChange: Boolean;
  1680. CurrentPath: string;
  1681. Drive: string;
  1682. begin
  1683. if Assigned(Node) and Assigned(Node.Data) and
  1684. (not FValidateFlag) and DoScanDir(Node) then
  1685. begin
  1686. SelDir := Directory;
  1687. SaveCursor := Screen.Cursor;
  1688. if Self.Focused and (Screen.Cursor <> crHourGlass) then
  1689. Screen.Cursor := crHourGlass;
  1690. CurrentPath := NodePath(Node);
  1691. Drive := DriveInfo.GetDriveKey(CurrentPath);
  1692. if Node.Level = 0 then
  1693. GetDriveStatus(Drive).ChangeTimer.Enabled := False;
  1694. RestartWatchThread := WatchThreadActive;
  1695. try
  1696. if WatchThreadActive then
  1697. StopWatchThread;
  1698. FValidateFlag := True;
  1699. New(Info);
  1700. Info^.StartNode := Node;
  1701. Info^.SearchNewDirs := NewDirs;
  1702. Info^.DriveType := DriveInfo.Get(Drive).DriveType;
  1703. SaveCanChange := FCanChange;
  1704. FCanChange := True;
  1705. FChangeFlag := False;
  1706. IterateSubTree(Node, CallBackValidateDir, Recurse, coScanStartNode, Info);
  1707. FValidateFlag := False;
  1708. if (not Assigned(Selected)) and (Length(SelDir) > 0) then
  1709. Directory := ExtractFileDrive(SelDir);
  1710. if (SelDir <> Directory) and (not FChangeFlag) then
  1711. Change(Selected);
  1712. FCanChange := SaveCanChange;
  1713. Dispose(Info);
  1714. finally
  1715. if RestartWatchThread and FWatchDirectory and not WatchThreadActive then
  1716. StartWatchThread;
  1717. if Screen.Cursor <> SaveCursor then
  1718. Screen.Cursor := SaveCursor;
  1719. end;
  1720. end;
  1721. end; {ValidateDirectoryEx}
  1722. function TDriveView.GetDriveTypeToNode(Node: TTreeNode): Integer;
  1723. begin
  1724. Assert(Assigned(Node));
  1725. Result := DriveInfo.Get(GetDriveToNode(Node)).DriveType;
  1726. end; {GetDriveTypeToNode}
  1727. function TDriveView.CreateDirectory(ParentNode: TTreeNode; NewName: string): TTreeNode;
  1728. var
  1729. SRec: TSearchRec;
  1730. begin
  1731. Assert(Assigned(ParentNode));
  1732. Result := nil;
  1733. if not TNodeData(ParentNode.Data).Scanned then
  1734. ValidateDirectory(ParentNode);
  1735. StopWatchThread;
  1736. try
  1737. if Assigned(FDirView) then
  1738. FDirView.StopWatchThread;
  1739. {create phyical directory:}
  1740. LastIOResult := 0;
  1741. if not Windows.CreateDirectory(PChar(NodePath(ParentNode) + '\' + NewName), nil) then
  1742. LastIOResult := GetLastError;
  1743. if LastIOResult = 0 then
  1744. begin
  1745. {Create treenode:}
  1746. FindFirst(ApiPath(NodePath(ParentNode) + '\' + NewName), faAnyFile, SRec);
  1747. Result := AddChildNode(ParentNode, Srec);
  1748. FindClose(Srec);
  1749. TNodeData(Result.Data).Scanned := True;
  1750. SortChildren(ParentNode, False);
  1751. ParentNode.Expand(False);
  1752. end;
  1753. finally
  1754. StartWatchThread;
  1755. if Assigned(FDirView) then
  1756. begin
  1757. FDirView.StartWatchThread;
  1758. FDirView.Reload2;
  1759. end;
  1760. end;
  1761. end; {CreateDirectory}
  1762. function TDriveView.DeleteDirectory(Node: TTreeNode; AllowUndo: Boolean): Boolean;
  1763. var
  1764. DelDir: string;
  1765. OperatorResult: Boolean;
  1766. FileOperator: TFileOperator;
  1767. SaveCursor: TCursor;
  1768. begin
  1769. Assert(Assigned(Node));
  1770. Result := False;
  1771. if Assigned(Node) and (Node.Level > 0) then
  1772. begin
  1773. SaveCursor := Screen.Cursor;
  1774. Screen.Cursor := crHourGlass;
  1775. FileOperator := TFileOperator.Create(Self);
  1776. DelDir := NodePathName(Node);
  1777. FileOperator.OperandFrom.Add(DelDir);
  1778. FileOperator.Operation := foDelete;
  1779. if AllowUndo then
  1780. FileOperator.Flags := FileOperator.Flags + [foAllowUndo]
  1781. else
  1782. FileOperator.Flags := FileOperator.Flags - [foAllowUndo];
  1783. if not ConfirmDelete then
  1784. FileOperator.Flags := FileOperator.Flags + [foNoConfirmation];
  1785. try
  1786. if DirectoryExists(DelDir) then
  1787. begin
  1788. StopWatchThread;
  1789. OperatorResult := FileOperator.Execute;
  1790. if OperatorResult and (not FileOperator.OperationAborted) and
  1791. (not DirectoryExists(DelDir)) then
  1792. begin
  1793. Node.Delete
  1794. end
  1795. else
  1796. begin
  1797. Result := False;
  1798. if not AllowUndo then
  1799. begin
  1800. {WinNT4-Bug: FindFirst still returns the directories search record, even if the
  1801. directory was deleted:}
  1802. ChDir(DelDir);
  1803. if IOResult <> 0 then
  1804. Node.Delete;
  1805. end;
  1806. end;
  1807. end
  1808. else
  1809. begin
  1810. Node.Delete;
  1811. Result := True;
  1812. end;
  1813. finally
  1814. StartWatchThread;
  1815. if Assigned(DirView) and Assigned(Selected) then
  1816. DirView.Path := NodePathName(Selected);
  1817. FileOperator.Free;
  1818. Screen.Cursor := SaveCursor;
  1819. end;
  1820. end;
  1821. end; {DeleteDirectory}
  1822. procedure TDriveView.CreateWatchThread(Drive: string);
  1823. begin
  1824. if csDesigning in ComponentState then
  1825. Exit;
  1826. if (not Assigned(GetDriveStatus(Drive).DiscMonitor)) and
  1827. FWatchDirectory and
  1828. (DriveInfo.Get(Drive).DriveType <> DRIVE_REMOTE) then
  1829. begin
  1830. with GetDriveStatus(Drive) do
  1831. begin
  1832. DiscMonitor := TDiscMonitor.Create(Self);
  1833. DiscMonitor.ChangeDelay := msThreadChangeDelay;
  1834. DiscMonitor.SubTree := True;
  1835. DiscMonitor.Filters := [moDirName];
  1836. DiscMonitor.OnChange := ChangeDetected;
  1837. DiscMonitor.OnInvalid := ChangeInvalid;
  1838. DiscMonitor.SetDirectory(DriveInfo.GetDriveRoot(Drive));
  1839. DiscMonitor.Open;
  1840. end;
  1841. end;
  1842. end; {CreateWatchThread}
  1843. procedure TDriveView.SetWatchDirectory(Value: Boolean);
  1844. begin
  1845. if FWatchDirectory <> Value then
  1846. begin
  1847. FWatchDirectory := Value;
  1848. if (not (csDesigning in ComponentState)) and Value then
  1849. StartAllWatchThreads
  1850. else
  1851. StopAllWatchThreads;
  1852. end;
  1853. end; {SetAutoScan}
  1854. procedure TDriveView.SetDirView(Value: TDirView);
  1855. begin
  1856. if Assigned(FDirView) then
  1857. FDirView.DriveView := nil;
  1858. FDirView := Value;
  1859. if Assigned(FDirView) then
  1860. FDirView.DriveView := Self;
  1861. end; {SetDirView}
  1862. function TDriveView.NodeWatched(Node: TTreeNode): Boolean;
  1863. var
  1864. Drive: string;
  1865. begin
  1866. Drive := GetDriveToNode(Node);
  1867. Result := WatchThreadActive(Drive);
  1868. end; {NodeWatched}
  1869. procedure TDriveView.ChangeInvalid(Sender: TObject; const Directory: string;
  1870. const ErrorStr: string);
  1871. var
  1872. Dir: string;
  1873. begin
  1874. Dir := (Sender as TDiscMonitor).Directories[0];
  1875. with GetDriveStatus(DriveInfo.GetDriveKey(Dir)) do
  1876. begin
  1877. DiscMonitor.Close;
  1878. end;
  1879. end; {DirWatchChangeInvalid}
  1880. procedure TDriveView.ChangeDetected(Sender: TObject; const Directory: string;
  1881. var SubdirsChanged: Boolean);
  1882. var
  1883. DirChanged: string;
  1884. begin
  1885. if Sender is TDiscMonitor then
  1886. begin
  1887. DirChanged := (Sender as TDiscMonitor).Directories[0];
  1888. if Length(DirChanged) > 0 then
  1889. begin
  1890. with GetDriveStatus(DriveInfo.GetDriveKey(DirChanged)) do
  1891. begin
  1892. ChangeTimer.Interval := 0;
  1893. ChangeTimer.Interval := FChangeInterval;
  1894. ChangeTimer.Enabled := True;
  1895. end;
  1896. end;
  1897. end;
  1898. end; {DirWatchChangeDetected}
  1899. procedure TDriveView.ChangeTimerOnTimer(Sender: TObject);
  1900. var
  1901. DriveStatus: TDriveStatus;
  1902. begin
  1903. if (FChangeTimerSuspended = 0) and (Sender is TTimer) then
  1904. begin
  1905. for DriveStatus in FDriveStatus.Values do
  1906. begin
  1907. if DriveStatus.ChangeTimer = Sender then
  1908. begin
  1909. with DriveStatus.ChangeTimer do
  1910. begin
  1911. Interval := 0;
  1912. Enabled := False;
  1913. end;
  1914. if Assigned(DriveStatus.RootNode) then
  1915. begin
  1916. {Check also collapsed (invisible) subdirectories:}
  1917. ValidateDirectory(DriveStatus.RootNode);
  1918. end;
  1919. end;
  1920. end;
  1921. end;
  1922. end; {ChangeTimerOnTimer}
  1923. procedure TDriveView.StartWatchThread;
  1924. var
  1925. Drive: string;
  1926. begin
  1927. if (csDesigning in ComponentState) or
  1928. not Assigned(Selected) or
  1929. not fWatchDirectory then Exit;
  1930. Drive := GetDriveToNode(Selected);
  1931. with GetDriveStatus(Drive) do
  1932. begin
  1933. if not Assigned(DiscMonitor) then
  1934. CreateWatchThread(Drive);
  1935. if Assigned(DiscMonitor) and not DiscMonitor.Enabled then
  1936. DiscMonitor.Enabled := True;
  1937. end;
  1938. end; {StartWatchThread}
  1939. procedure TDriveView.StopWatchThread;
  1940. begin
  1941. if Assigned(Selected) then
  1942. with GetDriveStatus(GetDriveToNode(Selected)) do
  1943. if Assigned(DiscMonitor) then
  1944. DiscMonitor.Enabled := False;
  1945. end; {StopWatchThread}
  1946. procedure TDriveView.SuspendChangeTimer;
  1947. begin
  1948. Inc(FChangeTimerSuspended);
  1949. end;
  1950. procedure TDriveView.ResumeChangeTimer;
  1951. begin
  1952. Assert(FChangeTimerSuspended > 0);
  1953. Dec(FChangeTimerSuspended);
  1954. end;
  1955. procedure TDriveView.TerminateWatchThread(Drive: string);
  1956. begin
  1957. with GetDriveStatus(Drive) do
  1958. if Assigned(DiscMonitor) then
  1959. begin
  1960. DiscMonitor.Free;
  1961. DiscMonitor := nil;
  1962. end;
  1963. end; {StopWatchThread}
  1964. procedure TDriveView.StartAllWatchThreads;
  1965. var
  1966. DriveStatusPair: TPair<string, TDriveStatus>;
  1967. Drive: string;
  1968. begin
  1969. if (csDesigning in ComponentState) or (not FWatchDirectory) then
  1970. Exit;
  1971. for DriveStatusPair in FDriveStatus do
  1972. with DriveStatusPair.Value do
  1973. if Scanned then
  1974. begin
  1975. if not Assigned(DiscMonitor) then
  1976. CreateWatchThread(DriveStatusPair.Key);
  1977. if Assigned(DiscMonitor) and (not DiscMonitor.Active) then
  1978. DiscMonitor.Open;
  1979. end;
  1980. if Assigned(Selected) then
  1981. begin
  1982. Drive := GetDriveToNode(Selected);
  1983. if not DriveInfo.IsFixedDrive(Drive) then
  1984. begin
  1985. StartWatchThread;
  1986. end;
  1987. end;
  1988. end; {StartAllWatchThreads}
  1989. procedure TDriveView.StopAllWatchThreads;
  1990. var
  1991. DriveStatusPair: TPair<string, TDriveStatus>;
  1992. begin
  1993. if (csDesigning in ComponentState) or (not FWatchDirectory) then
  1994. Exit;
  1995. for DriveStatusPair in FDriveStatus do
  1996. with DriveStatusPair.Value do
  1997. begin
  1998. if Assigned(DiscMonitor) then
  1999. DiscMonitor.Close;
  2000. end;
  2001. end; {StopAllWatchThreads}
  2002. function TDriveView.WatchThreadActive(Drive: string): Boolean;
  2003. begin
  2004. Result := FWatchDirectory and
  2005. Assigned(GetDriveStatus(Drive).DiscMonitor) and
  2006. GetDriveStatus(Drive).DiscMonitor.Active and
  2007. GetDriveStatus(Drive).DiscMonitor.Enabled;
  2008. end; {WatchThreadActive}
  2009. function TDriveView.WatchThreadActive: Boolean;
  2010. var
  2011. Drive: string;
  2012. begin
  2013. if not Assigned(Selected) then
  2014. begin
  2015. Result := False;
  2016. Exit;
  2017. end;
  2018. Drive := GetDriveToNode(Selected);
  2019. Result := WatchThreadActive(Drive);
  2020. end; {WatchThreadActive}
  2021. procedure TDriveView.SetFullDriveScan(DoFullDriveScan: Boolean);
  2022. begin
  2023. FFullDriveScan := DoFullDriveScan;
  2024. end; {SetAutoScan}
  2025. function TDriveView.FindPathNode(Path: string): TTreeNode;
  2026. begin
  2027. {Find existing path or parent path of not existing path:}
  2028. repeat
  2029. Result := FindNodeToPath(Path);
  2030. if not Assigned(Result) then
  2031. Path := ExtractFilePath(ExcludeTrailingBackslash(Path));
  2032. until Assigned(Result) or (Length(Path) < 3);
  2033. end;
  2034. procedure TDriveView.SetDirectory(Value: string);
  2035. begin
  2036. Value := IncludeTrailingBackslash(Value);
  2037. FDirectory := Value;
  2038. inherited;
  2039. if Assigned(Selected) and (Selected.Level = 0) then
  2040. begin
  2041. if not GetDriveStatus(GetDriveToNode(Selected)).Scanned then
  2042. ScanDrive(GetDriveToNode(Selected));
  2043. end;
  2044. end; {SetDirectory}
  2045. function TDriveView.GetDirName(Node: TTreeNode): string;
  2046. begin
  2047. if Assigned(Node) and Assigned(Node.Data) then
  2048. Result := TNodeData(Node.Data).DirName
  2049. else
  2050. Result := '';
  2051. end; {GetDirName}
  2052. {GetDrive: returns the drive of the Node.}
  2053. function TDriveView.GetDriveToNode(Node: TTreeNode): string;
  2054. var
  2055. Path: string;
  2056. begin
  2057. if (not Assigned (Node)) or (not Assigned(Node.Data)) then
  2058. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDrive']));
  2059. Path := NodePath(Node);
  2060. Result := DriveInfo.GetDriveKey(Path);
  2061. end; {GetDrive}
  2062. {RootNode: returns the rootnode to the Node:}
  2063. function TDriveView.RootNode(Node: TTreeNode): TTreeNode;
  2064. begin
  2065. Result := Node;
  2066. if not Assigned(Node) then
  2067. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['RootNode']));
  2068. while Assigned(Result.Parent) do
  2069. Result := Result.Parent;
  2070. end; {RootNode}
  2071. function TDriveView.GetDisplayName(Node: TTreeNode): string;
  2072. begin
  2073. Result := '';
  2074. if (not Assigned(Node)) or (not Assigned(Node.Data)) then
  2075. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDisplayName']));
  2076. if Node.Level = 0 then Result := GetDriveText(GetDriveToNode(Node))
  2077. else
  2078. begin
  2079. Result := GetDirName(Node);
  2080. end;
  2081. end; {GetDisplayName}
  2082. procedure TDriveView.SetShowVolLabel(ShowIt: Boolean);
  2083. begin
  2084. if ShowIt = FShowVolLabel then
  2085. Exit;
  2086. FShowVolLabel := ShowIt;
  2087. RefreshRootNodes(dvdsFloppy);
  2088. end; {SetShowVolLabel}
  2089. procedure TDriveView.DisplayContextMenu(Node: TTreeNode; Point: TPoint);
  2090. var
  2091. Verb: string;
  2092. DirWatched: Boolean;
  2093. begin
  2094. DirWatched := NodeWatched(Node) and WatchThreadActive;
  2095. Assert(Node <> nil);
  2096. if Node <> Selected then
  2097. DropTarget := Node;
  2098. Verb := EmptyStr;
  2099. if Assigned(FOnDisplayContextMenu) then
  2100. FOnDisplayContextMenu(Self);
  2101. ShellDisplayContextMenu(FParentForm.Handle, Point, NodePathName(Node),
  2102. CanEdit(Node), Verb, False);
  2103. if Verb = shcRename then Node.EditText
  2104. else
  2105. if Verb = shcCut then
  2106. begin
  2107. LastClipBoardOperation := cboCut;
  2108. LastPathCut := NodePathName(Node);
  2109. end
  2110. else
  2111. if Verb = shcCopy then LastClipBoardOperation := cboCopy
  2112. else
  2113. if Verb = shcPaste then
  2114. PasteFromClipBoard(NodePathName(Node));
  2115. DropTarget := nil;
  2116. if not DirWatched then
  2117. ValidateDirectory(Node);
  2118. end; {DisplayContextMenu (2)}
  2119. procedure TDriveView.DisplayPropertiesMenu(Node: TTreeNode);
  2120. begin
  2121. Assert(Assigned(Node));
  2122. ShellExecuteContextCommand(FParentForm.Handle, shcProperties, NodePathName(Node));
  2123. end; {ContextMenu}
  2124. procedure TDriveView.SetSelected(Node: TTreeNode);
  2125. begin
  2126. if Node <> Selected then
  2127. begin
  2128. FChangeFlag := False;
  2129. FCanChange := True;
  2130. inherited Selected := Node;
  2131. if not FChangeFlag then
  2132. Change(Selected);
  2133. end;
  2134. end; {SetSelected}
  2135. {Called by TFileDeleteThread, when a file deletion was detected by the D&D receiving application:}
  2136. procedure TDriveView.SignalDirDelete(Sender: TObject; Files: TStringList);
  2137. begin
  2138. if Files.Count > 0 then
  2139. ValidateDirectory(FindNodeToPath(Files[0]));
  2140. end; {SignalDirDelete}
  2141. function TDriveView.DDSourceEffects: TDropEffectSet;
  2142. begin
  2143. if FDragNode.Level = 0 then
  2144. Result := [deLink]
  2145. else
  2146. Result := [deLink, deCopy, deMove];
  2147. end;
  2148. procedure TDriveView.DDChooseEffect(KeyState: Integer; var Effect: Integer);
  2149. begin
  2150. if DropTarget = nil then Effect := DROPEFFECT_NONE
  2151. else
  2152. if (KeyState and (MK_CONTROL or MK_SHIFT) = 0) then
  2153. begin
  2154. if FDragDrive <> '' then
  2155. begin
  2156. if FExeDrag and DriveInfo.IsFixedDrive(GetDriveToNode(DropTarget)) and DriveInfo.IsFixedDrive(FDragDrive) then
  2157. begin
  2158. Effect := DROPEFFECT_LINK;
  2159. end
  2160. else
  2161. if (Effect = DROPEFFECT_COPY) and
  2162. (SameText(FDragDrive, GetDriveToNode(DropTarget)) and
  2163. (FDragDropFilesEx.AvailableDropEffects and DROPEFFECT_MOVE <> 0)) then
  2164. begin
  2165. Effect := DROPEFFECT_MOVE;
  2166. end;
  2167. end;
  2168. end;
  2169. inherited;
  2170. end;
  2171. function TDriveView.DragCompleteFileList: Boolean;
  2172. begin
  2173. Result := (GetDriveTypeToNode(FDragNode) <> DRIVE_REMOVABLE);
  2174. end;
  2175. function TDriveView.DDExecute: TDragResult;
  2176. var
  2177. WatchThreadOK: Boolean;
  2178. DragParentPath: string;
  2179. DragPath: string;
  2180. begin
  2181. WatchThreadOK := WatchThreadActive;
  2182. Result := FDragDropFilesEx.Execute(nil);
  2183. if (Result = drMove) and (not WatchThreadOK) then
  2184. begin
  2185. DragPath := NodePathName(FDragNode);
  2186. if Assigned(FDragNode.Parent) then
  2187. DragParentPath := NodePathName(FDragNode.Parent)
  2188. else
  2189. DragParentPath := DragPath;
  2190. if (FDragNode.Level > 0) or (DragParentPath <> NodePathName(Selected.Parent)) then
  2191. begin
  2192. FDragNode := FindNodeToPath(DragPath);
  2193. if Assigned(FDragNode) then
  2194. begin
  2195. FDragFileList.Clear;
  2196. FDragFileList.Add(DragPath);
  2197. TFileDeleteThread.Create(FDragFileList, MaxWaitTimeOut, SignalDirDelete);
  2198. end;
  2199. end;
  2200. end;
  2201. end;
  2202. procedure TDriveView.PerformDragDropFileOperation(Node: TTreeNode; Effect: Integer);
  2203. var
  2204. Index: Integer;
  2205. SourcePath: string;
  2206. SourceParentPath: string;
  2207. SourceIsDirectory: Boolean;
  2208. SaveCursor: TCursor;
  2209. TargetNode: TTreeNode;
  2210. TargetPath: string;
  2211. IsRecycleBin: Boolean;
  2212. begin
  2213. TargetPath := NodePathName(Node);
  2214. IsRecycleBin := NodeIsRecycleBin(Node);
  2215. if FDragDropFilesEx.FileList.Count = 0 then
  2216. Exit;
  2217. SaveCursor := Screen.Cursor;
  2218. Screen.Cursor := crHourGlass;
  2219. SourcePath := EmptyStr;
  2220. try
  2221. if (Effect = DROPEFFECT_COPY) or (Effect = DROPEFFECT_MOVE) then
  2222. begin
  2223. StopAllWatchThreads;
  2224. if Assigned(FDirView) then
  2225. FDirView.StopWatchThread;
  2226. if Assigned(DropSourceControl) and
  2227. (DropSourceControl is TDirView) and
  2228. (DropSourceControl <> FDirView) then
  2229. begin
  2230. TDirView(DropSourceControl).StopWatchThread;
  2231. end;
  2232. if DropFiles(
  2233. DragDropFilesEx, Effect, FFileOperator, TargetPath, false, IsRecycleBin, ConfirmDelete, ConfirmOverwrite, False,
  2234. Self, OnDDFileOperation, SourcePath, SourceIsDirectory) then
  2235. begin
  2236. if Assigned(FOnDDFileOperationExecuted) then
  2237. FOnDDFileOperationExecuted(Self, Effect, SourcePath, TargetPath);
  2238. end;
  2239. ClearDragFileList(FDragDropFilesEx.FileList);
  2240. SourceParentPath := ExtractFilePath(ExcludeTrailingBackslash(SourcePath));
  2241. end
  2242. else
  2243. if Effect = DROPEFFECT_LINK then
  2244. { Create Link requested: }
  2245. begin
  2246. for Index := 0 to FDragDropFilesEx.FileList.Count - 1 do
  2247. begin
  2248. if not DropLink(PFDDListItem(FDragDropFilesEx.FileList[Index]), TargetPath) then
  2249. begin
  2250. DDError(DDCreateShortCutError);
  2251. end;
  2252. end;
  2253. end;
  2254. if Effect = DROPEFFECT_MOVE then
  2255. Items.BeginUpdate;
  2256. {Update source directory, if move-operation was performed:}
  2257. if ((Effect = DROPEFFECT_MOVE) or IsRecycleBin) then
  2258. begin
  2259. ValidateDirectory(FindNodeToPath(SourceParentPath));
  2260. end;
  2261. {Update subdirectories of target directory:}
  2262. TargetNode := FindNodeToPath(TargetPath);
  2263. if Assigned(TargetNode) then
  2264. ValidateDirectory(TargetNode)
  2265. else
  2266. ValidateDirectory(GetDriveStatus(DriveInfo.GetDriveKey(TargetPath)).RootNode);
  2267. if Effect = DROPEFFECT_MOVE then
  2268. Items.EndUpdate;
  2269. {Update linked component TDirView:}
  2270. if Assigned(FDirView) and (not FDirView.WatchThreadActive) then
  2271. begin
  2272. case Effect of
  2273. DROPEFFECT_COPY,
  2274. DROPEFFECT_LINK:
  2275. if (IncludeTrailingBackslash(TargetPath) = IncludeTrailingBackslash(DirView.Path)) then
  2276. FDirView.Reload2;
  2277. DROPEFFECT_MOVE:
  2278. if (IncludeTrailingBackslash(TargetPath) = IncludeTrailingBackslash(DirView.Path)) or
  2279. (IncludeTrailingBackslash(SourceParentPath) = IncludeTrailingBackslash(DirView.Path)) then
  2280. begin
  2281. if FDirView <> DropSourceControl then FDirView.Reload2;
  2282. end;
  2283. end; {Case}
  2284. end;
  2285. {Update the DropSource control, if files are moved and it is a TDirView:}
  2286. if (Effect = DROPEFFECT_MOVE) and (DropSourceControl is TDirView) then
  2287. begin
  2288. TDirView(DropSourceControl).ValidateSelectedFiles;
  2289. end;
  2290. finally
  2291. FFileOperator.OperandFrom.Clear;
  2292. FFileOperator.OperandTo.Clear;
  2293. StartAllWatchThreads;
  2294. if Assigned(FDirView) and (not FDirView.WatchThreadActive) then
  2295. FDirView.StartWatchThread;
  2296. if Assigned(DropSourceControl) and (DropSourceControl is TDirView) and
  2297. (not TDirView(DropSourceControl).WatchThreadActive) then
  2298. TDirView(DropSourceControl).StartWatchThread;
  2299. Screen.Cursor := SaveCursor;
  2300. end;
  2301. end; {PerformDragDropFileOperation}
  2302. function TDriveView.GetCanUndoCopyMove: Boolean;
  2303. begin
  2304. Result := Assigned(FFileOperator) and FFileOperator.CanUndo;
  2305. end; {CanUndoCopyMove}
  2306. function TDriveView.UndoCopyMove: Boolean;
  2307. var
  2308. LastTarget: string;
  2309. LastSource: string;
  2310. begin
  2311. Result := False;
  2312. if FFileOperator.CanUndo then
  2313. begin
  2314. Lasttarget := FFileOperator.LastOperandTo[0];
  2315. LastSource := FFileOperator.LastOperandFrom[0];
  2316. StopAllWatchThreads;
  2317. Result := FFileOperator.UndoExecute;
  2318. ValidateDirectory(FindNodeToPath(ExtractFilePath(LastTarget)));
  2319. ValidateDirectory(FindNodeToPath(ExtractFilePath(LastSource)));
  2320. StartAllWatchThreads;
  2321. if Assigned(FDirView) then
  2322. with FDirView do
  2323. if not WatchThreadActive then
  2324. begin
  2325. if (IncludeTrailingBackslash(ExtractFilePath(LastTarget)) = IncludeTrailingBackslash(Path)) or
  2326. (IncludeTrailingBackslash(ExtractFilePath(LastSource)) = IncludeTrailingBackslash(Path)) then
  2327. Reload2;
  2328. end;
  2329. end;
  2330. end; {UndoCopyMove}
  2331. {Clipboard operations:}
  2332. procedure TDriveView.SetLastPathCut(Path: string);
  2333. var
  2334. Node: TTreeNode;
  2335. begin
  2336. if FLastPathCut <> Path then
  2337. begin
  2338. Node := FindNodeToPath(FLastPathCut);
  2339. if Assigned(Node) then
  2340. begin
  2341. FLastPathCut := Path;
  2342. Node.Cut := False;
  2343. end;
  2344. Node := FindNodeToPath(Path);
  2345. if Assigned(Node) then
  2346. begin
  2347. FLastPathCut := Path;
  2348. Node.Cut := True;
  2349. end;
  2350. end;
  2351. end; {SetLastNodeCut}
  2352. procedure TDriveView.EmptyClipboard;
  2353. begin
  2354. if Windows.OpenClipBoard(0) then
  2355. begin
  2356. Windows.EmptyClipBoard;
  2357. Windows.CloseClipBoard;
  2358. LastPathCut := '';
  2359. LastClipBoardOperation := cboNone;
  2360. if Assigned(FDirView) then
  2361. FDirView.EmptyClipboard;
  2362. end;
  2363. end; {EmptyClipBoard}
  2364. function TDriveView.CopyToClipBoard(Node: TTreeNode): Boolean;
  2365. begin
  2366. Result := Assigned(Selected);
  2367. if Result then
  2368. begin
  2369. EmptyClipBoard;
  2370. ClearDragFileList(FDragDropFilesEx.FileList);
  2371. AddToDragFileList(FDragDropFilesEx.FileList, Selected);
  2372. Result := FDragDropFilesEx.CopyToClipBoard;
  2373. LastClipBoardOperation := cboCopy;
  2374. end;
  2375. end; {CopyToClipBoard}
  2376. function TDriveView.CutToClipBoard(Node: TTreeNode): Boolean;
  2377. begin
  2378. Result := Assigned(Node) and (Node.Level > 0) and CopyToClipBoard(Node);
  2379. if Result then
  2380. begin
  2381. LastPathCut := NodePathName(Node);
  2382. LastClipBoardOperation := cboCut;
  2383. end;
  2384. end; {CutToClipBoard}
  2385. function TDriveView.CanPasteFromClipBoard: Boolean;
  2386. begin
  2387. Result := False;
  2388. if Assigned(Selected) and Windows.OpenClipboard(0) then
  2389. begin
  2390. Result := IsClipboardFormatAvailable(CF_HDROP);
  2391. Windows.CloseClipBoard;
  2392. end;
  2393. end; {CanPasteFromClipBoard}
  2394. function TDriveView.PasteFromClipBoard(TargetPath: String = ''): Boolean;
  2395. begin
  2396. ClearDragFileList(FDragDropFilesEx.FileList);
  2397. Result := False;
  2398. if CanPasteFromClipBoard and {MP}FDragDropFilesEx.GetFromClipBoard{/MP}
  2399. then
  2400. begin
  2401. if TargetPath = '' then
  2402. TargetPath := NodePathName(Selected);
  2403. case LastClipBoardOperation of
  2404. cboCopy,
  2405. cboNone:
  2406. begin
  2407. PerformDragDropFileOperation(Selected, DROPEFFECT_COPY);
  2408. if Assigned(FOnDDExecuted) then
  2409. FOnDDExecuted(Self, DROPEFFECT_COPY);
  2410. end;
  2411. cboCut:
  2412. begin
  2413. PerformDragDropFileOperation(Selected, DROPEFFECT_MOVE);
  2414. if Assigned(FOnDDExecuted) then
  2415. FOnDDExecuted(Self, DROPEFFECT_MOVE);
  2416. EmptyClipBoard;
  2417. end;
  2418. end;
  2419. Result := True;
  2420. end;
  2421. end; {PasteFromClipBoard}
  2422. end.