DriveView.pas 92 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300
  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, BaseUtils, CustomDirView,
  35. CustomDriveView, System.Generics.Collections, CompThread;
  36. const
  37. msThreadChangeDelay = 50;
  38. ErrorNodeNA = '%s: Node not assigned';
  39. {Flags used by TDriveView.RefreshRootNodes:}
  40. dvdsFloppy = 8; {Include floppy drives}
  41. dvdsRereadAllways = 16; {Refresh drivestatus in any case}
  42. WM_USER_SHCHANGENOTIFY = WM_USER + $2000 + 13;
  43. WM_USER_SUBDIRREADER = WM_USER_SHCHANGENOTIFY + 1;
  44. type
  45. EInvalidDirName = class(Exception);
  46. ENodeNotAssigned = class(Exception);
  47. TDriveStatus = class
  48. Scanned: Boolean; {Drive allready scanned?}
  49. Verified: Boolean; {Drive completly scanned?}
  50. RootNode: TTreeNode; {Rootnode to drive}
  51. RootNodeIndex: Integer;
  52. DiscMonitor: TDiscMonitor; {Monitor thread}
  53. ChangeTimer: TTimer; {Change timer for the monitor thread}
  54. DefaultDir: string; {Current directory}
  55. DriveHandle: THandle;
  56. NotificationHandle: HDEVNOTIFY;
  57. end;
  58. TDriveStatusPair = TPair<string, TDriveStatus>;
  59. TScanDirInfo = record
  60. SearchNewDirs: Boolean;
  61. StartNode: TTreeNode;
  62. DriveType: Integer;
  63. end;
  64. PScanDirInfo = ^TScanDirInfo;
  65. TDriveView = class;
  66. TSubDirReaderSchedule = class
  67. Node: TTreeNode;
  68. Path: string;
  69. Deleted: Boolean;
  70. Processed: Boolean;
  71. end;
  72. TNodeData = class
  73. private
  74. FDirName: string;
  75. FAttr: Integer;
  76. FScanned: Boolean;
  77. FData: Pointer;
  78. FIsRecycleBin: Boolean;
  79. FIconEmpty: Boolean;
  80. FSchedule: TSubDirReaderSchedule;
  81. public
  82. DelayedSrec: TSearchRec;
  83. DelayedExclude: TStringList;
  84. constructor Create;
  85. destructor Destroy; override;
  86. property DirName: string read FDirName write FDirName;
  87. property Attr: Integer read FAttr write FAttr;
  88. property Scanned: Boolean read FScanned write FScanned;
  89. property Data: Pointer read FData write FData;
  90. property IsRecycleBin: Boolean read FIsRecycleBin;
  91. property IconEmpty: Boolean read FIconEmpty write FIconEmpty;
  92. property Schedule: TSubDirReaderSchedule read FSchedule write FSchedule;
  93. end;
  94. TDriveTreeNode = class(TTreeNode)
  95. procedure Assign(Source: TPersistent); override;
  96. end;
  97. TSubDirReaderThread = class(TCompThread)
  98. public
  99. destructor Destroy; override;
  100. procedure Terminate; override;
  101. protected
  102. constructor Create(DriveView: TDriveView);
  103. procedure Add(Node: TTreeNode; Path: string);
  104. procedure Delete(Node: TTreeNode);
  105. function Detach: Integer;
  106. procedure Reattach(Count: Integer);
  107. procedure Execute; override;
  108. private
  109. FDriveView: TDriveView;
  110. FEvent: THandle;
  111. FQueue: TStack<TSubDirReaderSchedule>;
  112. FResults: TQueue<TSubDirReaderSchedule>;
  113. FSection: TRTLCriticalSection;
  114. FTimer: TTimer;
  115. FWindowHandle: HWND;
  116. procedure TriggerEvent;
  117. procedure ScheduleProcess;
  118. procedure Process;
  119. function ProcessResult: Boolean;
  120. procedure Timer(Sender: TObject);
  121. procedure WndProc(var Msg: TMessage);
  122. end;
  123. TDriveViewRefreshDrives = procedure(Sender: TObject; Global: Boolean) of object;
  124. TDriveView = class(TCustomDriveView)
  125. private
  126. FDriveStatus: TObjectDictionary<string, TDriveStatus>;
  127. FConfirmDelete: Boolean;
  128. FConfirmOverwrite: Boolean;
  129. FWatchDirectory: Boolean;
  130. FDirectory: string;
  131. FShowVolLabel: Boolean;
  132. FVolDisplayStyle: TVolumeDisplayStyle;
  133. FChangeFlag: Boolean;
  134. FLastDir: string;
  135. FValidateFlag: Boolean;
  136. FSysColorChangePending: Boolean;
  137. FCreating: Boolean;
  138. FForceRename: Boolean;
  139. FRenameNode: TTreeNode;
  140. FLastRenameName: string;
  141. FInternalWindowHandle: HWND;
  142. FChangeNotify: ULONG;
  143. FPrevSelected: TTreeNode;
  144. FPrevSelectedIndex: Integer;
  145. FChangeTimerSuspended: Integer;
  146. FSubDirReaderThread: TSubDirReaderThread;
  147. FDelayedNodes: TStringList;
  148. FDelayedNodeTimer: TTimer;
  149. {Additional events:}
  150. FOnDisplayContextMenu: TNotifyEvent;
  151. FOnRefreshDrives: TDriveViewRefreshDrives;
  152. FOnNeedHiddenDirectories: TNotifyEvent;
  153. {used components:}
  154. FDirView: TDirView;
  155. FFileOperator: TFileOperator;
  156. FChangeInterval: Cardinal;
  157. {Drag&drop:}
  158. FLastPathCut: string;
  159. {Drag&drop helper functions:}
  160. procedure SignalDirDelete(Sender: TObject; Files: TStringList);
  161. function GetSubDir(var SRec: TSearchRec): Boolean;
  162. function FindFirstSubDir(Path: string; var SRec: TSearchRec): Boolean;
  163. function FindNextSubDir(var SRec: TSearchRec): Boolean;
  164. procedure ReadSubDirs(Node: TTreeNode);
  165. procedure CancelDelayedNode(Node: TTreeNode);
  166. procedure DelayedNodeTimer(Sender: TObject);
  167. function ReadSubDirsBatch(Node: TTreeNode; var SRec: TSearchRec; CheckInterval, Limit: Integer): Boolean;
  168. procedure UpdateDelayedNodeTimer;
  169. {Callback-functions used by iteratesubtree:}
  170. function CallBackValidateDir(var Node: TTreeNode; Data: Pointer): Boolean;
  171. procedure DeleteNode(Node: TTreeNode);
  172. { Notification procedures used by component TDiscMonitor: }
  173. procedure ChangeDetected(Sender: TObject; const Directory: string;
  174. var SubdirsChanged: Boolean);
  175. procedure ChangeInvalid(Sender: TObject; const Directory: string; const ErrorStr: string);
  176. {Notification procedure used by component TTimer:}
  177. procedure ChangeTimerOnTimer(Sender: TObject);
  178. protected
  179. procedure SetSelected(Node: TTreeNode);
  180. procedure SetWatchDirectory(Value: Boolean);
  181. procedure SetShowVolLabel(ShowIt: Boolean);
  182. procedure SetDirView(Value: TDirView);
  183. procedure SetDirectory(Value: string); override;
  184. function DoScanDir(FromNode: TTreeNode): Boolean;
  185. procedure AddChildNode(ParentNode: TTreeNode; ParentPath: string; SRec: TSearchRec);
  186. procedure CreateWatchThread(Drive: string);
  187. function NodeWatched(Node: TTreeNode): Boolean;
  188. procedure TerminateWatchThread(Drive: string);
  189. function WatchThreadActive: Boolean; overload;
  190. function WatchThreadActive(Drive: string): Boolean; overload;
  191. procedure InternalWndProc(var Msg: TMessage);
  192. procedure UpdateDriveNotifications(Drive: string);
  193. procedure DriveRemoved(Drive: string);
  194. procedure DriveRemoving(Drive: string);
  195. procedure CancelDriveRefresh;
  196. procedure DoRefreshDrives(Global: Boolean);
  197. procedure RefreshRootNodes(dsFlags: Integer);
  198. function DirAttrMask: Integer;
  199. function CreateDriveStatus: TDriveStatus;
  200. procedure ValidateDirectoryEx(Node: TTreeNode; Recurse: TRecursiveScan;
  201. NewDirs: Boolean); override;
  202. procedure RebuildTree; override;
  203. procedure SetLastPathCut(Path: string);
  204. function GetCanUndoCopyMove: Boolean; virtual;
  205. procedure CreateWnd; override;
  206. procedure DestroyWnd; override;
  207. procedure Edit(const Item: TTVItem); override;
  208. procedure WMUserRename(var Message: TMessage); message WM_USER_RENAME;
  209. procedure CMRecreateWnd(var Msg: TMessage); message CM_RECREATEWND;
  210. procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
  211. function GetCustomDirView: TCustomDirView; override;
  212. procedure SetCustomDirView(Value: TCustomDirView); override;
  213. function NodePath(Node: TTreeNode): string; override;
  214. function NodeIsRecycleBin(Node: TTreeNode): Boolean; override;
  215. function NodePathExists(Node: TTreeNode): Boolean; override;
  216. function NodeColor(Node: TTreeNode): TColor; override;
  217. function FindPathNode(Path: string): TTreeNode; override;
  218. function DoFindNodeToPath(Path: string; ExistingOnly: Boolean): TTreeNode;
  219. function CreateNode: TTreeNode; override;
  220. function DDSourceEffects: TDropEffectSet; override;
  221. procedure DDChooseEffect(KeyState: Integer; var Effect: Integer; PreferredEffect: Integer); override;
  222. function DragCompleteFileList: Boolean; override;
  223. function DDExecute: TDragResult; override;
  224. public
  225. property Images;
  226. property StateImages;
  227. property Items stored False;
  228. property Selected Write SetSelected stored False;
  229. property DragImageList: TDragImageList read FDragImageList;
  230. property CanUndoCopyMove: Boolean read GetCanUndoCopyMove;
  231. property DDFileOperator: TFileOperator read FFileOperator;
  232. property LastPathCut: string read FLastPathCut write SetLastPathCut;
  233. function UndoCopyMove: Boolean; dynamic;
  234. procedure EmptyClipboard; dynamic;
  235. function CopyToClipBoard(Node: TTreeNode): Boolean; dynamic;
  236. function CutToClipBoard(Node: TTreeNode): Boolean; dynamic;
  237. function CanPasteFromClipBoard: Boolean; dynamic;
  238. function PasteFromClipBoard(TargetPath: string = ''): Boolean; dynamic;
  239. procedure PerformDragDropFileOperation(Node: TTreeNode; Effect: Integer); override;
  240. {Drive handling:}
  241. function GetDriveStatus(Drive: string): TDriveStatus;
  242. function GetDriveTypetoNode(Node: TTreeNode): Integer; {Returns DRIVE_CDROM etc..}
  243. function GetDriveToNode(Node: TTreeNode): string;
  244. function GetDriveText(Drive: string): string;
  245. procedure ScanDrive(Drive: string);
  246. function GetDrives: TStrings;
  247. procedure ScheduleDriveRefresh;
  248. {Node handling:}
  249. procedure SetImageIndex(Node: TTreeNode); virtual;
  250. function FindNodeToPath(Path: string): TTreeNode;
  251. function TryFindNodeToPath(Path: string): TTreeNode;
  252. function RootNode(Node: TTreeNode): TTreeNode;
  253. function GetDirName(Node: TTreeNode): string;
  254. function GetDisplayName(Node: TTreeNode): string;
  255. function NodePathName(Node: TTreeNode): string; override;
  256. constructor Create(AOwner: TComponent); override;
  257. destructor Destroy; override;
  258. {Menu-handling:}
  259. procedure DisplayContextMenu(Node: TTreeNode; Point: TPoint); override;
  260. procedure DisplayPropertiesMenu(Node: TTreeNode); override;
  261. {Watchthread handling:}
  262. procedure StartWatchThread;
  263. procedure StopWatchThread;
  264. procedure SuspendChangeTimer;
  265. procedure ResumeChangeTimer;
  266. procedure StartAllWatchThreads;
  267. procedure StopAllWatchThreads;
  268. procedure ValidateCurrentDirectoryIfNotMonitoring;
  269. (* Modified Events: *)
  270. procedure GetImageIndex(Node: TTreeNode); override;
  271. function CanEdit(Node: TTreeNode): Boolean; override;
  272. function CanChange(Node: TTreeNode): Boolean; override;
  273. function CanExpand(Node: TTreeNode): Boolean; override;
  274. procedure Delete(Node: TTreeNode); override;
  275. procedure Loaded; override;
  276. procedure KeyPress(var Key: Char); override;
  277. procedure Change(Node: TTreeNode); override;
  278. published
  279. {Additional properties:}
  280. {Current selected directory:}
  281. property Directory;
  282. {Confirm deleting directories:}
  283. property ConfirmDelete: Boolean read FConfirmDelete write FConfirmDelete default True;
  284. {Confirm overwriting directories:}
  285. property ConfirmOverwrite: Boolean read FConfirmOverwrite write FConfirmOverwrite default True;
  286. {Enable automatic update on filesystem changes:}
  287. property WatchDirectory: Boolean read FWatchDirectory write SetWatchDirectory default False;
  288. {Linked component TDirView:}
  289. property DirView: TDirView read FDirView write SetDirView;
  290. {Show the volume labels of drives:}
  291. property ShowVolLabel: Boolean read FShowVolLabel write SetShowVolLabel default True;
  292. {Additional events:}
  293. property OnDisplayContextMenu: TNotifyEvent read FOnDisplayContextMenu
  294. write FOnDisplayContextMenu;
  295. property OnRefreshDrives: TDriveViewRefreshDrives read FOnRefreshDrives write FOnRefreshDrives;
  296. property OnBusy;
  297. property DDLinkOnExeDrag;
  298. property TargetPopUpMenu;
  299. property OnDDDragEnter;
  300. property OnDDDragLeave;
  301. property OnDDDragOver;
  302. property OnDDDrop;
  303. property OnDDQueryContinueDrag;
  304. property OnDDGiveFeedback;
  305. property OnDDDragDetect;
  306. property OnDDProcessDropped;
  307. property OnDDError;
  308. property OnDDExecuted;
  309. property OnDDFileOperation;
  310. property OnDDFileOperationExecuted;
  311. property Align;
  312. property Anchors;
  313. property AutoExpand;
  314. property BiDiMode;
  315. property BorderStyle;
  316. property BorderWidth;
  317. property ChangeDelay;
  318. property Color;
  319. property Ctl3D;
  320. property Constraints;
  321. property DoubleBuffered;
  322. {Delphi's drag&drop is not compatible with the OLE windows drag&drop:}
  323. property DragKind;
  324. property DragCursor;
  325. property DragMode Default dmAutomatic;
  326. property OnDragDrop;
  327. property OnDragOver;
  328. property Enabled;
  329. property Font;
  330. property HideSelection;
  331. property HotTrack;
  332. property Indent;
  333. property ParentBiDiMode;
  334. property ParentColor;
  335. property ParentCtl3D;
  336. property ParentDoubleBuffered;
  337. property ParentFont;
  338. property ParentShowHint;
  339. property PopupMenu;
  340. property ReadOnly;
  341. property RightClickSelect;
  342. property RowSelect;
  343. property ShowButtons;
  344. property ShowHint;
  345. property ShowLines;
  346. property TabOrder;
  347. property TabStop default True;
  348. property ToolTips;
  349. property Visible;
  350. property OnChange;
  351. property OnChanging;
  352. property OnClick;
  353. property OnCollapsing;
  354. property OnCollapsed;
  355. property OnCompare;
  356. property OnDblClick;
  357. property OnDeletion;
  358. property OnEdited;
  359. property OnEditing;
  360. property OnEndDock;
  361. property OnEndDrag;
  362. property OnEnter;
  363. property OnExit;
  364. property OnExpanding;
  365. property OnExpanded;
  366. property OnGetImageIndex;
  367. property OnGetSelectedIndex;
  368. property OnKeyDown;
  369. property OnKeyPress;
  370. property OnKeyUp;
  371. property OnMouseDown;
  372. property OnMouseMove;
  373. property OnMouseUp;
  374. property OnStartDock;
  375. property OnStartDrag;
  376. property OnNeedHiddenDirectories: TNotifyEvent read FOnNeedHiddenDirectories write FOnNeedHiddenDirectories;
  377. end;
  378. var
  379. DriveViewLoadingTooLongLimit: Integer = 0;
  380. procedure Register;
  381. implementation
  382. uses
  383. PasTools, UITypes, SyncObjs, IOUtils, System.DateUtils;
  384. type
  385. PInt = ^Integer;
  386. procedure Register;
  387. begin
  388. RegisterComponents('DriveDir', [TDriveView]);
  389. end; {Register}
  390. constructor TNodeData.Create;
  391. begin
  392. inherited;
  393. FAttr := 0;
  394. FScanned := False;
  395. FDirName := '';
  396. FIsRecycleBin := False;
  397. FIconEmpty := True;
  398. FSchedule := nil;
  399. DelayedExclude := nil;
  400. end; {TNodeData.Create}
  401. destructor TNodeData.Destroy;
  402. begin
  403. Assert(not Assigned(FSchedule));
  404. SetLength(FDirName, 0);
  405. inherited;
  406. end; {TNodeData.Destroy}
  407. { TSubDirReaderThread }
  408. constructor TSubDirReaderThread.Create(DriveView: TDriveView);
  409. begin
  410. inherited Create(True);
  411. FDriveView := DriveView;
  412. FSection.Initialize;
  413. FEvent := CreateEvent(nil, False, False, nil);
  414. FQueue := TStack<TSubDirReaderSchedule>.Create;
  415. FResults := TQueue<TSubDirReaderSchedule>.Create;
  416. FTimer := TTimer.Create(FDriveView);
  417. FTimer.Enabled := False;
  418. FTimer.Interval := 200;
  419. FTimer.OnTimer := Timer;
  420. FWindowHandle := AllocateHWnd(WndProc);
  421. end;
  422. destructor TSubDirReaderThread.Destroy;
  423. procedure DestroyScheduleList(List: TEnumerable<TSubDirReaderSchedule>);
  424. var
  425. Schedule: TSubDirReaderSchedule;
  426. begin
  427. for Schedule in List do
  428. begin
  429. if not Schedule.Deleted then
  430. TNodeData(Schedule.Node.Data).Schedule := nil;
  431. Schedule.Free;
  432. end;
  433. List.Destroy;
  434. end;
  435. begin
  436. inherited;
  437. DeallocateHWnd(FWindowHandle);
  438. DestroyScheduleList(FQueue);
  439. DestroyScheduleList(FResults);
  440. CloseHandle(FEvent);
  441. FTimer.Destroy;
  442. FSection.Destroy;
  443. end;
  444. procedure TSubDirReaderThread.WndProc(var Msg: TMessage);
  445. begin
  446. if Msg.Msg = WM_USER_SUBDIRREADER then
  447. ScheduleProcess
  448. else
  449. Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
  450. end;
  451. procedure TSubDirReaderThread.Process;
  452. var
  453. Started: DWORD;
  454. Elapsed: Integer;
  455. Later: Boolean;
  456. begin
  457. Started := GetTickCount;
  458. Later := False;
  459. while (not Later) and ProcessResult do
  460. begin
  461. Elapsed := GetTickCount - Started;
  462. Later := (Elapsed < 0) or (Elapsed > 20);
  463. end;
  464. if not Later then
  465. FTimer.Enabled := False;
  466. end;
  467. procedure TSubDirReaderThread.Timer(Sender: TObject);
  468. begin
  469. Process;
  470. end;
  471. procedure TSubDirReaderThread.Add(Node: TTreeNode; Path: string);
  472. var
  473. NodeData: TNodeData;
  474. Schedule: TSubDirReaderSchedule;
  475. begin
  476. if Suspended then
  477. Resume;
  478. FSection.Enter;
  479. try
  480. NodeData := TNodeData(Node.Data);
  481. Assert(not Assigned(NodeData.Schedule));
  482. Schedule := TSubDirReaderSchedule.Create;
  483. Schedule.Node := Node;
  484. Schedule.Path := Path;
  485. Schedule.Deleted := False;
  486. Schedule.Processed := False;
  487. FQueue.Push(Schedule);
  488. NodeData.Schedule := Schedule;
  489. finally
  490. FSection.Leave;
  491. end;
  492. TriggerEvent;
  493. end;
  494. procedure TSubDirReaderThread.Delete(Node: TTreeNode);
  495. var
  496. NodeData: TNodeData;
  497. begin
  498. FSection.Enter;
  499. try
  500. NodeData := TNodeData(Node.Data);
  501. if Assigned(NodeData.Schedule) then
  502. begin
  503. NodeData.Schedule.Deleted := True;
  504. NodeData.Schedule := nil;
  505. end;
  506. finally
  507. FSection.Leave;
  508. end;
  509. TriggerEvent;
  510. end;
  511. function TSubDirReaderThread.Detach: Integer;
  512. procedure DetachList(List: TEnumerable<TSubDirReaderSchedule>);
  513. var
  514. Schedule: TSubDirReaderSchedule;
  515. begin
  516. for Schedule in List do
  517. begin
  518. if Schedule.Deleted then Schedule.Free
  519. else
  520. begin
  521. Assert(Schedule.Processed = (List = FResults));
  522. Schedule.Node := nil;
  523. Inc(Result);
  524. end;
  525. end;
  526. end;
  527. begin
  528. // block thread while handle is being recreated
  529. FSection.Enter;
  530. try
  531. Result := 0;
  532. DetachList(FQueue);
  533. DetachList(FResults);
  534. FQueue.Clear;
  535. FResults.Clear;
  536. except
  537. FSection.Leave;
  538. raise;
  539. end;
  540. end;
  541. procedure TSubDirReaderThread.Reattach(Count: Integer);
  542. var
  543. Node: TTreeNode;
  544. Schedule: TSubDirReaderSchedule;
  545. begin
  546. try
  547. if Count > 0 then
  548. begin
  549. Node := FDriveView.Items.GetFirstNode;
  550. while Assigned(Node) do
  551. begin
  552. Schedule := TNodeData(Node.Data).Schedule;
  553. if Assigned(Schedule) then
  554. begin
  555. Assert(not Assigned(Schedule.Node));
  556. Schedule.Node := Node;
  557. if not Schedule.Processed then
  558. FQueue.Push(Schedule)
  559. else
  560. FResults.Enqueue(Schedule);
  561. Assert(Count > 0);
  562. // Can be optimized to stop once Count = 0
  563. Dec(Count);
  564. end;
  565. Node := Node.GetNext;
  566. end;
  567. if Count <> 0 then Assert(False); // shut up
  568. end;
  569. finally
  570. FSection.Leave;
  571. end;
  572. TriggerEvent;
  573. ScheduleProcess;
  574. end;
  575. procedure TSubDirReaderThread.Terminate;
  576. begin
  577. inherited;
  578. TriggerEvent;
  579. end;
  580. procedure TSubDirReaderThread.TriggerEvent;
  581. begin
  582. SetEvent(FEvent);
  583. end;
  584. function TSubDirReaderThread.ProcessResult: Boolean;
  585. var
  586. Node: TTreeNode;
  587. NodeData: TNodeData;
  588. Schedule: TSubDirReaderSchedule;
  589. begin
  590. FSection.Enter;
  591. try
  592. Result := (FResults.Count > 0);
  593. if Result then
  594. begin
  595. Schedule := FResults.Dequeue;
  596. if not Schedule.Deleted then
  597. begin
  598. Assert(Schedule.Processed);
  599. Node := Schedule.Node;
  600. Node.HasChildren := False;
  601. NodeData := TNodeData(Node.Data);
  602. NodeData.Scanned := not Node.HasChildren; // = True
  603. Assert(NodeData.Schedule = Schedule);
  604. NodeData.Schedule := nil;
  605. end;
  606. Schedule.Free;
  607. end;
  608. finally
  609. FSection.Leave;
  610. end;
  611. end;
  612. procedure TSubDirReaderThread.ScheduleProcess;
  613. begin
  614. // process the first batch immediatelly, to make it more likely that the first seen subdirectories
  615. // will immediatelly show correct status
  616. Process;
  617. FTimer.Enabled := True;
  618. end;
  619. procedure TSubDirReaderThread.Execute;
  620. var
  621. SRec: TSearchRec;
  622. HasSubDirs: Boolean;
  623. NodeData: TNodeData;
  624. Schedule: TSubDirReaderSchedule;
  625. DelayStart, DelayStartStep: Integer;
  626. begin
  627. DelayStart := 3000;
  628. DelayStartStep := 100;
  629. while (DelayStart > 0) and (not Terminated) do
  630. begin
  631. Sleep(DelayStartStep);
  632. Dec(DelayStart, DelayStartStep)
  633. end;
  634. while not Terminated do
  635. begin
  636. WaitForSingleObject(FEvent, INFINITE);
  637. while not Terminated do
  638. begin
  639. FSection.Enter;
  640. try
  641. if FQueue.Count = 0 then
  642. begin
  643. Break;
  644. end
  645. else
  646. begin
  647. Schedule := FQueue.Pop;
  648. if Schedule.Deleted then
  649. begin
  650. Schedule.Free;
  651. // Can be optimized to loop within locked critical section until first non-deleted schedule is found
  652. Continue;
  653. end;
  654. Assert(not Schedule.Processed);
  655. end
  656. finally
  657. FSection.Leave;
  658. end;
  659. HasSubDirs := FDriveView.FindFirstSubDir(IncludeTrailingBackslash(Schedule.Path) + '*.*', SRec);
  660. FindClose(SRec);
  661. FSection.Enter;
  662. try
  663. if Schedule.Deleted then
  664. begin
  665. Schedule.Free;
  666. end
  667. else
  668. begin
  669. Schedule.Processed := True;
  670. if not HasSubDirs then // optimization
  671. begin
  672. FResults.Enqueue(Schedule);
  673. if FResults.Count = 1 then
  674. PostMessage(FWindowHandle, WM_USER_SUBDIRREADER, 0, 0);
  675. end
  676. else
  677. begin
  678. // can happen only if the tree handle is just being recreated
  679. if Assigned(Schedule.Node) then
  680. begin
  681. NodeData := TNodeData(Schedule.Node.Data);
  682. NodeData.Schedule := nil;
  683. end;
  684. Schedule.Free;
  685. end;
  686. end;
  687. finally
  688. FSection.Leave;
  689. end;
  690. end;
  691. end;
  692. end;
  693. { TDriveTreeNode }
  694. // Not sure if this is ever used (possibly only then "assigning" tree view to another instance, what never do).
  695. // It is NOT used when recreating a tree view handle - for that a node is serialized and deserialized,
  696. // including a pointer to TNodeData. See csRecreating condition in TDriveView.Delete.
  697. procedure TDriveTreeNode.Assign(Source: TPersistent);
  698. var
  699. SourceData: TNodeData;
  700. NewData: TNodeData;
  701. begin
  702. Assert(False);
  703. inherited Assign(Source);
  704. if not Deleting and (Source is TTreeNode) then
  705. begin
  706. SourceData := TNodeData(TTreeNode(Source).Data);
  707. NewData := TNodeData.Create();
  708. NewData.DirName := SourceData.DirName;
  709. NewData.Attr := SourceData.Attr;
  710. NewData.Scanned := SourceData.Scanned;
  711. NewData.Data := SourceData.Data;
  712. NewData.FIsRecycleBin := SourceData.FIsRecycleBin;
  713. NewData.IconEmpty := SourceData.IconEmpty;
  714. TTreeNode(Source).Data := NewData;
  715. end;
  716. end;
  717. { TDriveView }
  718. constructor TDriveView.Create(AOwner: TComponent);
  719. var
  720. Drive: TRealDrive;
  721. ChangeNotifyEntry: TSHChangeNotifyEntry;
  722. Dummy: string;
  723. begin
  724. inherited;
  725. FCreating := True;
  726. FDriveStatus := TObjectDictionary<string, TDriveStatus>.Create([doOwnsValues]);
  727. FChangeInterval := MSecsPerSec;
  728. for Drive := FirstDrive to LastDrive do
  729. begin
  730. FDriveStatus.Add(Drive, CreateDriveStatus);
  731. end;
  732. FFileOperator := TFileOperator.Create(Self);
  733. FSubDirReaderThread := TSubDirReaderThread.Create(Self);
  734. FDelayedNodes := TStringList.Create;
  735. FDelayedNodeTimer := TTimer.Create(Self);
  736. UpdateDelayedNodeTimer;
  737. FDelayedNodeTimer.Interval := 250;
  738. FDelayedNodeTimer.OnTimer := DelayedNodeTimer;
  739. FShowVolLabel := True;
  740. FChangeFlag := False;
  741. FLastDir := EmptyStr;
  742. FValidateFlag := False;
  743. FSysColorChangePending := False;
  744. FConfirmDelete := True;
  745. FDirectory := EmptyStr;
  746. FForceRename := False;
  747. FLastRenameName := '';
  748. FRenameNode := nil;
  749. FPrevSelected := nil;
  750. FPrevSelectedIndex := -1;
  751. FChangeTimerSuspended := 0;
  752. FConfirmOverwrite := True;
  753. FLastPathCut := '';
  754. FStartPos.X := -1;
  755. FStartPos.Y := -1;
  756. FDragPos := FStartPos;
  757. FInternalWindowHandle := Classes.AllocateHWnd(InternalWndProc);
  758. // Source: petr.solin 2022-02-25
  759. FChangeNotify := 0;
  760. if SpecialFolderLocation(CSIDL_DESKTOP, Dummy, ChangeNotifyEntry.pidl) then
  761. begin
  762. ChangeNotifyEntry.fRecursive := False;
  763. FChangeNotify :=
  764. SHChangeNotifyRegister(
  765. FInternalWindowHandle, SHCNRF_ShellLevel or SHCNRF_NewDelivery,
  766. SHCNE_RENAMEFOLDER or SHCNE_MEDIAINSERTED or SHCNE_MEDIAREMOVED,
  767. WM_USER_SHCHANGENOTIFY, 1, ChangeNotifyEntry);
  768. end;
  769. with FDragDropFilesEx do
  770. begin
  771. ShellExtensions.DragDropHandler := True;
  772. end;
  773. end; {Create}
  774. destructor TDriveView.Destroy;
  775. var
  776. DriveStatusPair: TDriveStatusPair;
  777. begin
  778. if FChangeNotify <> 0 then SHChangeNotifyDeregister(FChangeNotify);
  779. Classes.DeallocateHWnd(FInternalWindowHandle);
  780. for DriveStatusPair in FDriveStatus do
  781. begin
  782. with DriveStatusPair.Value do
  783. begin
  784. if Assigned(DiscMonitor) then
  785. FreeAndNil(DiscMonitor);
  786. if Assigned(ChangeTimer) then
  787. FreeAndNil(ChangeTimer);
  788. end;
  789. UpdateDriveNotifications(DriveStatusPair.Key);
  790. end;
  791. FDriveStatus.Free;
  792. if Assigned(FFileOperator) then
  793. FFileOperator.Free;
  794. FSubDirReaderThread.Free;
  795. Assert(FDelayedNodes.Count = 0);
  796. FreeAndNil(FDelayedNodes);
  797. inherited Destroy;
  798. end; {Destroy}
  799. function TDriveView.CreateDriveStatus: TDriveStatus;
  800. begin
  801. Result := TDriveStatus.Create;
  802. with Result do
  803. begin
  804. Scanned := False;
  805. Verified := False;
  806. RootNode := nil;
  807. RootNodeIndex := -1;
  808. DiscMonitor := nil;
  809. DefaultDir := EmptyStr;
  810. {ChangeTimer: }
  811. ChangeTimer := TTimer.Create(Self);
  812. ChangeTimer.Interval := 0;
  813. ChangeTimer.Enabled := False;
  814. ChangeTimer.OnTimer := ChangeTimerOnTimer;
  815. DriveHandle := INVALID_HANDLE_VALUE;
  816. NotificationHandle := nil;
  817. end;
  818. end;
  819. procedure TDriveView.DriveRemoving(Drive: string);
  820. begin
  821. DriveRemoved(Drive);
  822. TerminateWatchThread(Drive);
  823. end;
  824. type
  825. PDevBroadcastHdr = ^TDevBroadcastHdr;
  826. TDevBroadcastHdr = record
  827. dbch_size: DWORD;
  828. dbch_devicetype: DWORD;
  829. dbch_reserved: DWORD;
  830. end;
  831. PDevBroadcastVolume = ^TDevBroadcastVolume;
  832. TDevBroadcastVolume = record
  833. dbcv_size: DWORD;
  834. dbcv_devicetype: DWORD;
  835. dbcv_reserved: DWORD;
  836. dbcv_unitmask: DWORD;
  837. dbcv_flags: WORD;
  838. end;
  839. PDEV_BROADCAST_HANDLE = ^DEV_BROADCAST_HANDLE;
  840. DEV_BROADCAST_HANDLE = record
  841. dbch_size : DWORD;
  842. dbch_devicetype : DWORD;
  843. dbch_reserved : DWORD;
  844. dbch_handle : THandle;
  845. dbch_hdevnotify : HDEVNOTIFY ;
  846. dbch_eventguid : TGUID;
  847. dbch_nameoffset : LongInt;
  848. dbch_data : Byte;
  849. end;
  850. PPItemIDList = ^PItemIDList;
  851. const
  852. DBT_DEVTYP_HANDLE = $00000006;
  853. DBT_CONFIGCHANGED = $0018;
  854. DBT_DEVICEARRIVAL = $8000;
  855. DBT_DEVICEQUERYREMOVE = $8001;
  856. DBT_DEVICEREMOVEPENDING = $8003;
  857. DBT_DEVICEREMOVECOMPLETE = $8004;
  858. DBT_DEVTYP_VOLUME = $00000002;
  859. // WORKAROUND Declaration in Winapi.ShlObj.pas is wrong
  860. function SHChangeNotification_Lock(hChange: THandle; dwProcId: DWORD;
  861. var PPidls: PPItemIDList; var plEvent: Longint): THANDLE; stdcall;
  862. external 'shell32.dll' name 'SHChangeNotification_Lock';
  863. procedure TDriveView.InternalWndProc(var Msg: TMessage);
  864. var
  865. DeviceType: DWORD;
  866. UnitMask: DWORD;
  867. DeviceHandle: THandle;
  868. Drive: Char;
  869. DriveStatusPair: TDriveStatusPair;
  870. PPIDL: PPItemIDList;
  871. Event: LONG;
  872. Lock: THandle;
  873. begin
  874. with Msg do
  875. begin
  876. if Msg = WM_USER_SHCHANGENOTIFY then
  877. begin
  878. Lock := SHChangeNotification_Lock(wParam, lParam, PPIDL, Event);
  879. try
  880. if (Event = SHCNE_RENAMEFOLDER) or // = drive rename
  881. (Event = SHCNE_MEDIAINSERTED) or // also bitlocker drive unlock (also sends SHCNE_UPDATEDIR)
  882. (Event = SHCNE_MEDIAREMOVED) then
  883. begin
  884. ScheduleDriveRefresh;
  885. end;
  886. finally
  887. SHChangeNotification_Unlock(Lock);
  888. end;
  889. end
  890. else
  891. if Msg = WM_DEVICECHANGE then
  892. begin
  893. if (wParam = DBT_CONFIGCHANGED) or
  894. (wParam = DBT_DEVICEARRIVAL) or
  895. (wParam = DBT_DEVICEREMOVECOMPLETE) then
  896. begin
  897. ScheduleDriveRefresh;
  898. end
  899. else
  900. if (wParam = DBT_DEVICEQUERYREMOVE) or
  901. (wParam = DBT_DEVICEREMOVEPENDING) then
  902. begin
  903. DeviceType := PDevBroadcastHdr(lParam)^.dbch_devicetype;
  904. // This is specifically for VeraCrypt.
  905. // For normal drives, see DBT_DEVTYP_HANDLE below
  906. // (and maybe now that we have generic implementation, this specific code for VeraCrypt might not be needed anymore)
  907. if DeviceType = DBT_DEVTYP_VOLUME then
  908. begin
  909. UnitMask := PDevBroadcastVolume(lParam)^.dbcv_unitmask;
  910. Drive := FirstDrive;
  911. while UnitMask > 0 do
  912. begin
  913. if UnitMask and $01 <> 0 then
  914. begin
  915. DriveRemoving(Drive);
  916. end;
  917. UnitMask := UnitMask shr 1;
  918. Drive := Chr(Ord(Drive) + 1);
  919. end;
  920. end
  921. else
  922. if DeviceType = DBT_DEVTYP_HANDLE then
  923. begin
  924. DeviceHandle := PDEV_BROADCAST_HANDLE(lParam)^.dbch_handle;
  925. for DriveStatusPair in FDriveStatus do
  926. if DriveStatusPair.Value.DriveHandle = DeviceHandle then
  927. begin
  928. DriveRemoving(DriveStatusPair.Key);
  929. end;
  930. end;
  931. end;
  932. end
  933. else
  934. if Msg = WM_TIMER then
  935. begin
  936. CancelDriveRefresh;
  937. try
  938. //DriveInfo.Load;
  939. RefreshRootNodes(dsAll or dvdsRereadAllways);
  940. DoRefreshDrives(True);
  941. except
  942. Application.HandleException(Self);
  943. end;
  944. end;
  945. Result := DefWindowProc(FInternalWindowHandle, Msg, wParam, lParam);
  946. end;
  947. end;
  948. procedure TDriveView.DoRefreshDrives(Global: Boolean);
  949. begin
  950. if Assigned(OnRefreshDrives) then
  951. OnRefreshDrives(Self, Global);
  952. end;
  953. procedure TDriveView.CancelDriveRefresh;
  954. begin
  955. KillTimer(FInternalWindowHandle, 1);
  956. end;
  957. procedure TDriveView.ScheduleDriveRefresh;
  958. begin
  959. CancelDriveRefresh;
  960. // Delay refreshing drives for a sec.
  961. // Particularly with CD/DVD drives, if we query display name
  962. // immediately after receiving DBT_DEVICEARRIVAL, we do not get media label.
  963. // Actually one sec does not help usually, but we do not want to wait any longer,
  964. // because we want to add USB drives asap.
  965. // And this problem might be solved now by SHChangeNotifyRegister/SHCNE_RENAMEFOLDER.
  966. SetTimer(FInternalWindowHandle, 1, MSecsPerSec, nil);
  967. end;
  968. procedure TDriveView.CreateWnd;
  969. var
  970. DriveStatus: TDriveStatus;
  971. begin
  972. inherited;
  973. FDragDropFilesEx.SourceEffects := [deCopy, deMove, deLink];
  974. FDragDropFilesEx.TargetEffects := [deCopy, deMove, deLink];
  975. if FPrevSelectedIndex >= 0 then
  976. begin
  977. FPrevSelected := Items[FPrevSelectedIndex];
  978. FPrevSelectedIndex := -1;
  979. end;
  980. for DriveStatus in FDriveStatus.Values do
  981. with DriveStatus do
  982. begin
  983. if RootNodeIndex >= 0 then
  984. begin
  985. RootNode := Items[RootNodeIndex];
  986. RootNodeIndex := -1;
  987. end;
  988. end;
  989. UpdateDelayedNodeTimer;
  990. end; {CreateWnd}
  991. procedure TDriveView.DestroyWnd;
  992. var
  993. DriveStatus: TDriveStatus;
  994. I: Integer;
  995. begin
  996. FDelayedNodeTimer.Enabled := False;
  997. for I := 0 to FDelayedNodes.Count - 1 do
  998. FDelayedNodes.Objects[I] := nil;
  999. if not (csRecreating in ControlState) then
  1000. begin
  1001. FSubDirReaderThread.Terminate;
  1002. FSubDirReaderThread.WaitFor;
  1003. end
  1004. else
  1005. if CreateWndRestores and (Items.Count > 0) then
  1006. begin
  1007. FPrevSelectedIndex := -1;
  1008. if Assigned(FPrevSelected) then
  1009. begin
  1010. FPrevSelectedIndex := FPrevSelected.AbsoluteIndex;
  1011. FPrevSelected := nil;
  1012. end;
  1013. for DriveStatus in FDriveStatus.Values do
  1014. with DriveStatus do
  1015. begin
  1016. RootNodeIndex := -1;
  1017. if Assigned(RootNode) then
  1018. begin
  1019. RootNodeIndex := RootNode.AbsoluteIndex;
  1020. RootNode := nil;
  1021. end;
  1022. end;
  1023. end;
  1024. inherited;
  1025. end;
  1026. function TDriveView.NodeColor(Node: TTreeNode): TColor;
  1027. begin
  1028. Result := clDefaultItemColor;
  1029. with TNodeData(Node.Data) do
  1030. if not Node.Selected then
  1031. begin
  1032. {Colored display of compressed directories:}
  1033. if (Attr and FILE_ATTRIBUTE_COMPRESSED) <> 0 then
  1034. begin
  1035. if SupportsDarkMode and DarkMode then Result := clSkyBlue
  1036. else Result := clBlue;
  1037. end
  1038. else
  1039. {Dimmed display, if hidden-atrribut set:}
  1040. if FDimmHiddenDirs and ((Attr and FILE_ATTRIBUTE_HIDDEN) <> 0) then
  1041. Result := clGrayText
  1042. end;
  1043. end;
  1044. function TDriveView.GetCustomDirView: TCustomDirView;
  1045. begin
  1046. Result := DirView;
  1047. end;
  1048. procedure TDriveView.SetCustomDirView(Value: TCustomDirView);
  1049. begin
  1050. DirView := Value as TDirView;
  1051. end;
  1052. function TDriveView.NodePath(Node: TTreeNode): string;
  1053. var
  1054. ParentNode: TTreeNode;
  1055. begin
  1056. if not Assigned(Node) then
  1057. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDirPath']));
  1058. Result := GetDirName(Node);
  1059. Node := Node.Parent;
  1060. while Assigned(Node) do
  1061. begin
  1062. ParentNode := Node.Parent;
  1063. if Assigned(ParentNode) then
  1064. Result := GetDirName(Node) + '\' + Result
  1065. else
  1066. Result := GetDirName(Node) + Result;
  1067. Node := ParentNode;
  1068. end;
  1069. if IsRootPath(Result) then
  1070. Result := ExcludeTrailingBackslash(Result);
  1071. end;
  1072. {NodePathName: Returns the complete path to Node with trailing backslash on rootnodes:
  1073. C:\ ,C:\WINDOWS, C:\WINDOWS\SYSTEM }
  1074. function TDriveView.NodePathName(Node: TTreeNode): string;
  1075. begin
  1076. Result := NodePath(Node);
  1077. if IsRootPath(Result) then
  1078. Result := IncludeTrailingBackslash(Result);
  1079. end; {NodePathName}
  1080. function TDriveView.NodeIsRecycleBin(Node: TTreeNode): Boolean;
  1081. begin
  1082. Result := TNodeData(Node.Data).IsRecycleBin;
  1083. end;
  1084. function TDriveView.NodePathExists(Node: TTreeNode): Boolean;
  1085. begin
  1086. Result := DirectoryExists(ApiPath(NodePathName(Node)));
  1087. end;
  1088. function TDriveView.CanEdit(Node: TTreeNode): Boolean;
  1089. begin
  1090. Result := inherited CanEdit(Node) or FForceRename;
  1091. if Result then
  1092. begin
  1093. Result := Assigned(Node.Parent) and
  1094. (not TNodeData(Node.Data).IsRecycleBin) and
  1095. (not ReadOnly) and
  1096. (FDragDropFilesEx.DragDetectStatus <> ddsDrag) and
  1097. ((TNodeData(Node.Data).Attr and (faReadOnly or faSysFile)) = 0) and
  1098. (UpperCase(Node.Text) = UpperCase(GetDirName(Node)));
  1099. end;
  1100. FForceRename := False;
  1101. end; {CanEdit}
  1102. procedure TDriveView.Edit(const Item: TTVItem);
  1103. var
  1104. Node: TTreeNode;
  1105. Info: string;
  1106. i: Integer;
  1107. begin
  1108. Node := GetNodeFromHItem(Item);
  1109. if (Length(Item.pszText) > 0) and (Item.pszText <> Node.Text) then
  1110. begin
  1111. if StrContains(coInvalidDosChars, Item.pszText) then
  1112. begin
  1113. Info := coInvalidDosChars;
  1114. for i := Length(Info) downto 1 do
  1115. System.Insert(Space, Info, i);
  1116. if Length(Item.pszText) > 0 then
  1117. raise EInvalidDirName.Create(SErrorInvalidName + Space + Info);
  1118. Exit;
  1119. end;
  1120. StopWatchThread;
  1121. if Assigned(DirView) then
  1122. DirView.StopWatchThread;
  1123. with FFileOperator do
  1124. begin
  1125. Flags := FileOperatorDefaultFlags + [foNoConfirmation];
  1126. Operation := foRename;
  1127. OperandFrom.Clear;
  1128. OperandTo.Clear;
  1129. OperandFrom.Add(NodePath(Node));
  1130. OperandTo.Add(IncludeTrailingBackslash(NodePath(Node.Parent)) + Item.pszText);
  1131. end;
  1132. try
  1133. if FFileOperator.Execute then
  1134. begin
  1135. Node.Text := Item.pszText;
  1136. TNodeData(Node.Data).DirName := Item.pszText;
  1137. SortChildren(Node.Parent, False);
  1138. inherited;
  1139. end
  1140. else
  1141. begin
  1142. if FileOrDirExists(IncludeTrailingBackslash(NodePath(Node.Parent)) + Item.pszText) then
  1143. Info := SErrorRenameFileExists + Item.pszText
  1144. else
  1145. Info := SErrorRenameFile + Item.pszText;
  1146. MessageBeep(MB_ICONHAND);
  1147. if MessageDlg(FormatLastOSError(Info), mtError, [mbOK, mbAbort], 0) = mrOK then
  1148. begin
  1149. FLastRenameName := Item.pszText;
  1150. FRenameNode := Node;
  1151. PostMessage(Self.Handle, WM_USER_RENAME, 0, 0);
  1152. end;
  1153. end;
  1154. finally
  1155. StartWatchThread;
  1156. if Assigned(DirView) then
  1157. begin
  1158. DirView.Reload2;
  1159. DirView.StartWatchThread;
  1160. end;
  1161. end;
  1162. end;
  1163. end; {Edit}
  1164. procedure TDriveView.WMUserRename(var Message: TMessage);
  1165. begin
  1166. if Assigned(FRenameNode) then
  1167. begin
  1168. FForceRename := True;
  1169. TreeView_EditLabel(Handle, FRenameNode.ItemID);
  1170. SetWindowText(TreeView_GetEditControl(Self.Handle), PChar(FLastRenameName));
  1171. FRenameNode := nil;
  1172. end;
  1173. end; {WMUserRename}
  1174. function TDriveView.CanExpand(Node: TTreeNode): Boolean;
  1175. var
  1176. SubNode: TTreeNode;
  1177. Drive: string;
  1178. SaveCursor: TCursor;
  1179. begin
  1180. Result := inherited CanExpand(Node);
  1181. Drive := GetDriveToNode(Node);
  1182. if Node.HasChildren then
  1183. begin
  1184. if (not Assigned(Node.Parent)) and
  1185. (not GetDriveStatus(Drive).Scanned) and
  1186. DriveInfo.IsFixedDrive(Drive) then
  1187. begin
  1188. SubNode := Node.GetFirstChild;
  1189. if not Assigned(SubNode) then
  1190. begin
  1191. ScanDrive(Drive);
  1192. SubNode := Node.GetFirstChild;
  1193. Node.HasChildren := Assigned(SubNode);
  1194. Result := Node.HasChildren;
  1195. if not Assigned(GetDriveStatus(Drive).DiscMonitor) then
  1196. CreateWatchThread(Drive);
  1197. end;
  1198. end
  1199. else
  1200. begin
  1201. SaveCursor := Screen.Cursor;
  1202. Screen.Cursor := crHourGlass;
  1203. try
  1204. if (not TNodeData(Node.Data).Scanned) and DoScanDir(Node) then
  1205. begin
  1206. ReadSubDirs(Node);
  1207. end;
  1208. finally
  1209. Screen.Cursor := SaveCursor;
  1210. end;
  1211. end;
  1212. end;
  1213. end; {CanExpand}
  1214. procedure TDriveView.GetImageIndex(Node: TTreeNode);
  1215. begin
  1216. if TNodeData(Node.Data).IconEmpty then
  1217. SetImageIndex(Node);
  1218. inherited;
  1219. end; {GetImageIndex}
  1220. procedure TDriveView.Loaded;
  1221. begin
  1222. inherited;
  1223. {Create the drive nodes:}
  1224. RefreshRootNodes(dsDisplayName or dvdsFloppy);
  1225. {Set the initial directory:}
  1226. if (Length(FDirectory) > 0) and DirectoryExists(ApiPath(FDirectory)) then
  1227. Directory := FDirectory;
  1228. FCreating := False;
  1229. end; {Loaded}
  1230. function TDriveView.CreateNode: TTreeNode;
  1231. begin
  1232. Result := TDriveTreeNode.Create(Items);
  1233. end;
  1234. procedure TDriveView.Delete(Node: TTreeNode);
  1235. var
  1236. NodeData: TNodeData;
  1237. begin
  1238. if Node = FPrevSelected then
  1239. FPrevSelected := nil;
  1240. NodeData := nil;
  1241. if Assigned(Node) and Assigned(Node.Data) then
  1242. NodeData := TNodeData(Node.Data);
  1243. Node.Data := nil;
  1244. inherited;
  1245. if Assigned(NodeData) and not (csRecreating in ControlState) then
  1246. begin
  1247. FSubDirReaderThread.Delete(Node);
  1248. if Assigned(NodeData.DelayedExclude) then
  1249. begin
  1250. CancelDelayedNode(Node);
  1251. FDelayedNodes.Delete(FDelayedNodes.IndexOfObject(Node));
  1252. UpdateDelayedNodeTimer;
  1253. end;
  1254. NodeData.Destroy;
  1255. end;
  1256. end; {OnDelete}
  1257. procedure TDriveView.KeyPress(var Key: Char);
  1258. begin
  1259. inherited;
  1260. if Assigned(Selected) then
  1261. begin
  1262. if Pos(Key, coInvalidDosChars) <> 0 then
  1263. begin
  1264. Beep;
  1265. Key := #0;
  1266. end;
  1267. end;
  1268. end; {KeyPress}
  1269. function TDriveView.CanChange(Node: TTreeNode): Boolean;
  1270. var
  1271. Path: string;
  1272. Drive: string;
  1273. begin
  1274. Result := inherited CanChange(Node);
  1275. if not Reading and not (csRecreating in ControlState) then
  1276. begin
  1277. if Result and Assigned(Node) then
  1278. begin
  1279. Path := NodePathName(Node);
  1280. if Path <> FLastDir then
  1281. begin
  1282. Drive := DriveInfo.GetDriveKey(Path);
  1283. DriveInfo.ReadDriveStatus(Drive, dsSize or dsImageIndex);
  1284. if not DriveInfo.Get(Drive).DriveReady then
  1285. begin
  1286. MessageDlg(Format(SDriveNotReady, [Drive]), mtError, [mbOK], 0);
  1287. Result := False;
  1288. end
  1289. else
  1290. try
  1291. CheckCanOpenDirectory(Path);
  1292. except
  1293. Application.HandleException(Self);
  1294. Result := False;
  1295. end;
  1296. end;
  1297. end;
  1298. if Result and (csDestroying in ComponentState) then
  1299. begin
  1300. Result := False;
  1301. end;
  1302. if Result and
  1303. (not FCanChange) and
  1304. Assigned(Node) and
  1305. Assigned(Node.Data) and
  1306. Assigned(Selected) and
  1307. Assigned(Selected.Data) then
  1308. begin
  1309. DropTarget := Node;
  1310. Result := False;
  1311. end
  1312. else
  1313. begin
  1314. DropTarget := nil;
  1315. end;
  1316. end;
  1317. end; {CanChange}
  1318. procedure TDriveView.Change(Node: TTreeNode);
  1319. var
  1320. Drive: string;
  1321. OldSerial: DWORD;
  1322. NewDir: string;
  1323. PrevDrive: string;
  1324. begin
  1325. if not Reading and not (csRecreating in ControlState) then
  1326. begin
  1327. if Assigned(Node) then
  1328. begin
  1329. NewDir := NodePathName(Node);
  1330. if NewDir <> FLastDir then
  1331. begin
  1332. Drive := DriveInfo.GetDriveKey(NewDir);
  1333. if Length(FLastDir) > 0 then
  1334. PrevDrive := DriveInfo.GetDriveKey(FLastDir)
  1335. else
  1336. PrevDrive := '';
  1337. FChangeFlag := True;
  1338. FLastDir := NewDir;
  1339. OldSerial := DriveInfo.Get(Drive).DriveSerial;
  1340. DriveInfo.ReadDriveStatus(Drive, dsSize or dsImageIndex);
  1341. with DriveInfo.Get(Drive) do
  1342. begin
  1343. if Assigned(FDirView) and (FDirView.Path <> NewDir) then
  1344. FDirView.Path := NewDir;
  1345. if DriveReady then
  1346. begin
  1347. if not DirectoryExists(ApiPath(NewDir)) then
  1348. begin
  1349. ValidateDirectory(GetDriveStatus(Drive).RootNode);
  1350. Exit;
  1351. end;
  1352. GetDriveStatus(Drive).DefaultDir := IncludeTrailingBackslash(NewDir);
  1353. if PrevDrive <> Drive then
  1354. begin
  1355. if (PrevDrive <> '') and
  1356. (DriveInfo.Get(PrevDrive).DriveType = DRIVE_REMOVABLE) then
  1357. begin
  1358. TerminateWatchThread(PrevDrive);
  1359. end;
  1360. {Drive serial has changed or is missing: allways reread the drive:}
  1361. if (DriveSerial <> OldSerial) or (DriveSerial = 0) then
  1362. begin
  1363. if TNodeData(GetDriveStatus(Drive).RootNode.Data).Scanned then
  1364. ScanDrive(Drive);
  1365. end;
  1366. end;
  1367. StartWatchThread;
  1368. end
  1369. else {Drive not ready:}
  1370. begin
  1371. GetDriveStatus(Drive).RootNode.DeleteChildren;
  1372. GetDriveStatus(Drive).DefaultDir := EmptyStr;
  1373. end;
  1374. end;
  1375. end;
  1376. if (not Assigned(FPrevSelected)) or (not FPrevSelected.HasAsParent(Node)) then
  1377. Node.Expand(False);
  1378. FPrevSelected := Node;
  1379. ValidateCurrentDirectoryIfNotMonitoring;
  1380. end;
  1381. end;
  1382. inherited;
  1383. end; {Change}
  1384. procedure TDriveView.SetImageIndex(Node: TTreeNode);
  1385. var
  1386. FileInfo: TShFileInfo;
  1387. Drive, NodePath: string;
  1388. begin
  1389. if Assigned(Node) and TNodeData(Node.Data).IconEmpty then
  1390. begin
  1391. NodePath := NodePathName(Node);
  1392. Drive := DriveInfo.GetDriveKey(NodePath);
  1393. if not Assigned(Node.Parent) then
  1394. begin
  1395. with DriveInfo.Get(Drive) do
  1396. begin
  1397. if ImageIndex = 0 then
  1398. begin
  1399. DriveInfo.ReadDriveStatus(Drive, dsImageIndex);
  1400. Node.ImageIndex := DriveInfo.Get(Drive).ImageIndex;
  1401. end
  1402. else Node.ImageIndex := ImageIndex;
  1403. Node.SelectedIndex := Node.ImageIndex;
  1404. end;
  1405. end
  1406. else
  1407. begin
  1408. if DriveInfo.Get(Drive).DriveType = DRIVE_REMOTE then
  1409. begin
  1410. Node.ImageIndex := StdDirIcon;
  1411. Node.SelectedIndex := StdDirSelIcon;
  1412. end
  1413. else
  1414. begin
  1415. try
  1416. SHGetFileInfo(PChar(NodePath), 0, FileInfo, SizeOf(FileInfo),
  1417. SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  1418. if (FileInfo.iIcon < Images.Count) and (FileInfo.iIcon > 0) then
  1419. begin
  1420. Node.ImageIndex := FileInfo.iIcon;
  1421. SHGetFileInfo(PChar(NodePath), 0, FileInfo, SizeOf(FileInfo),
  1422. SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_OPENICON);
  1423. Node.SelectedIndex := FileInfo.iIcon;
  1424. end
  1425. else
  1426. begin
  1427. Node.ImageIndex := StdDirIcon;
  1428. Node.SelectedIndex := StdDirSelIcon;
  1429. end;
  1430. except
  1431. Node.ImageIndex := StdDirIcon;
  1432. Node.SelectedIndex := StdDirSelIcon;
  1433. end;
  1434. end;
  1435. end;
  1436. end; {IconEmpty}
  1437. TNodeData(Node.Data).IconEmpty := False;
  1438. end; {SetImageIndex}
  1439. function TDriveView.GetDriveText(Drive: string): string;
  1440. begin
  1441. if FShowVolLabel and (Length(DriveInfo.GetPrettyName(Drive)) > 0) then
  1442. begin
  1443. case FVolDisplayStyle of
  1444. doPrettyName: Result := DriveInfo.GetPrettyName(Drive);
  1445. doDisplayName: Result := DriveInfo.GetDisplayName(Drive);
  1446. end; {Case}
  1447. end
  1448. else
  1449. begin
  1450. Result := DriveInfo.GetSimpleName(Drive);
  1451. end;
  1452. end; {GetDriveText}
  1453. function CompareDrive(List: TStringList; Index1, Index2: Integer): Integer;
  1454. var
  1455. Drive1, Drive2: string;
  1456. RealDrive1, RealDrive2: Boolean;
  1457. begin
  1458. Drive1 := List[Index1];
  1459. Drive2 := List[Index2];
  1460. RealDrive1 := DriveInfo.IsRealDrive(Drive1);
  1461. RealDrive2 := DriveInfo.IsRealDrive(Drive2);
  1462. if RealDrive1 = RealDrive2 then
  1463. begin
  1464. Result := CompareText(Drive1, Drive2);
  1465. end
  1466. else
  1467. if RealDrive1 and (not RealDrive2) then
  1468. begin
  1469. Result := -1;
  1470. end
  1471. else
  1472. begin
  1473. Result := 1;
  1474. end;
  1475. end;
  1476. function TDriveView.GetDrives: TStrings;
  1477. var
  1478. DriveStatusPair: TDriveStatusPair;
  1479. Drives: TStringList;
  1480. begin
  1481. Drives := TStringList.Create;
  1482. { We could iterate only .Keys here, but that crashes IDE for some reason }
  1483. for DriveStatusPair in FDriveStatus do
  1484. begin
  1485. Drives.Add(DriveStatusPair.Key);
  1486. end;
  1487. Drives.CustomSort(CompareDrive);
  1488. Result := Drives;
  1489. end;
  1490. procedure TDriveView.DriveRemoved(Drive: string);
  1491. var
  1492. NewDrive: Char;
  1493. begin
  1494. if (Directory <> '') and (Directory[1] = Drive) then
  1495. begin
  1496. if DriveInfo.IsRealDrive(Drive) then NewDrive := Drive[1]
  1497. else NewDrive := SystemDrive;
  1498. repeat
  1499. if NewDrive < SystemDrive then NewDrive := SystemDrive
  1500. else
  1501. if NewDrive = SystemDrive then NewDrive := LastDrive
  1502. else Dec(NewDrive);
  1503. DriveInfo.ReadDriveStatus(NewDrive, dsSize or dsImageIndex);
  1504. if NewDrive = Drive then
  1505. begin
  1506. Break;
  1507. end;
  1508. if DriveInfo.Get(NewDrive).Valid and DriveInfo.Get(NewDrive).DriveReady and Assigned(GetDriveStatus(NewDrive).RootNode) then
  1509. begin
  1510. Directory := NodePathName(GetDriveStatus(NewDrive).RootNode);
  1511. break;
  1512. end;
  1513. until False;
  1514. if not Assigned(Selected) then
  1515. begin
  1516. Directory := NodePathName(GetDriveStatus(SystemDrive).RootNode);
  1517. end;
  1518. end;
  1519. end;
  1520. procedure TDriveView.RefreshRootNodes(dsFlags: Integer);
  1521. var
  1522. Drives: TStrings;
  1523. NewText: string;
  1524. SaveCursor: TCursor;
  1525. WasValid: Boolean;
  1526. NodeData: TNodeData;
  1527. DriveStatus: TDriveStatus;
  1528. NextDriveNode: TTreeNode;
  1529. Index: Integer;
  1530. Drive: string;
  1531. begin
  1532. SaveCursor := Screen.Cursor;
  1533. Screen.Cursor := crHourGlass;
  1534. Drives := nil;
  1535. try
  1536. Drives := GetDrives;
  1537. NextDriveNode := nil;
  1538. for Index := Drives.Count - 1 downto 0 do
  1539. begin
  1540. Drive := Drives[Index];
  1541. DriveStatus := GetDriveStatus(Drive);
  1542. if ((dsFlags and dvdsFloppy) <> 0) or DriveInfo.IsFixedDrive(Drive) then
  1543. begin
  1544. with DriveInfo.Get(Drive) do
  1545. begin
  1546. WasValid := Assigned(DriveStatus.RootNode);
  1547. end;
  1548. if ((dsFlags and dvdsReReadAllways) = 0) and
  1549. (Length(DriveInfo.Get(Drive).DisplayName) > 0) then
  1550. dsFlags := dsFlags and (not dsDisplayName);
  1551. DriveInfo.ReadDriveStatus(Drive, dsFlags);
  1552. with DriveInfo.Get(Drive), DriveStatus do
  1553. begin
  1554. if Valid then
  1555. begin
  1556. if not WasValid then
  1557. {New drive has arrived: insert new rootnode:}
  1558. begin
  1559. { Create root directory node }
  1560. NodeData := TNodeData.Create;
  1561. NodeData.DirName := DriveInfo.GetDriveRoot(Drive);
  1562. if Assigned(NextDriveNode) then
  1563. RootNode := Items.InsertObject(NextDriveNode, '', NodeData)
  1564. else
  1565. RootNode := Items.AddObject(nil, '', NodeData);
  1566. RootNode.Text := GetDisplayName(RootNode);
  1567. RootNode.HasChildren := True;
  1568. Scanned := False;
  1569. Verified := False;
  1570. end
  1571. else
  1572. if RootNode.ImageIndex <> DriveInfo.Get(Drive).ImageIndex then
  1573. begin {WasValid = True}
  1574. RootNode.ImageIndex := DriveInfo.Get(Drive).ImageIndex;
  1575. RootNode.SelectedIndex := DriveInfo.Get(Drive).ImageIndex;
  1576. end;
  1577. if Assigned(RootNode) then
  1578. begin
  1579. NewText := GetDisplayName(RootNode);
  1580. if RootNode.Text <> NewText then
  1581. RootNode.Text := NewText;
  1582. end;
  1583. end
  1584. else
  1585. if WasValid then
  1586. {Drive has been removed => delete rootnode:}
  1587. begin
  1588. DriveRemoved(Drive);
  1589. Scanned := False;
  1590. Verified := False;
  1591. RootNode.Delete;
  1592. RootNode := nil;
  1593. end;
  1594. end;
  1595. end;
  1596. if Assigned(DriveStatus.RootNode) then
  1597. NextDriveNode := DriveStatus.RootNode;
  1598. end;
  1599. finally
  1600. Screen.Cursor := SaveCursor;
  1601. Drives.Free;
  1602. end;
  1603. end; {RefreshRootNodes}
  1604. procedure TDriveView.AddChildNode(ParentNode: TTreeNode; ParentPath: string; SRec: TSearchRec);
  1605. var
  1606. NewNode: TTreeNode;
  1607. NodeData: TNodeData;
  1608. begin
  1609. NodeData := TNodeData.Create;
  1610. NodeData.Attr := SRec.Attr;
  1611. NodeData.DirName := SRec.Name;
  1612. NodeData.FIsRecycleBin :=
  1613. (SRec.Attr and faSysFile <> 0) and
  1614. (not Assigned(ParentNode.Parent)) and
  1615. (SameText(SRec.Name, 'RECYCLED') or
  1616. SameText(SRec.Name, 'RECYCLER') or
  1617. SameText(SRec.Name, '$RECYCLE.BIN'));
  1618. NodeData.Scanned := False;
  1619. NewNode := Self.Items.AddChildObject(ParentNode, '', NodeData);
  1620. NewNode.Text := GetDisplayName(NewNode);
  1621. NewNode.HasChildren := True;
  1622. if GetDriveTypeToNode(ParentNode) <> DRIVE_REMOTE then
  1623. FSubDirReaderThread.Add(NewNode, IncludeTrailingBackslash(ParentPath) + SRec.Name);
  1624. end; {AddChildNode}
  1625. function TDriveView.GetDriveStatus(Drive: string): TDriveStatus;
  1626. begin
  1627. if not FDriveStatus.TryGetValue(Drive, Result) then
  1628. begin
  1629. Result := CreateDriveStatus;
  1630. FDriveStatus.Add(Drive, Result);
  1631. RefreshRootNodes(dsAll or dvdsRereadAllways);
  1632. DoRefreshDrives(False);
  1633. end;
  1634. end; {GetDriveStatus}
  1635. function TDriveView.DoScanDir(FromNode: TTreeNode): Boolean;
  1636. begin
  1637. Result := not TNodeData(FromNode.Data).IsRecycleBin;
  1638. end; {DoScanDir}
  1639. function TDriveView.DirAttrMask: Integer;
  1640. begin
  1641. Result := faDirectory or faSysFile;
  1642. if ShowHiddenDirs then
  1643. Result := Result or faHidden;
  1644. end;
  1645. procedure TDriveView.ScanDrive(Drive: string);
  1646. begin {ScanDrive}
  1647. with Self.Items do
  1648. begin
  1649. ValidateDirectory(FindNodeToPath(DriveInfo.GetDriveRoot(Drive)));
  1650. GetDriveStatus(Drive).Scanned := True;
  1651. GetDriveStatus(Drive).Verified := False;
  1652. end;
  1653. end; {ScanDrive}
  1654. function TDriveView.DoFindNodeToPath(Path: string; ExistingOnly: Boolean): TTreeNode;
  1655. var
  1656. SelectionHierarchy: array of TTreeNode;
  1657. SelectionHierarchyHeight: Integer;
  1658. function SearchSubDirs(ParentNode: TTreeNode; Path: string; Level: Integer): TTreeNode; forward;
  1659. function ExtractFirstName(S: string): string;
  1660. var
  1661. I: Integer;
  1662. begin
  1663. I := Pos('\', S);
  1664. if I = 0 then
  1665. I := Length(S);
  1666. Result := System.Copy(S, 1, I);
  1667. end;
  1668. function DoSearchSubDirs(ParentNode: TTreeNode; Path: string; Level: Integer): TTreeNode;
  1669. var
  1670. Node: TTreeNode;
  1671. Dir: string;
  1672. begin
  1673. {Extract first directory from path:}
  1674. Dir := ExtractFirstName(Path);
  1675. System.Delete(Path, 1, Length(Dir));
  1676. if Dir[Length(Dir)] = '\' then
  1677. SetLength(Dir, Pred(Length(Dir)));
  1678. // Optimization. Avoid iterating possibly thousands of nodes,
  1679. // when the node we are looking for is the selected node or its ancestor.
  1680. // This is often the case, when navigating under node that has lot of siblings.
  1681. // Typically, when navigating in user's profile folder, and there are many [thousands] other user profile folders.
  1682. if (SelectionHierarchyHeight > 0) and
  1683. // Change of selection might indicate that the tree was rebuilt meanwhile and
  1684. // the references in SelectionHierarchy might not be valid anymore
  1685. (Selected = SelectionHierarchy[SelectionHierarchyHeight - 1]) and
  1686. (Level < SelectionHierarchyHeight) and
  1687. (Uppercase(GetDirName(SelectionHierarchy[Level])) = Dir) then
  1688. begin
  1689. Result := SelectionHierarchy[Level];
  1690. end
  1691. else
  1692. begin
  1693. // Paths have diverted
  1694. SelectionHierarchyHeight := 0;
  1695. Node := ParentNode.GetFirstChild;
  1696. if (not Assigned(Node)) and (not ExistingOnly) then
  1697. begin
  1698. ValidateDirectoryEx(ParentNode, rsRecursiveExisting, True);
  1699. Node := ParentNode.GetFirstChild;
  1700. end;
  1701. Result := nil;
  1702. while (not Assigned(Result)) and Assigned(Node) do
  1703. begin
  1704. if UpperCase(GetDirName(Node)) = Dir then
  1705. begin
  1706. Result := Node;
  1707. end
  1708. else
  1709. begin
  1710. Node := ParentNode.GetNextChild(Node);
  1711. end;
  1712. end;
  1713. end;
  1714. if Assigned(Result) and (Length(Path) > 0) then
  1715. begin
  1716. Result := SearchSubDirs(Result, Path, Level + 1);
  1717. end;
  1718. end;
  1719. function SearchSubDirs(ParentNode: TTreeNode; Path: string; Level: Integer): TTreeNode;
  1720. var
  1721. ParentPath, SubPath: string;
  1722. SRec: TSearchRec;
  1723. ParentNodeData: TNodeData;
  1724. begin
  1725. Result := nil;
  1726. if Length(Path) > 0 then
  1727. begin
  1728. ParentNodeData := TNodeData(ParentNode.Data);
  1729. if (not ParentNodeData.Scanned) and (not ExistingOnly) then
  1730. begin
  1731. ReadSubDirs(ParentNode);
  1732. end;
  1733. // Factored out of DoSearchSubDirs is remnant of Bug 956 superceded by Bug 1320
  1734. Result := DoSearchSubDirs(ParentNode, Path, Level);
  1735. if (not Assigned(Result)) and (not ExistingOnly) then
  1736. begin
  1737. ParentPath := NodePath(ParentNode);
  1738. if DirectoryExists(ApiPath(IncludeTrailingBackslash(ParentPath) + Path)) then
  1739. begin
  1740. SubPath := IncludeTrailingBackslash(ParentPath) + ExcludeTrailingBackslash(ExtractFirstName(Path));
  1741. if FindFirstSubDir(SubPath, SRec) then
  1742. begin
  1743. AddChildNode(ParentNode, ParentPath, SRec);
  1744. if Assigned(ParentNodeData.DelayedExclude) then
  1745. ParentNodeData.DelayedExclude.Add(SRec.Name);
  1746. SortChildren(ParentNode, False);
  1747. FindClose(SRec);
  1748. end;
  1749. Result := DoSearchSubDirs(ParentNode, Path, Level);
  1750. end;
  1751. end;
  1752. end;
  1753. end; {SearchSubDirs}
  1754. var
  1755. Drive: string;
  1756. P, I: Integer;
  1757. RootNode, Node: TTreeNode;
  1758. begin {FindNodeToPath}
  1759. Result := nil;
  1760. if Length(Path) < 3 then
  1761. Exit;
  1762. // Particularly when used by TDirView to delegate browsing to
  1763. // hidden drive view, the handle may not be created
  1764. HandleNeeded;
  1765. Drive := DriveInfo.GetDriveKey(Path);
  1766. if (not Assigned(GetDriveStatus(Drive).RootNode)) and
  1767. // hidden or possibly recently un-hidden by other drive view (refresh is pending)
  1768. (DriveInfo.Get(Drive).Valid or DriveInfo.Get(Drive).ValidButHiddenByDrivePolicy) then
  1769. begin
  1770. if DriveInfo.Get(Drive).ValidButHiddenByDrivePolicy then
  1771. DriveInfo.OverrideDrivePolicy(Drive);
  1772. if DriveInfo.Get(Drive).Valid then
  1773. begin
  1774. CancelDriveRefresh; // cancel a possible pending refresh (see the previous comment)
  1775. RefreshRootNodes(dsAll or dvdsRereadAllways); // overkill and is likely already called by GetDriveStatus
  1776. DoRefreshDrives(False);
  1777. end;
  1778. end;
  1779. if Assigned(GetDriveStatus(Drive).RootNode) then
  1780. begin
  1781. if DriveInfo.IsRealDrive(Drive) then
  1782. begin
  1783. System.Delete(Path, 1, 3);
  1784. end
  1785. else
  1786. if IsUncPath(Path) then
  1787. begin
  1788. System.Delete(Path, 1, 2);
  1789. P := Pos('\', Path);
  1790. if P = 0 then
  1791. begin
  1792. Path := '';
  1793. end
  1794. else
  1795. begin
  1796. System.Delete(Path, 1, P);
  1797. P := Pos('\', Path);
  1798. if P = 0 then
  1799. begin
  1800. Path := '';
  1801. end
  1802. else
  1803. begin
  1804. System.Delete(Path, 1, P);
  1805. end;
  1806. end;
  1807. end
  1808. else
  1809. begin
  1810. raise EConvertError.Create(Format(ErrorInvalidDrive, [Path]))
  1811. end;
  1812. if Length(Path) > 0 then
  1813. begin
  1814. if (not GetDriveStatus(Drive).Scanned) and (not ExistingOnly) then
  1815. begin
  1816. ScanDrive(Drive);
  1817. end;
  1818. Node := Selected;
  1819. RootNode := GetDriveStatus(Drive).RootNode;
  1820. if not Assigned(Node) then
  1821. begin
  1822. SelectionHierarchyHeight := 0;
  1823. end
  1824. else
  1825. begin
  1826. SelectionHierarchyHeight := Node.Level + 1;
  1827. SetLength(SelectionHierarchy, SelectionHierarchyHeight);
  1828. for I := SelectionHierarchyHeight - 1 downto 0 do
  1829. begin
  1830. SelectionHierarchy[I] := Node;
  1831. Node := Node.Parent;
  1832. end;
  1833. Assert(Selected = SelectionHierarchy[SelectionHierarchyHeight - 1]);
  1834. // Different drive - nothing to optimize
  1835. if RootNode <> SelectionHierarchy[0] then
  1836. SelectionHierarchyHeight := 0;
  1837. end;
  1838. Result := SearchSubDirs(RootNode, UpperCase(Path), 1);
  1839. end
  1840. else Result := GetDriveStatus(Drive).RootNode;
  1841. end;
  1842. end; {FindNodetoPath}
  1843. function TDriveView.FindNodeToPath(Path: string): TTreeNode;
  1844. begin
  1845. Result := DoFindNodeToPath(Path, False);
  1846. end;
  1847. function TDriveView.TryFindNodeToPath(Path: string): TTreeNode;
  1848. begin
  1849. Result := DoFindNodeToPath(Path, True);
  1850. end;
  1851. function TDriveView.GetSubDir(var SRec: TSearchRec): Boolean;
  1852. begin
  1853. Result := True;
  1854. while Result and
  1855. ((SRec.Name = '.' ) or
  1856. (SRec.Name = '..') or
  1857. ((SRec.Attr and faDirectory) = 0)) do
  1858. begin
  1859. if FindNext(SRec) <> 0 then
  1860. begin
  1861. Result := False;
  1862. end;
  1863. end;
  1864. end;
  1865. function TDriveView.FindFirstSubDir(Path: string; var SRec: TSearchRec): Boolean;
  1866. begin
  1867. Result := (FindFirstEx(ApiPath(Path), DirAttrMask, SRec, FIND_FIRST_EX_LARGE_FETCH_PAS, FindExSearchLimitToDirectories) = 0);
  1868. if Result then
  1869. begin
  1870. Result := GetSubDir(SRec);
  1871. if not Result then FindClose(SRec);
  1872. end;
  1873. end;
  1874. function TDriveView.FindNextSubDir(var SRec: TSearchRec): Boolean;
  1875. begin
  1876. Result := (FindNext(SRec) = 0) and GetSubDir(SRec);
  1877. end;
  1878. function TDriveView.ReadSubDirsBatch(Node: TTreeNode; var SRec: TSearchRec; CheckInterval, Limit: Integer): Boolean;
  1879. var
  1880. Start: TDateTime;
  1881. Cont: Boolean;
  1882. Path: string;
  1883. Count: Integer;
  1884. DelayedExclude: TStringList;
  1885. begin
  1886. Start := Now;
  1887. Path := NodePath(Node);
  1888. Result := True;
  1889. Count := 0;
  1890. DelayedExclude := TNodeData(Node.Data).DelayedExclude;
  1891. // At least from SetDirectory > DoFindNodeToPath and CanExpand, this is not called within BeginUpdate/EndUpdate block.
  1892. // But in any case, adding it here makes expanding (which calls CanExpand) noticeably slower, when there are lot of nodes,
  1893. // because EndUpdate triggers TVN_GETDISPINFO for all nodes in the tree.
  1894. repeat
  1895. if (not Assigned(DelayedExclude)) or
  1896. (DelayedExclude.IndexOf(SRec.Name) < 0) then
  1897. begin
  1898. AddChildNode(Node, Path, SRec);
  1899. Inc(Count);
  1900. end;
  1901. Cont := FindNextSubDir(SRec);
  1902. // There are two other directory reading loops, where this is not checked
  1903. if Cont and
  1904. ((Count mod CheckInterval) = 0) and
  1905. (Limit > 0) and
  1906. (MilliSecondsBetween(Now, Start) > Limit) then
  1907. begin
  1908. Result := False;
  1909. Cont := False;
  1910. end
  1911. until not Cont;
  1912. if Result then
  1913. FindClose(Srec);
  1914. end;
  1915. procedure TDriveView.DelayedNodeTimer(Sender: TObject);
  1916. var
  1917. Node: TTreeNode;
  1918. NodeData: TNodeData;
  1919. begin
  1920. Assert(FDelayedNodes.Count > 0);
  1921. if FDelayedNodes.Count > 0 then
  1922. begin
  1923. // Control was recreated
  1924. if not Assigned(FDelayedNodes.Objects[0]) then
  1925. begin
  1926. FDelayedNodes.Objects[0] := TryFindNodeToPath(FDelayedNodes.Strings[0]);
  1927. end;
  1928. Node := TTreeNode(FDelayedNodes.Objects[0]);
  1929. if not Assigned(Node) then
  1930. begin
  1931. FDelayedNodes.Delete(0);
  1932. end
  1933. else
  1934. begin
  1935. NodeData := TNodeData(Node.Data);
  1936. if ReadSubDirsBatch(Node, NodeData.DelayedSrec, 10, 50) then
  1937. begin
  1938. FreeAndNil(NodeData.DelayedExclude);
  1939. FDelayedNodes.Delete(0);
  1940. SortChildren(Node, False);
  1941. end;
  1942. end;
  1943. end;
  1944. UpdateDelayedNodeTimer;
  1945. end;
  1946. procedure TDriveView.UpdateDelayedNodeTimer;
  1947. begin
  1948. FDelayedNodeTimer.Enabled := HandleAllocated and (FDelayedNodes.Count > 0);
  1949. end;
  1950. procedure TDriveView.ReadSubDirs(Node: TTreeNode);
  1951. var
  1952. SRec: TSearchRec;
  1953. NodeData: TNodeData;
  1954. Path: string;
  1955. CheckInterval, Limit: Integer;
  1956. begin
  1957. NodeData := TNodeData(Node.Data);
  1958. Path := NodePath(Node);
  1959. if not FindFirstSubDir(IncludeTrailingBackslash(Path) + '*.*', SRec) then
  1960. begin
  1961. Node.HasChildren := False;
  1962. end
  1963. else
  1964. begin
  1965. CheckInterval := 100;
  1966. Limit := DriveViewLoadingTooLongLimit * 1000;
  1967. if not Showing then
  1968. begin
  1969. Limit := Limit div 10;
  1970. CheckInterval := CheckInterval div 10;
  1971. end;
  1972. if not ReadSubDirsBatch(Node, SRec, CheckInterval, Limit) then
  1973. begin
  1974. NodeData.DelayedSrec := SRec;
  1975. NodeData.DelayedExclude := TStringList.Create;
  1976. NodeData.DelayedExclude.CaseSensitive := False;
  1977. NodeData.DelayedExclude.Sorted := True;
  1978. FDelayedNodes.AddObject(Path, Node);
  1979. Assert(FDelayedNodes.Count < 20); // if more, something went likely wrong
  1980. UpdateDelayedNodeTimer;
  1981. end;
  1982. SortChildren(Node, False);
  1983. end;
  1984. NodeData.Scanned := True;
  1985. Application.ProcessMessages;
  1986. end; {ReadSubDirs}
  1987. procedure TDriveView.CancelDelayedNode(Node: TTreeNode);
  1988. var
  1989. NodeData: TNodeData;
  1990. begin
  1991. NodeData := TNodeData(Node.Data);
  1992. FindClose(NodeData.DelayedSrec);
  1993. FreeAndNil(NodeData.DelayedExclude);
  1994. end;
  1995. procedure TDriveView.DeleteNode(Node: TTreeNode);
  1996. var
  1997. ValidNode: TTreeNode;
  1998. begin
  1999. if Assigned(Selected) and Assigned(Node.Parent) and
  2000. ((Selected = Node) or Selected.HasAsParent(Node)) then
  2001. begin
  2002. ValidNode := Node.Parent;
  2003. while (not NodePathExists(ValidNode)) and Assigned(ValidNode.Parent) do
  2004. ValidNode := ValidNode.Parent;
  2005. Selected := ValidNode;
  2006. end;
  2007. if DropTarget = Node then
  2008. DropTarget := nil;
  2009. Node.Delete;
  2010. end;
  2011. function TDriveView.CallBackValidateDir(var Node: TTreeNode; Data: Pointer): Boolean;
  2012. var
  2013. WorkNode: TTreeNode;
  2014. DelNode: TTreeNode;
  2015. SRec: TSearchRec;
  2016. SrecList: TStringList;
  2017. SubDirList: TStringList;
  2018. R: Boolean;
  2019. Index: Integer;
  2020. NewDirFound: Boolean;
  2021. ParentDir: string;
  2022. NodeData: TNodeData;
  2023. ScanDirInfo: PScanDirInfo;
  2024. begin {CallBackValidateDir}
  2025. Result := True;
  2026. if (not Assigned(Node)) or (not Assigned(Node.Data)) then
  2027. Exit;
  2028. NewDirFound := False;
  2029. ScanDirInfo := PScanDirInfo(Data);
  2030. {Check, if directory still exists: (but not with root directory) }
  2031. if Assigned(Node.Parent) and (ScanDirInfo^.StartNode = Node) and
  2032. (not NodePathExists(Node)) then
  2033. begin
  2034. DeleteNode(Node);
  2035. Node := nil;
  2036. Exit;
  2037. end;
  2038. WorkNode := Node.GetFirstChild;
  2039. NodeData := TNodeData(Node.Data);
  2040. if NodeData.Scanned and Assigned(WorkNode) then
  2041. {if node was already scanned: check wether the existing subnodes are still alive
  2042. and add all new subdirectories as subnodes:}
  2043. begin
  2044. if DoScanDir(Node) then
  2045. begin
  2046. ParentDir := IncludeTrailingBackslash(NodePath(Node));
  2047. {Build list of existing subnodes:}
  2048. SubDirList := TStringList.Create;
  2049. SubDirList.CaseSensitive := True; // We want to reflect changes in subfolder name case
  2050. while Assigned(WorkNode) do
  2051. begin
  2052. SubDirList.Add(TNodeData(WorkNode.Data).DirName);
  2053. WorkNode := Node.GetNextChild(WorkNode);
  2054. end;
  2055. // Nodes are sorted using natural sorting, while TStringList.Find uses simple sorting
  2056. SubDirList.Sort;
  2057. SRecList := TStringList.Create;
  2058. SRecList.CaseSensitive := True;
  2059. R := FindFirstSubDir(ParentDir + '*.*', SRec);
  2060. while R do
  2061. begin
  2062. SrecList.Add(Srec.Name);
  2063. if not SubDirList.Find(Srec.Name, Index) then
  2064. {Subnode does not exists: add it:}
  2065. begin
  2066. AddChildNode(Node, ParentDir, SRec);
  2067. NewDirFound := True;
  2068. end;
  2069. R := FindNextSubDir(Srec);
  2070. end;
  2071. FindClose(Srec);
  2072. Sreclist.Sort;
  2073. {Remove not existing subnodes:}
  2074. WorkNode := Node.GetFirstChild;
  2075. while Assigned(WorkNode) do
  2076. begin
  2077. if not Assigned(WorkNode.Data) or
  2078. not SrecList.Find(TNodeData(WorkNode.Data).DirName, Index) then
  2079. begin
  2080. DelNode := WorkNode;
  2081. WorkNode := Node.GetNextChild(WorkNode);
  2082. DeleteNode(DelNode);
  2083. end
  2084. else
  2085. begin
  2086. if (SrecList[Index] <> TNodeData(WorkNode.Data).DirName) then
  2087. begin
  2088. {Case of directory letters has changed:}
  2089. TNodeData(WorkNode.Data).DirName := SrecList[Index];
  2090. WorkNode.Text := SrecList[Index];
  2091. end;
  2092. WorkNode := Node.GetNextChild(WorkNode);
  2093. end;
  2094. end;
  2095. SrecList.Free;
  2096. SubDirList.Free;
  2097. {Sort subnodes:}
  2098. if NewDirFound then
  2099. SortChildren(Node, False);
  2100. end;
  2101. end
  2102. else
  2103. {Node was not already scanned:}
  2104. if (ScanDirInfo^.SearchNewDirs or
  2105. NodeData.Scanned or
  2106. (Node = ScanDirInfo^.StartNode)) and
  2107. DoScanDir(Node) then
  2108. begin
  2109. ReadSubDirs(Node);
  2110. end;
  2111. end; {CallBackValidateDir}
  2112. procedure TDriveView.RebuildTree;
  2113. var
  2114. Drive: string;
  2115. begin
  2116. for Drive in FDriveStatus.Keys do
  2117. with GetDriveStatus(Drive) do
  2118. if Assigned(RootNode) and Scanned then
  2119. ValidateDirectory(RootNode);
  2120. end;
  2121. procedure TDriveView.ValidateCurrentDirectoryIfNotMonitoring;
  2122. begin
  2123. if Assigned(Selected) and
  2124. not Assigned(GetDriveStatus(GetDriveToNode(Selected)).DiscMonitor) then
  2125. begin
  2126. ValidateDirectory(Selected);
  2127. end;
  2128. end;
  2129. procedure TDriveView.ValidateDirectoryEx(Node: TTreeNode; Recurse: TRecursiveScan;
  2130. NewDirs: Boolean);
  2131. var
  2132. Info: PScanDirInfo;
  2133. SelDir: string;
  2134. SaveCursor: TCursor;
  2135. RestartWatchThread: Boolean;
  2136. SaveCanChange: Boolean;
  2137. CurrentPath: string;
  2138. Drive: string;
  2139. begin
  2140. if Assigned(Node) and Assigned(Node.Data) and
  2141. (not FValidateFlag) and DoScanDir(Node) then
  2142. begin
  2143. SelDir := Directory;
  2144. SaveCursor := Screen.Cursor;
  2145. if Self.Focused and (Screen.Cursor <> crHourGlass) then
  2146. Screen.Cursor := crHourGlass;
  2147. CurrentPath := NodePath(Node);
  2148. Drive := DriveInfo.GetDriveKey(CurrentPath);
  2149. if not Assigned(Node.Parent) then
  2150. GetDriveStatus(Drive).ChangeTimer.Enabled := False;
  2151. RestartWatchThread := WatchThreadActive;
  2152. try
  2153. if WatchThreadActive then
  2154. StopWatchThread;
  2155. FValidateFlag := True;
  2156. FSysColorChangePending := False;
  2157. New(Info);
  2158. Info^.StartNode := Node;
  2159. Info^.SearchNewDirs := NewDirs;
  2160. Info^.DriveType := DriveInfo.Get(Drive).DriveType;
  2161. SaveCanChange := FCanChange;
  2162. FCanChange := True;
  2163. FChangeFlag := False;
  2164. Items.BeginUpdate;
  2165. try
  2166. IterateSubTree(Node, CallBackValidateDir, Recurse, coScanStartNode, Info);
  2167. finally
  2168. Items.EndUpdate;
  2169. end;
  2170. FValidateFlag := False;
  2171. if (not Assigned(Selected)) and (Length(SelDir) > 0) then
  2172. Directory := ExtractFileDrive(SelDir);
  2173. if (SelDir <> Directory) and (not FChangeFlag) then
  2174. Change(Selected);
  2175. FCanChange := SaveCanChange;
  2176. Dispose(Info);
  2177. finally
  2178. if RestartWatchThread and FWatchDirectory and not WatchThreadActive then
  2179. StartWatchThread;
  2180. if Screen.Cursor <> SaveCursor then
  2181. Screen.Cursor := SaveCursor;
  2182. if FSysColorChangePending then
  2183. begin
  2184. FSysColorChangePending := False;
  2185. if HandleAllocated then Perform(CM_SYSCOLORCHANGE, 0, 0);
  2186. end;
  2187. end;
  2188. end;
  2189. end; {ValidateDirectoryEx}
  2190. function TDriveView.GetDriveTypeToNode(Node: TTreeNode): Integer;
  2191. begin
  2192. Assert(Assigned(Node));
  2193. Result := DriveInfo.Get(GetDriveToNode(Node)).DriveType;
  2194. end; {GetDriveTypeToNode}
  2195. procedure TDriveView.CreateWatchThread(Drive: string);
  2196. begin
  2197. if csDesigning in ComponentState then
  2198. Exit;
  2199. if (not Assigned(GetDriveStatus(Drive).DiscMonitor)) and
  2200. FWatchDirectory and
  2201. (DriveInfo.Get(Drive).DriveType <> DRIVE_REMOTE) then
  2202. begin
  2203. with GetDriveStatus(Drive) do
  2204. begin
  2205. DiscMonitor := TDiscMonitor.Create(Self);
  2206. DiscMonitor.ChangeDelay := msThreadChangeDelay;
  2207. DiscMonitor.SubTree := True;
  2208. DiscMonitor.Filters := [moDirName];
  2209. DiscMonitor.OnChange := ChangeDetected;
  2210. DiscMonitor.OnInvalid := ChangeInvalid;
  2211. DiscMonitor.SetDirectory(DriveInfo.GetDriveRoot(Drive));
  2212. DiscMonitor.Open;
  2213. end;
  2214. UpdateDriveNotifications(Drive);
  2215. end;
  2216. end; {CreateWatchThread}
  2217. procedure TDriveView.SetWatchDirectory(Value: Boolean);
  2218. begin
  2219. if FWatchDirectory <> Value then
  2220. begin
  2221. FWatchDirectory := Value;
  2222. if (not (csDesigning in ComponentState)) and Value then
  2223. StartAllWatchThreads
  2224. else
  2225. StopAllWatchThreads;
  2226. end;
  2227. end; {SetAutoScan}
  2228. procedure TDriveView.SetDirView(Value: TDirView);
  2229. begin
  2230. if Assigned(FDirView) then
  2231. FDirView.DriveView := nil;
  2232. FDirView := Value;
  2233. if Assigned(FDirView) then
  2234. FDirView.DriveView := Self;
  2235. end; {SetDirView}
  2236. function TDriveView.NodeWatched(Node: TTreeNode): Boolean;
  2237. var
  2238. Drive: string;
  2239. begin
  2240. Drive := GetDriveToNode(Node);
  2241. Result := WatchThreadActive(Drive);
  2242. end; {NodeWatched}
  2243. procedure TDriveView.ChangeInvalid(Sender: TObject; const Directory: string;
  2244. const ErrorStr: string);
  2245. var
  2246. Drive: string;
  2247. begin
  2248. Drive := DriveInfo.GetDriveKey((Sender as TDiscMonitor).Directories[0]);
  2249. with GetDriveStatus(Drive) do
  2250. begin
  2251. DiscMonitor.Close;
  2252. end;
  2253. UpdateDriveNotifications(Drive);
  2254. end; {DirWatchChangeInvalid}
  2255. procedure TDriveView.ChangeDetected(Sender: TObject; const Directory: string;
  2256. var SubdirsChanged: Boolean);
  2257. var
  2258. DirChanged: string;
  2259. begin
  2260. if Sender is TDiscMonitor then
  2261. begin
  2262. DirChanged := (Sender as TDiscMonitor).Directories[0];
  2263. if Length(DirChanged) > 0 then
  2264. begin
  2265. with GetDriveStatus(DriveInfo.GetDriveKey(DirChanged)) do
  2266. begin
  2267. ChangeTimer.Interval := 0;
  2268. ChangeTimer.Interval := FChangeInterval;
  2269. ChangeTimer.Enabled := True;
  2270. end;
  2271. end;
  2272. end;
  2273. end; {DirWatchChangeDetected}
  2274. procedure TDriveView.ChangeTimerOnTimer(Sender: TObject);
  2275. var
  2276. DriveStatusPair: TDriveStatusPair;
  2277. begin
  2278. if (FChangeTimerSuspended = 0) and (Sender is TTimer) then
  2279. begin
  2280. for DriveStatusPair in FDriveStatus do
  2281. begin
  2282. if DriveStatusPair.Value.ChangeTimer = Sender then
  2283. begin
  2284. // Messages are processed during ValidateDirectory, so we may detect another change while
  2285. // updating the directory. Prevent the recursion.
  2286. // But retry the update afterwards (by reenabling the timer in ChangeDetected)
  2287. SuspendChangeTimer;
  2288. try
  2289. with DriveStatusPair.Value.ChangeTimer do
  2290. begin
  2291. Interval := 0;
  2292. Enabled := False;
  2293. end;
  2294. if Assigned(DriveStatusPair.Value.RootNode) then
  2295. begin
  2296. {Check also collapsed (invisible) subdirectories:}
  2297. ValidateDirectory(DriveStatusPair.Value.RootNode);
  2298. end;
  2299. finally
  2300. ResumeChangeTimer;
  2301. end;
  2302. end;
  2303. end;
  2304. end;
  2305. end; {ChangeTimerOnTimer}
  2306. procedure TDriveView.UpdateDriveNotifications(Drive: string);
  2307. var
  2308. NeedNotifications: Boolean;
  2309. Path: string;
  2310. DevBroadcastHandle: DEV_BROADCAST_HANDLE;
  2311. Size: Integer;
  2312. begin
  2313. if DriveInfo.IsFixedDrive(Drive) then
  2314. begin
  2315. with GetDriveStatus(Drive) do
  2316. begin
  2317. NeedNotifications :=
  2318. WatchThreadActive(Drive) and
  2319. (DriveInfo.Get(Drive).DriveType <> DRIVE_REMOTE) and
  2320. DriveInfo.Get(Drive).DriveReady;
  2321. if NeedNotifications <> (DriveHandle <> INVALID_HANDLE_VALUE) then
  2322. begin
  2323. if NeedNotifications then
  2324. begin
  2325. Path := DriveInfo.GetDriveRoot(Drive);
  2326. DriveHandle :=
  2327. CreateFile(PChar(Path), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
  2328. OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS or FILE_ATTRIBUTE_NORMAL, 0);
  2329. if DriveHandle <> INVALID_HANDLE_VALUE then
  2330. begin
  2331. Size := SizeOf(DevBroadcastHandle);
  2332. ZeroMemory(@DevBroadcastHandle, Size);
  2333. DevBroadcastHandle.dbch_size := Size;
  2334. DevBroadcastHandle.dbch_devicetype := DBT_DEVTYP_HANDLE;
  2335. DevBroadcastHandle.dbch_handle := DriveHandle;
  2336. NotificationHandle :=
  2337. RegisterDeviceNotification(FInternalWindowHandle, @DevBroadcastHandle, DEVICE_NOTIFY_WINDOW_HANDLE);
  2338. if NotificationHandle = nil then
  2339. begin
  2340. CloseHandle(DriveHandle);
  2341. DriveHandle := INVALID_HANDLE_VALUE;
  2342. end;
  2343. end;
  2344. end
  2345. else
  2346. begin
  2347. UnregisterDeviceNotification(NotificationHandle);
  2348. NotificationHandle := nil;
  2349. CloseHandle(DriveHandle);
  2350. DriveHandle := INVALID_HANDLE_VALUE;
  2351. end;
  2352. end;
  2353. end;
  2354. end;
  2355. end;
  2356. procedure TDriveView.StartWatchThread;
  2357. var
  2358. Drive: string;
  2359. begin
  2360. if (csDesigning in ComponentState) or
  2361. not Assigned(Selected) or
  2362. not fWatchDirectory then Exit;
  2363. Drive := GetDriveToNode(Selected);
  2364. with GetDriveStatus(Drive) do
  2365. begin
  2366. if not Assigned(DiscMonitor) then
  2367. CreateWatchThread(Drive);
  2368. if Assigned(DiscMonitor) and not DiscMonitor.Enabled then
  2369. DiscMonitor.Enabled := True;
  2370. end;
  2371. UpdateDriveNotifications(Drive);
  2372. end; {StartWatchThread}
  2373. procedure TDriveView.StopWatchThread;
  2374. var
  2375. Drive: string;
  2376. begin
  2377. if Assigned(Selected) then
  2378. begin
  2379. Drive := GetDriveToNode(Selected);
  2380. with GetDriveStatus(Drive) do
  2381. if Assigned(DiscMonitor) then
  2382. DiscMonitor.Enabled := False;
  2383. UpdateDriveNotifications(Drive);
  2384. end;
  2385. end; {StopWatchThread}
  2386. procedure TDriveView.SuspendChangeTimer;
  2387. begin
  2388. Inc(FChangeTimerSuspended);
  2389. end;
  2390. procedure TDriveView.ResumeChangeTimer;
  2391. begin
  2392. Assert(FChangeTimerSuspended > 0);
  2393. Dec(FChangeTimerSuspended);
  2394. end;
  2395. procedure TDriveView.TerminateWatchThread(Drive: string);
  2396. begin
  2397. with GetDriveStatus(Drive) do
  2398. if Assigned(DiscMonitor) then
  2399. begin
  2400. DiscMonitor.Free;
  2401. DiscMonitor := nil;
  2402. end;
  2403. UpdateDriveNotifications(Drive);
  2404. end; {StopWatchThread}
  2405. procedure TDriveView.StartAllWatchThreads;
  2406. var
  2407. DriveStatusPair: TDriveStatusPair;
  2408. Drive: string;
  2409. begin
  2410. if (csDesigning in ComponentState) or (not FWatchDirectory) then
  2411. Exit;
  2412. for DriveStatusPair in FDriveStatus do
  2413. with DriveStatusPair.Value do
  2414. if Scanned then
  2415. begin
  2416. if not Assigned(DiscMonitor) then
  2417. CreateWatchThread(DriveStatusPair.Key);
  2418. if Assigned(DiscMonitor) and (not DiscMonitor.Active) then
  2419. begin
  2420. DiscMonitor.Open;
  2421. UpdateDriveNotifications(DriveStatusPair.Key);
  2422. end;
  2423. end;
  2424. if Assigned(Selected) then
  2425. begin
  2426. Drive := GetDriveToNode(Selected);
  2427. if not DriveInfo.IsFixedDrive(Drive) then
  2428. begin
  2429. StartWatchThread;
  2430. end;
  2431. end;
  2432. end; {StartAllWatchThreads}
  2433. procedure TDriveView.StopAllWatchThreads;
  2434. var
  2435. DriveStatusPair: TDriveStatusPair;
  2436. begin
  2437. if (csDesigning in ComponentState) or (not FWatchDirectory) then
  2438. Exit;
  2439. for DriveStatusPair in FDriveStatus do
  2440. with DriveStatusPair.Value do
  2441. begin
  2442. if Assigned(DiscMonitor) then
  2443. begin
  2444. DiscMonitor.Close;
  2445. UpdateDriveNotifications(DriveStatusPair.Key);
  2446. end;
  2447. end;
  2448. end; {StopAllWatchThreads}
  2449. function TDriveView.WatchThreadActive(Drive: string): Boolean;
  2450. begin
  2451. Result := FWatchDirectory and
  2452. Assigned(GetDriveStatus(Drive).DiscMonitor) and
  2453. GetDriveStatus(Drive).DiscMonitor.Active and
  2454. GetDriveStatus(Drive).DiscMonitor.Enabled;
  2455. end; {WatchThreadActive}
  2456. function TDriveView.WatchThreadActive: Boolean;
  2457. var
  2458. Drive: string;
  2459. begin
  2460. if not Assigned(Selected) then
  2461. begin
  2462. Result := False;
  2463. Exit;
  2464. end;
  2465. Drive := GetDriveToNode(Selected);
  2466. Result := WatchThreadActive(Drive);
  2467. end; {WatchThreadActive}
  2468. function TDriveView.FindPathNode(Path: string): TTreeNode;
  2469. var
  2470. PossiblyHiddenPath: string;
  2471. Attrs: Integer;
  2472. begin
  2473. if Assigned(FOnNeedHiddenDirectories) and
  2474. (not ShowHiddenDirs) and
  2475. DirectoryExistsFix(Path) then // do not even bother if the path does not exist
  2476. begin
  2477. PossiblyHiddenPath := ExcludeTrailingPathDelimiter(Path);
  2478. while (PossiblyHiddenPath <> '') and
  2479. (not IsRootPath(PossiblyHiddenPath)) do // Drives have hidden attribute
  2480. begin
  2481. Attrs := FileGetAttr(PossiblyHiddenPath, False);
  2482. if (Attrs and faHidden) = faHidden then
  2483. begin
  2484. if Assigned(FOnNeedHiddenDirectories) then
  2485. begin
  2486. FOnNeedHiddenDirectories(Self);
  2487. end;
  2488. Break;
  2489. end
  2490. else
  2491. begin
  2492. PossiblyHiddenPath := ExtractFileDir(PossiblyHiddenPath);
  2493. end;
  2494. end;
  2495. end;
  2496. {Find existing path or parent path of not existing path:}
  2497. repeat
  2498. Result := FindNodeToPath(Path);
  2499. if not Assigned(Result) then
  2500. Path := ExtractFilePath(ExcludeTrailingBackslash(Path));
  2501. until Assigned(Result) or (Length(Path) < 3);
  2502. end;
  2503. procedure TDriveView.SetDirectory(Value: string);
  2504. begin
  2505. Value := IncludeTrailingBackslash(Value);
  2506. FDirectory := Value;
  2507. inherited;
  2508. if Assigned(Selected) and (not Assigned(Selected.Parent)) then
  2509. begin
  2510. if not GetDriveStatus(GetDriveToNode(Selected)).Scanned then
  2511. ScanDrive(GetDriveToNode(Selected));
  2512. end;
  2513. end; {SetDirectory}
  2514. function TDriveView.GetDirName(Node: TTreeNode): string;
  2515. begin
  2516. if Assigned(Node) and Assigned(Node.Data) then
  2517. Result := TNodeData(Node.Data).DirName
  2518. else
  2519. Result := '';
  2520. end; {GetDirName}
  2521. {GetDrive: returns the drive of the Node.}
  2522. function TDriveView.GetDriveToNode(Node: TTreeNode): string;
  2523. var
  2524. Path: string;
  2525. begin
  2526. if (not Assigned (Node)) or (not Assigned(Node.Data)) then
  2527. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDrive']));
  2528. Path := NodePath(Node);
  2529. Result := DriveInfo.GetDriveKey(Path);
  2530. end; {GetDrive}
  2531. {RootNode: returns the rootnode to the Node:}
  2532. function TDriveView.RootNode(Node: TTreeNode): TTreeNode;
  2533. begin
  2534. Result := Node;
  2535. if not Assigned(Node) then
  2536. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['RootNode']));
  2537. while Assigned(Result.Parent) do
  2538. Result := Result.Parent;
  2539. end; {RootNode}
  2540. function TDriveView.GetDisplayName(Node: TTreeNode): string;
  2541. begin
  2542. Result := '';
  2543. if (not Assigned(Node)) or (not Assigned(Node.Data)) then
  2544. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDisplayName']));
  2545. if not Assigned(Node.Parent) then Result := GetDriveText(GetDriveToNode(Node))
  2546. else
  2547. begin
  2548. Result := GetDirName(Node);
  2549. end;
  2550. end; {GetDisplayName}
  2551. procedure TDriveView.SetShowVolLabel(ShowIt: Boolean);
  2552. begin
  2553. if ShowIt = FShowVolLabel then
  2554. Exit;
  2555. FShowVolLabel := ShowIt;
  2556. RefreshRootNodes(dvdsFloppy);
  2557. end; {SetShowVolLabel}
  2558. procedure TDriveView.DisplayContextMenu(Node: TTreeNode; Point: TPoint);
  2559. var
  2560. Verb: string;
  2561. DirWatched: Boolean;
  2562. begin
  2563. DirWatched := NodeWatched(Node) and WatchThreadActive;
  2564. Assert(Node <> nil);
  2565. if Node <> Selected then
  2566. DropTarget := Node;
  2567. Verb := EmptyStr;
  2568. if Assigned(FOnDisplayContextMenu) then
  2569. FOnDisplayContextMenu(Self);
  2570. ShellDisplayContextMenu(FParentForm.Handle, Point, NodePathName(Node),
  2571. CanEdit(Node), Verb, False);
  2572. if Verb = shcRename then Node.EditText
  2573. else
  2574. if Verb = shcCut then
  2575. begin
  2576. LastClipBoardOperation := cboCut;
  2577. LastPathCut := NodePathName(Node);
  2578. end
  2579. else
  2580. if Verb = shcCopy then LastClipBoardOperation := cboCopy
  2581. else
  2582. if Verb = shcPaste then
  2583. PasteFromClipBoard(NodePathName(Node));
  2584. DropTarget := nil;
  2585. if not DirWatched then
  2586. ValidateDirectory(Node);
  2587. end; {DisplayContextMenu (2)}
  2588. procedure TDriveView.DisplayPropertiesMenu(Node: TTreeNode);
  2589. begin
  2590. Assert(Assigned(Node));
  2591. ShellExecuteContextCommand(FParentForm.Handle, shcProperties, NodePathName(Node));
  2592. end; {ContextMenu}
  2593. procedure TDriveView.SetSelected(Node: TTreeNode);
  2594. begin
  2595. if Node <> Selected then
  2596. begin
  2597. FChangeFlag := False;
  2598. FCanChange := True;
  2599. inherited Selected := Node;
  2600. if not FChangeFlag then
  2601. Change(Selected);
  2602. end;
  2603. end; {SetSelected}
  2604. {Called by TFileDeleteThread, when a file deletion was detected by the D&D receiving application:}
  2605. procedure TDriveView.SignalDirDelete(Sender: TObject; Files: TStringList);
  2606. begin
  2607. if Files.Count > 0 then
  2608. ValidateDirectory(FindNodeToPath(Files[0]));
  2609. end; {SignalDirDelete}
  2610. function TDriveView.DDSourceEffects: TDropEffectSet;
  2611. begin
  2612. if not Assigned(FDragNode.Parent) then
  2613. Result := [deLink]
  2614. else
  2615. Result := [deLink, deCopy, deMove];
  2616. end;
  2617. procedure TDriveView.DDChooseEffect(KeyState: Integer; var Effect: Integer; PreferredEffect: Integer);
  2618. begin
  2619. if DropTarget = nil then Effect := DROPEFFECT_NONE
  2620. else
  2621. if (KeyState and (MK_CONTROL or MK_SHIFT) = 0) and (PreferredEffect = 0) then
  2622. begin
  2623. if FDragDrive <> '' then
  2624. begin
  2625. if FExeDrag and DriveInfo.IsFixedDrive(GetDriveToNode(DropTarget)) and DriveInfo.IsFixedDrive(FDragDrive) then
  2626. begin
  2627. Effect := DROPEFFECT_LINK;
  2628. end
  2629. else
  2630. if (Effect = DROPEFFECT_COPY) and
  2631. (SameText(FDragDrive, GetDriveToNode(DropTarget)) and
  2632. (FDragDropFilesEx.AvailableDropEffects and DROPEFFECT_MOVE <> 0)) then
  2633. begin
  2634. Effect := DROPEFFECT_MOVE;
  2635. end;
  2636. end;
  2637. end;
  2638. inherited;
  2639. end;
  2640. function TDriveView.DragCompleteFileList: Boolean;
  2641. begin
  2642. Result := (GetDriveTypeToNode(FDragNode) <> DRIVE_REMOVABLE);
  2643. end;
  2644. function TDriveView.DDExecute: TDragResult;
  2645. var
  2646. WatchThreadOK: Boolean;
  2647. DragParentPath: string;
  2648. DragPath: string;
  2649. begin
  2650. WatchThreadOK := WatchThreadActive;
  2651. Result := FDragDropFilesEx.Execute(nil);
  2652. if (Result = drMove) and (not WatchThreadOK) then
  2653. begin
  2654. DragPath := NodePathName(FDragNode);
  2655. if Assigned(FDragNode.Parent) then
  2656. DragParentPath := NodePathName(FDragNode.Parent)
  2657. else
  2658. DragParentPath := DragPath;
  2659. if Assigned(FDragNode.Parent) or (DragParentPath <> NodePathName(Selected.Parent)) then
  2660. begin
  2661. FDragNode := FindNodeToPath(DragPath);
  2662. if Assigned(FDragNode) then
  2663. begin
  2664. FDragFileList.Clear;
  2665. FDragFileList.Add(DragPath);
  2666. TFileDeleteThread.Create(FDragFileList, MaxWaitTimeOut, SignalDirDelete);
  2667. end;
  2668. end;
  2669. end;
  2670. end;
  2671. procedure TDriveView.PerformDragDropFileOperation(Node: TTreeNode; Effect: Integer);
  2672. var
  2673. Index: Integer;
  2674. SourcePath: string;
  2675. SourceParentPath: string;
  2676. SourceIsDirectory: Boolean;
  2677. SaveCursor: TCursor;
  2678. SourceNode, TargetNode: TTreeNode;
  2679. TargetPath: string;
  2680. IsRecycleBin: Boolean;
  2681. begin
  2682. TargetPath := NodePathName(Node);
  2683. IsRecycleBin := NodeIsRecycleBin(Node);
  2684. if FDragDropFilesEx.FileList.Count = 0 then
  2685. Exit;
  2686. SaveCursor := Screen.Cursor;
  2687. Screen.Cursor := crHourGlass;
  2688. SourcePath := EmptyStr;
  2689. try
  2690. if (Effect = DROPEFFECT_COPY) or (Effect = DROPEFFECT_MOVE) then
  2691. begin
  2692. StopAllWatchThreads;
  2693. if Assigned(FDirView) then
  2694. FDirView.StopWatchThread;
  2695. if Assigned(DropSourceControl) and
  2696. (DropSourceControl is TDirView) and
  2697. (DropSourceControl <> FDirView) then
  2698. begin
  2699. TDirView(DropSourceControl).StopWatchThread;
  2700. end;
  2701. if DropFiles(
  2702. DragDropFilesEx, Effect, FFileOperator, TargetPath, false, IsRecycleBin, ConfirmDelete, ConfirmOverwrite, False,
  2703. Self, OnDDFileOperation, SourcePath, SourceIsDirectory) then
  2704. begin
  2705. if Assigned(FOnDDFileOperationExecuted) then
  2706. FOnDDFileOperationExecuted(Self, Effect, SourcePath, TargetPath);
  2707. end;
  2708. ClearDragFileList(FDragDropFilesEx.FileList);
  2709. // TDirView.PerformDragDropFileOperation validates the SourcePath and that actually seems correct
  2710. SourceParentPath := ExtractFilePath(ExcludeTrailingBackslash(SourcePath));
  2711. end
  2712. else
  2713. if Effect = DROPEFFECT_LINK then
  2714. { Create Link requested: }
  2715. begin
  2716. for Index := 0 to FDragDropFilesEx.FileList.Count - 1 do
  2717. begin
  2718. if not DropLink(PFDDListItem(FDragDropFilesEx.FileList[Index]), TargetPath) then
  2719. begin
  2720. DDError(DDCreateShortCutError);
  2721. end;
  2722. end;
  2723. end;
  2724. if Effect = DROPEFFECT_MOVE then
  2725. Items.BeginUpdate;
  2726. {Update source directory, if move-operation was performed:}
  2727. if ((Effect = DROPEFFECT_MOVE) or IsRecycleBin) then
  2728. begin
  2729. // See comment in corresponding operation in TDirView.PerformDragDropFileOperation
  2730. SourceNode := TryFindNodeToPath(SourceParentPath);
  2731. if Assigned(SourceNode) then
  2732. ValidateDirectory(SourceNode);
  2733. end;
  2734. {Update subdirectories of target directory:}
  2735. TargetNode := FindNodeToPath(TargetPath);
  2736. if Assigned(TargetNode) then
  2737. ValidateDirectory(TargetNode)
  2738. else
  2739. ValidateDirectory(GetDriveStatus(DriveInfo.GetDriveKey(TargetPath)).RootNode);
  2740. if Effect = DROPEFFECT_MOVE then
  2741. Items.EndUpdate;
  2742. {Update linked component TDirView:}
  2743. if Assigned(FDirView) and (not FDirView.WatchThreadActive) then
  2744. begin
  2745. case Effect of
  2746. DROPEFFECT_COPY,
  2747. DROPEFFECT_LINK:
  2748. if (IncludeTrailingBackslash(TargetPath) = IncludeTrailingBackslash(DirView.Path)) then
  2749. FDirView.Reload2;
  2750. DROPEFFECT_MOVE:
  2751. if (IncludeTrailingBackslash(TargetPath) = IncludeTrailingBackslash(DirView.Path)) or
  2752. (IncludeTrailingBackslash(SourceParentPath) = IncludeTrailingBackslash(DirView.Path)) then
  2753. begin
  2754. if FDirView <> DropSourceControl then FDirView.Reload2;
  2755. end;
  2756. end; {Case}
  2757. end;
  2758. {Update the DropSource control, if files are moved and it is a TDirView:}
  2759. if (Effect = DROPEFFECT_MOVE) and (DropSourceControl is TDirView) then
  2760. begin
  2761. TDirView(DropSourceControl).ValidateSelectedFiles;
  2762. end;
  2763. finally
  2764. FFileOperator.OperandFrom.Clear;
  2765. FFileOperator.OperandTo.Clear;
  2766. StartAllWatchThreads;
  2767. if Assigned(FDirView) and (not FDirView.WatchThreadActive) then
  2768. FDirView.StartWatchThread;
  2769. if Assigned(DropSourceControl) and (DropSourceControl is TDirView) and
  2770. (not TDirView(DropSourceControl).WatchThreadActive) then
  2771. TDirView(DropSourceControl).StartWatchThread;
  2772. Screen.Cursor := SaveCursor;
  2773. end;
  2774. end; {PerformDragDropFileOperation}
  2775. function TDriveView.GetCanUndoCopyMove: Boolean;
  2776. begin
  2777. Result := Assigned(FFileOperator) and FFileOperator.CanUndo;
  2778. end; {CanUndoCopyMove}
  2779. function TDriveView.UndoCopyMove: Boolean;
  2780. var
  2781. LastTarget: string;
  2782. LastSource: string;
  2783. begin
  2784. Result := False;
  2785. if FFileOperator.CanUndo then
  2786. begin
  2787. Lasttarget := FFileOperator.LastOperandTo[0];
  2788. LastSource := FFileOperator.LastOperandFrom[0];
  2789. StopAllWatchThreads;
  2790. Result := FFileOperator.UndoExecute;
  2791. ValidateDirectory(FindNodeToPath(ExtractFilePath(LastTarget)));
  2792. ValidateDirectory(FindNodeToPath(ExtractFilePath(LastSource)));
  2793. StartAllWatchThreads;
  2794. if Assigned(FDirView) then
  2795. with FDirView do
  2796. if not WatchThreadActive then
  2797. begin
  2798. if (IncludeTrailingBackslash(ExtractFilePath(LastTarget)) = IncludeTrailingBackslash(Path)) or
  2799. (IncludeTrailingBackslash(ExtractFilePath(LastSource)) = IncludeTrailingBackslash(Path)) then
  2800. Reload2;
  2801. end;
  2802. end;
  2803. end; {UndoCopyMove}
  2804. {Clipboard operations:}
  2805. procedure TDriveView.SetLastPathCut(Path: string);
  2806. var
  2807. Node: TTreeNode;
  2808. begin
  2809. if FLastPathCut <> Path then
  2810. begin
  2811. Node := FindNodeToPath(FLastPathCut);
  2812. if Assigned(Node) then
  2813. begin
  2814. FLastPathCut := Path;
  2815. Node.Cut := False;
  2816. end;
  2817. Node := FindNodeToPath(Path);
  2818. if Assigned(Node) then
  2819. begin
  2820. FLastPathCut := Path;
  2821. Node.Cut := True;
  2822. end;
  2823. end;
  2824. end; {SetLastNodeCut}
  2825. procedure TDriveView.EmptyClipboard;
  2826. begin
  2827. if Windows.OpenClipBoard(0) then
  2828. begin
  2829. Windows.EmptyClipBoard;
  2830. Windows.CloseClipBoard;
  2831. LastPathCut := '';
  2832. LastClipBoardOperation := cboNone;
  2833. if Assigned(FDirView) then
  2834. FDirView.EmptyClipboard;
  2835. end;
  2836. end; {EmptyClipBoard}
  2837. function TDriveView.CopyToClipBoard(Node: TTreeNode): Boolean;
  2838. begin
  2839. Result := Assigned(Selected);
  2840. if Result then
  2841. begin
  2842. EmptyClipBoard;
  2843. ClearDragFileList(FDragDropFilesEx.FileList);
  2844. AddToDragFileList(FDragDropFilesEx.FileList, Selected);
  2845. Result := FDragDropFilesEx.CopyToClipBoard;
  2846. LastClipBoardOperation := cboCopy;
  2847. end;
  2848. end; {CopyToClipBoard}
  2849. function TDriveView.CutToClipBoard(Node: TTreeNode): Boolean;
  2850. begin
  2851. Result := Assigned(Node) and Assigned(Node.Parent) and CopyToClipBoard(Node);
  2852. if Result then
  2853. begin
  2854. LastPathCut := NodePathName(Node);
  2855. LastClipBoardOperation := cboCut;
  2856. end;
  2857. end; {CutToClipBoard}
  2858. function TDriveView.CanPasteFromClipBoard: Boolean;
  2859. begin
  2860. Result := False;
  2861. if Assigned(Selected) and Windows.OpenClipboard(0) then
  2862. begin
  2863. Result := IsClipboardFormatAvailable(CF_HDROP);
  2864. Windows.CloseClipBoard;
  2865. end;
  2866. end; {CanPasteFromClipBoard}
  2867. function TDriveView.PasteFromClipBoard(TargetPath: String = ''): Boolean;
  2868. begin
  2869. ClearDragFileList(FDragDropFilesEx.FileList);
  2870. Result := False;
  2871. if CanPasteFromClipBoard and {MP}FDragDropFilesEx.GetFromClipBoard{/MP}
  2872. then
  2873. begin
  2874. if TargetPath = '' then
  2875. TargetPath := NodePathName(Selected);
  2876. case LastClipBoardOperation of
  2877. cboCopy,
  2878. cboNone:
  2879. begin
  2880. PerformDragDropFileOperation(Selected, DROPEFFECT_COPY);
  2881. if Assigned(FOnDDExecuted) then
  2882. FOnDDExecuted(Self, DROPEFFECT_COPY);
  2883. end;
  2884. cboCut:
  2885. begin
  2886. PerformDragDropFileOperation(Selected, DROPEFFECT_MOVE);
  2887. if Assigned(FOnDDExecuted) then
  2888. FOnDDExecuted(Self, DROPEFFECT_MOVE);
  2889. EmptyClipBoard;
  2890. end;
  2891. end;
  2892. Result := True;
  2893. end;
  2894. end; {PasteFromClipBoard}
  2895. procedure TDriveView.CMRecreateWnd(var Msg: TMessage);
  2896. var
  2897. ScheduledCount: Integer;
  2898. begin
  2899. ScheduledCount := FSubDirReaderThread.Detach;
  2900. try
  2901. inherited;
  2902. finally
  2903. FSubDirReaderThread.Reattach(ScheduledCount);
  2904. end;
  2905. end;
  2906. procedure TDriveView.CMSysColorChange(var Message: TMessage);
  2907. begin
  2908. if not FValidateFlag then
  2909. begin
  2910. inherited;
  2911. end
  2912. else
  2913. begin
  2914. // Do not recreate the handle, if we are just iterating nodes, at that invalidates the node objects.
  2915. // This is not perfect, as the handle can be recreated for other reasons.
  2916. // But system color change is by far the most common case.
  2917. FSysColorChangePending := True;
  2918. end;
  2919. end;
  2920. end.