DriveView.pas 79 KB

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