DriveView.pas 79 KB

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