DriveView.pas 77 KB

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