DriveView.pas 90 KB

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