DriveView.pas 92 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303
  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. if Assigned(PopupMenu) then
  974. PopupMenu.Autopopup := False;
  975. FDragDropFilesEx.SourceEffects := [deCopy, deMove, deLink];
  976. FDragDropFilesEx.TargetEffects := [deCopy, deMove, deLink];
  977. if FPrevSelectedIndex >= 0 then
  978. begin
  979. FPrevSelected := Items[FPrevSelectedIndex];
  980. FPrevSelectedIndex := -1;
  981. end;
  982. for DriveStatus in FDriveStatus.Values do
  983. with DriveStatus do
  984. begin
  985. if RootNodeIndex >= 0 then
  986. begin
  987. RootNode := Items[RootNodeIndex];
  988. RootNodeIndex := -1;
  989. end;
  990. end;
  991. UpdateDelayedNodeTimer;
  992. end; {CreateWnd}
  993. procedure TDriveView.DestroyWnd;
  994. var
  995. DriveStatus: TDriveStatus;
  996. I: Integer;
  997. begin
  998. FDelayedNodeTimer.Enabled := False;
  999. for I := 0 to FDelayedNodes.Count - 1 do
  1000. FDelayedNodes.Objects[I] := nil;
  1001. if not (csRecreating in ControlState) then
  1002. begin
  1003. FSubDirReaderThread.Terminate;
  1004. FSubDirReaderThread.WaitFor;
  1005. end
  1006. else
  1007. if CreateWndRestores and (Items.Count > 0) then
  1008. begin
  1009. FPrevSelectedIndex := -1;
  1010. if Assigned(FPrevSelected) then
  1011. begin
  1012. FPrevSelectedIndex := FPrevSelected.AbsoluteIndex;
  1013. FPrevSelected := nil;
  1014. end;
  1015. for DriveStatus in FDriveStatus.Values do
  1016. with DriveStatus do
  1017. begin
  1018. RootNodeIndex := -1;
  1019. if Assigned(RootNode) then
  1020. begin
  1021. RootNodeIndex := RootNode.AbsoluteIndex;
  1022. RootNode := nil;
  1023. end;
  1024. end;
  1025. end;
  1026. inherited;
  1027. end;
  1028. function TDriveView.NodeColor(Node: TTreeNode): TColor;
  1029. begin
  1030. Result := clDefaultItemColor;
  1031. with TNodeData(Node.Data) do
  1032. if not Node.Selected then
  1033. begin
  1034. {Colored display of compressed directories:}
  1035. if (Attr and FILE_ATTRIBUTE_COMPRESSED) <> 0 then
  1036. begin
  1037. if SupportsDarkMode and DarkMode then Result := clSkyBlue
  1038. else Result := clBlue;
  1039. end
  1040. else
  1041. {Dimmed display, if hidden-atrribut set:}
  1042. if FDimmHiddenDirs and ((Attr and FILE_ATTRIBUTE_HIDDEN) <> 0) then
  1043. Result := clGrayText
  1044. end;
  1045. end;
  1046. function TDriveView.GetCustomDirView: TCustomDirView;
  1047. begin
  1048. Result := DirView;
  1049. end;
  1050. procedure TDriveView.SetCustomDirView(Value: TCustomDirView);
  1051. begin
  1052. DirView := Value as TDirView;
  1053. end;
  1054. function TDriveView.NodePath(Node: TTreeNode): string;
  1055. var
  1056. ParentNode: TTreeNode;
  1057. begin
  1058. if not Assigned(Node) then
  1059. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDirPath']));
  1060. Result := GetDirName(Node);
  1061. Node := Node.Parent;
  1062. while Assigned(Node) do
  1063. begin
  1064. ParentNode := Node.Parent;
  1065. if Assigned(ParentNode) then
  1066. Result := GetDirName(Node) + '\' + Result
  1067. else
  1068. Result := GetDirName(Node) + Result;
  1069. Node := ParentNode;
  1070. end;
  1071. if IsRootPath(Result) then
  1072. Result := ExcludeTrailingBackslash(Result);
  1073. end;
  1074. {NodePathName: Returns the complete path to Node with trailing backslash on rootnodes:
  1075. C:\ ,C:\WINDOWS, C:\WINDOWS\SYSTEM }
  1076. function TDriveView.NodePathName(Node: TTreeNode): string;
  1077. begin
  1078. Result := NodePath(Node);
  1079. if IsRootPath(Result) then
  1080. Result := IncludeTrailingBackslash(Result);
  1081. end; {NodePathName}
  1082. function TDriveView.NodeIsRecycleBin(Node: TTreeNode): Boolean;
  1083. begin
  1084. Result := TNodeData(Node.Data).IsRecycleBin;
  1085. end;
  1086. function TDriveView.NodePathExists(Node: TTreeNode): Boolean;
  1087. begin
  1088. Result := DirectoryExists(ApiPath(NodePathName(Node)));
  1089. end;
  1090. function TDriveView.CanEdit(Node: TTreeNode): Boolean;
  1091. begin
  1092. Result := inherited CanEdit(Node) or FForceRename;
  1093. if Result then
  1094. begin
  1095. Result := Assigned(Node.Parent) and
  1096. (not TNodeData(Node.Data).IsRecycleBin) and
  1097. (not ReadOnly) and
  1098. (FDragDropFilesEx.DragDetectStatus <> ddsDrag) and
  1099. ((TNodeData(Node.Data).Attr and (faReadOnly or faSysFile)) = 0) and
  1100. (UpperCase(Node.Text) = UpperCase(GetDirName(Node)));
  1101. end;
  1102. FForceRename := False;
  1103. end; {CanEdit}
  1104. procedure TDriveView.Edit(const Item: TTVItem);
  1105. var
  1106. Node: TTreeNode;
  1107. Info: string;
  1108. i: Integer;
  1109. begin
  1110. Node := GetNodeFromHItem(Item);
  1111. if (Length(Item.pszText) > 0) and (Item.pszText <> Node.Text) then
  1112. begin
  1113. if StrContains(coInvalidDosChars, Item.pszText) then
  1114. begin
  1115. Info := coInvalidDosChars;
  1116. for i := Length(Info) downto 1 do
  1117. System.Insert(Space, Info, i);
  1118. if Length(Item.pszText) > 0 then
  1119. raise EInvalidDirName.Create(SErrorInvalidName + Space + Info);
  1120. Exit;
  1121. end;
  1122. StopWatchThread;
  1123. if Assigned(DirView) then
  1124. DirView.StopWatchThread;
  1125. with FFileOperator do
  1126. begin
  1127. Flags := FileOperatorDefaultFlags + [foNoConfirmation];
  1128. Operation := foRename;
  1129. OperandFrom.Clear;
  1130. OperandTo.Clear;
  1131. OperandFrom.Add(NodePath(Node));
  1132. OperandTo.Add(IncludeTrailingBackslash(NodePath(Node.Parent)) + Item.pszText);
  1133. end;
  1134. try
  1135. if FFileOperator.Execute then
  1136. begin
  1137. Node.Text := Item.pszText;
  1138. TNodeData(Node.Data).DirName := Item.pszText;
  1139. SortChildren(Node.Parent, False);
  1140. inherited;
  1141. end
  1142. else
  1143. begin
  1144. if FileOrDirExists(IncludeTrailingBackslash(NodePath(Node.Parent)) + Item.pszText) then
  1145. Info := SErrorRenameFileExists + Item.pszText
  1146. else
  1147. Info := SErrorRenameFile + Item.pszText;
  1148. MessageBeep(MB_ICONHAND);
  1149. if MessageDlg(FormatLastOSError(Info), mtError, [mbOK, mbAbort], 0) = mrOK then
  1150. begin
  1151. FLastRenameName := Item.pszText;
  1152. FRenameNode := Node;
  1153. PostMessage(Self.Handle, WM_USER_RENAME, 0, 0);
  1154. end;
  1155. end;
  1156. finally
  1157. StartWatchThread;
  1158. if Assigned(DirView) then
  1159. begin
  1160. DirView.Reload2;
  1161. DirView.StartWatchThread;
  1162. end;
  1163. end;
  1164. end;
  1165. end; {Edit}
  1166. procedure TDriveView.WMUserRename(var Message: TMessage);
  1167. begin
  1168. if Assigned(FRenameNode) then
  1169. begin
  1170. FForceRename := True;
  1171. TreeView_EditLabel(Handle, FRenameNode.ItemID);
  1172. SetWindowText(TreeView_GetEditControl(Self.Handle), PChar(FLastRenameName));
  1173. FRenameNode := nil;
  1174. end;
  1175. end; {WMUserRename}
  1176. function TDriveView.CanExpand(Node: TTreeNode): Boolean;
  1177. var
  1178. SubNode: TTreeNode;
  1179. Drive: string;
  1180. SaveCursor: TCursor;
  1181. begin
  1182. Result := inherited CanExpand(Node);
  1183. Drive := GetDriveToNode(Node);
  1184. if Node.HasChildren then
  1185. begin
  1186. if (not Assigned(Node.Parent)) and
  1187. (not GetDriveStatus(Drive).Scanned) and
  1188. DriveInfo.IsFixedDrive(Drive) then
  1189. begin
  1190. SubNode := Node.GetFirstChild;
  1191. if not Assigned(SubNode) then
  1192. begin
  1193. ScanDrive(Drive);
  1194. SubNode := Node.GetFirstChild;
  1195. Node.HasChildren := Assigned(SubNode);
  1196. Result := Node.HasChildren;
  1197. if not Assigned(GetDriveStatus(Drive).DiscMonitor) then
  1198. CreateWatchThread(Drive);
  1199. end;
  1200. end
  1201. else
  1202. begin
  1203. SaveCursor := Screen.Cursor;
  1204. Screen.Cursor := crHourGlass;
  1205. try
  1206. if (not TNodeData(Node.Data).Scanned) and DoScanDir(Node) then
  1207. begin
  1208. ReadSubDirs(Node);
  1209. end;
  1210. finally
  1211. Screen.Cursor := SaveCursor;
  1212. end;
  1213. end;
  1214. end;
  1215. end; {CanExpand}
  1216. procedure TDriveView.GetImageIndex(Node: TTreeNode);
  1217. begin
  1218. if TNodeData(Node.Data).IconEmpty then
  1219. SetImageIndex(Node);
  1220. inherited;
  1221. end; {GetImageIndex}
  1222. procedure TDriveView.Loaded;
  1223. begin
  1224. inherited;
  1225. {Create the drive nodes:}
  1226. RefreshRootNodes(dsDisplayName or dvdsFloppy);
  1227. {Set the initial directory:}
  1228. if (Length(FDirectory) > 0) and DirectoryExists(ApiPath(FDirectory)) then
  1229. Directory := FDirectory;
  1230. FCreating := False;
  1231. end; {Loaded}
  1232. function TDriveView.CreateNode: TTreeNode;
  1233. begin
  1234. Result := TDriveTreeNode.Create(Items);
  1235. end;
  1236. procedure TDriveView.Delete(Node: TTreeNode);
  1237. var
  1238. NodeData: TNodeData;
  1239. begin
  1240. if Node = FPrevSelected then
  1241. FPrevSelected := nil;
  1242. NodeData := nil;
  1243. if Assigned(Node) and Assigned(Node.Data) then
  1244. NodeData := TNodeData(Node.Data);
  1245. Node.Data := nil;
  1246. inherited;
  1247. if Assigned(NodeData) and not (csRecreating in ControlState) then
  1248. begin
  1249. FSubDirReaderThread.Delete(Node);
  1250. if Assigned(NodeData.DelayedExclude) then
  1251. begin
  1252. CancelDelayedNode(Node);
  1253. FDelayedNodes.Delete(FDelayedNodes.IndexOfObject(Node));
  1254. UpdateDelayedNodeTimer;
  1255. end;
  1256. NodeData.Destroy;
  1257. end;
  1258. end; {OnDelete}
  1259. procedure TDriveView.KeyPress(var Key: Char);
  1260. begin
  1261. inherited;
  1262. if Assigned(Selected) then
  1263. begin
  1264. if Pos(Key, coInvalidDosChars) <> 0 then
  1265. begin
  1266. Beep;
  1267. Key := #0;
  1268. end;
  1269. end;
  1270. end; {KeyPress}
  1271. function TDriveView.CanChange(Node: TTreeNode): Boolean;
  1272. var
  1273. Path: string;
  1274. Drive: string;
  1275. begin
  1276. Result := inherited CanChange(Node);
  1277. if not Reading and not (csRecreating in ControlState) then
  1278. begin
  1279. if Result and Assigned(Node) then
  1280. begin
  1281. Path := NodePathName(Node);
  1282. if Path <> FLastDir then
  1283. begin
  1284. Drive := DriveInfo.GetDriveKey(Path);
  1285. DriveInfo.ReadDriveStatus(Drive, dsSize or dsImageIndex);
  1286. if not DriveInfo.Get(Drive).DriveReady then
  1287. begin
  1288. MessageDlg(Format(SDriveNotReady, [Drive]), mtError, [mbOK], 0);
  1289. Result := False;
  1290. end
  1291. else
  1292. try
  1293. CheckCanOpenDirectory(Path);
  1294. except
  1295. Application.HandleException(Self);
  1296. Result := False;
  1297. end;
  1298. end;
  1299. end;
  1300. if Result and (csDestroying in ComponentState) then
  1301. begin
  1302. Result := False;
  1303. end;
  1304. if Result and
  1305. (not FCanChange) and
  1306. Assigned(Node) and
  1307. Assigned(Node.Data) and
  1308. Assigned(Selected) and
  1309. Assigned(Selected.Data) then
  1310. begin
  1311. DropTarget := Node;
  1312. Result := False;
  1313. end
  1314. else
  1315. begin
  1316. DropTarget := nil;
  1317. end;
  1318. end;
  1319. end; {CanChange}
  1320. procedure TDriveView.Change(Node: TTreeNode);
  1321. var
  1322. Drive: string;
  1323. OldSerial: DWORD;
  1324. NewDir: string;
  1325. PrevDrive: string;
  1326. begin
  1327. if not Reading and not (csRecreating in ControlState) then
  1328. begin
  1329. if Assigned(Node) then
  1330. begin
  1331. NewDir := NodePathName(Node);
  1332. if NewDir <> FLastDir then
  1333. begin
  1334. Drive := DriveInfo.GetDriveKey(NewDir);
  1335. if Length(FLastDir) > 0 then
  1336. PrevDrive := DriveInfo.GetDriveKey(FLastDir)
  1337. else
  1338. PrevDrive := '';
  1339. FChangeFlag := True;
  1340. FLastDir := NewDir;
  1341. OldSerial := DriveInfo.Get(Drive).DriveSerial;
  1342. DriveInfo.ReadDriveStatus(Drive, dsSize or dsImageIndex);
  1343. with DriveInfo.Get(Drive) do
  1344. begin
  1345. if Assigned(FDirView) and (FDirView.Path <> NewDir) then
  1346. FDirView.Path := NewDir;
  1347. if DriveReady then
  1348. begin
  1349. if not DirectoryExists(ApiPath(NewDir)) then
  1350. begin
  1351. ValidateDirectory(GetDriveStatus(Drive).RootNode);
  1352. Exit;
  1353. end;
  1354. GetDriveStatus(Drive).DefaultDir := IncludeTrailingBackslash(NewDir);
  1355. if PrevDrive <> Drive then
  1356. begin
  1357. if (PrevDrive <> '') and
  1358. (DriveInfo.Get(PrevDrive).DriveType = DRIVE_REMOVABLE) then
  1359. begin
  1360. TerminateWatchThread(PrevDrive);
  1361. end;
  1362. {Drive serial has changed or is missing: allways reread the drive:}
  1363. if (DriveSerial <> OldSerial) or (DriveSerial = 0) then
  1364. begin
  1365. if TNodeData(GetDriveStatus(Drive).RootNode.Data).Scanned then
  1366. ScanDrive(Drive);
  1367. end;
  1368. end;
  1369. StartWatchThread;
  1370. end
  1371. else {Drive not ready:}
  1372. begin
  1373. GetDriveStatus(Drive).RootNode.DeleteChildren;
  1374. GetDriveStatus(Drive).DefaultDir := EmptyStr;
  1375. end;
  1376. end;
  1377. end;
  1378. if (not Assigned(FPrevSelected)) or (not FPrevSelected.HasAsParent(Node)) then
  1379. Node.Expand(False);
  1380. FPrevSelected := Node;
  1381. ValidateCurrentDirectoryIfNotMonitoring;
  1382. end;
  1383. end;
  1384. inherited;
  1385. end; {Change}
  1386. procedure TDriveView.SetImageIndex(Node: TTreeNode);
  1387. var
  1388. FileInfo: TShFileInfo;
  1389. Drive, NodePath: string;
  1390. begin
  1391. if Assigned(Node) and TNodeData(Node.Data).IconEmpty then
  1392. begin
  1393. NodePath := NodePathName(Node);
  1394. Drive := DriveInfo.GetDriveKey(NodePath);
  1395. if not Assigned(Node.Parent) then
  1396. begin
  1397. with DriveInfo.Get(Drive) do
  1398. begin
  1399. if ImageIndex = 0 then
  1400. begin
  1401. DriveInfo.ReadDriveStatus(Drive, dsImageIndex);
  1402. Node.ImageIndex := DriveInfo.Get(Drive).ImageIndex;
  1403. end
  1404. else Node.ImageIndex := ImageIndex;
  1405. Node.SelectedIndex := Node.ImageIndex;
  1406. end;
  1407. end
  1408. else
  1409. begin
  1410. if DriveInfo.Get(Drive).DriveType = DRIVE_REMOTE then
  1411. begin
  1412. Node.ImageIndex := StdDirIcon;
  1413. Node.SelectedIndex := StdDirSelIcon;
  1414. end
  1415. else
  1416. begin
  1417. try
  1418. SHGetFileInfo(PChar(NodePath), 0, FileInfo, SizeOf(FileInfo),
  1419. SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  1420. if (FileInfo.iIcon < Images.Count) and (FileInfo.iIcon > 0) then
  1421. begin
  1422. Node.ImageIndex := FileInfo.iIcon;
  1423. SHGetFileInfo(PChar(NodePath), 0, FileInfo, SizeOf(FileInfo),
  1424. SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_OPENICON);
  1425. Node.SelectedIndex := FileInfo.iIcon;
  1426. end
  1427. else
  1428. begin
  1429. Node.ImageIndex := StdDirIcon;
  1430. Node.SelectedIndex := StdDirSelIcon;
  1431. end;
  1432. except
  1433. Node.ImageIndex := StdDirIcon;
  1434. Node.SelectedIndex := StdDirSelIcon;
  1435. end;
  1436. end;
  1437. end;
  1438. end; {IconEmpty}
  1439. TNodeData(Node.Data).IconEmpty := False;
  1440. end; {SetImageIndex}
  1441. function TDriveView.GetDriveText(Drive: string): string;
  1442. begin
  1443. if FShowVolLabel and (Length(DriveInfo.GetPrettyName(Drive)) > 0) then
  1444. begin
  1445. case FVolDisplayStyle of
  1446. doPrettyName: Result := DriveInfo.GetPrettyName(Drive);
  1447. doDisplayName: Result := DriveInfo.GetDisplayName(Drive);
  1448. end; {Case}
  1449. end
  1450. else
  1451. begin
  1452. Result := DriveInfo.GetSimpleName(Drive);
  1453. end;
  1454. end; {GetDriveText}
  1455. function CompareDrive(List: TStringList; Index1, Index2: Integer): Integer;
  1456. var
  1457. Drive1, Drive2: string;
  1458. RealDrive1, RealDrive2: Boolean;
  1459. begin
  1460. Drive1 := List[Index1];
  1461. Drive2 := List[Index2];
  1462. RealDrive1 := DriveInfo.IsRealDrive(Drive1);
  1463. RealDrive2 := DriveInfo.IsRealDrive(Drive2);
  1464. if RealDrive1 = RealDrive2 then
  1465. begin
  1466. Result := CompareText(Drive1, Drive2);
  1467. end
  1468. else
  1469. if RealDrive1 and (not RealDrive2) then
  1470. begin
  1471. Result := -1;
  1472. end
  1473. else
  1474. begin
  1475. Result := 1;
  1476. end;
  1477. end;
  1478. function TDriveView.GetDrives: TStrings;
  1479. var
  1480. DriveStatusPair: TDriveStatusPair;
  1481. Drives: TStringList;
  1482. begin
  1483. Drives := TStringList.Create;
  1484. { We could iterate only .Keys here, but that crashes IDE for some reason }
  1485. for DriveStatusPair in FDriveStatus do
  1486. begin
  1487. Drives.Add(DriveStatusPair.Key);
  1488. end;
  1489. Drives.CustomSort(CompareDrive);
  1490. Result := Drives;
  1491. end;
  1492. procedure TDriveView.DriveRemoved(Drive: string);
  1493. var
  1494. NewDrive: Char;
  1495. begin
  1496. if (Directory <> '') and (Directory[1] = Drive) then
  1497. begin
  1498. if DriveInfo.IsRealDrive(Drive) then NewDrive := Drive[1]
  1499. else NewDrive := SystemDrive;
  1500. repeat
  1501. if NewDrive < SystemDrive then NewDrive := SystemDrive
  1502. else
  1503. if NewDrive = SystemDrive then NewDrive := LastDrive
  1504. else Dec(NewDrive);
  1505. DriveInfo.ReadDriveStatus(NewDrive, dsSize or dsImageIndex);
  1506. if NewDrive = Drive then
  1507. begin
  1508. Break;
  1509. end;
  1510. if DriveInfo.Get(NewDrive).Valid and DriveInfo.Get(NewDrive).DriveReady and Assigned(GetDriveStatus(NewDrive).RootNode) then
  1511. begin
  1512. Directory := NodePathName(GetDriveStatus(NewDrive).RootNode);
  1513. break;
  1514. end;
  1515. until False;
  1516. if not Assigned(Selected) then
  1517. begin
  1518. Directory := NodePathName(GetDriveStatus(SystemDrive).RootNode);
  1519. end;
  1520. end;
  1521. end;
  1522. procedure TDriveView.RefreshRootNodes(dsFlags: Integer);
  1523. var
  1524. Drives: TStrings;
  1525. NewText: string;
  1526. SaveCursor: TCursor;
  1527. WasValid: Boolean;
  1528. NodeData: TNodeData;
  1529. DriveStatus: TDriveStatus;
  1530. NextDriveNode: TTreeNode;
  1531. Index: Integer;
  1532. Drive: string;
  1533. begin
  1534. SaveCursor := Screen.Cursor;
  1535. Screen.Cursor := crHourGlass;
  1536. Drives := nil;
  1537. try
  1538. Drives := GetDrives;
  1539. NextDriveNode := nil;
  1540. for Index := Drives.Count - 1 downto 0 do
  1541. begin
  1542. Drive := Drives[Index];
  1543. DriveStatus := GetDriveStatus(Drive);
  1544. if ((dsFlags and dvdsFloppy) <> 0) or DriveInfo.IsFixedDrive(Drive) then
  1545. begin
  1546. with DriveInfo.Get(Drive) do
  1547. begin
  1548. WasValid := Assigned(DriveStatus.RootNode);
  1549. end;
  1550. if ((dsFlags and dvdsReReadAllways) = 0) and
  1551. (Length(DriveInfo.Get(Drive).DisplayName) > 0) then
  1552. dsFlags := dsFlags and (not dsDisplayName);
  1553. DriveInfo.ReadDriveStatus(Drive, dsFlags);
  1554. with DriveInfo.Get(Drive), DriveStatus do
  1555. begin
  1556. if Valid then
  1557. begin
  1558. if not WasValid then
  1559. {New drive has arrived: insert new rootnode:}
  1560. begin
  1561. { Create root directory node }
  1562. NodeData := TNodeData.Create;
  1563. NodeData.DirName := DriveInfo.GetDriveRoot(Drive);
  1564. if Assigned(NextDriveNode) then
  1565. RootNode := Items.InsertObject(NextDriveNode, '', NodeData)
  1566. else
  1567. RootNode := Items.AddObject(nil, '', NodeData);
  1568. RootNode.Text := GetDisplayName(RootNode);
  1569. RootNode.HasChildren := True;
  1570. Scanned := False;
  1571. Verified := False;
  1572. end
  1573. else
  1574. if RootNode.ImageIndex <> DriveInfo.Get(Drive).ImageIndex then
  1575. begin {WasValid = True}
  1576. RootNode.ImageIndex := DriveInfo.Get(Drive).ImageIndex;
  1577. RootNode.SelectedIndex := DriveInfo.Get(Drive).ImageIndex;
  1578. end;
  1579. if Assigned(RootNode) then
  1580. begin
  1581. NewText := GetDisplayName(RootNode);
  1582. if RootNode.Text <> NewText then
  1583. RootNode.Text := NewText;
  1584. end;
  1585. end
  1586. else
  1587. if WasValid then
  1588. {Drive has been removed => delete rootnode:}
  1589. begin
  1590. DriveRemoved(Drive);
  1591. Scanned := False;
  1592. Verified := False;
  1593. RootNode.Delete;
  1594. RootNode := nil;
  1595. end;
  1596. end;
  1597. end;
  1598. if Assigned(DriveStatus.RootNode) then
  1599. NextDriveNode := DriveStatus.RootNode;
  1600. end;
  1601. finally
  1602. Screen.Cursor := SaveCursor;
  1603. Drives.Free;
  1604. end;
  1605. end; {RefreshRootNodes}
  1606. procedure TDriveView.AddChildNode(ParentNode: TTreeNode; ParentPath: string; SRec: TSearchRec);
  1607. var
  1608. NewNode: TTreeNode;
  1609. NodeData: TNodeData;
  1610. begin
  1611. NodeData := TNodeData.Create;
  1612. NodeData.Attr := SRec.Attr;
  1613. NodeData.DirName := SRec.Name;
  1614. NodeData.FIsRecycleBin :=
  1615. (SRec.Attr and faSysFile <> 0) and
  1616. (not Assigned(ParentNode.Parent)) and
  1617. (SameText(SRec.Name, 'RECYCLED') or
  1618. SameText(SRec.Name, 'RECYCLER') or
  1619. SameText(SRec.Name, '$RECYCLE.BIN'));
  1620. NodeData.Scanned := False;
  1621. NewNode := Self.Items.AddChildObject(ParentNode, '', NodeData);
  1622. NewNode.Text := GetDisplayName(NewNode);
  1623. NewNode.HasChildren := True;
  1624. if GetDriveTypeToNode(ParentNode) <> DRIVE_REMOTE then
  1625. FSubDirReaderThread.Add(NewNode, IncludeTrailingBackslash(ParentPath) + SRec.Name);
  1626. end; {AddChildNode}
  1627. function TDriveView.GetDriveStatus(Drive: string): TDriveStatus;
  1628. begin
  1629. if not FDriveStatus.TryGetValue(Drive, Result) then
  1630. begin
  1631. Result := CreateDriveStatus;
  1632. FDriveStatus.Add(Drive, Result);
  1633. RefreshRootNodes(dsAll or dvdsRereadAllways);
  1634. DoRefreshDrives(False);
  1635. end;
  1636. end; {GetDriveStatus}
  1637. function TDriveView.DoScanDir(FromNode: TTreeNode): Boolean;
  1638. begin
  1639. Result := not TNodeData(FromNode.Data).IsRecycleBin;
  1640. end; {DoScanDir}
  1641. function TDriveView.DirAttrMask: Integer;
  1642. begin
  1643. Result := faDirectory or faSysFile;
  1644. if ShowHiddenDirs then
  1645. Result := Result or faHidden;
  1646. end;
  1647. procedure TDriveView.ScanDrive(Drive: string);
  1648. begin {ScanDrive}
  1649. with Self.Items do
  1650. begin
  1651. ValidateDirectory(FindNodeToPath(DriveInfo.GetDriveRoot(Drive)));
  1652. GetDriveStatus(Drive).Scanned := True;
  1653. GetDriveStatus(Drive).Verified := False;
  1654. end;
  1655. end; {ScanDrive}
  1656. function TDriveView.DoFindNodeToPath(Path: string; ExistingOnly: Boolean): TTreeNode;
  1657. var
  1658. SelectionHierarchy: array of TTreeNode;
  1659. SelectionHierarchyHeight: Integer;
  1660. function SearchSubDirs(ParentNode: TTreeNode; Path: string; Level: Integer): TTreeNode; forward;
  1661. function ExtractFirstName(S: string): string;
  1662. var
  1663. I: Integer;
  1664. begin
  1665. I := Pos('\', S);
  1666. if I = 0 then
  1667. I := Length(S);
  1668. Result := System.Copy(S, 1, I);
  1669. end;
  1670. function DoSearchSubDirs(ParentNode: TTreeNode; Path: string; Level: Integer): TTreeNode;
  1671. var
  1672. Node: TTreeNode;
  1673. Dir: string;
  1674. begin
  1675. {Extract first directory from path:}
  1676. Dir := ExtractFirstName(Path);
  1677. System.Delete(Path, 1, Length(Dir));
  1678. if Dir[Length(Dir)] = '\' then
  1679. SetLength(Dir, Pred(Length(Dir)));
  1680. // Optimization. Avoid iterating possibly thousands of nodes,
  1681. // when the node we are looking for is the selected node or its ancestor.
  1682. // This is often the case, when navigating under node that has lot of siblings.
  1683. // Typically, when navigating in user's profile folder, and there are many [thousands] other user profile folders.
  1684. if (SelectionHierarchyHeight > 0) and
  1685. // Change of selection might indicate that the tree was rebuilt meanwhile and
  1686. // the references in SelectionHierarchy might not be valid anymore
  1687. (Selected = SelectionHierarchy[SelectionHierarchyHeight - 1]) and
  1688. (Level < SelectionHierarchyHeight) and
  1689. (Uppercase(GetDirName(SelectionHierarchy[Level])) = Dir) then
  1690. begin
  1691. Result := SelectionHierarchy[Level];
  1692. end
  1693. else
  1694. begin
  1695. // Paths have diverted
  1696. SelectionHierarchyHeight := 0;
  1697. Node := ParentNode.GetFirstChild;
  1698. if (not Assigned(Node)) and (not ExistingOnly) then
  1699. begin
  1700. ValidateDirectoryEx(ParentNode, rsRecursiveExisting, True);
  1701. Node := ParentNode.GetFirstChild;
  1702. end;
  1703. Result := nil;
  1704. while (not Assigned(Result)) and Assigned(Node) do
  1705. begin
  1706. if UpperCase(GetDirName(Node)) = Dir then
  1707. begin
  1708. Result := Node;
  1709. end
  1710. else
  1711. begin
  1712. Node := ParentNode.GetNextChild(Node);
  1713. end;
  1714. end;
  1715. end;
  1716. if Assigned(Result) and (Length(Path) > 0) then
  1717. begin
  1718. Result := SearchSubDirs(Result, Path, Level + 1);
  1719. end;
  1720. end;
  1721. function SearchSubDirs(ParentNode: TTreeNode; Path: string; Level: Integer): TTreeNode;
  1722. var
  1723. ParentPath, SubPath: string;
  1724. SRec: TSearchRec;
  1725. ParentNodeData: TNodeData;
  1726. begin
  1727. Result := nil;
  1728. if Length(Path) > 0 then
  1729. begin
  1730. ParentNodeData := TNodeData(ParentNode.Data);
  1731. if (not ParentNodeData.Scanned) and (not ExistingOnly) then
  1732. begin
  1733. ReadSubDirs(ParentNode);
  1734. end;
  1735. // Factored out of DoSearchSubDirs is remnant of Bug 956 superceded by Bug 1320
  1736. Result := DoSearchSubDirs(ParentNode, Path, Level);
  1737. if (not Assigned(Result)) and (not ExistingOnly) then
  1738. begin
  1739. ParentPath := NodePath(ParentNode);
  1740. if DirectoryExists(ApiPath(IncludeTrailingBackslash(ParentPath) + Path)) then
  1741. begin
  1742. SubPath := IncludeTrailingBackslash(ParentPath) + ExcludeTrailingBackslash(ExtractFirstName(Path));
  1743. if FindFirstSubDir(SubPath, SRec) then
  1744. begin
  1745. AddChildNode(ParentNode, ParentPath, SRec);
  1746. if Assigned(ParentNodeData.DelayedExclude) then
  1747. ParentNodeData.DelayedExclude.Add(SRec.Name);
  1748. SortChildren(ParentNode, False);
  1749. FindClose(SRec);
  1750. end;
  1751. Result := DoSearchSubDirs(ParentNode, Path, Level);
  1752. end;
  1753. end;
  1754. end;
  1755. end; {SearchSubDirs}
  1756. var
  1757. Drive: string;
  1758. P, I: Integer;
  1759. RootNode, Node: TTreeNode;
  1760. begin {FindNodeToPath}
  1761. Result := nil;
  1762. if Length(Path) < 3 then
  1763. Exit;
  1764. // Particularly when used by TDirView to delegate browsing to
  1765. // hidden drive view, the handle may not be created
  1766. HandleNeeded;
  1767. Drive := DriveInfo.GetDriveKey(Path);
  1768. if (not Assigned(GetDriveStatus(Drive).RootNode)) and
  1769. // hidden or possibly recently un-hidden by other drive view (refresh is pending)
  1770. (DriveInfo.Get(Drive).Valid or DriveInfo.Get(Drive).ValidButHiddenByDrivePolicy) then
  1771. begin
  1772. if DriveInfo.Get(Drive).ValidButHiddenByDrivePolicy then
  1773. DriveInfo.OverrideDrivePolicy(Drive);
  1774. if DriveInfo.Get(Drive).Valid then
  1775. begin
  1776. CancelDriveRefresh; // cancel a possible pending refresh (see the previous comment)
  1777. RefreshRootNodes(dsAll or dvdsRereadAllways); // overkill and is likely already called by GetDriveStatus
  1778. DoRefreshDrives(False);
  1779. end;
  1780. end;
  1781. if Assigned(GetDriveStatus(Drive).RootNode) then
  1782. begin
  1783. if DriveInfo.IsRealDrive(Drive) then
  1784. begin
  1785. System.Delete(Path, 1, 3);
  1786. end
  1787. else
  1788. if IsUncPath(Path) then
  1789. begin
  1790. System.Delete(Path, 1, 2);
  1791. P := Pos('\', Path);
  1792. if P = 0 then
  1793. begin
  1794. Path := '';
  1795. end
  1796. else
  1797. begin
  1798. System.Delete(Path, 1, P);
  1799. P := Pos('\', Path);
  1800. if P = 0 then
  1801. begin
  1802. Path := '';
  1803. end
  1804. else
  1805. begin
  1806. System.Delete(Path, 1, P);
  1807. end;
  1808. end;
  1809. end
  1810. else
  1811. begin
  1812. raise EConvertError.Create(Format(ErrorInvalidDrive, [Path]))
  1813. end;
  1814. if Length(Path) > 0 then
  1815. begin
  1816. if (not GetDriveStatus(Drive).Scanned) and (not ExistingOnly) then
  1817. begin
  1818. ScanDrive(Drive);
  1819. end;
  1820. Node := Selected;
  1821. RootNode := GetDriveStatus(Drive).RootNode;
  1822. if not Assigned(Node) then
  1823. begin
  1824. SelectionHierarchyHeight := 0;
  1825. end
  1826. else
  1827. begin
  1828. SelectionHierarchyHeight := Node.Level + 1;
  1829. SetLength(SelectionHierarchy, SelectionHierarchyHeight);
  1830. for I := SelectionHierarchyHeight - 1 downto 0 do
  1831. begin
  1832. SelectionHierarchy[I] := Node;
  1833. Node := Node.Parent;
  1834. end;
  1835. Assert(Selected = SelectionHierarchy[SelectionHierarchyHeight - 1]);
  1836. // Different drive - nothing to optimize
  1837. if RootNode <> SelectionHierarchy[0] then
  1838. SelectionHierarchyHeight := 0;
  1839. end;
  1840. Result := SearchSubDirs(RootNode, UpperCase(Path), 1);
  1841. end
  1842. else Result := GetDriveStatus(Drive).RootNode;
  1843. end;
  1844. end; {FindNodetoPath}
  1845. function TDriveView.FindNodeToPath(Path: string): TTreeNode;
  1846. begin
  1847. Result := DoFindNodeToPath(Path, False);
  1848. end;
  1849. function TDriveView.TryFindNodeToPath(Path: string): TTreeNode;
  1850. begin
  1851. Result := DoFindNodeToPath(Path, True);
  1852. end;
  1853. function TDriveView.GetSubDir(var SRec: TSearchRec): Boolean;
  1854. begin
  1855. Result := True;
  1856. while Result and
  1857. ((SRec.Name = '.' ) or
  1858. (SRec.Name = '..') or
  1859. ((SRec.Attr and faDirectory) = 0)) do
  1860. begin
  1861. if FindNext(SRec) <> 0 then
  1862. begin
  1863. Result := False;
  1864. end;
  1865. end;
  1866. end;
  1867. function TDriveView.FindFirstSubDir(Path: string; var SRec: TSearchRec): Boolean;
  1868. begin
  1869. Result := (FindFirstEx(ApiPath(Path), DirAttrMask, SRec, FIND_FIRST_EX_LARGE_FETCH_PAS, FindExSearchLimitToDirectories) = 0);
  1870. if Result then
  1871. begin
  1872. Result := GetSubDir(SRec);
  1873. if not Result then FindClose(SRec);
  1874. end;
  1875. end;
  1876. function TDriveView.FindNextSubDir(var SRec: TSearchRec): Boolean;
  1877. begin
  1878. Result := (FindNext(SRec) = 0) and GetSubDir(SRec);
  1879. end;
  1880. function TDriveView.ReadSubDirsBatch(Node: TTreeNode; var SRec: TSearchRec; CheckInterval, Limit: Integer): Boolean;
  1881. var
  1882. Start: TDateTime;
  1883. Cont: Boolean;
  1884. Path: string;
  1885. Count: Integer;
  1886. DelayedExclude: TStringList;
  1887. begin
  1888. Start := Now;
  1889. Path := NodePath(Node);
  1890. Result := True;
  1891. Count := 0;
  1892. DelayedExclude := TNodeData(Node.Data).DelayedExclude;
  1893. // At least from SetDirectory > DoFindNodeToPath and CanExpand, this is not called within BeginUpdate/EndUpdate block.
  1894. // But in any case, adding it here makes expanding (which calls CanExpand) noticeably slower, when there are lot of nodes,
  1895. // because EndUpdate triggers TVN_GETDISPINFO for all nodes in the tree.
  1896. repeat
  1897. if (not Assigned(DelayedExclude)) or
  1898. (DelayedExclude.IndexOf(SRec.Name) < 0) then
  1899. begin
  1900. AddChildNode(Node, Path, SRec);
  1901. Inc(Count);
  1902. end;
  1903. Cont := FindNextSubDir(SRec);
  1904. // There are two other directory reading loops, where this is not checked
  1905. if Cont and
  1906. ((Count mod CheckInterval) = 0) and
  1907. (Limit > 0) and
  1908. (MilliSecondsBetween(Now, Start) > Limit) then
  1909. begin
  1910. Result := False;
  1911. Cont := False;
  1912. end
  1913. until not Cont;
  1914. if Result then
  1915. FindClose(Srec);
  1916. end;
  1917. procedure TDriveView.DelayedNodeTimer(Sender: TObject);
  1918. var
  1919. Node: TTreeNode;
  1920. NodeData: TNodeData;
  1921. begin
  1922. Assert(FDelayedNodes.Count > 0);
  1923. if FDelayedNodes.Count > 0 then
  1924. begin
  1925. // Control was recreated
  1926. if not Assigned(FDelayedNodes.Objects[0]) then
  1927. begin
  1928. FDelayedNodes.Objects[0] := TryFindNodeToPath(FDelayedNodes.Strings[0]);
  1929. end;
  1930. Node := TTreeNode(FDelayedNodes.Objects[0]);
  1931. if not Assigned(Node) then
  1932. begin
  1933. FDelayedNodes.Delete(0);
  1934. end
  1935. else
  1936. begin
  1937. NodeData := TNodeData(Node.Data);
  1938. if ReadSubDirsBatch(Node, NodeData.DelayedSrec, 10, 50) then
  1939. begin
  1940. FreeAndNil(NodeData.DelayedExclude);
  1941. FDelayedNodes.Delete(0);
  1942. SortChildren(Node, False);
  1943. end;
  1944. end;
  1945. end;
  1946. UpdateDelayedNodeTimer;
  1947. end;
  1948. procedure TDriveView.UpdateDelayedNodeTimer;
  1949. begin
  1950. FDelayedNodeTimer.Enabled := HandleAllocated and (FDelayedNodes.Count > 0);
  1951. end;
  1952. procedure TDriveView.ReadSubDirs(Node: TTreeNode);
  1953. var
  1954. SRec: TSearchRec;
  1955. NodeData: TNodeData;
  1956. Path: string;
  1957. CheckInterval, Limit: Integer;
  1958. begin
  1959. NodeData := TNodeData(Node.Data);
  1960. Path := NodePath(Node);
  1961. if not FindFirstSubDir(IncludeTrailingBackslash(Path) + '*.*', SRec) then
  1962. begin
  1963. Node.HasChildren := False;
  1964. end
  1965. else
  1966. begin
  1967. CheckInterval := 100;
  1968. Limit := DriveViewLoadingTooLongLimit * 1000;
  1969. if not Showing then
  1970. begin
  1971. Limit := Limit div 10;
  1972. CheckInterval := CheckInterval div 10;
  1973. end;
  1974. if not ReadSubDirsBatch(Node, SRec, CheckInterval, Limit) then
  1975. begin
  1976. NodeData.DelayedSrec := SRec;
  1977. NodeData.DelayedExclude := TStringList.Create;
  1978. NodeData.DelayedExclude.CaseSensitive := False;
  1979. NodeData.DelayedExclude.Sorted := True;
  1980. FDelayedNodes.AddObject(Path, Node);
  1981. Assert(FDelayedNodes.Count < 20); // if more, something went likely wrong
  1982. UpdateDelayedNodeTimer;
  1983. end;
  1984. SortChildren(Node, False);
  1985. end;
  1986. NodeData.Scanned := True;
  1987. Application.ProcessMessages;
  1988. end; {ReadSubDirs}
  1989. procedure TDriveView.CancelDelayedNode(Node: TTreeNode);
  1990. var
  1991. NodeData: TNodeData;
  1992. begin
  1993. NodeData := TNodeData(Node.Data);
  1994. FindClose(NodeData.DelayedSrec);
  1995. FreeAndNil(NodeData.DelayedExclude);
  1996. end;
  1997. procedure TDriveView.DeleteNode(Node: TTreeNode);
  1998. var
  1999. ValidNode: TTreeNode;
  2000. begin
  2001. if Assigned(Selected) and Assigned(Node.Parent) and
  2002. ((Selected = Node) or Selected.HasAsParent(Node)) then
  2003. begin
  2004. ValidNode := Node.Parent;
  2005. while (not NodePathExists(ValidNode)) and Assigned(ValidNode.Parent) do
  2006. ValidNode := ValidNode.Parent;
  2007. Selected := ValidNode;
  2008. end;
  2009. if DropTarget = Node then
  2010. DropTarget := nil;
  2011. Node.Delete;
  2012. end;
  2013. function TDriveView.CallBackValidateDir(var Node: TTreeNode; Data: Pointer): Boolean;
  2014. var
  2015. WorkNode: TTreeNode;
  2016. DelNode: TTreeNode;
  2017. SRec: TSearchRec;
  2018. SrecList: TStringList;
  2019. SubDirList: TStringList;
  2020. R: Boolean;
  2021. Index: Integer;
  2022. NewDirFound: Boolean;
  2023. ParentDir: string;
  2024. NodeData: TNodeData;
  2025. ScanDirInfo: PScanDirInfo;
  2026. begin {CallBackValidateDir}
  2027. Result := True;
  2028. if (not Assigned(Node)) or (not Assigned(Node.Data)) then
  2029. Exit;
  2030. NewDirFound := False;
  2031. ScanDirInfo := PScanDirInfo(Data);
  2032. {Check, if directory still exists: (but not with root directory) }
  2033. if Assigned(Node.Parent) and (ScanDirInfo^.StartNode = Node) and
  2034. (not NodePathExists(Node)) then
  2035. begin
  2036. DeleteNode(Node);
  2037. Node := nil;
  2038. Exit;
  2039. end;
  2040. WorkNode := Node.GetFirstChild;
  2041. NodeData := TNodeData(Node.Data);
  2042. if NodeData.Scanned and Assigned(WorkNode) then
  2043. {if node was already scanned: check wether the existing subnodes are still alive
  2044. and add all new subdirectories as subnodes:}
  2045. begin
  2046. if DoScanDir(Node) then
  2047. begin
  2048. ParentDir := IncludeTrailingBackslash(NodePath(Node));
  2049. {Build list of existing subnodes:}
  2050. SubDirList := TStringList.Create;
  2051. SubDirList.CaseSensitive := True; // We want to reflect changes in subfolder name case
  2052. while Assigned(WorkNode) do
  2053. begin
  2054. SubDirList.Add(TNodeData(WorkNode.Data).DirName);
  2055. WorkNode := Node.GetNextChild(WorkNode);
  2056. end;
  2057. // Nodes are sorted using natural sorting, while TStringList.Find uses simple sorting
  2058. SubDirList.Sort;
  2059. SRecList := TStringList.Create;
  2060. SRecList.CaseSensitive := True;
  2061. R := FindFirstSubDir(ParentDir + '*.*', SRec);
  2062. while R do
  2063. begin
  2064. SrecList.Add(Srec.Name);
  2065. if not SubDirList.Find(Srec.Name, Index) then
  2066. {Subnode does not exists: add it:}
  2067. begin
  2068. AddChildNode(Node, ParentDir, SRec);
  2069. NewDirFound := True;
  2070. end;
  2071. R := FindNextSubDir(Srec);
  2072. end;
  2073. FindClose(Srec);
  2074. Sreclist.Sort;
  2075. {Remove not existing subnodes:}
  2076. WorkNode := Node.GetFirstChild;
  2077. while Assigned(WorkNode) do
  2078. begin
  2079. if not Assigned(WorkNode.Data) or
  2080. not SrecList.Find(TNodeData(WorkNode.Data).DirName, Index) then
  2081. begin
  2082. DelNode := WorkNode;
  2083. WorkNode := Node.GetNextChild(WorkNode);
  2084. DeleteNode(DelNode);
  2085. end
  2086. else
  2087. begin
  2088. if (SrecList[Index] <> TNodeData(WorkNode.Data).DirName) then
  2089. begin
  2090. {Case of directory letters has changed:}
  2091. TNodeData(WorkNode.Data).DirName := SrecList[Index];
  2092. WorkNode.Text := SrecList[Index];
  2093. end;
  2094. WorkNode := Node.GetNextChild(WorkNode);
  2095. end;
  2096. end;
  2097. SrecList.Free;
  2098. SubDirList.Free;
  2099. {Sort subnodes:}
  2100. if NewDirFound then
  2101. SortChildren(Node, False);
  2102. end;
  2103. end
  2104. else
  2105. {Node was not already scanned:}
  2106. if (ScanDirInfo^.SearchNewDirs or
  2107. NodeData.Scanned or
  2108. (Node = ScanDirInfo^.StartNode)) and
  2109. DoScanDir(Node) then
  2110. begin
  2111. ReadSubDirs(Node);
  2112. end;
  2113. end; {CallBackValidateDir}
  2114. procedure TDriveView.RebuildTree;
  2115. var
  2116. Drive: string;
  2117. begin
  2118. for Drive in FDriveStatus.Keys do
  2119. with GetDriveStatus(Drive) do
  2120. if Assigned(RootNode) and Scanned then
  2121. ValidateDirectory(RootNode);
  2122. end;
  2123. procedure TDriveView.ValidateCurrentDirectoryIfNotMonitoring;
  2124. begin
  2125. if Assigned(Selected) and
  2126. not Assigned(GetDriveStatus(GetDriveToNode(Selected)).DiscMonitor) then
  2127. begin
  2128. ValidateDirectory(Selected);
  2129. end;
  2130. end;
  2131. procedure TDriveView.ValidateDirectoryEx(Node: TTreeNode; Recurse: TRecursiveScan;
  2132. NewDirs: Boolean);
  2133. var
  2134. Info: PScanDirInfo;
  2135. SelDir: string;
  2136. SaveCursor: TCursor;
  2137. RestartWatchThread: Boolean;
  2138. SaveCanChange: Boolean;
  2139. CurrentPath: string;
  2140. Drive: string;
  2141. begin
  2142. if Assigned(Node) and Assigned(Node.Data) and
  2143. (not FValidateFlag) and DoScanDir(Node) then
  2144. begin
  2145. SelDir := Directory;
  2146. SaveCursor := Screen.Cursor;
  2147. if Self.Focused and (Screen.Cursor <> crHourGlass) then
  2148. Screen.Cursor := crHourGlass;
  2149. CurrentPath := NodePath(Node);
  2150. Drive := DriveInfo.GetDriveKey(CurrentPath);
  2151. if not Assigned(Node.Parent) then
  2152. GetDriveStatus(Drive).ChangeTimer.Enabled := False;
  2153. RestartWatchThread := WatchThreadActive;
  2154. try
  2155. if WatchThreadActive then
  2156. StopWatchThread;
  2157. FValidateFlag := True;
  2158. FSysColorChangePending := False;
  2159. New(Info);
  2160. Info^.StartNode := Node;
  2161. Info^.SearchNewDirs := NewDirs;
  2162. Info^.DriveType := DriveInfo.Get(Drive).DriveType;
  2163. SaveCanChange := FCanChange;
  2164. FCanChange := True;
  2165. FChangeFlag := False;
  2166. Items.BeginUpdate;
  2167. try
  2168. IterateSubTree(Node, CallBackValidateDir, Recurse, coScanStartNode, Info);
  2169. finally
  2170. Items.EndUpdate;
  2171. end;
  2172. FValidateFlag := False;
  2173. if (not Assigned(Selected)) and (Length(SelDir) > 0) then
  2174. Directory := ExtractFileDrive(SelDir);
  2175. if (SelDir <> Directory) and (not FChangeFlag) then
  2176. Change(Selected);
  2177. FCanChange := SaveCanChange;
  2178. Dispose(Info);
  2179. finally
  2180. if RestartWatchThread and FWatchDirectory and not WatchThreadActive then
  2181. StartWatchThread;
  2182. if Screen.Cursor <> SaveCursor then
  2183. Screen.Cursor := SaveCursor;
  2184. if FSysColorChangePending then
  2185. begin
  2186. FSysColorChangePending := False;
  2187. if HandleAllocated then Perform(CM_SYSCOLORCHANGE, 0, 0);
  2188. end;
  2189. end;
  2190. end;
  2191. end; {ValidateDirectoryEx}
  2192. function TDriveView.GetDriveTypeToNode(Node: TTreeNode): Integer;
  2193. begin
  2194. Assert(Assigned(Node));
  2195. Result := DriveInfo.Get(GetDriveToNode(Node)).DriveType;
  2196. end; {GetDriveTypeToNode}
  2197. procedure TDriveView.CreateWatchThread(Drive: string);
  2198. begin
  2199. if csDesigning in ComponentState then
  2200. Exit;
  2201. if (not Assigned(GetDriveStatus(Drive).DiscMonitor)) and
  2202. FWatchDirectory and
  2203. (DriveInfo.Get(Drive).DriveType <> DRIVE_REMOTE) then
  2204. begin
  2205. with GetDriveStatus(Drive) do
  2206. begin
  2207. DiscMonitor := TDiscMonitor.Create(Self);
  2208. DiscMonitor.ChangeDelay := msThreadChangeDelay;
  2209. DiscMonitor.SubTree := True;
  2210. DiscMonitor.Filters := [moDirName];
  2211. DiscMonitor.OnChange := ChangeDetected;
  2212. DiscMonitor.OnInvalid := ChangeInvalid;
  2213. DiscMonitor.SetDirectory(DriveInfo.GetDriveRoot(Drive));
  2214. DiscMonitor.Open;
  2215. end;
  2216. UpdateDriveNotifications(Drive);
  2217. end;
  2218. end; {CreateWatchThread}
  2219. procedure TDriveView.SetWatchDirectory(Value: Boolean);
  2220. begin
  2221. if FWatchDirectory <> Value then
  2222. begin
  2223. FWatchDirectory := Value;
  2224. if (not (csDesigning in ComponentState)) and Value then
  2225. StartAllWatchThreads
  2226. else
  2227. StopAllWatchThreads;
  2228. end;
  2229. end; {SetAutoScan}
  2230. procedure TDriveView.SetDirView(Value: TDirView);
  2231. begin
  2232. if Assigned(FDirView) then
  2233. FDirView.DriveView := nil;
  2234. FDirView := Value;
  2235. if Assigned(FDirView) then
  2236. FDirView.DriveView := Self;
  2237. end; {SetDirView}
  2238. function TDriveView.NodeWatched(Node: TTreeNode): Boolean;
  2239. var
  2240. Drive: string;
  2241. begin
  2242. Drive := GetDriveToNode(Node);
  2243. Result := WatchThreadActive(Drive);
  2244. end; {NodeWatched}
  2245. procedure TDriveView.ChangeInvalid(Sender: TObject; const Directory: string;
  2246. const ErrorStr: string);
  2247. var
  2248. Drive: string;
  2249. begin
  2250. Drive := DriveInfo.GetDriveKey((Sender as TDiscMonitor).Directories[0]);
  2251. with GetDriveStatus(Drive) do
  2252. begin
  2253. DiscMonitor.Close;
  2254. end;
  2255. UpdateDriveNotifications(Drive);
  2256. end; {DirWatchChangeInvalid}
  2257. procedure TDriveView.ChangeDetected(Sender: TObject; const Directory: string;
  2258. var SubdirsChanged: Boolean);
  2259. var
  2260. DirChanged: string;
  2261. begin
  2262. if Sender is TDiscMonitor then
  2263. begin
  2264. DirChanged := (Sender as TDiscMonitor).Directories[0];
  2265. if Length(DirChanged) > 0 then
  2266. begin
  2267. with GetDriveStatus(DriveInfo.GetDriveKey(DirChanged)) do
  2268. begin
  2269. ChangeTimer.Interval := 0;
  2270. ChangeTimer.Interval := FChangeInterval;
  2271. ChangeTimer.Enabled := True;
  2272. end;
  2273. end;
  2274. end;
  2275. end; {DirWatchChangeDetected}
  2276. procedure TDriveView.ChangeTimerOnTimer(Sender: TObject);
  2277. var
  2278. DriveStatusPair: TDriveStatusPair;
  2279. begin
  2280. if (FChangeTimerSuspended = 0) and (Sender is TTimer) then
  2281. begin
  2282. for DriveStatusPair in FDriveStatus do
  2283. begin
  2284. if DriveStatusPair.Value.ChangeTimer = Sender then
  2285. begin
  2286. // Messages are processed during ValidateDirectory, so we may detect another change while
  2287. // updating the directory. Prevent the recursion.
  2288. // But retry the update afterwards (by reenabling the timer in ChangeDetected)
  2289. SuspendChangeTimer;
  2290. try
  2291. with DriveStatusPair.Value.ChangeTimer do
  2292. begin
  2293. Interval := 0;
  2294. Enabled := False;
  2295. end;
  2296. if Assigned(DriveStatusPair.Value.RootNode) then
  2297. begin
  2298. {Check also collapsed (invisible) subdirectories:}
  2299. ValidateDirectory(DriveStatusPair.Value.RootNode);
  2300. end;
  2301. finally
  2302. ResumeChangeTimer;
  2303. end;
  2304. end;
  2305. end;
  2306. end;
  2307. end; {ChangeTimerOnTimer}
  2308. procedure TDriveView.UpdateDriveNotifications(Drive: string);
  2309. var
  2310. NeedNotifications: Boolean;
  2311. Path: string;
  2312. DevBroadcastHandle: DEV_BROADCAST_HANDLE;
  2313. Size: Integer;
  2314. begin
  2315. if DriveInfo.IsFixedDrive(Drive) then
  2316. begin
  2317. with GetDriveStatus(Drive) do
  2318. begin
  2319. NeedNotifications :=
  2320. WatchThreadActive(Drive) and
  2321. (DriveInfo.Get(Drive).DriveType <> DRIVE_REMOTE) and
  2322. DriveInfo.Get(Drive).DriveReady;
  2323. if NeedNotifications <> (DriveHandle <> INVALID_HANDLE_VALUE) then
  2324. begin
  2325. if NeedNotifications then
  2326. begin
  2327. Path := DriveInfo.GetDriveRoot(Drive);
  2328. DriveHandle :=
  2329. CreateFile(PChar(Path), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
  2330. OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS or FILE_ATTRIBUTE_NORMAL, 0);
  2331. if DriveHandle <> INVALID_HANDLE_VALUE then
  2332. begin
  2333. Size := SizeOf(DevBroadcastHandle);
  2334. ZeroMemory(@DevBroadcastHandle, Size);
  2335. DevBroadcastHandle.dbch_size := Size;
  2336. DevBroadcastHandle.dbch_devicetype := DBT_DEVTYP_HANDLE;
  2337. DevBroadcastHandle.dbch_handle := DriveHandle;
  2338. NotificationHandle :=
  2339. RegisterDeviceNotification(FInternalWindowHandle, @DevBroadcastHandle, DEVICE_NOTIFY_WINDOW_HANDLE);
  2340. if NotificationHandle = nil then
  2341. begin
  2342. CloseHandle(DriveHandle);
  2343. DriveHandle := INVALID_HANDLE_VALUE;
  2344. end;
  2345. end;
  2346. end
  2347. else
  2348. begin
  2349. UnregisterDeviceNotification(NotificationHandle);
  2350. NotificationHandle := nil;
  2351. CloseHandle(DriveHandle);
  2352. DriveHandle := INVALID_HANDLE_VALUE;
  2353. end;
  2354. end;
  2355. end;
  2356. end;
  2357. end;
  2358. procedure TDriveView.StartWatchThread;
  2359. var
  2360. Drive: string;
  2361. begin
  2362. if (csDesigning in ComponentState) or
  2363. not Assigned(Selected) or
  2364. not fWatchDirectory then Exit;
  2365. Drive := GetDriveToNode(Selected);
  2366. with GetDriveStatus(Drive) do
  2367. begin
  2368. if not Assigned(DiscMonitor) then
  2369. CreateWatchThread(Drive);
  2370. if Assigned(DiscMonitor) and not DiscMonitor.Enabled then
  2371. DiscMonitor.Enabled := True;
  2372. end;
  2373. UpdateDriveNotifications(Drive);
  2374. end; {StartWatchThread}
  2375. procedure TDriveView.StopWatchThread;
  2376. var
  2377. Drive: string;
  2378. begin
  2379. if Assigned(Selected) then
  2380. begin
  2381. Drive := GetDriveToNode(Selected);
  2382. with GetDriveStatus(Drive) do
  2383. if Assigned(DiscMonitor) then
  2384. DiscMonitor.Enabled := False;
  2385. UpdateDriveNotifications(Drive);
  2386. end;
  2387. end; {StopWatchThread}
  2388. procedure TDriveView.SuspendChangeTimer;
  2389. begin
  2390. Inc(FChangeTimerSuspended);
  2391. end;
  2392. procedure TDriveView.ResumeChangeTimer;
  2393. begin
  2394. Assert(FChangeTimerSuspended > 0);
  2395. Dec(FChangeTimerSuspended);
  2396. end;
  2397. procedure TDriveView.TerminateWatchThread(Drive: string);
  2398. begin
  2399. with GetDriveStatus(Drive) do
  2400. if Assigned(DiscMonitor) then
  2401. begin
  2402. DiscMonitor.Free;
  2403. DiscMonitor := nil;
  2404. end;
  2405. UpdateDriveNotifications(Drive);
  2406. end; {StopWatchThread}
  2407. procedure TDriveView.StartAllWatchThreads;
  2408. var
  2409. DriveStatusPair: TDriveStatusPair;
  2410. Drive: string;
  2411. begin
  2412. if (csDesigning in ComponentState) or (not FWatchDirectory) then
  2413. Exit;
  2414. for DriveStatusPair in FDriveStatus do
  2415. with DriveStatusPair.Value do
  2416. if Scanned then
  2417. begin
  2418. if not Assigned(DiscMonitor) then
  2419. CreateWatchThread(DriveStatusPair.Key);
  2420. if Assigned(DiscMonitor) and (not DiscMonitor.Active) then
  2421. begin
  2422. DiscMonitor.Open;
  2423. UpdateDriveNotifications(DriveStatusPair.Key);
  2424. end;
  2425. end;
  2426. if Assigned(Selected) then
  2427. begin
  2428. Drive := GetDriveToNode(Selected);
  2429. if not DriveInfo.IsFixedDrive(Drive) then
  2430. begin
  2431. StartWatchThread;
  2432. end;
  2433. end;
  2434. end; {StartAllWatchThreads}
  2435. procedure TDriveView.StopAllWatchThreads;
  2436. var
  2437. DriveStatusPair: TDriveStatusPair;
  2438. begin
  2439. if (csDesigning in ComponentState) or (not FWatchDirectory) then
  2440. Exit;
  2441. for DriveStatusPair in FDriveStatus do
  2442. with DriveStatusPair.Value do
  2443. begin
  2444. if Assigned(DiscMonitor) then
  2445. begin
  2446. DiscMonitor.Close;
  2447. UpdateDriveNotifications(DriveStatusPair.Key);
  2448. end;
  2449. end;
  2450. end; {StopAllWatchThreads}
  2451. function TDriveView.WatchThreadActive(Drive: string): Boolean;
  2452. begin
  2453. Result := FWatchDirectory and
  2454. Assigned(GetDriveStatus(Drive).DiscMonitor) and
  2455. GetDriveStatus(Drive).DiscMonitor.Active and
  2456. GetDriveStatus(Drive).DiscMonitor.Enabled;
  2457. end; {WatchThreadActive}
  2458. function TDriveView.WatchThreadActive: Boolean;
  2459. var
  2460. Drive: string;
  2461. begin
  2462. if not Assigned(Selected) then
  2463. begin
  2464. Result := False;
  2465. Exit;
  2466. end;
  2467. Drive := GetDriveToNode(Selected);
  2468. Result := WatchThreadActive(Drive);
  2469. end; {WatchThreadActive}
  2470. function TDriveView.FindPathNode(Path: string): TTreeNode;
  2471. var
  2472. PossiblyHiddenPath: string;
  2473. Attrs: Integer;
  2474. begin
  2475. if Assigned(FOnNeedHiddenDirectories) and
  2476. (not ShowHiddenDirs) and
  2477. DirectoryExistsFix(Path) then // do not even bother if the path does not exist
  2478. begin
  2479. PossiblyHiddenPath := ExcludeTrailingPathDelimiter(Path);
  2480. while (PossiblyHiddenPath <> '') and
  2481. (not IsRootPath(PossiblyHiddenPath)) do // Drives have hidden attribute
  2482. begin
  2483. Attrs := FileGetAttr(PossiblyHiddenPath, False);
  2484. if (Attrs and faHidden) = faHidden then
  2485. begin
  2486. if Assigned(FOnNeedHiddenDirectories) then
  2487. begin
  2488. FOnNeedHiddenDirectories(Self);
  2489. end;
  2490. Break;
  2491. end
  2492. else
  2493. begin
  2494. PossiblyHiddenPath := ExtractFileDir(PossiblyHiddenPath);
  2495. end;
  2496. end;
  2497. end;
  2498. {Find existing path or parent path of not existing path:}
  2499. repeat
  2500. Result := FindNodeToPath(Path);
  2501. if not Assigned(Result) then
  2502. Path := ExtractFilePath(ExcludeTrailingBackslash(Path));
  2503. until Assigned(Result) or (Length(Path) < 3);
  2504. end;
  2505. procedure TDriveView.SetDirectory(Value: string);
  2506. begin
  2507. Value := IncludeTrailingBackslash(Value);
  2508. FDirectory := Value;
  2509. inherited;
  2510. if Assigned(Selected) and (not Assigned(Selected.Parent)) then
  2511. begin
  2512. if not GetDriveStatus(GetDriveToNode(Selected)).Scanned then
  2513. ScanDrive(GetDriveToNode(Selected));
  2514. end;
  2515. end; {SetDirectory}
  2516. function TDriveView.GetDirName(Node: TTreeNode): string;
  2517. begin
  2518. if Assigned(Node) and Assigned(Node.Data) then
  2519. Result := TNodeData(Node.Data).DirName
  2520. else
  2521. Result := '';
  2522. end; {GetDirName}
  2523. {GetDrive: returns the drive of the Node.}
  2524. function TDriveView.GetDriveToNode(Node: TTreeNode): string;
  2525. var
  2526. Path: string;
  2527. begin
  2528. if (not Assigned (Node)) or (not Assigned(Node.Data)) then
  2529. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDrive']));
  2530. Path := NodePath(Node);
  2531. Result := DriveInfo.GetDriveKey(Path);
  2532. end; {GetDrive}
  2533. {RootNode: returns the rootnode to the Node:}
  2534. function TDriveView.RootNode(Node: TTreeNode): TTreeNode;
  2535. begin
  2536. Result := Node;
  2537. if not Assigned(Node) then
  2538. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['RootNode']));
  2539. while Assigned(Result.Parent) do
  2540. Result := Result.Parent;
  2541. end; {RootNode}
  2542. function TDriveView.GetDisplayName(Node: TTreeNode): string;
  2543. begin
  2544. Result := '';
  2545. if (not Assigned(Node)) or (not Assigned(Node.Data)) then
  2546. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDisplayName']));
  2547. if not Assigned(Node.Parent) then Result := GetDriveText(GetDriveToNode(Node))
  2548. else
  2549. begin
  2550. Result := GetDirName(Node);
  2551. end;
  2552. end; {GetDisplayName}
  2553. procedure TDriveView.SetShowVolLabel(ShowIt: Boolean);
  2554. begin
  2555. if ShowIt = FShowVolLabel then
  2556. Exit;
  2557. FShowVolLabel := ShowIt;
  2558. RefreshRootNodes(dvdsFloppy);
  2559. end; {SetShowVolLabel}
  2560. procedure TDriveView.DisplayContextMenu(Node: TTreeNode; Point: TPoint);
  2561. var
  2562. Verb: string;
  2563. DirWatched: Boolean;
  2564. begin
  2565. DirWatched := NodeWatched(Node) and WatchThreadActive;
  2566. Assert(Node <> nil);
  2567. if Node <> Selected then
  2568. DropTarget := Node;
  2569. Verb := EmptyStr;
  2570. if Assigned(FOnDisplayContextMenu) then
  2571. FOnDisplayContextMenu(Self);
  2572. ShellDisplayContextMenu(FParentForm.Handle, Point, NodePathName(Node),
  2573. CanEdit(Node), Verb, False);
  2574. if Verb = shcRename then Node.EditText
  2575. else
  2576. if Verb = shcCut then
  2577. begin
  2578. LastClipBoardOperation := cboCut;
  2579. LastPathCut := NodePathName(Node);
  2580. end
  2581. else
  2582. if Verb = shcCopy then LastClipBoardOperation := cboCopy
  2583. else
  2584. if Verb = shcPaste then
  2585. PasteFromClipBoard(NodePathName(Node));
  2586. DropTarget := nil;
  2587. if not DirWatched then
  2588. ValidateDirectory(Node);
  2589. end; {DisplayContextMenu (2)}
  2590. procedure TDriveView.DisplayPropertiesMenu(Node: TTreeNode);
  2591. begin
  2592. Assert(Assigned(Node));
  2593. ShellExecuteContextCommand(FParentForm.Handle, shcProperties, NodePathName(Node));
  2594. end; {ContextMenu}
  2595. procedure TDriveView.SetSelected(Node: TTreeNode);
  2596. begin
  2597. if Node <> Selected then
  2598. begin
  2599. FChangeFlag := False;
  2600. FCanChange := True;
  2601. inherited Selected := Node;
  2602. if not FChangeFlag then
  2603. Change(Selected);
  2604. end;
  2605. end; {SetSelected}
  2606. {Called by TFileDeleteThread, when a file deletion was detected by the D&D receiving application:}
  2607. procedure TDriveView.SignalDirDelete(Sender: TObject; Files: TStringList);
  2608. begin
  2609. if Files.Count > 0 then
  2610. ValidateDirectory(FindNodeToPath(Files[0]));
  2611. end; {SignalDirDelete}
  2612. function TDriveView.DDSourceEffects: TDropEffectSet;
  2613. begin
  2614. if not Assigned(FDragNode.Parent) then
  2615. Result := [deLink]
  2616. else
  2617. Result := [deLink, deCopy, deMove];
  2618. end;
  2619. procedure TDriveView.DDChooseEffect(KeyState: Integer; var Effect: Integer; PreferredEffect: Integer);
  2620. begin
  2621. if DropTarget = nil then Effect := DROPEFFECT_NONE
  2622. else
  2623. if (KeyState and (MK_CONTROL or MK_SHIFT) = 0) and (PreferredEffect = 0) then
  2624. begin
  2625. if FDragDrive <> '' then
  2626. begin
  2627. if FExeDrag and DriveInfo.IsFixedDrive(GetDriveToNode(DropTarget)) and DriveInfo.IsFixedDrive(FDragDrive) then
  2628. begin
  2629. Effect := DROPEFFECT_LINK;
  2630. end
  2631. else
  2632. if (Effect = DROPEFFECT_COPY) and
  2633. (SameText(FDragDrive, GetDriveToNode(DropTarget)) and
  2634. (FDragDropFilesEx.AvailableDropEffects and DROPEFFECT_MOVE <> 0)) then
  2635. begin
  2636. Effect := DROPEFFECT_MOVE;
  2637. end;
  2638. end;
  2639. end;
  2640. inherited;
  2641. end;
  2642. function TDriveView.DragCompleteFileList: Boolean;
  2643. begin
  2644. Result := (GetDriveTypeToNode(FDragNode) <> DRIVE_REMOVABLE);
  2645. end;
  2646. function TDriveView.DDExecute: TDragResult;
  2647. var
  2648. WatchThreadOK: Boolean;
  2649. DragParentPath: string;
  2650. DragPath: string;
  2651. begin
  2652. WatchThreadOK := WatchThreadActive;
  2653. Result := FDragDropFilesEx.Execute(nil);
  2654. if (Result = drMove) and (not WatchThreadOK) then
  2655. begin
  2656. DragPath := NodePathName(FDragNode);
  2657. if Assigned(FDragNode.Parent) then
  2658. DragParentPath := NodePathName(FDragNode.Parent)
  2659. else
  2660. DragParentPath := DragPath;
  2661. if Assigned(FDragNode.Parent) or (DragParentPath <> NodePathName(Selected.Parent)) then
  2662. begin
  2663. FDragNode := FindNodeToPath(DragPath);
  2664. if Assigned(FDragNode) then
  2665. begin
  2666. FDragFileList.Clear;
  2667. FDragFileList.Add(DragPath);
  2668. TFileDeleteThread.Create(FDragFileList, MaxWaitTimeOut, SignalDirDelete);
  2669. end;
  2670. end;
  2671. end;
  2672. end;
  2673. procedure TDriveView.PerformDragDropFileOperation(Node: TTreeNode; Effect: Integer);
  2674. var
  2675. Index: Integer;
  2676. SourcePath: string;
  2677. SourceParentPath: string;
  2678. SourceIsDirectory: Boolean;
  2679. SaveCursor: TCursor;
  2680. SourceNode, TargetNode: TTreeNode;
  2681. TargetPath: string;
  2682. IsRecycleBin: Boolean;
  2683. begin
  2684. TargetPath := NodePathName(Node);
  2685. IsRecycleBin := NodeIsRecycleBin(Node);
  2686. if FDragDropFilesEx.FileList.Count = 0 then
  2687. Exit;
  2688. SaveCursor := Screen.Cursor;
  2689. Screen.Cursor := crHourGlass;
  2690. SourcePath := EmptyStr;
  2691. try
  2692. if (Effect = DROPEFFECT_COPY) or (Effect = DROPEFFECT_MOVE) then
  2693. begin
  2694. StopAllWatchThreads;
  2695. if Assigned(FDirView) then
  2696. FDirView.StopWatchThread;
  2697. if Assigned(DropSourceControl) and
  2698. (DropSourceControl is TDirView) and
  2699. (DropSourceControl <> FDirView) then
  2700. begin
  2701. TDirView(DropSourceControl).StopWatchThread;
  2702. end;
  2703. if DropFiles(
  2704. DragDropFilesEx, Effect, FFileOperator, TargetPath, false, IsRecycleBin, ConfirmDelete, ConfirmOverwrite, False,
  2705. Self, OnDDFileOperation, SourcePath, SourceIsDirectory) then
  2706. begin
  2707. if Assigned(FOnDDFileOperationExecuted) then
  2708. FOnDDFileOperationExecuted(Self, Effect, SourcePath, TargetPath);
  2709. end;
  2710. ClearDragFileList(FDragDropFilesEx.FileList);
  2711. // TDirView.PerformDragDropFileOperation validates the SourcePath and that actually seems correct
  2712. SourceParentPath := ExtractFilePath(ExcludeTrailingBackslash(SourcePath));
  2713. end
  2714. else
  2715. if Effect = DROPEFFECT_LINK then
  2716. { Create Link requested: }
  2717. begin
  2718. for Index := 0 to FDragDropFilesEx.FileList.Count - 1 do
  2719. begin
  2720. if not DropLink(PFDDListItem(FDragDropFilesEx.FileList[Index]), TargetPath) then
  2721. begin
  2722. DDError(DDCreateShortCutError);
  2723. end;
  2724. end;
  2725. end;
  2726. if Effect = DROPEFFECT_MOVE then
  2727. Items.BeginUpdate;
  2728. {Update source directory, if move-operation was performed:}
  2729. if ((Effect = DROPEFFECT_MOVE) or IsRecycleBin) then
  2730. begin
  2731. // See comment in corresponding operation in TDirView.PerformDragDropFileOperation
  2732. SourceNode := TryFindNodeToPath(SourceParentPath);
  2733. if Assigned(SourceNode) then
  2734. ValidateDirectory(SourceNode);
  2735. end;
  2736. {Update subdirectories of target directory:}
  2737. TargetNode := FindNodeToPath(TargetPath);
  2738. if Assigned(TargetNode) then
  2739. ValidateDirectory(TargetNode)
  2740. else
  2741. ValidateDirectory(GetDriveStatus(DriveInfo.GetDriveKey(TargetPath)).RootNode);
  2742. if Effect = DROPEFFECT_MOVE then
  2743. Items.EndUpdate;
  2744. {Update linked component TDirView:}
  2745. if Assigned(FDirView) and (not FDirView.WatchThreadActive) then
  2746. begin
  2747. case Effect of
  2748. DROPEFFECT_COPY,
  2749. DROPEFFECT_LINK:
  2750. if (IncludeTrailingBackslash(TargetPath) = IncludeTrailingBackslash(DirView.Path)) then
  2751. FDirView.Reload2;
  2752. DROPEFFECT_MOVE:
  2753. if (IncludeTrailingBackslash(TargetPath) = IncludeTrailingBackslash(DirView.Path)) or
  2754. (IncludeTrailingBackslash(SourceParentPath) = IncludeTrailingBackslash(DirView.Path)) then
  2755. begin
  2756. if FDirView <> DropSourceControl then FDirView.Reload2;
  2757. end;
  2758. end; {Case}
  2759. end;
  2760. {Update the DropSource control, if files are moved and it is a TDirView:}
  2761. if (Effect = DROPEFFECT_MOVE) and (DropSourceControl is TDirView) then
  2762. begin
  2763. TDirView(DropSourceControl).ValidateSelectedFiles;
  2764. end;
  2765. finally
  2766. FFileOperator.OperandFrom.Clear;
  2767. FFileOperator.OperandTo.Clear;
  2768. StartAllWatchThreads;
  2769. if Assigned(FDirView) and (not FDirView.WatchThreadActive) then
  2770. FDirView.StartWatchThread;
  2771. if Assigned(DropSourceControl) and (DropSourceControl is TDirView) and
  2772. (not TDirView(DropSourceControl).WatchThreadActive) then
  2773. TDirView(DropSourceControl).StartWatchThread;
  2774. Screen.Cursor := SaveCursor;
  2775. end;
  2776. end; {PerformDragDropFileOperation}
  2777. function TDriveView.GetCanUndoCopyMove: Boolean;
  2778. begin
  2779. Result := Assigned(FFileOperator) and FFileOperator.CanUndo;
  2780. end; {CanUndoCopyMove}
  2781. function TDriveView.UndoCopyMove: Boolean;
  2782. var
  2783. LastTarget: string;
  2784. LastSource: string;
  2785. begin
  2786. Result := False;
  2787. if FFileOperator.CanUndo then
  2788. begin
  2789. Lasttarget := FFileOperator.LastOperandTo[0];
  2790. LastSource := FFileOperator.LastOperandFrom[0];
  2791. StopAllWatchThreads;
  2792. Result := FFileOperator.UndoExecute;
  2793. ValidateDirectory(FindNodeToPath(ExtractFilePath(LastTarget)));
  2794. ValidateDirectory(FindNodeToPath(ExtractFilePath(LastSource)));
  2795. StartAllWatchThreads;
  2796. if Assigned(FDirView) then
  2797. with FDirView do
  2798. if not WatchThreadActive then
  2799. begin
  2800. if (IncludeTrailingBackslash(ExtractFilePath(LastTarget)) = IncludeTrailingBackslash(Path)) or
  2801. (IncludeTrailingBackslash(ExtractFilePath(LastSource)) = IncludeTrailingBackslash(Path)) then
  2802. Reload2;
  2803. end;
  2804. end;
  2805. end; {UndoCopyMove}
  2806. {Clipboard operations:}
  2807. procedure TDriveView.SetLastPathCut(Path: string);
  2808. var
  2809. Node: TTreeNode;
  2810. begin
  2811. if FLastPathCut <> Path then
  2812. begin
  2813. Node := FindNodeToPath(FLastPathCut);
  2814. if Assigned(Node) then
  2815. begin
  2816. FLastPathCut := Path;
  2817. Node.Cut := False;
  2818. end;
  2819. Node := FindNodeToPath(Path);
  2820. if Assigned(Node) then
  2821. begin
  2822. FLastPathCut := Path;
  2823. Node.Cut := True;
  2824. end;
  2825. end;
  2826. end; {SetLastNodeCut}
  2827. procedure TDriveView.EmptyClipboard;
  2828. begin
  2829. if Windows.OpenClipBoard(0) then
  2830. begin
  2831. Windows.EmptyClipBoard;
  2832. Windows.CloseClipBoard;
  2833. LastPathCut := '';
  2834. LastClipBoardOperation := cboNone;
  2835. if Assigned(FDirView) then
  2836. FDirView.EmptyClipboard;
  2837. end;
  2838. end; {EmptyClipBoard}
  2839. function TDriveView.CopyToClipBoard(Node: TTreeNode): Boolean;
  2840. begin
  2841. Result := Assigned(Selected);
  2842. if Result then
  2843. begin
  2844. EmptyClipBoard;
  2845. ClearDragFileList(FDragDropFilesEx.FileList);
  2846. AddToDragFileList(FDragDropFilesEx.FileList, Selected);
  2847. Result := FDragDropFilesEx.CopyToClipBoard;
  2848. LastClipBoardOperation := cboCopy;
  2849. end;
  2850. end; {CopyToClipBoard}
  2851. function TDriveView.CutToClipBoard(Node: TTreeNode): Boolean;
  2852. begin
  2853. Result := Assigned(Node) and Assigned(Node.Parent) and CopyToClipBoard(Node);
  2854. if Result then
  2855. begin
  2856. LastPathCut := NodePathName(Node);
  2857. LastClipBoardOperation := cboCut;
  2858. end;
  2859. end; {CutToClipBoard}
  2860. function TDriveView.CanPasteFromClipBoard: Boolean;
  2861. begin
  2862. Result := False;
  2863. if Assigned(Selected) and Windows.OpenClipboard(0) then
  2864. begin
  2865. Result := IsClipboardFormatAvailable(CF_HDROP);
  2866. Windows.CloseClipBoard;
  2867. end;
  2868. end; {CanPasteFromClipBoard}
  2869. function TDriveView.PasteFromClipBoard(TargetPath: String = ''): Boolean;
  2870. begin
  2871. ClearDragFileList(FDragDropFilesEx.FileList);
  2872. Result := False;
  2873. if CanPasteFromClipBoard and {MP}FDragDropFilesEx.GetFromClipBoard{/MP}
  2874. then
  2875. begin
  2876. if TargetPath = '' then
  2877. TargetPath := NodePathName(Selected);
  2878. case LastClipBoardOperation of
  2879. cboCopy,
  2880. cboNone:
  2881. begin
  2882. PerformDragDropFileOperation(Selected, DROPEFFECT_COPY);
  2883. if Assigned(FOnDDExecuted) then
  2884. FOnDDExecuted(Self, DROPEFFECT_COPY);
  2885. end;
  2886. cboCut:
  2887. begin
  2888. PerformDragDropFileOperation(Selected, DROPEFFECT_MOVE);
  2889. if Assigned(FOnDDExecuted) then
  2890. FOnDDExecuted(Self, DROPEFFECT_MOVE);
  2891. EmptyClipBoard;
  2892. end;
  2893. end;
  2894. Result := True;
  2895. end;
  2896. end; {PasteFromClipBoard}
  2897. procedure TDriveView.CMRecreateWnd(var Msg: TMessage);
  2898. var
  2899. ScheduledCount: Integer;
  2900. begin
  2901. ScheduledCount := FSubDirReaderThread.Detach;
  2902. try
  2903. inherited;
  2904. finally
  2905. FSubDirReaderThread.Reattach(ScheduledCount);
  2906. end;
  2907. end;
  2908. procedure TDriveView.CMSysColorChange(var Message: TMessage);
  2909. begin
  2910. if not FValidateFlag then
  2911. begin
  2912. inherited;
  2913. end
  2914. else
  2915. begin
  2916. // Do not recreate the handle, if we are just iterating nodes, at that invalidates the node objects.
  2917. // This is not perfect, as the handle can be recreated for other reasons.
  2918. // But system color change is by far the most common case.
  2919. FSysColorChangePending := True;
  2920. end;
  2921. end;
  2922. end.