DriveView.pas 77 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747
  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. begin
  1054. NodeData.shAttr := SFGAO_CONTENTSMASK;
  1055. // Previously we would also make use of SFGAO_SHARE to display a share overlay.
  1056. // But for directories, Windows File Explorer does not display the overlay anymore (probably since Vista).
  1057. // And for drives (where Explorer does display the overlay), it did not work ever since we use "desktop"
  1058. // (and not "workspace" as before) to resolve drive interface (see Bug 1717).
  1059. if not Succeeded(ShellFolderGetAttributesOfWithTimeout(ParentFolder, 1, NodeData.PIDL, NodeData.shAttr, MSecsPerSec)) then
  1060. begin
  1061. NodeData.shAttr := 0;
  1062. end;
  1063. end
  1064. else
  1065. begin
  1066. NodeData.shAttr := 0;
  1067. end;
  1068. if not Assigned(NodeData.ShellFolder) then
  1069. begin
  1070. ParentFolder.BindToObject(NodeData.PIDL, nil, IID_IShellFolder,
  1071. Pointer(NodeData.ShellFolder));
  1072. end;
  1073. end
  1074. end;
  1075. if NodeData.shAttr = 0 then
  1076. begin
  1077. // If we cannot resolve attrs, we do not want to assume that the folder has no subfolders,
  1078. // as that will make us scan the folder.
  1079. NodeData.shAttr := SFGAO_HASSUBFOLDER;
  1080. end;
  1081. end; {GetNodeAttr}
  1082. function CompareDrive(List: TStringList; Index1, Index2: Integer): Integer;
  1083. var
  1084. Drive1, Drive2: string;
  1085. RealDrive1, RealDrive2: Boolean;
  1086. begin
  1087. Drive1 := List[Index1];
  1088. Drive2 := List[Index2];
  1089. RealDrive1 := DriveInfo.IsRealDrive(Drive1);
  1090. RealDrive2 := DriveInfo.IsRealDrive(Drive2);
  1091. if RealDrive1 = RealDrive2 then
  1092. begin
  1093. Result := CompareText(Drive1, Drive2);
  1094. end
  1095. else
  1096. if RealDrive1 and (not RealDrive2) then
  1097. begin
  1098. Result := -1;
  1099. end
  1100. else
  1101. begin
  1102. Result := 1;
  1103. end;
  1104. end;
  1105. function TDriveView.GetDrives: TStrings;
  1106. var
  1107. DriveStatusPair: TPair<string, TDriveStatus>;
  1108. Drives: TStringList;
  1109. begin
  1110. Drives := TStringList.Create;
  1111. { We could iterate only .Keys here, but that crashes IDE for some reason }
  1112. for DriveStatusPair in FDriveStatus do
  1113. begin
  1114. Drives.Add(DriveStatusPair.Key);
  1115. end;
  1116. Drives.CustomSort(CompareDrive);
  1117. Result := Drives;
  1118. end;
  1119. procedure TDriveView.RefreshRootNodes(dsFlags: Integer);
  1120. var
  1121. Drives: TStrings;
  1122. NewText: string;
  1123. SaveCursor: TCursor;
  1124. WasValid: Boolean;
  1125. NodeData: TNodeData;
  1126. NewDrive: Char;
  1127. DriveStatus: TDriveStatus;
  1128. NextDriveNode: TTreeNode;
  1129. Index: Integer;
  1130. Drive: string;
  1131. begin
  1132. SaveCursor := Screen.Cursor;
  1133. Screen.Cursor := crHourGlass;
  1134. Drives := nil;
  1135. try
  1136. Drives := GetDrives;
  1137. NextDriveNode := nil;
  1138. for Index := Drives.Count - 1 downto 0 do
  1139. begin
  1140. Drive := Drives[Index];
  1141. DriveStatus := GetDriveStatus(Drive);
  1142. if ((dsFlags and dvdsFloppy) <> 0) or DriveInfo.IsFixedDrive(Drive) then
  1143. begin
  1144. with DriveInfo.Get(Drive) do
  1145. begin
  1146. WasValid := Assigned(DriveStatus.RootNode);
  1147. end;
  1148. if ((dsFlags and dvdsReReadAllways) = 0) and
  1149. (Length(DriveInfo.Get(Drive).DisplayName) > 0) then
  1150. dsFlags := dsFlags and (not dsDisplayName);
  1151. DriveInfo.ReadDriveStatus(Drive, dsFlags);
  1152. with DriveInfo.Get(Drive), DriveStatus do
  1153. begin
  1154. if Valid then
  1155. begin
  1156. if not WasValid then
  1157. {New drive has arrived: insert new rootnode:}
  1158. begin
  1159. { Create root directory node }
  1160. NodeData := TNodeData.Create;
  1161. NodeData.DirName := DriveInfo.GetDriveRoot(Drive);
  1162. NodeData.ShortName := NodeData.DirName;
  1163. {Get the shared attributes:}
  1164. if DriveInfo.IsFixedDrive(Drive) and (DriveType <> DRIVE_REMOVABLE) and
  1165. ((DriveType <> DRIVE_REMOTE) or GetNetWorkConnected(Drive)) then
  1166. begin
  1167. GetNodeShellAttr(FDesktop, NodeData, NodeData.DirName);
  1168. end;
  1169. if Assigned(NextDriveNode) then
  1170. RootNode := Items.InsertObject(NextDriveNode, '', NodeData)
  1171. else
  1172. RootNode := Items.AddObject(nil, '', NodeData);
  1173. RootNode.Text := GetDisplayName(RootNode);
  1174. RootNode.HasChildren := True;
  1175. Scanned := False;
  1176. Verified := False;
  1177. end
  1178. else
  1179. if RootNode.ImageIndex <> DriveInfo.Get(Drive).ImageIndex then
  1180. begin {WasValid = True}
  1181. RootNode.ImageIndex := DriveInfo.Get(Drive).ImageIndex;
  1182. RootNode.SelectedIndex := DriveInfo.Get(Drive).ImageIndex;
  1183. end;
  1184. if Assigned(RootNode) then
  1185. begin
  1186. NewText := GetDisplayName(RootNode);
  1187. if RootNode.Text <> NewText then
  1188. RootNode.Text := NewText;
  1189. end;
  1190. end
  1191. else
  1192. if WasValid then
  1193. {Drive has been removed => delete rootnode:}
  1194. begin
  1195. if (Directory <> '') and (Directory[1] = Drive) then
  1196. begin
  1197. if DriveInfo.IsRealDrive(Drive) then NewDrive := Drive[1]
  1198. else NewDrive := FirstFixedDrive;
  1199. repeat
  1200. if NewDrive < FirstFixedDrive then NewDrive := FirstFixedDrive
  1201. else
  1202. if NewDrive = FirstFixedDrive then NewDrive := LastDrive
  1203. else Dec(NewDrive);
  1204. DriveInfo.ReadDriveStatus(NewDrive, dsSize or dsImageIndex);
  1205. if NewDrive = Drive then
  1206. begin
  1207. Break;
  1208. end;
  1209. if DriveInfo.Get(NewDrive).Valid and DriveInfo.Get(NewDrive).DriveReady and Assigned(GetDriveStatus(NewDrive).RootNode) then
  1210. begin
  1211. Directory := NodePathName(GetDriveStatus(NewDrive).RootNode);
  1212. break;
  1213. end;
  1214. until False;
  1215. if not Assigned(Selected) then
  1216. begin
  1217. Directory := NodePathName(GetDriveStatus(FirstFixedDrive).RootNode);
  1218. end;
  1219. end;
  1220. Scanned := False;
  1221. Verified := False;
  1222. RootNode.Delete;
  1223. RootNode := nil;
  1224. end;
  1225. end;
  1226. end;
  1227. if Assigned(DriveStatus.RootNode) then
  1228. NextDriveNode := DriveStatus.RootNode;
  1229. end;
  1230. finally
  1231. Screen.Cursor := SaveCursor;
  1232. Drives.Free;
  1233. end;
  1234. end; {RefreshRootNodes}
  1235. function TDriveView.AddChildNode(ParentNode: TTreeNode; SRec: TSearchRec): TTreeNode;
  1236. var
  1237. NewNode: TTreeNode;
  1238. NodeData: TNodeData;
  1239. ContentMask: Boolean;
  1240. begin
  1241. NodeData := TNodeData.Create;
  1242. NodeData.Attr := SRec.Attr;
  1243. NodeData.DirName := SRec.Name;
  1244. NodeData.ShortName := SRec.FindData.cAlternateFileName;
  1245. NodeData.FIsRecycleBin :=
  1246. (SRec.Attr and faSysFile <> 0) and
  1247. (ParentNode.Level = 0) and
  1248. ((UpperCase(SRec.Name) = 'RECYCLED') or
  1249. (UpperCase(SRec.Name) = 'RECYCLER'));
  1250. { query content attributes ("has subfolder") only if tree view is visible }
  1251. { to avoid unnecessary scan of subfolders (which may take some time) }
  1252. { if tree view is not visible anyway }
  1253. ContentMask :=
  1254. Visible and
  1255. (GetDriveTypeToNode(ParentNode) <> DRIVE_REMOTE);
  1256. if not Assigned(TNodeData(ParentNode.Data).ShellFolder) then
  1257. begin
  1258. GetNodeShellAttr(FDesktop, TNodeData(ParentNode.Data), NodePathName(ParentNode), ContentMask);
  1259. end;
  1260. GetNodeShellAttr(TNodeData(ParentNode.Data).ShellFolder, NodeData, SRec.Name, ContentMask);
  1261. NewNode := Self.Items.AddChildObject(ParentNode, '', NodeData);
  1262. NewNode.Text := GetDisplayName(NewNode);
  1263. Result := NewNode;
  1264. end; {AddChildNode}
  1265. function TDriveView.GetDriveStatus(Drive: string): TDriveStatus;
  1266. begin
  1267. if not FDriveStatus.TryGetValue(Drive, Result) then
  1268. begin
  1269. Result := CreateDriveStatus;
  1270. FDriveStatus.Add(Drive, Result);
  1271. RefreshRootNodes(dsAll or dvdsRereadAllways);
  1272. if Assigned(OnRefreshDrives) then
  1273. OnRefreshDrives(Self);
  1274. end;
  1275. end; {GetDriveStatus}
  1276. function TDriveView.DoScanDir(FromNode: TTreeNode): Boolean;
  1277. begin
  1278. Result := not TNodeData(FromNode.Data).IsRecycleBin;
  1279. end; {DoScanDir}
  1280. function TDriveView.DirAttrMask: Integer;
  1281. begin
  1282. Result := faDirectory or faSysFile;
  1283. if ShowHiddenDirs then
  1284. Result := Result or faHidden;
  1285. end;
  1286. procedure TDriveView.ScanDrive(Drive: string);
  1287. var
  1288. DosError: Integer;
  1289. RootNode: TTreeNode;
  1290. SaveCursor: TCursor;
  1291. procedure ScanPath(const Path: string; ParentNode: TTreeNode);
  1292. var
  1293. SRec: TSearchRec;
  1294. SubNode: TTreeNode;
  1295. begin
  1296. if not DoScanDir(ParentNode) then
  1297. Exit;
  1298. DosError := FindFirst(ApiPath(Path), DirAttrMask, Srec);
  1299. while DosError = 0 do
  1300. begin
  1301. if (SRec.Name <> '.') and
  1302. (SRec.Name <> '..') and
  1303. (SRec.Attr and faDirectory <> 0) then
  1304. begin
  1305. if (SRec.Attr And faDirectory) <> 0 then
  1306. begin { Scan subdirectory }
  1307. SubNode := AddChildNode(ParentNode, SRec);
  1308. TNodeData(SubNode.Data).Scanned := True;
  1309. ScanPath(ExtractFilePath(Path) + SRec.Name + '\*.*', SubNode);
  1310. if not FContinue then
  1311. Break;
  1312. end;
  1313. end;
  1314. DosError := FindNext(SRec);
  1315. end;
  1316. FindClose(Srec);
  1317. if (Items.Count mod 10) = 0 then
  1318. Application.ProcessMessages;
  1319. if not FContinue then
  1320. Exit;
  1321. end; {ScanPath}
  1322. begin {ScanDrive}
  1323. with Self.Items do
  1324. begin
  1325. FContinue := True;
  1326. if not FFullDriveScan then
  1327. begin
  1328. ValidateDirectory(FindNodeToPath(DriveInfo.GetDriveRoot(Drive)));
  1329. GetDriveStatus(Drive).Scanned := True;
  1330. GetDriveStatus(Drive).Verified := False;
  1331. end
  1332. else
  1333. begin
  1334. SaveCursor := Screen.Cursor;
  1335. Screen.Cursor := crHourGlass;
  1336. Items.BeginUpdate;
  1337. try
  1338. RootNode := GetDriveStatus(Drive).RootNode;
  1339. if not Assigned(RootNode) then Exit;
  1340. iF RootNode.HasChildren then
  1341. RootNode.DeleteChildren;
  1342. ScanPath(DriveInfo.GetDriveRoot(Drive) + '*.*', RootNode); { scan subdirectories of rootdir}
  1343. TNodeData(RootNode.Data).Scanned := True;
  1344. GetDriveStatus(Drive).Scanned := True;
  1345. GetDriveStatus(Drive).Verified := True;
  1346. finally
  1347. SortChildren(GetDriveStatus(Drive).RootNode, True);
  1348. EndUpdate;
  1349. end;
  1350. RootNode.Expand(False);
  1351. Screen.Cursor := SaveCursor;
  1352. end;
  1353. end;
  1354. end; {ScanDrive}
  1355. function TDriveView.FindNodeToPath(Path: string): TTreeNode;
  1356. function SearchSubDirs(ParentNode: TTreeNode; Path: string): TTreeNode; forward;
  1357. function DoSearchSubDirs(ParentNode: TTreeNode; Path: string): TTreeNode;
  1358. var
  1359. i: Integer;
  1360. Node: TTreeNode;
  1361. Dir: string;
  1362. begin
  1363. {Extract first directory from path:}
  1364. i := Pos('\', Path);
  1365. if i = 0 then
  1366. i := Length(Path);
  1367. Dir := System.Copy(Path, 1, i);
  1368. System.Delete(Path, 1, i);
  1369. if Dir[Length(Dir)] = '\' then
  1370. SetLength(Dir, Pred(Length(Dir)));
  1371. Node := ParentNode.GetFirstChild;
  1372. if not Assigned(Node) then
  1373. begin
  1374. ValidateDirectoryEx(ParentNode, rsRecursiveExisting, True);
  1375. Node := ParentNode.GetFirstChild;
  1376. end;
  1377. Result := nil;
  1378. while Assigned(Node) do
  1379. begin
  1380. if (UpperCase(GetDirName(Node)) = Dir) or (TNodeData(Node.Data).ShortName = Dir) then
  1381. begin
  1382. if Length(Path) > 0 then
  1383. begin
  1384. Result := SearchSubDirs(Node, Path)
  1385. end
  1386. else
  1387. begin
  1388. Result := Node;
  1389. end;
  1390. Exit;
  1391. end;
  1392. Node := ParentNode.GetNextChild(Node);
  1393. end;
  1394. end;
  1395. function SearchSubDirs(ParentNode: TTreeNode; Path: string): TTreeNode;
  1396. var
  1397. Read: Boolean;
  1398. begin
  1399. Result := nil;
  1400. if Length(Path) > 0 then
  1401. begin
  1402. Read := False;
  1403. if not TNodeData(ParentNode.Data).Scanned then
  1404. begin
  1405. ReadSubDirs(ParentNode, GetDriveTypetoNode(ParentNode));
  1406. Read := True;
  1407. end;
  1408. Result := DoSearchSubDirs(ParentNode, Path);
  1409. // reread subfolders, just in case the directory we look for was just created
  1410. // (as can happen when navigating to new remote directory with synchronized
  1411. // browsing enabled and opting to create the non-existing local directory)
  1412. if (not Assigned(Result)) and (not Read) then
  1413. begin
  1414. ValidateDirectoryEx(ParentNode, rsNoRecursive, True);
  1415. Result := DoSearchSubDirs(ParentNode, Path);
  1416. end;
  1417. end;
  1418. end; {SearchSubDirs}
  1419. var
  1420. Drive: string;
  1421. P: Integer;
  1422. begin {FindNodeToPath}
  1423. Result := nil;
  1424. if Length(Path) < 3 then
  1425. Exit;
  1426. // Particularly when used by TDirView to delegate browsing to
  1427. // hidden drive view, the handle may not be created
  1428. HandleNeeded;
  1429. Drive := DriveInfo.GetDriveKey(Path);
  1430. if Assigned(GetDriveStatus(Drive).RootNode) then
  1431. begin
  1432. if DriveInfo.IsRealDrive(Drive) then
  1433. begin
  1434. System.Delete(Path, 1, 3);
  1435. end
  1436. else
  1437. if IsUncPath(Path) then
  1438. begin
  1439. System.Delete(Path, 1, 2);
  1440. P := Pos('\', Path);
  1441. if P = 0 then
  1442. begin
  1443. Path := '';
  1444. end
  1445. else
  1446. begin
  1447. System.Delete(Path, 1, P);
  1448. P := Pos('\', Path);
  1449. if P = 0 then
  1450. begin
  1451. Path := '';
  1452. end
  1453. else
  1454. begin
  1455. System.Delete(Path, 1, P);
  1456. end;
  1457. end;
  1458. end
  1459. else
  1460. begin
  1461. raise EConvertError.Create(Format(ErrorInvalidDrive, [Path]))
  1462. end;
  1463. if Length(Path) > 0 then
  1464. begin
  1465. if not GetDriveStatus(Drive).Scanned then
  1466. ScanDrive(Drive);
  1467. Result := SearchSubDirs(GetDriveStatus(Drive).RootNode, UpperCase(Path));
  1468. end
  1469. else Result := GetDriveStatus(Drive).RootNode;
  1470. end;
  1471. end; {FindNodetoPath}
  1472. function TDriveView.CheckForSubDirs(Path: string): Boolean;
  1473. var
  1474. DosError: Integer;
  1475. SRec: TSearchRec;
  1476. begin
  1477. Result := False;
  1478. DosError := FindFirst(ApiPath(IncludeTrailingBackslash(Path) + '*.'), DirAttrMask, SRec);
  1479. while DosError = 0 do
  1480. begin
  1481. if (SRec.Name <> '.' ) and
  1482. (SRec.Name <> '..') and
  1483. (SRec.Attr and faDirectory <> 0) then
  1484. begin
  1485. Result := True;
  1486. Break;
  1487. end;
  1488. DosError := FindNext(SRec);
  1489. end;
  1490. FindClose(SRec);
  1491. end; {CheckForSubDirs}
  1492. function TDriveView.ReadSubDirs(Node: TTreeNode; DriveType: Integer): Boolean;
  1493. var
  1494. DosError: Integer;
  1495. SRec: TSearchRec;
  1496. NewNode: TTreeNode;
  1497. begin
  1498. Result := False;
  1499. DosError := FindFirst(ApiPath(IncludeTrailingBackslash(NodePath(Node)) + '*.*'), DirAttrMask, SRec);
  1500. while DosError = 0 do
  1501. begin
  1502. if (SRec.Name <> '.' ) and
  1503. (SRec.Name <> '..') and
  1504. (SRec.Attr and faDirectory <> 0) then
  1505. begin
  1506. NewNode := AddChildNode(Node, SRec);
  1507. if DoScanDir(NewNode) then
  1508. begin
  1509. NewNode.HasChildren := Bool(TNodeData(NewNode.Data).shAttr and SFGAO_HASSUBFOLDER);
  1510. TNodeData(NewNode.Data).Scanned := not NewNode.HasChildren;
  1511. end
  1512. else
  1513. begin
  1514. NewNode.HasChildren := False;
  1515. TNodeData(NewNode.Data).Scanned := True;
  1516. end;
  1517. Result := True;
  1518. end;
  1519. DosError := FindNext(SRec);
  1520. end; {While DosError = 0}
  1521. FindClose(Srec);
  1522. TNodeData(Node.Data).Scanned := True;
  1523. if Result then SortChildren(Node, False)
  1524. else Node.HasChildren := False;
  1525. Application.ProcessMessages;
  1526. end; {ReadSubDirs}
  1527. function TDriveView.CallBackValidateDir(Var Node: TTreeNode; Data: Pointer): Boolean;
  1528. type
  1529. PSearchRec = ^TSearchRec;
  1530. var
  1531. WorkNode: TTreeNode;
  1532. DelNode: TTreeNode;
  1533. NewNode: TTreeNode;
  1534. SRec: TSearchRec;
  1535. SrecList: TStringList;
  1536. SubDirList: TStringList;
  1537. DosError: Integer;
  1538. Index: Integer;
  1539. NewDirFound: Boolean;
  1540. ParentDir: string;
  1541. NodeData: TNodeData;
  1542. ScanDirInfo: PScanDirInfo;
  1543. begin {CallBackValidateDir}
  1544. Result := True;
  1545. if (not Assigned(Node)) or (not Assigned(Node.Data)) then
  1546. Exit;
  1547. NewDirFound := False;
  1548. ScanDirInfo := PScanDirInfo(Data);
  1549. {Check, if directory still exists: (but not with root directory) }
  1550. if Assigned(Node.Parent) and (ScanDirInfo^.StartNode = Node) then
  1551. if not DirectoryExists(NodePathName(Node)) then
  1552. begin
  1553. WorkNode := Node.Parent;
  1554. if Selected = Node then
  1555. Selected := WorkNode;
  1556. if DropTarget = Node then
  1557. DropTarget := nil;
  1558. Node.Delete;
  1559. Node := nil;
  1560. Exit;
  1561. end;
  1562. WorkNode := Node.GetFirstChild;
  1563. NodeData := TNodeData(Node.Data);
  1564. if NodeData.Scanned and Assigned(WorkNode) then
  1565. {if node was already scanned: check wether the existing subnodes are still alive
  1566. and add all new subdirectories as subnodes:}
  1567. begin
  1568. if DoScanDir(Node) then
  1569. begin
  1570. ParentDir := IncludeTrailingBackslash(NodePath(Node));
  1571. {Build list of existing subnodes:}
  1572. SubDirList := TStringList.Create;
  1573. while Assigned(WorkNode) do
  1574. begin
  1575. SubDirList.Add(TNodeData(WorkNode.Data).DirName);
  1576. WorkNode := Node.GetNextChild(WorkNode);
  1577. end;
  1578. {Sorting not required, because the subnodes are already sorted!}
  1579. SRecList := TStringList.Create;
  1580. DosError := FindFirst(ApiPath(ParentDir + '*.*'), DirAttrMask, SRec);
  1581. while DosError = 0 do
  1582. begin
  1583. if (Srec.Name <> '.' ) and
  1584. (Srec.Name <> '..') and
  1585. (Srec.Attr and faDirectory <> 0) then
  1586. begin
  1587. SrecList.Add(Srec.Name);
  1588. if not SubDirList.Find(Srec.Name, Index) then
  1589. {Subnode does not exists: add it:}
  1590. begin
  1591. NewNode := AddChildNode(Node, SRec);
  1592. NewNode.HasChildren := CheckForSubDirs(ParentDir + Srec.Name);
  1593. TNodeData(NewNode.Data).Scanned := Not NewNode.HasChildren;
  1594. NewDirFound := True;
  1595. end;
  1596. end;
  1597. DosError := FindNext(Srec);
  1598. end;
  1599. FindClose(Srec);
  1600. Sreclist.Sort;
  1601. {Remove not existing subnodes:}
  1602. WorkNode := Node.GetFirstChild;
  1603. while Assigned(WorkNode) do
  1604. begin
  1605. if not Assigned(WorkNode.Data) or
  1606. not SrecList.Find(TNodeData(WorkNode.Data).DirName, Index) then
  1607. begin
  1608. DelNode := WorkNode;
  1609. WorkNode := Node.GetNextChild(WorkNode);
  1610. DelNode.Delete;
  1611. end
  1612. else
  1613. begin
  1614. if (SrecList[Index] <> TNodeData(WorkNode.Data).DirName) then
  1615. begin
  1616. {Case of directory letters has changed:}
  1617. TNodeData(WorkNode.Data).DirName := SrecList[Index];
  1618. TNodeData(WorkNode.Data).ShortName := ExtractShortPathName(NodePathName(WorkNode));
  1619. WorkNode.Text := SrecList[Index];
  1620. end;
  1621. SrecList.Delete(Index);
  1622. WorkNode := Node.GetNextChild(WorkNode);
  1623. end;
  1624. end;
  1625. SrecList.Free;
  1626. SubDirList.Free;
  1627. {Sort subnodes:}
  1628. if NewDirFound then
  1629. SortChildren(Node, False);
  1630. end;
  1631. end
  1632. else
  1633. {Node was not already scanned:}
  1634. if (ScanDirInfo^.SearchNewDirs or
  1635. NodeData.Scanned or
  1636. (Node = ScanDirInfo^.StartNode)) and
  1637. DoScanDir(Node) then
  1638. begin
  1639. ReadSubDirs(Node, ScanDirInfo^.DriveType);
  1640. end;
  1641. end; {CallBackValidateDir}
  1642. procedure TDriveView.RebuildTree;
  1643. var
  1644. Drive: string;
  1645. begin
  1646. for Drive in FDriveStatus.Keys do
  1647. with GetDriveStatus(Drive) do
  1648. if Assigned(RootNode) and Scanned then
  1649. ValidateDirectory(RootNode);
  1650. end;
  1651. procedure TDriveView.ValidateCurrentDirectoryIfNotMonitoring;
  1652. begin
  1653. if Assigned(Selected) and
  1654. not Assigned(GetDriveStatus(GetDriveToNode(Selected)).DiscMonitor) then
  1655. begin
  1656. ValidateDirectory(Selected);
  1657. end;
  1658. end;
  1659. procedure TDriveView.ValidateDirectoryEx(Node: TTreeNode; Recurse: TRecursiveScan;
  1660. NewDirs: Boolean);
  1661. var
  1662. Info: PScanDirInfo;
  1663. SelDir: string;
  1664. SaveCursor: TCursor;
  1665. RestartWatchThread: Boolean;
  1666. SaveCanChange: Boolean;
  1667. CurrentPath: string;
  1668. Drive: string;
  1669. begin
  1670. if Assigned(Node) and Assigned(Node.Data) and
  1671. (not FValidateFlag) and DoScanDir(Node) then
  1672. begin
  1673. SelDir := Directory;
  1674. SaveCursor := Screen.Cursor;
  1675. if Self.Focused and (Screen.Cursor <> crHourGlass) then
  1676. Screen.Cursor := crHourGlass;
  1677. CurrentPath := NodePath(Node);
  1678. Drive := DriveInfo.GetDriveKey(CurrentPath);
  1679. if Node.Level = 0 then
  1680. GetDriveStatus(Drive).ChangeTimer.Enabled := False;
  1681. RestartWatchThread := WatchThreadActive;
  1682. try
  1683. if WatchThreadActive then
  1684. StopWatchThread;
  1685. FValidateFlag := True;
  1686. New(Info);
  1687. Info^.StartNode := Node;
  1688. Info^.SearchNewDirs := NewDirs;
  1689. Info^.DriveType := DriveInfo.Get(Drive).DriveType;
  1690. SaveCanChange := FCanChange;
  1691. FCanChange := True;
  1692. FChangeFlag := False;
  1693. IterateSubTree(Node, CallBackValidateDir, Recurse, coScanStartNode, Info);
  1694. FValidateFlag := False;
  1695. if (not Assigned(Selected)) and (Length(SelDir) > 0) then
  1696. Directory := ExtractFileDrive(SelDir);
  1697. if (SelDir <> Directory) and (not FChangeFlag) then
  1698. Change(Selected);
  1699. FCanChange := SaveCanChange;
  1700. Dispose(Info);
  1701. finally
  1702. if RestartWatchThread and FWatchDirectory and not WatchThreadActive then
  1703. StartWatchThread;
  1704. if Screen.Cursor <> SaveCursor then
  1705. Screen.Cursor := SaveCursor;
  1706. end;
  1707. end;
  1708. end; {ValidateDirectoryEx}
  1709. function TDriveView.GetDriveTypeToNode(Node: TTreeNode): Integer;
  1710. begin
  1711. Assert(Assigned(Node));
  1712. Result := DriveInfo.Get(GetDriveToNode(Node)).DriveType;
  1713. end; {GetDriveTypeToNode}
  1714. function TDriveView.CreateDirectory(ParentNode: TTreeNode; NewName: string): TTreeNode;
  1715. var
  1716. SRec: TSearchRec;
  1717. begin
  1718. Assert(Assigned(ParentNode));
  1719. Result := nil;
  1720. if not TNodeData(ParentNode.Data).Scanned then
  1721. ValidateDirectory(ParentNode);
  1722. StopWatchThread;
  1723. try
  1724. if Assigned(FDirView) then
  1725. FDirView.StopWatchThread;
  1726. {create phyical directory:}
  1727. LastIOResult := 0;
  1728. if not Windows.CreateDirectory(PChar(NodePath(ParentNode) + '\' + NewName), nil) then
  1729. LastIOResult := GetLastError;
  1730. if LastIOResult = 0 then
  1731. begin
  1732. {Create treenode:}
  1733. FindFirst(ApiPath(NodePath(ParentNode) + '\' + NewName), faAnyFile, SRec);
  1734. Result := AddChildNode(ParentNode, Srec);
  1735. FindClose(Srec);
  1736. TNodeData(Result.Data).Scanned := True;
  1737. SortChildren(ParentNode, False);
  1738. ParentNode.Expand(False);
  1739. end;
  1740. finally
  1741. StartWatchThread;
  1742. if Assigned(FDirView) then
  1743. begin
  1744. FDirView.StartWatchThread;
  1745. FDirView.Reload2;
  1746. end;
  1747. end;
  1748. end; {CreateDirectory}
  1749. function TDriveView.DeleteDirectory(Node: TTreeNode; AllowUndo: Boolean): Boolean;
  1750. var
  1751. DelDir: string;
  1752. OperatorResult: Boolean;
  1753. FileOperator: TFileOperator;
  1754. SaveCursor: TCursor;
  1755. begin
  1756. Assert(Assigned(Node));
  1757. Result := False;
  1758. if Assigned(Node) and (Node.Level > 0) then
  1759. begin
  1760. SaveCursor := Screen.Cursor;
  1761. Screen.Cursor := crHourGlass;
  1762. FileOperator := TFileOperator.Create(Self);
  1763. DelDir := NodePathName(Node);
  1764. FileOperator.OperandFrom.Add(DelDir);
  1765. FileOperator.Operation := foDelete;
  1766. if AllowUndo then
  1767. FileOperator.Flags := FileOperator.Flags + [foAllowUndo]
  1768. else
  1769. FileOperator.Flags := FileOperator.Flags - [foAllowUndo];
  1770. if not ConfirmDelete then
  1771. FileOperator.Flags := FileOperator.Flags + [foNoConfirmation];
  1772. try
  1773. if DirectoryExists(DelDir) then
  1774. begin
  1775. StopWatchThread;
  1776. OperatorResult := FileOperator.Execute;
  1777. if OperatorResult and (not FileOperator.OperationAborted) and
  1778. (not DirectoryExists(DelDir)) then
  1779. begin
  1780. Node.Delete
  1781. end
  1782. else
  1783. begin
  1784. Result := False;
  1785. if not AllowUndo then
  1786. begin
  1787. {WinNT4-Bug: FindFirst still returns the directories search record, even if the
  1788. directory was deleted:}
  1789. ChDir(DelDir);
  1790. if IOResult <> 0 then
  1791. Node.Delete;
  1792. end;
  1793. end;
  1794. end
  1795. else
  1796. begin
  1797. Node.Delete;
  1798. Result := True;
  1799. end;
  1800. finally
  1801. StartWatchThread;
  1802. if Assigned(DirView) and Assigned(Selected) then
  1803. DirView.Path := NodePathName(Selected);
  1804. FileOperator.Free;
  1805. Screen.Cursor := SaveCursor;
  1806. end;
  1807. end;
  1808. end; {DeleteDirectory}
  1809. procedure TDriveView.CreateWatchThread(Drive: string);
  1810. begin
  1811. if csDesigning in ComponentState then
  1812. Exit;
  1813. if (not Assigned(GetDriveStatus(Drive).DiscMonitor)) and
  1814. FWatchDirectory and
  1815. (DriveInfo.Get(Drive).DriveType <> DRIVE_REMOTE) then
  1816. begin
  1817. with GetDriveStatus(Drive) do
  1818. begin
  1819. DiscMonitor := TDiscMonitor.Create(Self);
  1820. DiscMonitor.ChangeDelay := msThreadChangeDelay;
  1821. DiscMonitor.SubTree := True;
  1822. DiscMonitor.Filters := [moDirName];
  1823. DiscMonitor.OnChange := ChangeDetected;
  1824. DiscMonitor.OnInvalid := ChangeInvalid;
  1825. DiscMonitor.SetDirectory(DriveInfo.GetDriveRoot(Drive));
  1826. DiscMonitor.Open;
  1827. end;
  1828. end;
  1829. end; {CreateWatchThread}
  1830. procedure TDriveView.SetWatchDirectory(Value: Boolean);
  1831. begin
  1832. if FWatchDirectory <> Value then
  1833. begin
  1834. FWatchDirectory := Value;
  1835. if (not (csDesigning in ComponentState)) and Value then
  1836. StartAllWatchThreads
  1837. else
  1838. StopAllWatchThreads;
  1839. end;
  1840. end; {SetAutoScan}
  1841. procedure TDriveView.SetDirView(Value: TDirView);
  1842. begin
  1843. if Assigned(FDirView) then
  1844. FDirView.DriveView := nil;
  1845. FDirView := Value;
  1846. if Assigned(FDirView) then
  1847. FDirView.DriveView := Self;
  1848. end; {SetDirView}
  1849. function TDriveView.NodeWatched(Node: TTreeNode): Boolean;
  1850. var
  1851. Drive: string;
  1852. begin
  1853. Drive := GetDriveToNode(Node);
  1854. Result := WatchThreadActive(Drive);
  1855. end; {NodeWatched}
  1856. procedure TDriveView.ChangeInvalid(Sender: TObject; const Directory: string;
  1857. const ErrorStr: string);
  1858. var
  1859. Dir: string;
  1860. begin
  1861. Dir := (Sender as TDiscMonitor).Directories[0];
  1862. with GetDriveStatus(DriveInfo.GetDriveKey(Dir)) do
  1863. begin
  1864. DiscMonitor.Close;
  1865. end;
  1866. end; {DirWatchChangeInvalid}
  1867. procedure TDriveView.ChangeDetected(Sender: TObject; const Directory: string;
  1868. var SubdirsChanged: Boolean);
  1869. var
  1870. DirChanged: string;
  1871. begin
  1872. if Sender is TDiscMonitor then
  1873. begin
  1874. DirChanged := (Sender as TDiscMonitor).Directories[0];
  1875. if Length(DirChanged) > 0 then
  1876. begin
  1877. with GetDriveStatus(DriveInfo.GetDriveKey(DirChanged)) do
  1878. begin
  1879. ChangeTimer.Interval := 0;
  1880. ChangeTimer.Interval := FChangeInterval;
  1881. ChangeTimer.Enabled := True;
  1882. end;
  1883. end;
  1884. end;
  1885. end; {DirWatchChangeDetected}
  1886. procedure TDriveView.ChangeTimerOnTimer(Sender: TObject);
  1887. var
  1888. DriveStatus: TDriveStatus;
  1889. begin
  1890. if (FChangeTimerSuspended = 0) and (Sender is TTimer) then
  1891. begin
  1892. for DriveStatus in FDriveStatus.Values do
  1893. begin
  1894. if DriveStatus.ChangeTimer = Sender then
  1895. begin
  1896. with DriveStatus.ChangeTimer do
  1897. begin
  1898. Interval := 0;
  1899. Enabled := False;
  1900. end;
  1901. if Assigned(DriveStatus.RootNode) then
  1902. begin
  1903. {Check also collapsed (invisible) subdirectories:}
  1904. ValidateDirectory(DriveStatus.RootNode);
  1905. end;
  1906. end;
  1907. end;
  1908. end;
  1909. end; {ChangeTimerOnTimer}
  1910. procedure TDriveView.StartWatchThread;
  1911. var
  1912. Drive: string;
  1913. begin
  1914. if (csDesigning in ComponentState) or
  1915. not Assigned(Selected) or
  1916. not fWatchDirectory then Exit;
  1917. Drive := GetDriveToNode(Selected);
  1918. with GetDriveStatus(Drive) do
  1919. begin
  1920. if not Assigned(DiscMonitor) then
  1921. CreateWatchThread(Drive);
  1922. if Assigned(DiscMonitor) and not DiscMonitor.Enabled then
  1923. DiscMonitor.Enabled := True;
  1924. end;
  1925. end; {StartWatchThread}
  1926. procedure TDriveView.StopWatchThread;
  1927. begin
  1928. if Assigned(Selected) then
  1929. with GetDriveStatus(GetDriveToNode(Selected)) do
  1930. if Assigned(DiscMonitor) then
  1931. DiscMonitor.Enabled := False;
  1932. end; {StopWatchThread}
  1933. procedure TDriveView.SuspendChangeTimer;
  1934. begin
  1935. Inc(FChangeTimerSuspended);
  1936. end;
  1937. procedure TDriveView.ResumeChangeTimer;
  1938. begin
  1939. Assert(FChangeTimerSuspended > 0);
  1940. Dec(FChangeTimerSuspended);
  1941. end;
  1942. procedure TDriveView.TerminateWatchThread(Drive: string);
  1943. begin
  1944. with GetDriveStatus(Drive) do
  1945. if Assigned(DiscMonitor) then
  1946. begin
  1947. DiscMonitor.Free;
  1948. DiscMonitor := nil;
  1949. end;
  1950. end; {StopWatchThread}
  1951. procedure TDriveView.StartAllWatchThreads;
  1952. var
  1953. DriveStatusPair: TPair<string, TDriveStatus>;
  1954. Drive: string;
  1955. begin
  1956. if (csDesigning in ComponentState) or (not FWatchDirectory) then
  1957. Exit;
  1958. for DriveStatusPair in FDriveStatus do
  1959. with DriveStatusPair.Value do
  1960. if Scanned then
  1961. begin
  1962. if not Assigned(DiscMonitor) then
  1963. CreateWatchThread(DriveStatusPair.Key);
  1964. if Assigned(DiscMonitor) and (not DiscMonitor.Active) then
  1965. DiscMonitor.Open;
  1966. end;
  1967. if Assigned(Selected) then
  1968. begin
  1969. Drive := GetDriveToNode(Selected);
  1970. if not DriveInfo.IsFixedDrive(Drive) then
  1971. begin
  1972. StartWatchThread;
  1973. end;
  1974. end;
  1975. end; {StartAllWatchThreads}
  1976. procedure TDriveView.StopAllWatchThreads;
  1977. var
  1978. DriveStatusPair: TPair<string, TDriveStatus>;
  1979. begin
  1980. if (csDesigning in ComponentState) or (not FWatchDirectory) then
  1981. Exit;
  1982. for DriveStatusPair in FDriveStatus do
  1983. with DriveStatusPair.Value do
  1984. begin
  1985. if Assigned(DiscMonitor) then
  1986. DiscMonitor.Close;
  1987. end;
  1988. end; {StopAllWatchThreads}
  1989. function TDriveView.WatchThreadActive(Drive: string): Boolean;
  1990. begin
  1991. Result := FWatchDirectory and
  1992. Assigned(GetDriveStatus(Drive).DiscMonitor) and
  1993. GetDriveStatus(Drive).DiscMonitor.Active and
  1994. GetDriveStatus(Drive).DiscMonitor.Enabled;
  1995. end; {WatchThreadActive}
  1996. function TDriveView.WatchThreadActive: Boolean;
  1997. var
  1998. Drive: string;
  1999. begin
  2000. if not Assigned(Selected) then
  2001. begin
  2002. Result := False;
  2003. Exit;
  2004. end;
  2005. Drive := GetDriveToNode(Selected);
  2006. Result := WatchThreadActive(Drive);
  2007. end; {WatchThreadActive}
  2008. procedure TDriveView.SetFullDriveScan(DoFullDriveScan: Boolean);
  2009. begin
  2010. FFullDriveScan := DoFullDriveScan;
  2011. end; {SetAutoScan}
  2012. function TDriveView.FindPathNode(Path: string): TTreeNode;
  2013. begin
  2014. {Find existing path or parent path of not existing path:}
  2015. repeat
  2016. Result := FindNodeToPath(Path);
  2017. if not Assigned(Result) then
  2018. Path := ExtractFilePath(ExcludeTrailingBackslash(Path));
  2019. until Assigned(Result) or (Length(Path) < 3);
  2020. end;
  2021. procedure TDriveView.SetDirectory(Value: string);
  2022. begin
  2023. Value := IncludeTrailingBackslash(Value);
  2024. FDirectory := Value;
  2025. inherited;
  2026. if Assigned(Selected) and (Selected.Level = 0) then
  2027. begin
  2028. if not GetDriveStatus(GetDriveToNode(Selected)).Scanned then
  2029. ScanDrive(GetDriveToNode(Selected));
  2030. end;
  2031. end; {SetDirectory}
  2032. function TDriveView.GetDirName(Node: TTreeNode): string;
  2033. begin
  2034. if Assigned(Node) and Assigned(Node.Data) then
  2035. Result := TNodeData(Node.Data).DirName
  2036. else
  2037. Result := '';
  2038. end; {GetDirName}
  2039. {GetDrive: returns the drive of the Node.}
  2040. function TDriveView.GetDriveToNode(Node: TTreeNode): string;
  2041. var
  2042. Path: string;
  2043. begin
  2044. if (not Assigned (Node)) or (not Assigned(Node.Data)) then
  2045. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDrive']));
  2046. Path := NodePath(Node);
  2047. Result := DriveInfo.GetDriveKey(Path);
  2048. end; {GetDrive}
  2049. {RootNode: returns the rootnode to the Node:}
  2050. function TDriveView.RootNode(Node: TTreeNode): TTreeNode;
  2051. begin
  2052. Result := Node;
  2053. if not Assigned(Node) then
  2054. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['RootNode']));
  2055. while Assigned(Result.Parent) do
  2056. Result := Result.Parent;
  2057. end; {RootNode}
  2058. function TDriveView.GetDisplayName(Node: TTreeNode): string;
  2059. begin
  2060. Result := '';
  2061. if (not Assigned(Node)) or (not Assigned(Node.Data)) then
  2062. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDisplayName']));
  2063. if Node.Level = 0 then Result := GetDriveText(GetDriveToNode(Node))
  2064. else
  2065. begin
  2066. Result := GetDirName(Node);
  2067. end;
  2068. end; {GetDisplayName}
  2069. procedure TDriveView.SetShowVolLabel(ShowIt: Boolean);
  2070. begin
  2071. if ShowIt = FShowVolLabel then
  2072. Exit;
  2073. FShowVolLabel := ShowIt;
  2074. RefreshRootNodes(dvdsFloppy);
  2075. end; {SetShowVolLabel}
  2076. procedure TDriveView.DisplayContextMenu(Node: TTreeNode; Point: TPoint);
  2077. var
  2078. Verb: string;
  2079. DirWatched: Boolean;
  2080. begin
  2081. DirWatched := NodeWatched(Node) and WatchThreadActive;
  2082. Assert(Node <> nil);
  2083. if Node <> Selected then
  2084. DropTarget := Node;
  2085. Verb := EmptyStr;
  2086. if Assigned(FOnDisplayContextMenu) then
  2087. FOnDisplayContextMenu(Self);
  2088. ShellDisplayContextMenu(FParentForm.Handle, Point, NodePathName(Node),
  2089. CanEdit(Node), Verb, False);
  2090. if Verb = shcRename then Node.EditText
  2091. else
  2092. if Verb = shcCut then
  2093. begin
  2094. LastClipBoardOperation := cboCut;
  2095. LastPathCut := NodePathName(Node);
  2096. end
  2097. else
  2098. if Verb = shcCopy then LastClipBoardOperation := cboCopy
  2099. else
  2100. if Verb = shcPaste then
  2101. PasteFromClipBoard(NodePathName(Node));
  2102. DropTarget := nil;
  2103. if not DirWatched then
  2104. ValidateDirectory(Node);
  2105. end; {DisplayContextMenu (2)}
  2106. procedure TDriveView.DisplayPropertiesMenu(Node: TTreeNode);
  2107. begin
  2108. Assert(Assigned(Node));
  2109. ShellExecuteContextCommand(FParentForm.Handle, shcProperties, NodePathName(Node));
  2110. end; {ContextMenu}
  2111. procedure TDriveView.SetSelected(Node: TTreeNode);
  2112. begin
  2113. if Node <> Selected then
  2114. begin
  2115. FChangeFlag := False;
  2116. FCanChange := True;
  2117. inherited Selected := Node;
  2118. if not FChangeFlag then
  2119. Change(Selected);
  2120. end;
  2121. end; {SetSelected}
  2122. {Called by TFileDeleteThread, when a file deletion was detected by the D&D receiving application:}
  2123. procedure TDriveView.SignalDirDelete(Sender: TObject; Files: TStringList);
  2124. begin
  2125. if Files.Count > 0 then
  2126. ValidateDirectory(FindNodeToPath(Files[0]));
  2127. end; {SignalDirDelete}
  2128. function TDriveView.DDSourceEffects: TDropEffectSet;
  2129. begin
  2130. if FDragNode.Level = 0 then
  2131. Result := [deLink]
  2132. else
  2133. Result := [deLink, deCopy, deMove];
  2134. end;
  2135. procedure TDriveView.DDChooseEffect(KeyState: Integer; var Effect: Integer);
  2136. begin
  2137. if DropTarget = nil then Effect := DROPEFFECT_NONE
  2138. else
  2139. if (KeyState and (MK_CONTROL or MK_SHIFT) = 0) then
  2140. begin
  2141. if FDragDrive <> '' then
  2142. begin
  2143. if FExeDrag and DriveInfo.IsFixedDrive(GetDriveToNode(DropTarget)) and DriveInfo.IsFixedDrive(FDragDrive) then
  2144. begin
  2145. Effect := DROPEFFECT_LINK;
  2146. end
  2147. else
  2148. if (Effect = DROPEFFECT_COPY) and
  2149. (SameText(FDragDrive, GetDriveToNode(DropTarget)) and
  2150. (FDragDropFilesEx.AvailableDropEffects and DROPEFFECT_MOVE <> 0)) then
  2151. begin
  2152. Effect := DROPEFFECT_MOVE;
  2153. end;
  2154. end;
  2155. end;
  2156. inherited;
  2157. end;
  2158. function TDriveView.DragCompleteFileList: Boolean;
  2159. begin
  2160. Result := (GetDriveTypeToNode(FDragNode) <> DRIVE_REMOVABLE);
  2161. end;
  2162. function TDriveView.DDExecute: TDragResult;
  2163. var
  2164. WatchThreadOK: Boolean;
  2165. DragParentPath: string;
  2166. DragPath: string;
  2167. begin
  2168. WatchThreadOK := WatchThreadActive;
  2169. Result := FDragDropFilesEx.Execute(nil);
  2170. if (Result = drMove) and (not WatchThreadOK) then
  2171. begin
  2172. DragPath := NodePathName(FDragNode);
  2173. if Assigned(FDragNode.Parent) then
  2174. DragParentPath := NodePathName(FDragNode.Parent)
  2175. else
  2176. DragParentPath := DragPath;
  2177. if (FDragNode.Level > 0) or (DragParentPath <> NodePathName(Selected.Parent)) then
  2178. begin
  2179. FDragNode := FindNodeToPath(DragPath);
  2180. if Assigned(FDragNode) then
  2181. begin
  2182. FDragFileList.Clear;
  2183. FDragFileList.Add(DragPath);
  2184. TFileDeleteThread.Create(FDragFileList, MaxWaitTimeOut, SignalDirDelete);
  2185. end;
  2186. end;
  2187. end;
  2188. end;
  2189. procedure TDriveView.PerformDragDropFileOperation(Node: TTreeNode; Effect: Integer);
  2190. var
  2191. Index: Integer;
  2192. SourcePath: string;
  2193. SourceParentPath: string;
  2194. SourceIsDirectory: Boolean;
  2195. SaveCursor: TCursor;
  2196. TargetNode: TTreeNode;
  2197. TargetPath: string;
  2198. IsRecycleBin: Boolean;
  2199. begin
  2200. TargetPath := NodePathName(Node);
  2201. IsRecycleBin := NodeIsRecycleBin(Node);
  2202. if FDragDropFilesEx.FileList.Count = 0 then
  2203. Exit;
  2204. SaveCursor := Screen.Cursor;
  2205. Screen.Cursor := crHourGlass;
  2206. SourcePath := EmptyStr;
  2207. try
  2208. if (Effect = DROPEFFECT_COPY) or (Effect = DROPEFFECT_MOVE) then
  2209. begin
  2210. StopAllWatchThreads;
  2211. if Assigned(FDirView) then
  2212. FDirView.StopWatchThread;
  2213. if Assigned(DropSourceControl) and
  2214. (DropSourceControl is TDirView) and
  2215. (DropSourceControl <> FDirView) then
  2216. begin
  2217. TDirView(DropSourceControl).StopWatchThread;
  2218. end;
  2219. if DropFiles(
  2220. DragDropFilesEx, Effect, FFileOperator, TargetPath, false, IsRecycleBin, ConfirmDelete, ConfirmOverwrite, False,
  2221. Self, OnDDFileOperation, SourcePath, SourceIsDirectory) then
  2222. begin
  2223. if Assigned(FOnDDFileOperationExecuted) then
  2224. FOnDDFileOperationExecuted(Self, Effect, SourcePath, TargetPath);
  2225. end;
  2226. ClearDragFileList(FDragDropFilesEx.FileList);
  2227. SourceParentPath := ExtractFilePath(ExcludeTrailingBackslash(SourcePath));
  2228. end
  2229. else
  2230. if Effect = DROPEFFECT_LINK then
  2231. { Create Link requested: }
  2232. begin
  2233. for Index := 0 to FDragDropFilesEx.FileList.Count - 1 do
  2234. begin
  2235. if not DropLink(PFDDListItem(FDragDropFilesEx.FileList[Index]), TargetPath) then
  2236. begin
  2237. DDError(DDCreateShortCutError);
  2238. end;
  2239. end;
  2240. end;
  2241. if Effect = DROPEFFECT_MOVE then
  2242. Items.BeginUpdate;
  2243. {Update source directory, if move-operation was performed:}
  2244. if ((Effect = DROPEFFECT_MOVE) or IsRecycleBin) then
  2245. begin
  2246. ValidateDirectory(FindNodeToPath(SourceParentPath));
  2247. end;
  2248. {Update subdirectories of target directory:}
  2249. TargetNode := FindNodeToPath(TargetPath);
  2250. if Assigned(TargetNode) then
  2251. ValidateDirectory(TargetNode)
  2252. else
  2253. ValidateDirectory(GetDriveStatus(DriveInfo.GetDriveKey(TargetPath)).RootNode);
  2254. if Effect = DROPEFFECT_MOVE then
  2255. Items.EndUpdate;
  2256. {Update linked component TDirView:}
  2257. if Assigned(FDirView) and (not FDirView.WatchThreadActive) then
  2258. begin
  2259. case Effect of
  2260. DROPEFFECT_COPY,
  2261. DROPEFFECT_LINK:
  2262. if (IncludeTrailingBackslash(TargetPath) = IncludeTrailingBackslash(DirView.Path)) then
  2263. FDirView.Reload2;
  2264. DROPEFFECT_MOVE:
  2265. if (IncludeTrailingBackslash(TargetPath) = IncludeTrailingBackslash(DirView.Path)) or
  2266. (IncludeTrailingBackslash(SourceParentPath) = IncludeTrailingBackslash(DirView.Path)) then
  2267. begin
  2268. if FDirView <> DropSourceControl then FDirView.Reload2;
  2269. end;
  2270. end; {Case}
  2271. end;
  2272. {Update the DropSource control, if files are moved and it is a TDirView:}
  2273. if (Effect = DROPEFFECT_MOVE) and (DropSourceControl is TDirView) then
  2274. begin
  2275. TDirView(DropSourceControl).ValidateSelectedFiles;
  2276. end;
  2277. finally
  2278. FFileOperator.OperandFrom.Clear;
  2279. FFileOperator.OperandTo.Clear;
  2280. StartAllWatchThreads;
  2281. if Assigned(FDirView) and (not FDirView.WatchThreadActive) then
  2282. FDirView.StartWatchThread;
  2283. if Assigned(DropSourceControl) and (DropSourceControl is TDirView) and
  2284. (not TDirView(DropSourceControl).WatchThreadActive) then
  2285. TDirView(DropSourceControl).StartWatchThread;
  2286. Screen.Cursor := SaveCursor;
  2287. end;
  2288. end; {PerformDragDropFileOperation}
  2289. function TDriveView.GetCanUndoCopyMove: Boolean;
  2290. begin
  2291. Result := Assigned(FFileOperator) and FFileOperator.CanUndo;
  2292. end; {CanUndoCopyMove}
  2293. function TDriveView.UndoCopyMove: Boolean;
  2294. var
  2295. LastTarget: string;
  2296. LastSource: string;
  2297. begin
  2298. Result := False;
  2299. if FFileOperator.CanUndo then
  2300. begin
  2301. Lasttarget := FFileOperator.LastOperandTo[0];
  2302. LastSource := FFileOperator.LastOperandFrom[0];
  2303. StopAllWatchThreads;
  2304. Result := FFileOperator.UndoExecute;
  2305. ValidateDirectory(FindNodeToPath(ExtractFilePath(LastTarget)));
  2306. ValidateDirectory(FindNodeToPath(ExtractFilePath(LastSource)));
  2307. StartAllWatchThreads;
  2308. if Assigned(FDirView) then
  2309. with FDirView do
  2310. if not WatchThreadActive then
  2311. begin
  2312. if (IncludeTrailingBackslash(ExtractFilePath(LastTarget)) = IncludeTrailingBackslash(Path)) or
  2313. (IncludeTrailingBackslash(ExtractFilePath(LastSource)) = IncludeTrailingBackslash(Path)) then
  2314. Reload2;
  2315. end;
  2316. end;
  2317. end; {UndoCopyMove}
  2318. {Clipboard operations:}
  2319. procedure TDriveView.SetLastPathCut(Path: string);
  2320. var
  2321. Node: TTreeNode;
  2322. begin
  2323. if FLastPathCut <> Path then
  2324. begin
  2325. Node := FindNodeToPath(FLastPathCut);
  2326. if Assigned(Node) then
  2327. begin
  2328. FLastPathCut := Path;
  2329. Node.Cut := False;
  2330. end;
  2331. Node := FindNodeToPath(Path);
  2332. if Assigned(Node) then
  2333. begin
  2334. FLastPathCut := Path;
  2335. Node.Cut := True;
  2336. end;
  2337. end;
  2338. end; {SetLastNodeCut}
  2339. procedure TDriveView.EmptyClipboard;
  2340. begin
  2341. if Windows.OpenClipBoard(0) then
  2342. begin
  2343. Windows.EmptyClipBoard;
  2344. Windows.CloseClipBoard;
  2345. LastPathCut := '';
  2346. LastClipBoardOperation := cboNone;
  2347. if Assigned(FDirView) then
  2348. FDirView.EmptyClipboard;
  2349. end;
  2350. end; {EmptyClipBoard}
  2351. function TDriveView.CopyToClipBoard(Node: TTreeNode): Boolean;
  2352. begin
  2353. Result := Assigned(Selected);
  2354. if Result then
  2355. begin
  2356. EmptyClipBoard;
  2357. ClearDragFileList(FDragDropFilesEx.FileList);
  2358. AddToDragFileList(FDragDropFilesEx.FileList, Selected);
  2359. Result := FDragDropFilesEx.CopyToClipBoard;
  2360. LastClipBoardOperation := cboCopy;
  2361. end;
  2362. end; {CopyToClipBoard}
  2363. function TDriveView.CutToClipBoard(Node: TTreeNode): Boolean;
  2364. begin
  2365. Result := Assigned(Node) and (Node.Level > 0) and CopyToClipBoard(Node);
  2366. if Result then
  2367. begin
  2368. LastPathCut := NodePathName(Node);
  2369. LastClipBoardOperation := cboCut;
  2370. end;
  2371. end; {CutToClipBoard}
  2372. function TDriveView.CanPasteFromClipBoard: Boolean;
  2373. begin
  2374. Result := False;
  2375. if Assigned(Selected) and Windows.OpenClipboard(0) then
  2376. begin
  2377. Result := IsClipboardFormatAvailable(CF_HDROP);
  2378. Windows.CloseClipBoard;
  2379. end;
  2380. end; {CanPasteFromClipBoard}
  2381. function TDriveView.PasteFromClipBoard(TargetPath: String = ''): Boolean;
  2382. begin
  2383. ClearDragFileList(FDragDropFilesEx.FileList);
  2384. Result := False;
  2385. if CanPasteFromClipBoard and {MP}FDragDropFilesEx.GetFromClipBoard{/MP}
  2386. then
  2387. begin
  2388. if TargetPath = '' then
  2389. TargetPath := NodePathName(Selected);
  2390. case LastClipBoardOperation of
  2391. cboCopy,
  2392. cboNone:
  2393. begin
  2394. PerformDragDropFileOperation(Selected, DROPEFFECT_COPY);
  2395. if Assigned(FOnDDExecuted) then
  2396. FOnDDExecuted(Self, DROPEFFECT_COPY);
  2397. end;
  2398. cboCut:
  2399. begin
  2400. PerformDragDropFileOperation(Selected, DROPEFFECT_MOVE);
  2401. if Assigned(FOnDDExecuted) then
  2402. FOnDDExecuted(Self, DROPEFFECT_MOVE);
  2403. EmptyClipBoard;
  2404. end;
  2405. end;
  2406. Result := True;
  2407. end;
  2408. end; {PasteFromClipBoard}
  2409. end.