DriveView.pas 87 KB

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