DriveView.pas 87 KB

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