DriveView.pas 79 KB

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