DriveView.pas 92 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302
  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. Schedule := nil; // shut up
  644. Break;
  645. end
  646. else
  647. begin
  648. Schedule := FQueue.Pop;
  649. if Schedule.Deleted then
  650. begin
  651. Schedule.Free;
  652. // Can be optimized to loop within locked critical section until first non-deleted schedule is found
  653. Continue;
  654. end;
  655. Assert(not Schedule.Processed);
  656. end
  657. finally
  658. FSection.Leave;
  659. end;
  660. HasSubDirs := FDriveView.FindFirstSubDir(IncludeTrailingBackslash(Schedule.Path) + '*.*', SRec);
  661. FindClose(SRec);
  662. FSection.Enter;
  663. try
  664. if Schedule.Deleted then
  665. begin
  666. Schedule.Free;
  667. end
  668. else
  669. begin
  670. Schedule.Processed := True;
  671. if not HasSubDirs then // optimization
  672. begin
  673. FResults.Enqueue(Schedule);
  674. if FResults.Count = 1 then
  675. PostMessage(FWindowHandle, WM_USER_SUBDIRREADER, 0, 0);
  676. end
  677. else
  678. begin
  679. // can happen only if the tree handle is just being recreated
  680. if Assigned(Schedule.Node) then
  681. begin
  682. NodeData := TNodeData(Schedule.Node.Data);
  683. NodeData.Schedule := nil;
  684. end;
  685. Schedule.Free;
  686. end;
  687. end;
  688. finally
  689. FSection.Leave;
  690. end;
  691. end;
  692. end;
  693. end;
  694. { TDriveTreeNode }
  695. // Not sure if this is ever used (possibly only then "assigning" tree view to another instance, what never do).
  696. // It is NOT used when recreating a tree view handle - for that a node is serialized and deserialized,
  697. // including a pointer to TNodeData. See csRecreating condition in TDriveView.Delete.
  698. procedure TDriveTreeNode.Assign(Source: TPersistent);
  699. var
  700. SourceData: TNodeData;
  701. NewData: TNodeData;
  702. begin
  703. Assert(False);
  704. inherited Assign(Source);
  705. if not Deleting and (Source is TTreeNode) then
  706. begin
  707. SourceData := TNodeData(TTreeNode(Source).Data);
  708. NewData := TNodeData.Create();
  709. NewData.DirName := SourceData.DirName;
  710. NewData.Attr := SourceData.Attr;
  711. NewData.Scanned := SourceData.Scanned;
  712. NewData.Data := SourceData.Data;
  713. NewData.FIsRecycleBin := SourceData.FIsRecycleBin;
  714. NewData.IconEmpty := SourceData.IconEmpty;
  715. TTreeNode(Source).Data := NewData;
  716. end;
  717. end;
  718. { TDriveView }
  719. constructor TDriveView.Create(AOwner: TComponent);
  720. var
  721. Drive: TRealDrive;
  722. ChangeNotifyEntry: TSHChangeNotifyEntry;
  723. Dummy: string;
  724. begin
  725. inherited;
  726. FCreating := True;
  727. FDriveStatus := TObjectDictionary<string, TDriveStatus>.Create([doOwnsValues]);
  728. FChangeInterval := MSecsPerSec;
  729. for Drive := FirstDrive to LastDrive do
  730. begin
  731. FDriveStatus.Add(Drive, CreateDriveStatus);
  732. end;
  733. FFileOperator := TFileOperator.Create(Self);
  734. FSubDirReaderThread := TSubDirReaderThread.Create(Self);
  735. FDelayedNodes := TStringList.Create;
  736. FDelayedNodeTimer := TTimer.Create(Self);
  737. UpdateDelayedNodeTimer;
  738. FDelayedNodeTimer.Interval := 250;
  739. FDelayedNodeTimer.OnTimer := DelayedNodeTimer;
  740. FShowVolLabel := True;
  741. FChangeFlag := False;
  742. FLastDir := EmptyStr;
  743. FValidateFlag := False;
  744. FSysColorChangePending := False;
  745. FConfirmDelete := True;
  746. FDirectory := EmptyStr;
  747. FForceRename := False;
  748. FLastRenameName := '';
  749. FRenameNode := nil;
  750. FPrevSelected := nil;
  751. FPrevSelectedIndex := -1;
  752. FChangeTimerSuspended := 0;
  753. FConfirmOverwrite := True;
  754. FLastPathCut := '';
  755. FStartPos.X := -1;
  756. FStartPos.Y := -1;
  757. FDragPos := FStartPos;
  758. FInternalWindowHandle := Classes.AllocateHWnd(InternalWndProc);
  759. // Source: petr.solin 2022-02-25
  760. FChangeNotify := 0;
  761. if SpecialFolderLocation(CSIDL_DESKTOP, Dummy, ChangeNotifyEntry.pidl) then
  762. begin
  763. ChangeNotifyEntry.fRecursive := False;
  764. FChangeNotify :=
  765. SHChangeNotifyRegister(
  766. FInternalWindowHandle, SHCNRF_ShellLevel or SHCNRF_NewDelivery,
  767. SHCNE_RENAMEFOLDER or SHCNE_MEDIAINSERTED or SHCNE_MEDIAREMOVED,
  768. WM_USER_SHCHANGENOTIFY, 1, ChangeNotifyEntry);
  769. end;
  770. with FDragDropFilesEx do
  771. begin
  772. ShellExtensions.DragDropHandler := True;
  773. end;
  774. end; {Create}
  775. destructor TDriveView.Destroy;
  776. var
  777. DriveStatusPair: TDriveStatusPair;
  778. begin
  779. if FChangeNotify <> 0 then SHChangeNotifyDeregister(FChangeNotify);
  780. Classes.DeallocateHWnd(FInternalWindowHandle);
  781. for DriveStatusPair in FDriveStatus do
  782. begin
  783. with DriveStatusPair.Value do
  784. begin
  785. if Assigned(DiscMonitor) then
  786. FreeAndNil(DiscMonitor);
  787. if Assigned(ChangeTimer) then
  788. FreeAndNil(ChangeTimer);
  789. end;
  790. UpdateDriveNotifications(DriveStatusPair.Key);
  791. end;
  792. FDriveStatus.Free;
  793. if Assigned(FFileOperator) then
  794. FFileOperator.Free;
  795. FSubDirReaderThread.Free;
  796. Assert(FDelayedNodes.Count = 0);
  797. FreeAndNil(FDelayedNodes);
  798. inherited Destroy;
  799. end; {Destroy}
  800. function TDriveView.CreateDriveStatus: TDriveStatus;
  801. begin
  802. Result := TDriveStatus.Create;
  803. with Result do
  804. begin
  805. Scanned := False;
  806. Verified := False;
  807. RootNode := nil;
  808. RootNodeIndex := -1;
  809. DiscMonitor := nil;
  810. DefaultDir := EmptyStr;
  811. {ChangeTimer: }
  812. ChangeTimer := TTimer.Create(Self);
  813. ChangeTimer.Interval := 0;
  814. ChangeTimer.Enabled := False;
  815. ChangeTimer.OnTimer := ChangeTimerOnTimer;
  816. DriveHandle := INVALID_HANDLE_VALUE;
  817. NotificationHandle := nil;
  818. end;
  819. end;
  820. procedure TDriveView.DriveRemoving(Drive: string);
  821. begin
  822. DriveRemoved(Drive);
  823. TerminateWatchThread(Drive);
  824. end;
  825. type
  826. PDevBroadcastHdr = ^TDevBroadcastHdr;
  827. TDevBroadcastHdr = record
  828. dbch_size: DWORD;
  829. dbch_devicetype: DWORD;
  830. dbch_reserved: DWORD;
  831. end;
  832. PDevBroadcastVolume = ^TDevBroadcastVolume;
  833. TDevBroadcastVolume = record
  834. dbcv_size: DWORD;
  835. dbcv_devicetype: DWORD;
  836. dbcv_reserved: DWORD;
  837. dbcv_unitmask: DWORD;
  838. dbcv_flags: WORD;
  839. end;
  840. PDEV_BROADCAST_HANDLE = ^DEV_BROADCAST_HANDLE;
  841. DEV_BROADCAST_HANDLE = record
  842. dbch_size : DWORD;
  843. dbch_devicetype : DWORD;
  844. dbch_reserved : DWORD;
  845. dbch_handle : THandle;
  846. dbch_hdevnotify : HDEVNOTIFY ;
  847. dbch_eventguid : TGUID;
  848. dbch_nameoffset : LongInt;
  849. dbch_data : Byte;
  850. end;
  851. PPItemIDList = ^PItemIDList;
  852. const
  853. DBT_DEVTYP_HANDLE = $00000006;
  854. DBT_CONFIGCHANGED = $0018;
  855. DBT_DEVICEARRIVAL = $8000;
  856. DBT_DEVICEQUERYREMOVE = $8001;
  857. DBT_DEVICEREMOVEPENDING = $8003;
  858. DBT_DEVICEREMOVECOMPLETE = $8004;
  859. DBT_DEVTYP_VOLUME = $00000002;
  860. // WORKAROUND Declaration in Winapi.ShlObj.pas is wrong
  861. function SHChangeNotification_Lock(hChange: THandle; dwProcId: DWORD;
  862. var PPidls: PPItemIDList; var plEvent: Longint): THANDLE; stdcall;
  863. external 'shell32.dll' name 'SHChangeNotification_Lock';
  864. procedure TDriveView.InternalWndProc(var Msg: TMessage);
  865. var
  866. DeviceType: DWORD;
  867. UnitMask: DWORD;
  868. DeviceHandle: THandle;
  869. Drive: Char;
  870. DriveStatusPair: TDriveStatusPair;
  871. PPIDL: PPItemIDList;
  872. Event: LONG;
  873. Lock: THandle;
  874. begin
  875. with Msg do
  876. begin
  877. if Msg = WM_USER_SHCHANGENOTIFY then
  878. begin
  879. Lock := SHChangeNotification_Lock(wParam, lParam, PPIDL, Event);
  880. try
  881. if (Event = SHCNE_RENAMEFOLDER) or // = drive rename
  882. (Event = SHCNE_MEDIAINSERTED) or // also bitlocker drive unlock (also sends SHCNE_UPDATEDIR)
  883. (Event = SHCNE_MEDIAREMOVED) then
  884. begin
  885. ScheduleDriveRefresh;
  886. end;
  887. finally
  888. SHChangeNotification_Unlock(Lock);
  889. end;
  890. end
  891. else
  892. if Msg = WM_DEVICECHANGE then
  893. begin
  894. if (wParam = DBT_CONFIGCHANGED) or
  895. (wParam = DBT_DEVICEARRIVAL) or
  896. (wParam = DBT_DEVICEREMOVECOMPLETE) then
  897. begin
  898. ScheduleDriveRefresh;
  899. end
  900. else
  901. if (wParam = DBT_DEVICEQUERYREMOVE) or
  902. (wParam = DBT_DEVICEREMOVEPENDING) then
  903. begin
  904. DeviceType := PDevBroadcastHdr(lParam)^.dbch_devicetype;
  905. // This is specifically for VeraCrypt.
  906. // For normal drives, see DBT_DEVTYP_HANDLE below
  907. // (and maybe now that we have generic implementation, this specific code for VeraCrypt might not be needed anymore)
  908. if DeviceType = DBT_DEVTYP_VOLUME then
  909. begin
  910. UnitMask := PDevBroadcastVolume(lParam)^.dbcv_unitmask;
  911. Drive := FirstDrive;
  912. while UnitMask > 0 do
  913. begin
  914. if UnitMask and $01 <> 0 then
  915. begin
  916. DriveRemoving(Drive);
  917. end;
  918. UnitMask := UnitMask shr 1;
  919. Drive := Chr(Ord(Drive) + 1);
  920. end;
  921. end
  922. else
  923. if DeviceType = DBT_DEVTYP_HANDLE then
  924. begin
  925. DeviceHandle := PDEV_BROADCAST_HANDLE(lParam)^.dbch_handle;
  926. for DriveStatusPair in FDriveStatus do
  927. if DriveStatusPair.Value.DriveHandle = DeviceHandle then
  928. begin
  929. DriveRemoving(DriveStatusPair.Key);
  930. end;
  931. end;
  932. end;
  933. end
  934. else
  935. if Msg = WM_TIMER then
  936. begin
  937. CancelDriveRefresh;
  938. try
  939. //DriveInfo.Load;
  940. RefreshRootNodes(dsAll or dvdsRereadAllways);
  941. DoRefreshDrives(True);
  942. except
  943. Application.HandleException(Self);
  944. end;
  945. end;
  946. Result := DefWindowProc(FInternalWindowHandle, Msg, wParam, lParam);
  947. end;
  948. end;
  949. procedure TDriveView.DoRefreshDrives(Global: Boolean);
  950. begin
  951. if Assigned(OnRefreshDrives) then
  952. OnRefreshDrives(Self, Global);
  953. end;
  954. procedure TDriveView.CancelDriveRefresh;
  955. begin
  956. KillTimer(FInternalWindowHandle, 1);
  957. end;
  958. procedure TDriveView.ScheduleDriveRefresh;
  959. begin
  960. CancelDriveRefresh;
  961. // Delay refreshing drives for a sec.
  962. // Particularly with CD/DVD drives, if we query display name
  963. // immediately after receiving DBT_DEVICEARRIVAL, we do not get media label.
  964. // Actually one sec does not help usually, but we do not want to wait any longer,
  965. // because we want to add USB drives asap.
  966. // And this problem might be solved now by SHChangeNotifyRegister/SHCNE_RENAMEFOLDER.
  967. SetTimer(FInternalWindowHandle, 1, MSecsPerSec, nil);
  968. end;
  969. procedure TDriveView.CreateWnd;
  970. var
  971. DriveStatus: TDriveStatus;
  972. begin
  973. inherited;
  974. if Assigned(PopupMenu) then
  975. PopupMenu.Autopopup := False;
  976. FDragDropFilesEx.SourceEffects := [deCopy, deMove, deLink];
  977. FDragDropFilesEx.TargetEffects := [deCopy, deMove, deLink];
  978. if FPrevSelectedIndex >= 0 then
  979. begin
  980. FPrevSelected := Items[FPrevSelectedIndex];
  981. FPrevSelectedIndex := -1;
  982. end;
  983. for DriveStatus in FDriveStatus.Values do
  984. with DriveStatus do
  985. begin
  986. if RootNodeIndex >= 0 then
  987. begin
  988. RootNode := Items[RootNodeIndex];
  989. RootNodeIndex := -1;
  990. end;
  991. end;
  992. UpdateDelayedNodeTimer;
  993. end; {CreateWnd}
  994. procedure TDriveView.DestroyWnd;
  995. var
  996. DriveStatus: TDriveStatus;
  997. I: Integer;
  998. begin
  999. FDelayedNodeTimer.Enabled := False;
  1000. for I := 0 to FDelayedNodes.Count - 1 do
  1001. FDelayedNodes.Objects[I] := nil;
  1002. if not (csRecreating in ControlState) then
  1003. begin
  1004. FSubDirReaderThread.Terminate;
  1005. FSubDirReaderThread.WaitFor;
  1006. end
  1007. else
  1008. if CreateWndRestores and (Items.Count > 0) then
  1009. begin
  1010. FPrevSelectedIndex := -1;
  1011. if Assigned(FPrevSelected) then
  1012. begin
  1013. FPrevSelectedIndex := FPrevSelected.AbsoluteIndex;
  1014. FPrevSelected := nil;
  1015. end;
  1016. for DriveStatus in FDriveStatus.Values do
  1017. with DriveStatus do
  1018. begin
  1019. RootNodeIndex := -1;
  1020. if Assigned(RootNode) then
  1021. begin
  1022. RootNodeIndex := RootNode.AbsoluteIndex;
  1023. RootNode := nil;
  1024. end;
  1025. end;
  1026. end;
  1027. inherited;
  1028. end;
  1029. function TDriveView.NodeColor(Node: TTreeNode): TColor;
  1030. begin
  1031. Result := clDefaultItemColor;
  1032. with TNodeData(Node.Data) do
  1033. if not Node.Selected then
  1034. begin
  1035. {Colored display of compressed directories:}
  1036. if (Attr and FILE_ATTRIBUTE_COMPRESSED) <> 0 then
  1037. begin
  1038. if SupportsDarkMode and DarkMode then Result := clSkyBlue
  1039. else Result := clBlue;
  1040. end
  1041. else
  1042. {Dimmed display, if hidden-atrribut set:}
  1043. if FDimmHiddenDirs and ((Attr and FILE_ATTRIBUTE_HIDDEN) <> 0) then
  1044. Result := clGrayText
  1045. end;
  1046. end;
  1047. function TDriveView.GetCustomDirView: TCustomDirView;
  1048. begin
  1049. Result := DirView;
  1050. end;
  1051. procedure TDriveView.SetCustomDirView(Value: TCustomDirView);
  1052. begin
  1053. DirView := Value as TDirView;
  1054. end;
  1055. function TDriveView.NodePath(Node: TTreeNode): string;
  1056. var
  1057. ParentNode: TTreeNode;
  1058. begin
  1059. if not Assigned(Node) then
  1060. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDirPath']));
  1061. Result := GetDirName(Node);
  1062. ParentNode := Node.Parent;
  1063. while (ParentNode <> nil) and (ParentNode.Level >= 0) do
  1064. begin
  1065. if ParentNode.Level > 0 then
  1066. Result := GetDirName(ParentNode) + '\' + Result
  1067. else
  1068. Result := GetDirName(ParentNode) + Result;
  1069. ParentNode := ParentNode.Parent;
  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(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 (Node.Level = 0) 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(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(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 Node.Level = 0 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. (ParentNode.Level = 0) 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. ParentPath := NodePath(ParentNode);
  1738. if (not Assigned(Result)) and
  1739. DirectoryExists(IncludeTrailingBackslash(ParentPath) + Path) and
  1740. (not ExistingOnly) 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; {SearchSubDirs}
  1755. var
  1756. Drive: string;
  1757. P, I: Integer;
  1758. RootNode, Node: TTreeNode;
  1759. begin {FindNodeToPath}
  1760. Result := nil;
  1761. if Length(Path) < 3 then
  1762. Exit;
  1763. // Particularly when used by TDirView to delegate browsing to
  1764. // hidden drive view, the handle may not be created
  1765. HandleNeeded;
  1766. Drive := DriveInfo.GetDriveKey(Path);
  1767. if (not Assigned(GetDriveStatus(Drive).RootNode)) and
  1768. // hidden or possibly recently un-hidden by other drive view (refresh is pending)
  1769. (DriveInfo.Get(Drive).Valid or DriveInfo.Get(Drive).ValidButHiddenByDrivePolicy) then
  1770. begin
  1771. if DriveInfo.Get(Drive).ValidButHiddenByDrivePolicy then
  1772. DriveInfo.OverrideDrivePolicy(Drive);
  1773. if DriveInfo.Get(Drive).Valid then
  1774. begin
  1775. CancelDriveRefresh; // cancel a possible pending refresh (see the previous comment)
  1776. RefreshRootNodes(dsAll or dvdsRereadAllways); // overkill and is likely already called by GetDriveStatus
  1777. DoRefreshDrives(False);
  1778. end;
  1779. end;
  1780. if Assigned(GetDriveStatus(Drive).RootNode) then
  1781. begin
  1782. if DriveInfo.IsRealDrive(Drive) then
  1783. begin
  1784. System.Delete(Path, 1, 3);
  1785. end
  1786. else
  1787. if IsUncPath(Path) then
  1788. begin
  1789. System.Delete(Path, 1, 2);
  1790. P := Pos('\', Path);
  1791. if P = 0 then
  1792. begin
  1793. Path := '';
  1794. end
  1795. else
  1796. begin
  1797. System.Delete(Path, 1, P);
  1798. P := Pos('\', Path);
  1799. if P = 0 then
  1800. begin
  1801. Path := '';
  1802. end
  1803. else
  1804. begin
  1805. System.Delete(Path, 1, P);
  1806. end;
  1807. end;
  1808. end
  1809. else
  1810. begin
  1811. raise EConvertError.Create(Format(ErrorInvalidDrive, [Path]))
  1812. end;
  1813. if Length(Path) > 0 then
  1814. begin
  1815. if (not GetDriveStatus(Drive).Scanned) and (not ExistingOnly) then
  1816. begin
  1817. ScanDrive(Drive);
  1818. end;
  1819. Node := Selected;
  1820. RootNode := GetDriveStatus(Drive).RootNode;
  1821. if not Assigned(Node) then
  1822. begin
  1823. SelectionHierarchyHeight := 0;
  1824. end
  1825. else
  1826. begin
  1827. SelectionHierarchyHeight := Node.Level + 1;
  1828. SetLength(SelectionHierarchy, SelectionHierarchyHeight);
  1829. for I := SelectionHierarchyHeight - 1 downto 0 do
  1830. begin
  1831. SelectionHierarchy[I] := Node;
  1832. Node := Node.Parent;
  1833. end;
  1834. Assert(Selected = SelectionHierarchy[SelectionHierarchyHeight - 1]);
  1835. // Different drive - nothing to optimize
  1836. if RootNode <> SelectionHierarchy[0] then
  1837. SelectionHierarchyHeight := 0;
  1838. end;
  1839. Result := SearchSubDirs(RootNode, UpperCase(Path), 1);
  1840. end
  1841. else Result := GetDriveStatus(Drive).RootNode;
  1842. end;
  1843. end; {FindNodetoPath}
  1844. function TDriveView.FindNodeToPath(Path: string): TTreeNode;
  1845. begin
  1846. Result := DoFindNodeToPath(Path, False);
  1847. end;
  1848. function TDriveView.TryFindNodeToPath(Path: string): TTreeNode;
  1849. begin
  1850. Result := DoFindNodeToPath(Path, True);
  1851. end;
  1852. function TDriveView.GetSubDir(var SRec: TSearchRec): Boolean;
  1853. begin
  1854. Result := True;
  1855. while Result and
  1856. ((SRec.Name = '.' ) or
  1857. (SRec.Name = '..') or
  1858. ((SRec.Attr and faDirectory) = 0)) do
  1859. begin
  1860. if FindNext(SRec) <> 0 then
  1861. begin
  1862. Result := False;
  1863. end;
  1864. end;
  1865. end;
  1866. function TDriveView.FindFirstSubDir(Path: string; var SRec: TSearchRec): Boolean;
  1867. begin
  1868. Result := (FindFirstEx(ApiPath(Path), DirAttrMask, SRec, FIND_FIRST_EX_LARGE_FETCH_PAS, FindExSearchLimitToDirectories) = 0);
  1869. if Result then
  1870. begin
  1871. Result := GetSubDir(SRec);
  1872. if not Result then FindClose(SRec);
  1873. end;
  1874. end;
  1875. function TDriveView.FindNextSubDir(var SRec: TSearchRec): Boolean;
  1876. begin
  1877. Result := (FindNext(SRec) = 0) and GetSubDir(SRec);
  1878. end;
  1879. function TDriveView.ReadSubDirsBatch(Node: TTreeNode; var SRec: TSearchRec; CheckInterval, Limit: Integer): Boolean;
  1880. var
  1881. Start: TDateTime;
  1882. Cont: Boolean;
  1883. Path: string;
  1884. Count: Integer;
  1885. DelayedExclude: TStringList;
  1886. begin
  1887. Start := Now;
  1888. Path := NodePath(Node);
  1889. Result := True;
  1890. Count := 0;
  1891. DelayedExclude := TNodeData(Node.Data).DelayedExclude;
  1892. // At least from SetDirectory > DoFindNodeToPath and CanExpand, this is not called within BeginUpdate/EndUpdate block.
  1893. // But in any case, adding it here makes expanding (which calls CanExpand) noticeably slower, when there are lot of nodes,
  1894. // because EndUpdate triggers TVN_GETDISPINFO for all nodes in the tree.
  1895. repeat
  1896. if (not Assigned(DelayedExclude)) or
  1897. (DelayedExclude.IndexOf(SRec.Name) < 0) then
  1898. begin
  1899. AddChildNode(Node, Path, SRec);
  1900. Inc(Count);
  1901. end;
  1902. Cont := FindNextSubDir(SRec);
  1903. // There are two other directory reading loops, where this is not checked
  1904. if Cont and
  1905. ((Count mod CheckInterval) = 0) and
  1906. (Limit > 0) and
  1907. (MilliSecondsBetween(Now, Start) > Limit) then
  1908. begin
  1909. Result := False;
  1910. Cont := False;
  1911. end
  1912. until not Cont;
  1913. if Result then
  1914. FindClose(Srec);
  1915. end;
  1916. procedure TDriveView.DelayedNodeTimer(Sender: TObject);
  1917. var
  1918. Node: TTreeNode;
  1919. NodeData: TNodeData;
  1920. begin
  1921. Assert(FDelayedNodes.Count > 0);
  1922. if FDelayedNodes.Count > 0 then
  1923. begin
  1924. // Control was recreated
  1925. if not Assigned(FDelayedNodes.Objects[0]) then
  1926. begin
  1927. FDelayedNodes.Objects[0] := TryFindNodeToPath(FDelayedNodes.Strings[0]);
  1928. end;
  1929. Node := TTreeNode(FDelayedNodes.Objects[0]);
  1930. if not Assigned(Node) then
  1931. begin
  1932. FDelayedNodes.Delete(0);
  1933. end
  1934. else
  1935. begin
  1936. NodeData := TNodeData(Node.Data);
  1937. if ReadSubDirsBatch(Node, NodeData.DelayedSrec, 10, 50) then
  1938. begin
  1939. FreeAndNil(NodeData.DelayedExclude);
  1940. FDelayedNodes.Delete(0);
  1941. SortChildren(Node, False);
  1942. end;
  1943. end;
  1944. end;
  1945. UpdateDelayedNodeTimer;
  1946. end;
  1947. procedure TDriveView.UpdateDelayedNodeTimer;
  1948. begin
  1949. FDelayedNodeTimer.Enabled := HandleAllocated and (FDelayedNodes.Count > 0);
  1950. end;
  1951. procedure TDriveView.ReadSubDirs(Node: TTreeNode);
  1952. var
  1953. SRec: TSearchRec;
  1954. NodeData: TNodeData;
  1955. Path: string;
  1956. CheckInterval, Limit: Integer;
  1957. begin
  1958. NodeData := TNodeData(Node.Data);
  1959. Path := NodePath(Node);
  1960. if not FindFirstSubDir(IncludeTrailingBackslash(Path) + '*.*', SRec) then
  1961. begin
  1962. Node.HasChildren := False;
  1963. end
  1964. else
  1965. begin
  1966. CheckInterval := 100;
  1967. Limit := DriveViewLoadingTooLongLimit * 1000;
  1968. if not Showing then
  1969. begin
  1970. Limit := Limit div 10;
  1971. CheckInterval := CheckInterval div 10;
  1972. end;
  1973. if not ReadSubDirsBatch(Node, SRec, CheckInterval, Limit) then
  1974. begin
  1975. NodeData.DelayedSrec := SRec;
  1976. NodeData.DelayedExclude := TStringList.Create;
  1977. NodeData.DelayedExclude.CaseSensitive := False;
  1978. NodeData.DelayedExclude.Sorted := True;
  1979. FDelayedNodes.AddObject(Path, Node);
  1980. Assert(FDelayedNodes.Count < 20); // if more, something went likely wrong
  1981. UpdateDelayedNodeTimer;
  1982. end;
  1983. SortChildren(Node, False);
  1984. end;
  1985. NodeData.Scanned := True;
  1986. Application.ProcessMessages;
  1987. end; {ReadSubDirs}
  1988. procedure TDriveView.CancelDelayedNode(Node: TTreeNode);
  1989. var
  1990. NodeData: TNodeData;
  1991. begin
  1992. NodeData := TNodeData(Node.Data);
  1993. FindClose(NodeData.DelayedSrec);
  1994. FreeAndNil(NodeData.DelayedExclude);
  1995. end;
  1996. procedure TDriveView.DeleteNode(Node: TTreeNode);
  1997. var
  1998. ValidNode: TTreeNode;
  1999. begin
  2000. if Assigned(Selected) and Assigned(Node.Parent) and
  2001. ((Selected = Node) or Selected.HasAsParent(Node)) then
  2002. begin
  2003. ValidNode := Node.Parent;
  2004. while (not DirectoryExists(NodePathName(ValidNode))) and Assigned(ValidNode.Parent) do
  2005. ValidNode := ValidNode.Parent;
  2006. Selected := ValidNode;
  2007. end;
  2008. if DropTarget = Node then
  2009. DropTarget := nil;
  2010. Node.Delete;
  2011. end;
  2012. function TDriveView.CallBackValidateDir(var Node: TTreeNode; Data: Pointer): Boolean;
  2013. var
  2014. WorkNode: TTreeNode;
  2015. DelNode: TTreeNode;
  2016. SRec: TSearchRec;
  2017. SrecList: TStringList;
  2018. SubDirList: TStringList;
  2019. R: Boolean;
  2020. Index: Integer;
  2021. NewDirFound: Boolean;
  2022. ParentDir: string;
  2023. NodeData: TNodeData;
  2024. ScanDirInfo: PScanDirInfo;
  2025. begin {CallBackValidateDir}
  2026. Result := True;
  2027. if (not Assigned(Node)) or (not Assigned(Node.Data)) then
  2028. Exit;
  2029. NewDirFound := False;
  2030. ScanDirInfo := PScanDirInfo(Data);
  2031. {Check, if directory still exists: (but not with root directory) }
  2032. if Assigned(Node.Parent) and (ScanDirInfo^.StartNode = Node) then
  2033. if not DirectoryExists(NodePathName(Node)) then
  2034. begin
  2035. DeleteNode(Node);
  2036. Node := nil;
  2037. Exit;
  2038. end;
  2039. WorkNode := Node.GetFirstChild;
  2040. NodeData := TNodeData(Node.Data);
  2041. if NodeData.Scanned and Assigned(WorkNode) then
  2042. {if node was already scanned: check wether the existing subnodes are still alive
  2043. and add all new subdirectories as subnodes:}
  2044. begin
  2045. if DoScanDir(Node) then
  2046. begin
  2047. ParentDir := IncludeTrailingBackslash(NodePath(Node));
  2048. {Build list of existing subnodes:}
  2049. SubDirList := TStringList.Create;
  2050. SubDirList.CaseSensitive := True; // We want to reflect changes in subfolder name case
  2051. while Assigned(WorkNode) do
  2052. begin
  2053. SubDirList.Add(TNodeData(WorkNode.Data).DirName);
  2054. WorkNode := Node.GetNextChild(WorkNode);
  2055. end;
  2056. // Nodes are sorted using natural sorting, while TStringList.Find uses simple sorting
  2057. SubDirList.Sort;
  2058. SRecList := TStringList.Create;
  2059. SRecList.CaseSensitive := True;
  2060. R := FindFirstSubDir(ParentDir + '*.*', SRec);
  2061. while R do
  2062. begin
  2063. SrecList.Add(Srec.Name);
  2064. if not SubDirList.Find(Srec.Name, Index) then
  2065. {Subnode does not exists: add it:}
  2066. begin
  2067. AddChildNode(Node, ParentDir, SRec);
  2068. NewDirFound := True;
  2069. end;
  2070. R := FindNextSubDir(Srec);
  2071. end;
  2072. FindClose(Srec);
  2073. Sreclist.Sort;
  2074. {Remove not existing subnodes:}
  2075. WorkNode := Node.GetFirstChild;
  2076. while Assigned(WorkNode) do
  2077. begin
  2078. if not Assigned(WorkNode.Data) or
  2079. not SrecList.Find(TNodeData(WorkNode.Data).DirName, Index) then
  2080. begin
  2081. DelNode := WorkNode;
  2082. WorkNode := Node.GetNextChild(WorkNode);
  2083. DeleteNode(DelNode);
  2084. end
  2085. else
  2086. begin
  2087. if (SrecList[Index] <> TNodeData(WorkNode.Data).DirName) then
  2088. begin
  2089. {Case of directory letters has changed:}
  2090. TNodeData(WorkNode.Data).DirName := SrecList[Index];
  2091. WorkNode.Text := SrecList[Index];
  2092. end;
  2093. WorkNode := Node.GetNextChild(WorkNode);
  2094. end;
  2095. end;
  2096. SrecList.Free;
  2097. SubDirList.Free;
  2098. {Sort subnodes:}
  2099. if NewDirFound then
  2100. SortChildren(Node, False);
  2101. end;
  2102. end
  2103. else
  2104. {Node was not already scanned:}
  2105. if (ScanDirInfo^.SearchNewDirs or
  2106. NodeData.Scanned or
  2107. (Node = ScanDirInfo^.StartNode)) and
  2108. DoScanDir(Node) then
  2109. begin
  2110. ReadSubDirs(Node);
  2111. end;
  2112. end; {CallBackValidateDir}
  2113. procedure TDriveView.RebuildTree;
  2114. var
  2115. Drive: string;
  2116. begin
  2117. for Drive in FDriveStatus.Keys do
  2118. with GetDriveStatus(Drive) do
  2119. if Assigned(RootNode) and Scanned then
  2120. ValidateDirectory(RootNode);
  2121. end;
  2122. procedure TDriveView.ValidateCurrentDirectoryIfNotMonitoring;
  2123. begin
  2124. if Assigned(Selected) and
  2125. not Assigned(GetDriveStatus(GetDriveToNode(Selected)).DiscMonitor) then
  2126. begin
  2127. ValidateDirectory(Selected);
  2128. end;
  2129. end;
  2130. procedure TDriveView.ValidateDirectoryEx(Node: TTreeNode; Recurse: TRecursiveScan;
  2131. NewDirs: Boolean);
  2132. var
  2133. Info: PScanDirInfo;
  2134. SelDir: string;
  2135. SaveCursor: TCursor;
  2136. RestartWatchThread: Boolean;
  2137. SaveCanChange: Boolean;
  2138. CurrentPath: string;
  2139. Drive: string;
  2140. begin
  2141. if Assigned(Node) and Assigned(Node.Data) and
  2142. (not FValidateFlag) and DoScanDir(Node) then
  2143. begin
  2144. SelDir := Directory;
  2145. SaveCursor := Screen.Cursor;
  2146. if Self.Focused and (Screen.Cursor <> crHourGlass) then
  2147. Screen.Cursor := crHourGlass;
  2148. CurrentPath := NodePath(Node);
  2149. Drive := DriveInfo.GetDriveKey(CurrentPath);
  2150. if Node.Level = 0 then
  2151. GetDriveStatus(Drive).ChangeTimer.Enabled := False;
  2152. RestartWatchThread := WatchThreadActive;
  2153. try
  2154. if WatchThreadActive then
  2155. StopWatchThread;
  2156. FValidateFlag := True;
  2157. FSysColorChangePending := False;
  2158. New(Info);
  2159. Info^.StartNode := Node;
  2160. Info^.SearchNewDirs := NewDirs;
  2161. Info^.DriveType := DriveInfo.Get(Drive).DriveType;
  2162. SaveCanChange := FCanChange;
  2163. FCanChange := True;
  2164. FChangeFlag := False;
  2165. Items.BeginUpdate;
  2166. try
  2167. IterateSubTree(Node, CallBackValidateDir, Recurse, coScanStartNode, Info);
  2168. finally
  2169. Items.EndUpdate;
  2170. end;
  2171. FValidateFlag := False;
  2172. if (not Assigned(Selected)) and (Length(SelDir) > 0) then
  2173. Directory := ExtractFileDrive(SelDir);
  2174. if (SelDir <> Directory) and (not FChangeFlag) then
  2175. Change(Selected);
  2176. FCanChange := SaveCanChange;
  2177. Dispose(Info);
  2178. finally
  2179. if RestartWatchThread and FWatchDirectory and not WatchThreadActive then
  2180. StartWatchThread;
  2181. if Screen.Cursor <> SaveCursor then
  2182. Screen.Cursor := SaveCursor;
  2183. if FSysColorChangePending then
  2184. begin
  2185. FSysColorChangePending := False;
  2186. if HandleAllocated then Perform(CM_SYSCOLORCHANGE, 0, 0);
  2187. end;
  2188. end;
  2189. end;
  2190. end; {ValidateDirectoryEx}
  2191. function TDriveView.GetDriveTypeToNode(Node: TTreeNode): Integer;
  2192. begin
  2193. Assert(Assigned(Node));
  2194. Result := DriveInfo.Get(GetDriveToNode(Node)).DriveType;
  2195. end; {GetDriveTypeToNode}
  2196. procedure TDriveView.CreateWatchThread(Drive: string);
  2197. begin
  2198. if csDesigning in ComponentState then
  2199. Exit;
  2200. if (not Assigned(GetDriveStatus(Drive).DiscMonitor)) and
  2201. FWatchDirectory and
  2202. (DriveInfo.Get(Drive).DriveType <> DRIVE_REMOTE) then
  2203. begin
  2204. with GetDriveStatus(Drive) do
  2205. begin
  2206. DiscMonitor := TDiscMonitor.Create(Self);
  2207. DiscMonitor.ChangeDelay := msThreadChangeDelay;
  2208. DiscMonitor.SubTree := True;
  2209. DiscMonitor.Filters := [moDirName];
  2210. DiscMonitor.OnChange := ChangeDetected;
  2211. DiscMonitor.OnInvalid := ChangeInvalid;
  2212. DiscMonitor.SetDirectory(DriveInfo.GetDriveRoot(Drive));
  2213. DiscMonitor.Open;
  2214. end;
  2215. UpdateDriveNotifications(Drive);
  2216. end;
  2217. end; {CreateWatchThread}
  2218. procedure TDriveView.SetWatchDirectory(Value: Boolean);
  2219. begin
  2220. if FWatchDirectory <> Value then
  2221. begin
  2222. FWatchDirectory := Value;
  2223. if (not (csDesigning in ComponentState)) and Value then
  2224. StartAllWatchThreads
  2225. else
  2226. StopAllWatchThreads;
  2227. end;
  2228. end; {SetAutoScan}
  2229. procedure TDriveView.SetDirView(Value: TDirView);
  2230. begin
  2231. if Assigned(FDirView) then
  2232. FDirView.DriveView := nil;
  2233. FDirView := Value;
  2234. if Assigned(FDirView) then
  2235. FDirView.DriveView := Self;
  2236. end; {SetDirView}
  2237. function TDriveView.NodeWatched(Node: TTreeNode): Boolean;
  2238. var
  2239. Drive: string;
  2240. begin
  2241. Drive := GetDriveToNode(Node);
  2242. Result := WatchThreadActive(Drive);
  2243. end; {NodeWatched}
  2244. procedure TDriveView.ChangeInvalid(Sender: TObject; const Directory: string;
  2245. const ErrorStr: string);
  2246. var
  2247. Drive: string;
  2248. begin
  2249. Drive := DriveInfo.GetDriveKey((Sender as TDiscMonitor).Directories[0]);
  2250. with GetDriveStatus(Drive) do
  2251. begin
  2252. DiscMonitor.Close;
  2253. end;
  2254. UpdateDriveNotifications(Drive);
  2255. end; {DirWatchChangeInvalid}
  2256. procedure TDriveView.ChangeDetected(Sender: TObject; const Directory: string;
  2257. var SubdirsChanged: Boolean);
  2258. var
  2259. DirChanged: string;
  2260. begin
  2261. if Sender is TDiscMonitor then
  2262. begin
  2263. DirChanged := (Sender as TDiscMonitor).Directories[0];
  2264. if Length(DirChanged) > 0 then
  2265. begin
  2266. with GetDriveStatus(DriveInfo.GetDriveKey(DirChanged)) do
  2267. begin
  2268. ChangeTimer.Interval := 0;
  2269. ChangeTimer.Interval := FChangeInterval;
  2270. ChangeTimer.Enabled := True;
  2271. end;
  2272. end;
  2273. end;
  2274. end; {DirWatchChangeDetected}
  2275. procedure TDriveView.ChangeTimerOnTimer(Sender: TObject);
  2276. var
  2277. DriveStatusPair: TDriveStatusPair;
  2278. begin
  2279. if (FChangeTimerSuspended = 0) and (Sender is TTimer) then
  2280. begin
  2281. for DriveStatusPair in FDriveStatus do
  2282. begin
  2283. if DriveStatusPair.Value.ChangeTimer = Sender then
  2284. begin
  2285. // Messages are processed during ValidateDirectory, so we may detect another change while
  2286. // updating the directory. Prevent the recursion.
  2287. // But retry the update afterwards (by reenabling the timer in ChangeDetected)
  2288. SuspendChangeTimer;
  2289. try
  2290. with DriveStatusPair.Value.ChangeTimer do
  2291. begin
  2292. Interval := 0;
  2293. Enabled := False;
  2294. end;
  2295. if Assigned(DriveStatusPair.Value.RootNode) then
  2296. begin
  2297. {Check also collapsed (invisible) subdirectories:}
  2298. ValidateDirectory(DriveStatusPair.Value.RootNode);
  2299. end;
  2300. finally
  2301. ResumeChangeTimer;
  2302. end;
  2303. end;
  2304. end;
  2305. end;
  2306. end; {ChangeTimerOnTimer}
  2307. procedure TDriveView.UpdateDriveNotifications(Drive: string);
  2308. var
  2309. NeedNotifications: Boolean;
  2310. Path: string;
  2311. DevBroadcastHandle: DEV_BROADCAST_HANDLE;
  2312. Size: Integer;
  2313. begin
  2314. if DriveInfo.IsFixedDrive(Drive) then
  2315. begin
  2316. with GetDriveStatus(Drive) do
  2317. begin
  2318. NeedNotifications :=
  2319. WatchThreadActive(Drive) and
  2320. (DriveInfo.Get(Drive).DriveType <> DRIVE_REMOTE) and
  2321. DriveInfo.Get(Drive).DriveReady;
  2322. if NeedNotifications <> (DriveHandle <> INVALID_HANDLE_VALUE) then
  2323. begin
  2324. if NeedNotifications then
  2325. begin
  2326. Path := DriveInfo.GetDriveRoot(Drive);
  2327. DriveHandle :=
  2328. CreateFile(PChar(Path), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
  2329. OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS or FILE_ATTRIBUTE_NORMAL, 0);
  2330. if DriveHandle <> INVALID_HANDLE_VALUE then
  2331. begin
  2332. Size := SizeOf(DevBroadcastHandle);
  2333. ZeroMemory(@DevBroadcastHandle, Size);
  2334. DevBroadcastHandle.dbch_size := Size;
  2335. DevBroadcastHandle.dbch_devicetype := DBT_DEVTYP_HANDLE;
  2336. DevBroadcastHandle.dbch_handle := DriveHandle;
  2337. NotificationHandle :=
  2338. RegisterDeviceNotification(FInternalWindowHandle, @DevBroadcastHandle, DEVICE_NOTIFY_WINDOW_HANDLE);
  2339. if NotificationHandle = nil then
  2340. begin
  2341. CloseHandle(DriveHandle);
  2342. DriveHandle := INVALID_HANDLE_VALUE;
  2343. end;
  2344. end;
  2345. end
  2346. else
  2347. begin
  2348. UnregisterDeviceNotification(NotificationHandle);
  2349. NotificationHandle := nil;
  2350. CloseHandle(DriveHandle);
  2351. DriveHandle := INVALID_HANDLE_VALUE;
  2352. end;
  2353. end;
  2354. end;
  2355. end;
  2356. end;
  2357. procedure TDriveView.StartWatchThread;
  2358. var
  2359. Drive: string;
  2360. begin
  2361. if (csDesigning in ComponentState) or
  2362. not Assigned(Selected) or
  2363. not fWatchDirectory then Exit;
  2364. Drive := GetDriveToNode(Selected);
  2365. with GetDriveStatus(Drive) do
  2366. begin
  2367. if not Assigned(DiscMonitor) then
  2368. CreateWatchThread(Drive);
  2369. if Assigned(DiscMonitor) and not DiscMonitor.Enabled then
  2370. DiscMonitor.Enabled := True;
  2371. end;
  2372. UpdateDriveNotifications(Drive);
  2373. end; {StartWatchThread}
  2374. procedure TDriveView.StopWatchThread;
  2375. var
  2376. Drive: string;
  2377. begin
  2378. if Assigned(Selected) then
  2379. begin
  2380. Drive := GetDriveToNode(Selected);
  2381. with GetDriveStatus(Drive) do
  2382. if Assigned(DiscMonitor) then
  2383. DiscMonitor.Enabled := False;
  2384. UpdateDriveNotifications(Drive);
  2385. end;
  2386. end; {StopWatchThread}
  2387. procedure TDriveView.SuspendChangeTimer;
  2388. begin
  2389. Inc(FChangeTimerSuspended);
  2390. end;
  2391. procedure TDriveView.ResumeChangeTimer;
  2392. begin
  2393. Assert(FChangeTimerSuspended > 0);
  2394. Dec(FChangeTimerSuspended);
  2395. end;
  2396. procedure TDriveView.TerminateWatchThread(Drive: string);
  2397. begin
  2398. with GetDriveStatus(Drive) do
  2399. if Assigned(DiscMonitor) then
  2400. begin
  2401. DiscMonitor.Free;
  2402. DiscMonitor := nil;
  2403. end;
  2404. UpdateDriveNotifications(Drive);
  2405. end; {StopWatchThread}
  2406. procedure TDriveView.StartAllWatchThreads;
  2407. var
  2408. DriveStatusPair: TDriveStatusPair;
  2409. Drive: string;
  2410. begin
  2411. if (csDesigning in ComponentState) or (not FWatchDirectory) then
  2412. Exit;
  2413. for DriveStatusPair in FDriveStatus do
  2414. with DriveStatusPair.Value do
  2415. if Scanned then
  2416. begin
  2417. if not Assigned(DiscMonitor) then
  2418. CreateWatchThread(DriveStatusPair.Key);
  2419. if Assigned(DiscMonitor) and (not DiscMonitor.Active) then
  2420. begin
  2421. DiscMonitor.Open;
  2422. UpdateDriveNotifications(DriveStatusPair.Key);
  2423. end;
  2424. end;
  2425. if Assigned(Selected) then
  2426. begin
  2427. Drive := GetDriveToNode(Selected);
  2428. if not DriveInfo.IsFixedDrive(Drive) then
  2429. begin
  2430. StartWatchThread;
  2431. end;
  2432. end;
  2433. end; {StartAllWatchThreads}
  2434. procedure TDriveView.StopAllWatchThreads;
  2435. var
  2436. DriveStatusPair: TDriveStatusPair;
  2437. begin
  2438. if (csDesigning in ComponentState) or (not FWatchDirectory) then
  2439. Exit;
  2440. for DriveStatusPair in FDriveStatus do
  2441. with DriveStatusPair.Value do
  2442. begin
  2443. if Assigned(DiscMonitor) then
  2444. begin
  2445. DiscMonitor.Close;
  2446. UpdateDriveNotifications(DriveStatusPair.Key);
  2447. end;
  2448. end;
  2449. end; {StopAllWatchThreads}
  2450. function TDriveView.WatchThreadActive(Drive: string): Boolean;
  2451. begin
  2452. Result := FWatchDirectory and
  2453. Assigned(GetDriveStatus(Drive).DiscMonitor) and
  2454. GetDriveStatus(Drive).DiscMonitor.Active and
  2455. GetDriveStatus(Drive).DiscMonitor.Enabled;
  2456. end; {WatchThreadActive}
  2457. function TDriveView.WatchThreadActive: Boolean;
  2458. var
  2459. Drive: string;
  2460. begin
  2461. if not Assigned(Selected) then
  2462. begin
  2463. Result := False;
  2464. Exit;
  2465. end;
  2466. Drive := GetDriveToNode(Selected);
  2467. Result := WatchThreadActive(Drive);
  2468. end; {WatchThreadActive}
  2469. function TDriveView.FindPathNode(Path: string): TTreeNode;
  2470. var
  2471. PossiblyHiddenPath: string;
  2472. Attrs: Integer;
  2473. begin
  2474. if Assigned(FOnNeedHiddenDirectories) and
  2475. (not ShowHiddenDirs) and
  2476. DirectoryExistsFix(Path) then // do not even bother if the path does not exist
  2477. begin
  2478. PossiblyHiddenPath := ExcludeTrailingPathDelimiter(Path);
  2479. while (PossiblyHiddenPath <> '') and
  2480. (not IsRootPath(PossiblyHiddenPath)) do // Drives have hidden attribute
  2481. begin
  2482. Attrs := FileGetAttr(PossiblyHiddenPath, False);
  2483. if (Attrs and faHidden) = faHidden then
  2484. begin
  2485. if Assigned(FOnNeedHiddenDirectories) then
  2486. begin
  2487. FOnNeedHiddenDirectories(Self);
  2488. end;
  2489. Break;
  2490. end
  2491. else
  2492. begin
  2493. PossiblyHiddenPath := ExtractFileDir(PossiblyHiddenPath);
  2494. end;
  2495. end;
  2496. end;
  2497. {Find existing path or parent path of not existing path:}
  2498. repeat
  2499. Result := FindNodeToPath(Path);
  2500. if not Assigned(Result) then
  2501. Path := ExtractFilePath(ExcludeTrailingBackslash(Path));
  2502. until Assigned(Result) or (Length(Path) < 3);
  2503. end;
  2504. procedure TDriveView.SetDirectory(Value: string);
  2505. begin
  2506. Value := IncludeTrailingBackslash(Value);
  2507. FDirectory := Value;
  2508. inherited;
  2509. if Assigned(Selected) and (Selected.Level = 0) then
  2510. begin
  2511. if not GetDriveStatus(GetDriveToNode(Selected)).Scanned then
  2512. ScanDrive(GetDriveToNode(Selected));
  2513. end;
  2514. end; {SetDirectory}
  2515. function TDriveView.GetDirName(Node: TTreeNode): string;
  2516. begin
  2517. if Assigned(Node) and Assigned(Node.Data) then
  2518. Result := TNodeData(Node.Data).DirName
  2519. else
  2520. Result := '';
  2521. end; {GetDirName}
  2522. {GetDrive: returns the drive of the Node.}
  2523. function TDriveView.GetDriveToNode(Node: TTreeNode): string;
  2524. var
  2525. Path: string;
  2526. begin
  2527. if (not Assigned (Node)) or (not Assigned(Node.Data)) then
  2528. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDrive']));
  2529. Path := NodePath(Node);
  2530. Result := DriveInfo.GetDriveKey(Path);
  2531. end; {GetDrive}
  2532. {RootNode: returns the rootnode to the Node:}
  2533. function TDriveView.RootNode(Node: TTreeNode): TTreeNode;
  2534. begin
  2535. Result := Node;
  2536. if not Assigned(Node) then
  2537. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['RootNode']));
  2538. while Assigned(Result.Parent) do
  2539. Result := Result.Parent;
  2540. end; {RootNode}
  2541. function TDriveView.GetDisplayName(Node: TTreeNode): string;
  2542. begin
  2543. Result := '';
  2544. if (not Assigned(Node)) or (not Assigned(Node.Data)) then
  2545. raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDisplayName']));
  2546. if Node.Level = 0 then Result := GetDriveText(GetDriveToNode(Node))
  2547. else
  2548. begin
  2549. Result := GetDirName(Node);
  2550. end;
  2551. end; {GetDisplayName}
  2552. procedure TDriveView.SetShowVolLabel(ShowIt: Boolean);
  2553. begin
  2554. if ShowIt = FShowVolLabel then
  2555. Exit;
  2556. FShowVolLabel := ShowIt;
  2557. RefreshRootNodes(dvdsFloppy);
  2558. end; {SetShowVolLabel}
  2559. procedure TDriveView.DisplayContextMenu(Node: TTreeNode; Point: TPoint);
  2560. var
  2561. Verb: string;
  2562. DirWatched: Boolean;
  2563. begin
  2564. DirWatched := NodeWatched(Node) and WatchThreadActive;
  2565. Assert(Node <> nil);
  2566. if Node <> Selected then
  2567. DropTarget := Node;
  2568. Verb := EmptyStr;
  2569. if Assigned(FOnDisplayContextMenu) then
  2570. FOnDisplayContextMenu(Self);
  2571. ShellDisplayContextMenu(FParentForm.Handle, Point, NodePathName(Node),
  2572. CanEdit(Node), Verb, False);
  2573. if Verb = shcRename then Node.EditText
  2574. else
  2575. if Verb = shcCut then
  2576. begin
  2577. LastClipBoardOperation := cboCut;
  2578. LastPathCut := NodePathName(Node);
  2579. end
  2580. else
  2581. if Verb = shcCopy then LastClipBoardOperation := cboCopy
  2582. else
  2583. if Verb = shcPaste then
  2584. PasteFromClipBoard(NodePathName(Node));
  2585. DropTarget := nil;
  2586. if not DirWatched then
  2587. ValidateDirectory(Node);
  2588. end; {DisplayContextMenu (2)}
  2589. procedure TDriveView.DisplayPropertiesMenu(Node: TTreeNode);
  2590. begin
  2591. Assert(Assigned(Node));
  2592. ShellExecuteContextCommand(FParentForm.Handle, shcProperties, NodePathName(Node));
  2593. end; {ContextMenu}
  2594. procedure TDriveView.SetSelected(Node: TTreeNode);
  2595. begin
  2596. if Node <> Selected then
  2597. begin
  2598. FChangeFlag := False;
  2599. FCanChange := True;
  2600. inherited Selected := Node;
  2601. if not FChangeFlag then
  2602. Change(Selected);
  2603. end;
  2604. end; {SetSelected}
  2605. {Called by TFileDeleteThread, when a file deletion was detected by the D&D receiving application:}
  2606. procedure TDriveView.SignalDirDelete(Sender: TObject; Files: TStringList);
  2607. begin
  2608. if Files.Count > 0 then
  2609. ValidateDirectory(FindNodeToPath(Files[0]));
  2610. end; {SignalDirDelete}
  2611. function TDriveView.DDSourceEffects: TDropEffectSet;
  2612. begin
  2613. if FDragNode.Level = 0 then
  2614. Result := [deLink]
  2615. else
  2616. Result := [deLink, deCopy, deMove];
  2617. end;
  2618. procedure TDriveView.DDChooseEffect(KeyState: Integer; var Effect: Integer; PreferredEffect: Integer);
  2619. begin
  2620. if DropTarget = nil then Effect := DROPEFFECT_NONE
  2621. else
  2622. if (KeyState and (MK_CONTROL or MK_SHIFT) = 0) and (PreferredEffect = 0) then
  2623. begin
  2624. if FDragDrive <> '' then
  2625. begin
  2626. if FExeDrag and DriveInfo.IsFixedDrive(GetDriveToNode(DropTarget)) and DriveInfo.IsFixedDrive(FDragDrive) then
  2627. begin
  2628. Effect := DROPEFFECT_LINK;
  2629. end
  2630. else
  2631. if (Effect = DROPEFFECT_COPY) and
  2632. (SameText(FDragDrive, GetDriveToNode(DropTarget)) and
  2633. (FDragDropFilesEx.AvailableDropEffects and DROPEFFECT_MOVE <> 0)) then
  2634. begin
  2635. Effect := DROPEFFECT_MOVE;
  2636. end;
  2637. end;
  2638. end;
  2639. inherited;
  2640. end;
  2641. function TDriveView.DragCompleteFileList: Boolean;
  2642. begin
  2643. Result := (GetDriveTypeToNode(FDragNode) <> DRIVE_REMOVABLE);
  2644. end;
  2645. function TDriveView.DDExecute: TDragResult;
  2646. var
  2647. WatchThreadOK: Boolean;
  2648. DragParentPath: string;
  2649. DragPath: string;
  2650. begin
  2651. WatchThreadOK := WatchThreadActive;
  2652. Result := FDragDropFilesEx.Execute(nil);
  2653. if (Result = drMove) and (not WatchThreadOK) then
  2654. begin
  2655. DragPath := NodePathName(FDragNode);
  2656. if Assigned(FDragNode.Parent) then
  2657. DragParentPath := NodePathName(FDragNode.Parent)
  2658. else
  2659. DragParentPath := DragPath;
  2660. if (FDragNode.Level > 0) or (DragParentPath <> NodePathName(Selected.Parent)) then
  2661. begin
  2662. FDragNode := FindNodeToPath(DragPath);
  2663. if Assigned(FDragNode) then
  2664. begin
  2665. FDragFileList.Clear;
  2666. FDragFileList.Add(DragPath);
  2667. TFileDeleteThread.Create(FDragFileList, MaxWaitTimeOut, SignalDirDelete);
  2668. end;
  2669. end;
  2670. end;
  2671. end;
  2672. procedure TDriveView.PerformDragDropFileOperation(Node: TTreeNode; Effect: Integer);
  2673. var
  2674. Index: Integer;
  2675. SourcePath: string;
  2676. SourceParentPath: string;
  2677. SourceIsDirectory: Boolean;
  2678. SaveCursor: TCursor;
  2679. SourceNode, TargetNode: TTreeNode;
  2680. TargetPath: string;
  2681. IsRecycleBin: Boolean;
  2682. begin
  2683. TargetPath := NodePathName(Node);
  2684. IsRecycleBin := NodeIsRecycleBin(Node);
  2685. if FDragDropFilesEx.FileList.Count = 0 then
  2686. Exit;
  2687. SaveCursor := Screen.Cursor;
  2688. Screen.Cursor := crHourGlass;
  2689. SourcePath := EmptyStr;
  2690. try
  2691. if (Effect = DROPEFFECT_COPY) or (Effect = DROPEFFECT_MOVE) then
  2692. begin
  2693. StopAllWatchThreads;
  2694. if Assigned(FDirView) then
  2695. FDirView.StopWatchThread;
  2696. if Assigned(DropSourceControl) and
  2697. (DropSourceControl is TDirView) and
  2698. (DropSourceControl <> FDirView) then
  2699. begin
  2700. TDirView(DropSourceControl).StopWatchThread;
  2701. end;
  2702. if DropFiles(
  2703. DragDropFilesEx, Effect, FFileOperator, TargetPath, false, IsRecycleBin, ConfirmDelete, ConfirmOverwrite, False,
  2704. Self, OnDDFileOperation, SourcePath, SourceIsDirectory) then
  2705. begin
  2706. if Assigned(FOnDDFileOperationExecuted) then
  2707. FOnDDFileOperationExecuted(Self, Effect, SourcePath, TargetPath);
  2708. end;
  2709. ClearDragFileList(FDragDropFilesEx.FileList);
  2710. // TDirView.PerformDragDropFileOperation validates the SourcePath and that actually seems correct
  2711. SourceParentPath := ExtractFilePath(ExcludeTrailingBackslash(SourcePath));
  2712. end
  2713. else
  2714. if Effect = DROPEFFECT_LINK then
  2715. { Create Link requested: }
  2716. begin
  2717. for Index := 0 to FDragDropFilesEx.FileList.Count - 1 do
  2718. begin
  2719. if not DropLink(PFDDListItem(FDragDropFilesEx.FileList[Index]), TargetPath) then
  2720. begin
  2721. DDError(DDCreateShortCutError);
  2722. end;
  2723. end;
  2724. end;
  2725. if Effect = DROPEFFECT_MOVE then
  2726. Items.BeginUpdate;
  2727. {Update source directory, if move-operation was performed:}
  2728. if ((Effect = DROPEFFECT_MOVE) or IsRecycleBin) then
  2729. begin
  2730. // See comment in corresponding operation in TDirView.PerformDragDropFileOperation
  2731. SourceNode := TryFindNodeToPath(SourceParentPath);
  2732. if Assigned(SourceNode) then
  2733. ValidateDirectory(SourceNode);
  2734. end;
  2735. {Update subdirectories of target directory:}
  2736. TargetNode := FindNodeToPath(TargetPath);
  2737. if Assigned(TargetNode) then
  2738. ValidateDirectory(TargetNode)
  2739. else
  2740. ValidateDirectory(GetDriveStatus(DriveInfo.GetDriveKey(TargetPath)).RootNode);
  2741. if Effect = DROPEFFECT_MOVE then
  2742. Items.EndUpdate;
  2743. {Update linked component TDirView:}
  2744. if Assigned(FDirView) and (not FDirView.WatchThreadActive) then
  2745. begin
  2746. case Effect of
  2747. DROPEFFECT_COPY,
  2748. DROPEFFECT_LINK:
  2749. if (IncludeTrailingBackslash(TargetPath) = IncludeTrailingBackslash(DirView.Path)) then
  2750. FDirView.Reload2;
  2751. DROPEFFECT_MOVE:
  2752. if (IncludeTrailingBackslash(TargetPath) = IncludeTrailingBackslash(DirView.Path)) or
  2753. (IncludeTrailingBackslash(SourceParentPath) = IncludeTrailingBackslash(DirView.Path)) then
  2754. begin
  2755. if FDirView <> DropSourceControl then FDirView.Reload2;
  2756. end;
  2757. end; {Case}
  2758. end;
  2759. {Update the DropSource control, if files are moved and it is a TDirView:}
  2760. if (Effect = DROPEFFECT_MOVE) and (DropSourceControl is TDirView) then
  2761. begin
  2762. TDirView(DropSourceControl).ValidateSelectedFiles;
  2763. end;
  2764. finally
  2765. FFileOperator.OperandFrom.Clear;
  2766. FFileOperator.OperandTo.Clear;
  2767. StartAllWatchThreads;
  2768. if Assigned(FDirView) and (not FDirView.WatchThreadActive) then
  2769. FDirView.StartWatchThread;
  2770. if Assigned(DropSourceControl) and (DropSourceControl is TDirView) and
  2771. (not TDirView(DropSourceControl).WatchThreadActive) then
  2772. TDirView(DropSourceControl).StartWatchThread;
  2773. Screen.Cursor := SaveCursor;
  2774. end;
  2775. end; {PerformDragDropFileOperation}
  2776. function TDriveView.GetCanUndoCopyMove: Boolean;
  2777. begin
  2778. Result := Assigned(FFileOperator) and FFileOperator.CanUndo;
  2779. end; {CanUndoCopyMove}
  2780. function TDriveView.UndoCopyMove: Boolean;
  2781. var
  2782. LastTarget: string;
  2783. LastSource: string;
  2784. begin
  2785. Result := False;
  2786. if FFileOperator.CanUndo then
  2787. begin
  2788. Lasttarget := FFileOperator.LastOperandTo[0];
  2789. LastSource := FFileOperator.LastOperandFrom[0];
  2790. StopAllWatchThreads;
  2791. Result := FFileOperator.UndoExecute;
  2792. ValidateDirectory(FindNodeToPath(ExtractFilePath(LastTarget)));
  2793. ValidateDirectory(FindNodeToPath(ExtractFilePath(LastSource)));
  2794. StartAllWatchThreads;
  2795. if Assigned(FDirView) then
  2796. with FDirView do
  2797. if not WatchThreadActive then
  2798. begin
  2799. if (IncludeTrailingBackslash(ExtractFilePath(LastTarget)) = IncludeTrailingBackslash(Path)) or
  2800. (IncludeTrailingBackslash(ExtractFilePath(LastSource)) = IncludeTrailingBackslash(Path)) then
  2801. Reload2;
  2802. end;
  2803. end;
  2804. end; {UndoCopyMove}
  2805. {Clipboard operations:}
  2806. procedure TDriveView.SetLastPathCut(Path: string);
  2807. var
  2808. Node: TTreeNode;
  2809. begin
  2810. if FLastPathCut <> Path then
  2811. begin
  2812. Node := FindNodeToPath(FLastPathCut);
  2813. if Assigned(Node) then
  2814. begin
  2815. FLastPathCut := Path;
  2816. Node.Cut := False;
  2817. end;
  2818. Node := FindNodeToPath(Path);
  2819. if Assigned(Node) then
  2820. begin
  2821. FLastPathCut := Path;
  2822. Node.Cut := True;
  2823. end;
  2824. end;
  2825. end; {SetLastNodeCut}
  2826. procedure TDriveView.EmptyClipboard;
  2827. begin
  2828. if Windows.OpenClipBoard(0) then
  2829. begin
  2830. Windows.EmptyClipBoard;
  2831. Windows.CloseClipBoard;
  2832. LastPathCut := '';
  2833. LastClipBoardOperation := cboNone;
  2834. if Assigned(FDirView) then
  2835. FDirView.EmptyClipboard;
  2836. end;
  2837. end; {EmptyClipBoard}
  2838. function TDriveView.CopyToClipBoard(Node: TTreeNode): Boolean;
  2839. begin
  2840. Result := Assigned(Selected);
  2841. if Result then
  2842. begin
  2843. EmptyClipBoard;
  2844. ClearDragFileList(FDragDropFilesEx.FileList);
  2845. AddToDragFileList(FDragDropFilesEx.FileList, Selected);
  2846. Result := FDragDropFilesEx.CopyToClipBoard;
  2847. LastClipBoardOperation := cboCopy;
  2848. end;
  2849. end; {CopyToClipBoard}
  2850. function TDriveView.CutToClipBoard(Node: TTreeNode): Boolean;
  2851. begin
  2852. Result := Assigned(Node) and (Node.Level > 0) and CopyToClipBoard(Node);
  2853. if Result then
  2854. begin
  2855. LastPathCut := NodePathName(Node);
  2856. LastClipBoardOperation := cboCut;
  2857. end;
  2858. end; {CutToClipBoard}
  2859. function TDriveView.CanPasteFromClipBoard: Boolean;
  2860. begin
  2861. Result := False;
  2862. if Assigned(Selected) and Windows.OpenClipboard(0) then
  2863. begin
  2864. Result := IsClipboardFormatAvailable(CF_HDROP);
  2865. Windows.CloseClipBoard;
  2866. end;
  2867. end; {CanPasteFromClipBoard}
  2868. function TDriveView.PasteFromClipBoard(TargetPath: String = ''): Boolean;
  2869. begin
  2870. ClearDragFileList(FDragDropFilesEx.FileList);
  2871. Result := False;
  2872. if CanPasteFromClipBoard and {MP}FDragDropFilesEx.GetFromClipBoard{/MP}
  2873. then
  2874. begin
  2875. if TargetPath = '' then
  2876. TargetPath := NodePathName(Selected);
  2877. case LastClipBoardOperation of
  2878. cboCopy,
  2879. cboNone:
  2880. begin
  2881. PerformDragDropFileOperation(Selected, DROPEFFECT_COPY);
  2882. if Assigned(FOnDDExecuted) then
  2883. FOnDDExecuted(Self, DROPEFFECT_COPY);
  2884. end;
  2885. cboCut:
  2886. begin
  2887. PerformDragDropFileOperation(Selected, DROPEFFECT_MOVE);
  2888. if Assigned(FOnDDExecuted) then
  2889. FOnDDExecuted(Self, DROPEFFECT_MOVE);
  2890. EmptyClipBoard;
  2891. end;
  2892. end;
  2893. Result := True;
  2894. end;
  2895. end; {PasteFromClipBoard}
  2896. procedure TDriveView.CMRecreateWnd(var Msg: TMessage);
  2897. var
  2898. ScheduledCount: Integer;
  2899. begin
  2900. ScheduledCount := FSubDirReaderThread.Detach;
  2901. try
  2902. inherited;
  2903. finally
  2904. FSubDirReaderThread.Reattach(ScheduledCount);
  2905. end;
  2906. end;
  2907. procedure TDriveView.CMSysColorChange(var Message: TMessage);
  2908. begin
  2909. if not FValidateFlag then
  2910. begin
  2911. inherited;
  2912. end
  2913. else
  2914. begin
  2915. // Do not recreate the handle, if we are just iterating nodes, at that invalidates the node objects.
  2916. // This is not perfect, as the handle can be recreated for other reasons.
  2917. // But system color change is by far the most common case.
  2918. FSysColorChangePending := True;
  2919. end;
  2920. end;
  2921. end.