DriveView.pas 79 KB

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