DriveView.pas 77 KB

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