| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303 | unit DriveView;{================================================================== Component TDriveView / Version 2.6, January 2000 ==================================================================    Description:    ============    Displays the the directory structure of all drives as treeview    with shell icons. Complete drag&Drop support for files and    directories.    Author:    =======    (c) Ingo Eckel 1998, 1999    Sodener Weg 38    65812 Bad Soden    Germany    Modifications (for WinSCP):    ===========================    (c) Martin Prikryl 2004    V2.6:    - Shows "shared"-symbol with directories    - Delphi5 compatible    For detailed documentation and history see TDriveView.htm.{==================================================================}interface{ Define ENHVALIDATE to scan all existing directories on a detected filesystem change:}{.$DEFINE ENHVALIDATE}{Required compiler options for TDriveView:}{$A+,B-,X+,H+,P+}{$WARN SYMBOL_PLATFORM OFF}uses  Windows, Messages, SysUtils, Classes,  Graphics, Controls, Forms, ComObj,  Dialogs, ComCtrls, ShellApi, CommCtrl, ExtCtrls, ActiveX,  ShlObj,  DirView, ShellDialogs, DragDrop, DragDropFilesEx, FileChanges, FileOperator,  DiscMon, IEDriveInfo, IEListView, BaseUtils, CustomDirView,  CustomDriveView, System.Generics.Collections, CompThread;const  msThreadChangeDelay = 50;  ErrorNodeNA = '%s: Node not assigned';  {Flags used by TDriveView.RefreshRootNodes:}  dvdsFloppy          = 8;  {Include floppy drives}  dvdsRereadAllways   = 16; {Refresh drivestatus in any case}  WM_USER_SHCHANGENOTIFY = WM_USER + $2000 + 13;  WM_USER_SUBDIRREADER = WM_USER_SHCHANGENOTIFY + 1;type  EInvalidDirName  = class(Exception);  ENodeNotAssigned = class(Exception);  TDriveStatus = class    Scanned: Boolean;          {Drive allready scanned?}    Verified: Boolean;         {Drive completly scanned?}    RootNode: TTreeNode;       {Rootnode to drive}    RootNodeIndex: Integer;    DiscMonitor: TDiscMonitor; {Monitor thread}    ChangeTimer: TTimer;       {Change timer for the monitor thread}    DefaultDir: string;        {Current directory}    DriveHandle: THandle;    NotificationHandle: HDEVNOTIFY;  end;  TDriveStatusPair = TPair<string, TDriveStatus>;  TScanDirInfo = record    SearchNewDirs: Boolean;    StartNode: TTreeNode;    DriveType: Integer;  end;  PScanDirInfo = ^TScanDirInfo;  TDriveView = class;  TSubDirReaderSchedule = class    Node: TTreeNode;    Path: string;    Deleted: Boolean;    Processed: Boolean;  end;  TNodeData = class  private    FDirName: string;    FAttr: Integer;    FScanned: Boolean;    FData: Pointer;    FIsRecycleBin: Boolean;    FIconEmpty: Boolean;    FSchedule: TSubDirReaderSchedule;  public    DelayedSrec: TSearchRec;    DelayedExclude: TStringList;    constructor Create;    destructor Destroy; override;    property DirName: string read FDirName write FDirName;    property Attr: Integer read FAttr write FAttr;    property Scanned: Boolean read FScanned write FScanned;    property Data: Pointer read FData write FData;    property IsRecycleBin: Boolean read FIsRecycleBin;    property IconEmpty: Boolean read FIconEmpty write FIconEmpty;    property Schedule: TSubDirReaderSchedule read FSchedule write FSchedule;  end;  TDriveTreeNode = class(TTreeNode)    procedure Assign(Source: TPersistent); override;  end;  TSubDirReaderThread = class(TCompThread)  public    destructor Destroy; override;    procedure Terminate; override;  protected    constructor Create(DriveView: TDriveView);    procedure Add(Node: TTreeNode; Path: string);    procedure Delete(Node: TTreeNode);    function Detach: Integer;    procedure Reattach(Count: Integer);    procedure Execute; override;  private    FDriveView: TDriveView;    FEvent: THandle;    FQueue: TStack<TSubDirReaderSchedule>;    FResults: TQueue<TSubDirReaderSchedule>;    FSection: TRTLCriticalSection;    FTimer: TTimer;    FWindowHandle: HWND;    procedure TriggerEvent;    procedure ScheduleProcess;    procedure Process;    function ProcessResult: Boolean;    procedure Timer(Sender: TObject);    procedure WndProc(var Msg: TMessage);  end;  TDriveViewRefreshDrives = procedure(Sender: TObject; Global: Boolean) of object;  TDriveView = class(TCustomDriveView)  private    FDriveStatus: TObjectDictionary<string, TDriveStatus>;    FConfirmDelete: Boolean;    FConfirmOverwrite: Boolean;    FWatchDirectory: Boolean;    FDirectory: string;    FShowVolLabel: Boolean;    FVolDisplayStyle: TVolumeDisplayStyle;    FChangeFlag: Boolean;    FLastDir: string;    FValidateFlag: Boolean;    FSysColorChangePending: Boolean;    FCreating: Boolean;    FForceRename: Boolean;    FRenameNode: TTreeNode;    FLastRenameName: string;    FInternalWindowHandle: HWND;    FChangeNotify: ULONG;    FPrevSelected: TTreeNode;    FPrevSelectedIndex: Integer;    FChangeTimerSuspended: Integer;    FSubDirReaderThread: TSubDirReaderThread;    FDelayedNodes: TStringList;    FDelayedNodeTimer: TTimer;    {Additional events:}    FOnDisplayContextMenu: TNotifyEvent;    FOnRefreshDrives: TDriveViewRefreshDrives;    FOnNeedHiddenDirectories: TNotifyEvent;    {used components:}    FDirView: TDirView;    FFileOperator: TFileOperator;    FChangeInterval: Cardinal;    {Drag&drop:}    FLastPathCut: string;    {Drag&drop helper functions:}    procedure SignalDirDelete(Sender: TObject; Files: TStringList);    function GetSubDir(var SRec: TSearchRec): Boolean;    function FindFirstSubDir(Path: string; var SRec: TSearchRec): Boolean;    function FindNextSubDir(var SRec: TSearchRec): Boolean;    procedure ReadSubDirs(Node: TTreeNode);    procedure CancelDelayedNode(Node: TTreeNode);    procedure DelayedNodeTimer(Sender: TObject);    function ReadSubDirsBatch(Node: TTreeNode; var SRec: TSearchRec; CheckInterval, Limit: Integer): Boolean;    procedure UpdateDelayedNodeTimer;    {Callback-functions used by iteratesubtree:}    function CallBackValidateDir(var Node: TTreeNode; Data: Pointer): Boolean;    procedure DeleteNode(Node: TTreeNode);    { Notification procedures used by component TDiscMonitor: }    procedure ChangeDetected(Sender: TObject; const Directory: string;      var SubdirsChanged: Boolean);    procedure ChangeInvalid(Sender: TObject; const Directory: string; const ErrorStr: string);    {Notification procedure used by component TTimer:}    procedure ChangeTimerOnTimer(Sender: TObject);  protected    procedure SetSelected(Node: TTreeNode);    procedure SetWatchDirectory(Value: Boolean);    procedure SetShowVolLabel(ShowIt: Boolean);    procedure SetDirView(Value: TDirView);    procedure SetDirectory(Value: string); override;    function  DoScanDir(FromNode: TTreeNode): Boolean;    procedure AddChildNode(ParentNode: TTreeNode; ParentPath: string; SRec: TSearchRec);    procedure CreateWatchThread(Drive: string);    function NodeWatched(Node: TTreeNode): Boolean;    procedure TerminateWatchThread(Drive: string);    function WatchThreadActive: Boolean; overload;    function WatchThreadActive(Drive: string): Boolean; overload;    procedure InternalWndProc(var Msg: TMessage);    procedure UpdateDriveNotifications(Drive: string);    procedure DriveRemoved(Drive: string);    procedure DriveRemoving(Drive: string);    procedure CancelDriveRefresh;    procedure DoRefreshDrives(Global: Boolean);    procedure RefreshRootNodes(dsFlags: Integer);    function DirAttrMask: Integer;    function CreateDriveStatus: TDriveStatus;    procedure ValidateDirectoryEx(Node: TTreeNode; Recurse: TRecursiveScan;      NewDirs: Boolean); override;    procedure RebuildTree; override;    procedure SetLastPathCut(Path: string);    function GetCanUndoCopyMove: Boolean; virtual;    procedure CreateWnd; override;    procedure DestroyWnd; override;    procedure Edit(const Item: TTVItem); override;    procedure WMUserRename(var Message: TMessage); message WM_USER_RENAME;    procedure CMRecreateWnd(var Msg: TMessage); message CM_RECREATEWND;    procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;    function GetCustomDirView: TCustomDirView; override;    procedure SetCustomDirView(Value: TCustomDirView); override;    function NodePath(Node: TTreeNode): string; override;    function NodeIsRecycleBin(Node: TTreeNode): Boolean; override;    function NodePathExists(Node: TTreeNode): Boolean; override;    function NodeColor(Node: TTreeNode): TColor; override;    function FindPathNode(Path: string): TTreeNode; override;    function DoFindNodeToPath(Path: string; ExistingOnly: Boolean): TTreeNode;    function CreateNode: TTreeNode; override;    function DDSourceEffects: TDropEffectSet; override;    procedure DDChooseEffect(KeyState: Integer; var Effect: Integer; PreferredEffect: Integer); override;    function DragCompleteFileList: Boolean; override;    function DDExecute: TDragResult; override;  public    property Images;    property StateImages;    property Items stored False;    property Selected Write SetSelected stored False;    property DragImageList: TDragImageList read FDragImageList;    property CanUndoCopyMove: Boolean read GetCanUndoCopyMove;    property DDFileOperator: TFileOperator read FFileOperator;    property LastPathCut: string read FLastPathCut write SetLastPathCut;    function UndoCopyMove: Boolean; dynamic;    procedure EmptyClipboard; dynamic;    function CopyToClipBoard(Node: TTreeNode): Boolean; dynamic;    function CutToClipBoard(Node: TTreeNode): Boolean; dynamic;    function CanPasteFromClipBoard: Boolean; dynamic;    function PasteFromClipBoard(TargetPath: string = ''): Boolean; dynamic;    procedure PerformDragDropFileOperation(Node: TTreeNode; Effect: Integer); override;    {Drive handling:}    function GetDriveStatus(Drive: string): TDriveStatus;    function GetDriveTypetoNode(Node: TTreeNode): Integer;  {Returns DRIVE_CDROM etc..}    function GetDriveToNode(Node: TTreeNode): string;    function GetDriveText(Drive: string): string;    procedure ScanDrive(Drive: string);    function GetDrives: TStrings;    procedure ScheduleDriveRefresh;    {Node handling:}    procedure SetImageIndex(Node: TTreeNode); virtual;    function FindNodeToPath(Path: string): TTreeNode;    function TryFindNodeToPath(Path: string): TTreeNode;    function RootNode(Node: TTreeNode): TTreeNode;    function GetDirName(Node: TTreeNode): string;    function GetDisplayName(Node: TTreeNode): string;    function NodePathName(Node: TTreeNode): string; override;    constructor Create(AOwner: TComponent); override;    destructor Destroy; override;    {Menu-handling:}    procedure DisplayContextMenu(Node: TTreeNode; Point: TPoint); override;    procedure DisplayPropertiesMenu(Node: TTreeNode); override;    {Watchthread handling:}    procedure StartWatchThread;    procedure StopWatchThread;    procedure SuspendChangeTimer;    procedure ResumeChangeTimer;    procedure StartAllWatchThreads;    procedure StopAllWatchThreads;    procedure ValidateCurrentDirectoryIfNotMonitoring;    (* Modified Events: *)    procedure GetImageIndex(Node: TTreeNode); override;    function CanEdit(Node: TTreeNode): Boolean; override;    function CanChange(Node: TTreeNode): Boolean; override;    function CanExpand(Node: TTreeNode): Boolean; override;    procedure Delete(Node: TTreeNode); override;    procedure Loaded; override;    procedure KeyPress(var Key: Char); override;    procedure Change(Node: TTreeNode); override;  published    {Additional properties:}    {Current selected directory:}    property Directory;    {Confirm deleting directories:}    property ConfirmDelete: Boolean read FConfirmDelete write FConfirmDelete default True;    {Confirm overwriting directories:}    property ConfirmOverwrite: Boolean read FConfirmOverwrite write FConfirmOverwrite default True;    {Enable automatic update on filesystem changes:}    property WatchDirectory: Boolean read FWatchDirectory write SetWatchDirectory default False;    {Linked component TDirView:}    property DirView: TDirView read FDirView write SetDirView;    {Show the volume labels of drives:}    property ShowVolLabel: Boolean read FShowVolLabel write SetShowVolLabel default True;    {Additional events:}    property OnDisplayContextMenu: TNotifyEvent read FOnDisplayContextMenu      write FOnDisplayContextMenu;    property OnRefreshDrives: TDriveViewRefreshDrives read FOnRefreshDrives write FOnRefreshDrives;    property OnBusy;    property DDLinkOnExeDrag;    property TargetPopUpMenu;    property OnDDDragEnter;    property OnDDDragLeave;    property OnDDDragOver;    property OnDDDrop;    property OnDDQueryContinueDrag;    property OnDDGiveFeedback;    property OnDDDragDetect;    property OnDDProcessDropped;    property OnDDError;    property OnDDExecuted;    property OnDDFileOperation;    property OnDDFileOperationExecuted;    property Align;    property Anchors;    property AutoExpand;    property BiDiMode;    property BorderStyle;    property BorderWidth;    property ChangeDelay;    property Color;    property Ctl3D;    property Constraints;    property DoubleBuffered;    {Delphi's drag&drop is not compatible with the OLE windows drag&drop:}    property DragKind;    property DragCursor;    property DragMode Default dmAutomatic;    property OnDragDrop;    property OnDragOver;    property Enabled;    property Font;    property HideSelection;    property HotTrack;    property Indent;    property ParentBiDiMode;    property ParentColor;    property ParentCtl3D;    property ParentDoubleBuffered;    property ParentFont;    property ParentShowHint;    property PopupMenu;    property ReadOnly;    property RightClickSelect;    property RowSelect;    property ShowButtons;    property ShowHint;    property ShowLines;    property TabOrder;    property TabStop default True;    property ToolTips;    property Visible;    property OnChange;    property OnChanging;    property OnClick;    property OnCollapsing;    property OnCollapsed;    property OnCompare;    property OnDblClick;    property OnDeletion;    property OnEdited;    property OnEditing;    property OnEndDock;    property OnEndDrag;    property OnEnter;    property OnExit;    property OnExpanding;    property OnExpanded;    property OnGetImageIndex;    property OnGetSelectedIndex;    property OnKeyDown;    property OnKeyPress;    property OnKeyUp;    property OnMouseDown;    property OnMouseMove;    property OnMouseUp;    property OnStartDock;    property OnStartDrag;    property OnNeedHiddenDirectories: TNotifyEvent read FOnNeedHiddenDirectories write FOnNeedHiddenDirectories;  end;var  DriveViewLoadingTooLongLimit: Integer = 0;procedure Register;implementationuses  PasTools, UITypes, SyncObjs, IOUtils, System.DateUtils;type  PInt = ^Integer;procedure Register;begin  RegisterComponents('DriveDir', [TDriveView]);end; {Register}constructor TNodeData.Create;begin  inherited;  FAttr := 0;  FScanned := False;  FDirName := '';  FIsRecycleBin := False;  FIconEmpty := True;  FSchedule := nil;  DelayedExclude := nil;end; {TNodeData.Create}destructor TNodeData.Destroy;begin  Assert(not Assigned(FSchedule));  SetLength(FDirName, 0);  inherited;end; {TNodeData.Destroy}  { TSubDirReaderThread }constructor TSubDirReaderThread.Create(DriveView: TDriveView);begin  inherited Create(True);  FDriveView := DriveView;  FSection.Initialize;  FEvent := CreateEvent(nil, False, False, nil);  FQueue := TStack<TSubDirReaderSchedule>.Create;  FResults := TQueue<TSubDirReaderSchedule>.Create;  FTimer := TTimer.Create(FDriveView);  FTimer.Enabled := False;  FTimer.Interval := 200;  FTimer.OnTimer := Timer;  FWindowHandle := AllocateHWnd(WndProc);end;destructor TSubDirReaderThread.Destroy;  procedure DestroyScheduleList(List: TEnumerable<TSubDirReaderSchedule>);  var    Schedule: TSubDirReaderSchedule;  begin    for Schedule in List do    begin      if not Schedule.Deleted then        TNodeData(Schedule.Node.Data).Schedule := nil;      Schedule.Free;    end;    List.Destroy;  end;begin  inherited;  DeallocateHWnd(FWindowHandle);  DestroyScheduleList(FQueue);  DestroyScheduleList(FResults);  CloseHandle(FEvent);  FTimer.Destroy;  FSection.Destroy;end;procedure TSubDirReaderThread.WndProc(var Msg: TMessage);begin  if Msg.Msg = WM_USER_SUBDIRREADER then    ScheduleProcess  else    Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);end;procedure TSubDirReaderThread.Process;var  Started: DWORD;  Elapsed: Integer;  Later: Boolean;begin  Started := GetTickCount;  Later := False;  while (not Later) and ProcessResult do  begin    Elapsed := GetTickCount - Started;    Later := (Elapsed < 0) or (Elapsed > 20);  end;  if not Later then    FTimer.Enabled := False;end;procedure TSubDirReaderThread.Timer(Sender: TObject);begin  Process;end;procedure TSubDirReaderThread.Add(Node: TTreeNode; Path: string);var  NodeData: TNodeData;  Schedule: TSubDirReaderSchedule;begin  if Suspended then    Resume;  FSection.Enter;  try    NodeData := TNodeData(Node.Data);    Assert(not Assigned(NodeData.Schedule));    Schedule := TSubDirReaderSchedule.Create;    Schedule.Node := Node;    Schedule.Path := Path;    Schedule.Deleted := False;    Schedule.Processed := False;    FQueue.Push(Schedule);    NodeData.Schedule := Schedule;  finally    FSection.Leave;  end;  TriggerEvent;end;procedure TSubDirReaderThread.Delete(Node: TTreeNode);var  NodeData: TNodeData;begin  FSection.Enter;  try    NodeData := TNodeData(Node.Data);    if Assigned(NodeData.Schedule) then    begin      NodeData.Schedule.Deleted := True;      NodeData.Schedule := nil;    end;  finally    FSection.Leave;  end;  TriggerEvent;end;function TSubDirReaderThread.Detach: Integer;  procedure DetachList(List: TEnumerable<TSubDirReaderSchedule>);  var    Schedule: TSubDirReaderSchedule;  begin    for Schedule in List do    begin      if Schedule.Deleted then Schedule.Free        else      begin        Assert(Schedule.Processed = (List = FResults));        Schedule.Node := nil;        Inc(Result);      end;    end;  end;begin  // block thread while handle is being recreated  FSection.Enter;  try    Result := 0;    DetachList(FQueue);    DetachList(FResults);    FQueue.Clear;    FResults.Clear;  except    FSection.Leave;    raise;  end;end;procedure TSubDirReaderThread.Reattach(Count: Integer);var  Node: TTreeNode;  Schedule: TSubDirReaderSchedule;begin  try    if Count > 0 then    begin      Node := FDriveView.Items.GetFirstNode;      while Assigned(Node) do      begin        Schedule := TNodeData(Node.Data).Schedule;        if Assigned(Schedule) then        begin          Assert(not Assigned(Schedule.Node));          Schedule.Node := Node;          if not Schedule.Processed then            FQueue.Push(Schedule)          else            FResults.Enqueue(Schedule);          Assert(Count > 0);          // Can be optimized to stop once Count = 0          Dec(Count);        end;        Node := Node.GetNext;      end;      if Count = 0 then Assert(False); // shut up    end;  finally    FSection.Leave;  end;  TriggerEvent;  ScheduleProcess;end;procedure TSubDirReaderThread.Terminate;begin  inherited;  TriggerEvent;end;procedure TSubDirReaderThread.TriggerEvent;begin  SetEvent(FEvent);end;function TSubDirReaderThread.ProcessResult: Boolean;var  Node: TTreeNode;  NodeData: TNodeData;  Schedule: TSubDirReaderSchedule;begin  FSection.Enter;  try    Result := (FResults.Count > 0);    if Result then    begin      Schedule := FResults.Dequeue;      if not Schedule.Deleted then      begin        Assert(Schedule.Processed);        Node := Schedule.Node;        Node.HasChildren := False;        NodeData := TNodeData(Node.Data);        NodeData.Scanned := not Node.HasChildren; // = True        Assert(NodeData.Schedule = Schedule);        NodeData.Schedule := nil;      end;      Schedule.Free;    end;  finally    FSection.Leave;  end;end;procedure TSubDirReaderThread.ScheduleProcess;begin  // process the first batch immediatelly, to make it more likely that the first seen subdirectories  // will immediatelly show correct status  Process;  FTimer.Enabled := True;end;procedure TSubDirReaderThread.Execute;var  SRec: TSearchRec;  HasSubDirs: Boolean;  NodeData: TNodeData;  Schedule: TSubDirReaderSchedule;  DelayStart, DelayStartStep: Integer;begin  DelayStart := 3000;  DelayStartStep := 100;  while (DelayStart > 0) and (not Terminated) do  begin    Sleep(DelayStartStep);    Dec(DelayStart, DelayStartStep)  end;  while not Terminated do  begin    WaitForSingleObject(FEvent, INFINITE);    while not Terminated do    begin      FSection.Enter;      try        if FQueue.Count = 0 then        begin          Break;        end          else        begin          Schedule := FQueue.Pop;          if Schedule.Deleted then          begin            Schedule.Free;            // Can be optimized to loop within locked critical section until first non-deleted schedule is found            Continue;          end;          Assert(not Schedule.Processed);        end      finally        FSection.Leave;      end;      HasSubDirs := FDriveView.FindFirstSubDir(IncludeTrailingBackslash(Schedule.Path) + '*.*', SRec);      FindClose(SRec);      FSection.Enter;      try        if Schedule.Deleted then        begin          Schedule.Free;        end          else        begin          Schedule.Processed := True;          if not HasSubDirs then // optimization          begin            FResults.Enqueue(Schedule);            if FResults.Count = 1 then              PostMessage(FWindowHandle, WM_USER_SUBDIRREADER, 0, 0);          end            else          begin            // can happen only if the tree handle is just being recreated            if Assigned(Schedule.Node) then            begin              NodeData := TNodeData(Schedule.Node.Data);              NodeData.Schedule := nil;            end;            Schedule.Free;          end;        end;      finally        FSection.Leave;      end;    end;  end;end;  { TDriveTreeNode }// Not sure if this is ever used (possibly only then "assigning" tree view to another instance, what never do).// It is NOT used when recreating a tree view handle - for that a node is serialized and deserialized,// including a pointer to TNodeData. See csRecreating condition in TDriveView.Delete.procedure TDriveTreeNode.Assign(Source: TPersistent);var  SourceData: TNodeData;  NewData: TNodeData;begin  Assert(False);  inherited Assign(Source);  if not Deleting and (Source is TTreeNode) then  begin    SourceData := TNodeData(TTreeNode(Source).Data);    NewData := TNodeData.Create();    NewData.DirName := SourceData.DirName;    NewData.Attr := SourceData.Attr;    NewData.Scanned := SourceData.Scanned;    NewData.Data := SourceData.Data;    NewData.FIsRecycleBin := SourceData.FIsRecycleBin;    NewData.IconEmpty := SourceData.IconEmpty;    TTreeNode(Source).Data := NewData;  end;end;  { TDriveView }constructor TDriveView.Create(AOwner: TComponent);var  Drive: TRealDrive;  ChangeNotifyEntry: TSHChangeNotifyEntry;  Dummy: string;begin  inherited;  FCreating := True;  FDriveStatus := TObjectDictionary<string, TDriveStatus>.Create([doOwnsValues]);  FChangeInterval := MSecsPerSec;  for Drive := FirstDrive to LastDrive do  begin    FDriveStatus.Add(Drive, CreateDriveStatus);  end;  FFileOperator := TFileOperator.Create(Self);  FSubDirReaderThread := TSubDirReaderThread.Create(Self);  FDelayedNodes := TStringList.Create;  FDelayedNodeTimer := TTimer.Create(Self);  UpdateDelayedNodeTimer;  FDelayedNodeTimer.Interval := 250;  FDelayedNodeTimer.OnTimer := DelayedNodeTimer;  FShowVolLabel := True;  FChangeFlag := False;  FLastDir := EmptyStr;  FValidateFlag := False;  FSysColorChangePending := False;  FConfirmDelete := True;  FDirectory := EmptyStr;  FForceRename := False;  FLastRenameName := '';  FRenameNode := nil;  FPrevSelected := nil;  FPrevSelectedIndex := -1;  FChangeTimerSuspended := 0;  FConfirmOverwrite := True;  FLastPathCut := '';  FStartPos.X := -1;  FStartPos.Y := -1;  FDragPos := FStartPos;  FInternalWindowHandle := Classes.AllocateHWnd(InternalWndProc);  // Source: petr.solin 2022-02-25  FChangeNotify := 0;  if SpecialFolderLocation(CSIDL_DESKTOP, Dummy, ChangeNotifyEntry.pidl) then  begin    ChangeNotifyEntry.fRecursive := False;    FChangeNotify :=      SHChangeNotifyRegister(        FInternalWindowHandle, SHCNRF_ShellLevel or SHCNRF_NewDelivery,        SHCNE_RENAMEFOLDER or SHCNE_MEDIAINSERTED or SHCNE_MEDIAREMOVED,        WM_USER_SHCHANGENOTIFY, 1, ChangeNotifyEntry);  end;  with FDragDropFilesEx do  begin    ShellExtensions.DragDropHandler := True;  end;end; {Create}destructor TDriveView.Destroy;var  DriveStatusPair: TDriveStatusPair;begin  if FChangeNotify <> 0 then SHChangeNotifyDeregister(FChangeNotify);  Classes.DeallocateHWnd(FInternalWindowHandle);  for DriveStatusPair in FDriveStatus do  begin    with DriveStatusPair.Value do    begin      if Assigned(DiscMonitor) then        FreeAndNil(DiscMonitor);      if Assigned(ChangeTimer) then        FreeAndNil(ChangeTimer);    end;    UpdateDriveNotifications(DriveStatusPair.Key);  end;  FDriveStatus.Free;  if Assigned(FFileOperator) then    FFileOperator.Free;  FSubDirReaderThread.Free;  Assert(FDelayedNodes.Count = 0);  FreeAndNil(FDelayedNodes);  inherited Destroy;end; {Destroy}function TDriveView.CreateDriveStatus: TDriveStatus;begin  Result := TDriveStatus.Create;  with Result do  begin    Scanned := False;    Verified := False;    RootNode := nil;    RootNodeIndex := -1;    DiscMonitor := nil;    DefaultDir := EmptyStr;    {ChangeTimer: }    ChangeTimer := TTimer.Create(Self);    ChangeTimer.Interval := 0;    ChangeTimer.Enabled := False;    ChangeTimer.OnTimer := ChangeTimerOnTimer;    DriveHandle := INVALID_HANDLE_VALUE;    NotificationHandle := nil;  end;end;procedure TDriveView.DriveRemoving(Drive: string);begin  DriveRemoved(Drive);  TerminateWatchThread(Drive);end;type  PDevBroadcastHdr = ^TDevBroadcastHdr;  TDevBroadcastHdr = record    dbch_size: DWORD;    dbch_devicetype: DWORD;    dbch_reserved: DWORD;  end;  PDevBroadcastVolume = ^TDevBroadcastVolume;  TDevBroadcastVolume = record    dbcv_size: DWORD;    dbcv_devicetype: DWORD;    dbcv_reserved: DWORD;    dbcv_unitmask: DWORD;    dbcv_flags: WORD;  end;  PDEV_BROADCAST_HANDLE = ^DEV_BROADCAST_HANDLE;  DEV_BROADCAST_HANDLE = record    dbch_size       : DWORD;    dbch_devicetype : DWORD;    dbch_reserved   : DWORD;    dbch_handle     : THandle;    dbch_hdevnotify : HDEVNOTIFY  ;    dbch_eventguid  : TGUID;    dbch_nameoffset : LongInt;    dbch_data       : Byte;  end;  PPItemIDList = ^PItemIDList;const  DBT_DEVTYP_HANDLE = $00000006;  DBT_CONFIGCHANGED = $0018;  DBT_DEVICEARRIVAL = $8000;  DBT_DEVICEQUERYREMOVE = $8001;  DBT_DEVICEREMOVEPENDING = $8003;  DBT_DEVICEREMOVECOMPLETE = $8004;  DBT_DEVTYP_VOLUME = $00000002;// WORKAROUND Declaration in Winapi.ShlObj.pas is wrongfunction SHChangeNotification_Lock(hChange: THandle; dwProcId: DWORD;  var PPidls: PPItemIDList; var plEvent: Longint): THANDLE; stdcall;external 'shell32.dll' name 'SHChangeNotification_Lock';procedure TDriveView.InternalWndProc(var Msg: TMessage);var  DeviceType: DWORD;  UnitMask: DWORD;  DeviceHandle: THandle;  Drive: Char;  DriveStatusPair: TDriveStatusPair;  PPIDL: PPItemIDList;  Event: LONG;  Lock: THandle;begin  with Msg do  begin    if Msg = WM_USER_SHCHANGENOTIFY then    begin      Lock := SHChangeNotification_Lock(wParam, lParam, PPIDL, Event);      try        if (Event = SHCNE_RENAMEFOLDER) or // = drive rename           (Event = SHCNE_MEDIAINSERTED) or // also bitlocker drive unlock (also sends SHCNE_UPDATEDIR)           (Event = SHCNE_MEDIAREMOVED) then        begin          ScheduleDriveRefresh;        end;      finally        SHChangeNotification_Unlock(Lock);      end;    end      else    if Msg = WM_DEVICECHANGE then    begin      if (wParam = DBT_CONFIGCHANGED) or         (wParam = DBT_DEVICEARRIVAL) or         (wParam = DBT_DEVICEREMOVECOMPLETE) then      begin        ScheduleDriveRefresh;      end        else      if (wParam = DBT_DEVICEQUERYREMOVE) or         (wParam = DBT_DEVICEREMOVEPENDING) then      begin        DeviceType := PDevBroadcastHdr(lParam)^.dbch_devicetype;        // This is specifically for VeraCrypt.        // For normal drives, see DBT_DEVTYP_HANDLE below        // (and maybe now that we have generic implementation, this specific code for VeraCrypt might not be needed anymore)        if DeviceType = DBT_DEVTYP_VOLUME then        begin          UnitMask := PDevBroadcastVolume(lParam)^.dbcv_unitmask;          Drive := FirstDrive;          while UnitMask > 0 do          begin            if UnitMask and $01 <> 0 then            begin              DriveRemoving(Drive);            end;            UnitMask := UnitMask shr 1;            Drive := Chr(Ord(Drive) + 1);          end;        end          else        if DeviceType = DBT_DEVTYP_HANDLE then        begin          DeviceHandle := PDEV_BROADCAST_HANDLE(lParam)^.dbch_handle;          for DriveStatusPair in FDriveStatus do            if DriveStatusPair.Value.DriveHandle = DeviceHandle then            begin              DriveRemoving(DriveStatusPair.Key);            end;        end;      end;    end      else    if Msg = WM_TIMER then    begin      CancelDriveRefresh;      try        //DriveInfo.Load;        RefreshRootNodes(dsAll or dvdsRereadAllways);        DoRefreshDrives(True);      except        Application.HandleException(Self);      end;    end;    Result := DefWindowProc(FInternalWindowHandle, Msg, wParam, lParam);  end;end;procedure TDriveView.DoRefreshDrives(Global: Boolean);begin  if Assigned(OnRefreshDrives) then    OnRefreshDrives(Self, Global);end;procedure TDriveView.CancelDriveRefresh;begin  KillTimer(FInternalWindowHandle, 1);end;procedure TDriveView.ScheduleDriveRefresh;begin  CancelDriveRefresh;  // Delay refreshing drives for a sec.  // Particularly with CD/DVD drives, if we query display name  // immediately after receiving DBT_DEVICEARRIVAL, we do not get media label.  // Actually one sec does not help usually, but we do not want to wait any longer,  // because we want to add USB drives asap.  // And this problem might be solved now by SHChangeNotifyRegister/SHCNE_RENAMEFOLDER.  SetTimer(FInternalWindowHandle, 1, MSecsPerSec, nil);end;procedure TDriveView.CreateWnd;var  DriveStatus: TDriveStatus;begin  inherited;  if Assigned(PopupMenu) then    PopupMenu.Autopopup := False;  FDragDropFilesEx.SourceEffects := [deCopy, deMove, deLink];  FDragDropFilesEx.TargetEffects := [deCopy, deMove, deLink];  if FPrevSelectedIndex >= 0 then  begin    FPrevSelected := Items[FPrevSelectedIndex];    FPrevSelectedIndex := -1;  end;  for DriveStatus in FDriveStatus.Values do    with DriveStatus do    begin      if RootNodeIndex >= 0 then      begin        RootNode := Items[RootNodeIndex];        RootNodeIndex := -1;      end;    end;  UpdateDelayedNodeTimer;end; {CreateWnd}procedure TDriveView.DestroyWnd;var  DriveStatus: TDriveStatus;  I: Integer;begin  FDelayedNodeTimer.Enabled := False;  for I := 0 to FDelayedNodes.Count - 1 do    FDelayedNodes.Objects[I] := nil;  if not (csRecreating in ControlState) then  begin    FSubDirReaderThread.Terminate;    FSubDirReaderThread.WaitFor;  end    else  if CreateWndRestores and (Items.Count > 0) then  begin    FPrevSelectedIndex := -1;    if Assigned(FPrevSelected) then    begin      FPrevSelectedIndex := FPrevSelected.AbsoluteIndex;      FPrevSelected := nil;    end;    for DriveStatus in FDriveStatus.Values do      with DriveStatus do      begin        RootNodeIndex := -1;        if Assigned(RootNode) then        begin          RootNodeIndex := RootNode.AbsoluteIndex;          RootNode := nil;        end;      end;  end;  inherited;end;function TDriveView.NodeColor(Node: TTreeNode): TColor;begin  Result := clDefaultItemColor;  with TNodeData(Node.Data) do    if not Node.Selected then    begin      {Colored display of compressed directories:}      if (Attr and FILE_ATTRIBUTE_COMPRESSED) <> 0 then      begin        if SupportsDarkMode and DarkMode then Result := clSkyBlue          else Result := clBlue;      end        else      {Dimmed display, if hidden-atrribut set:}      if FDimmHiddenDirs and ((Attr and FILE_ATTRIBUTE_HIDDEN) <> 0) then          Result := clGrayText    end;end;function TDriveView.GetCustomDirView: TCustomDirView;begin  Result := DirView;end;procedure TDriveView.SetCustomDirView(Value: TCustomDirView);begin  DirView := Value as TDirView;end;function TDriveView.NodePath(Node: TTreeNode): string;var  ParentNode: TTreeNode;begin  if not Assigned(Node) then    raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDirPath']));  Result := GetDirName(Node);  Node := Node.Parent;  while Assigned(Node) do  begin    ParentNode := Node.Parent;    if Assigned(ParentNode) then      Result := GetDirName(Node) + '\' + Result    else      Result := GetDirName(Node) + Result;    Node := ParentNode;  end;  if IsRootPath(Result) then    Result := ExcludeTrailingBackslash(Result);end;{NodePathName: Returns the complete path to Node with trailing backslash on rootnodes: C:\ ,C:\WINDOWS, C:\WINDOWS\SYSTEM  }function TDriveView.NodePathName(Node: TTreeNode): string;begin  Result := NodePath(Node);  if IsRootPath(Result) then    Result := IncludeTrailingBackslash(Result);end; {NodePathName}function TDriveView.NodeIsRecycleBin(Node: TTreeNode): Boolean;begin  Result := TNodeData(Node.Data).IsRecycleBin;end;function TDriveView.NodePathExists(Node: TTreeNode): Boolean;begin  Result := DirectoryExists(ApiPath(NodePathName(Node)));end;function TDriveView.CanEdit(Node: TTreeNode): Boolean;begin  Result := inherited CanEdit(Node) or FForceRename;  if Result then  begin    Result := Assigned(Node.Parent) and      (not TNodeData(Node.Data).IsRecycleBin) and      (not ReadOnly) and      (FDragDropFilesEx.DragDetectStatus <> ddsDrag) and      ((TNodeData(Node.Data).Attr and (faReadOnly or faSysFile)) = 0) and      (UpperCase(Node.Text) = UpperCase(GetDirName(Node)));  end;  FForceRename := False;end; {CanEdit}procedure TDriveView.Edit(const Item: TTVItem);var  Node: TTreeNode;  Info: string;  i: Integer;begin  Node := GetNodeFromHItem(Item);  if (Length(Item.pszText) > 0) and (Item.pszText <> Node.Text) then  begin    if StrContains(coInvalidDosChars, Item.pszText) then    begin      Info := coInvalidDosChars;      for i := Length(Info) downto 1 do        System.Insert(Space, Info, i);      if Length(Item.pszText) > 0 then        raise EInvalidDirName.Create(SErrorInvalidName + Space + Info);      Exit;    end;    StopWatchThread;    if Assigned(DirView) then      DirView.StopWatchThread;    with FFileOperator do    begin      Flags := FileOperatorDefaultFlags + [foNoConfirmation];      Operation := foRename;      OperandFrom.Clear;      OperandTo.Clear;      OperandFrom.Add(NodePath(Node));      OperandTo.Add(IncludeTrailingBackslash(NodePath(Node.Parent)) + Item.pszText);    end;    try      if FFileOperator.Execute then      begin        Node.Text := Item.pszText;        TNodeData(Node.Data).DirName := Item.pszText;        SortChildren(Node.Parent, False);        inherited;      end        else      begin        if FileOrDirExists(IncludeTrailingBackslash(NodePath(Node.Parent)) + Item.pszText) then          Info := SErrorRenameFileExists + Item.pszText        else          Info := SErrorRenameFile + Item.pszText;        MessageBeep(MB_ICONHAND);        if MessageDlg(FormatLastOSError(Info), mtError, [mbOK, mbAbort], 0) = mrOK then        begin          FLastRenameName := Item.pszText;          FRenameNode := Node;          PostMessage(Self.Handle, WM_USER_RENAME, 0, 0);        end;      end;    finally      StartWatchThread;      if Assigned(DirView) then      begin        DirView.Reload2;        DirView.StartWatchThread;      end;    end;  end;end; {Edit}procedure TDriveView.WMUserRename(var Message: TMessage);begin  if Assigned(FRenameNode) then  begin    FForceRename := True;    TreeView_EditLabel(Handle, FRenameNode.ItemID);    SetWindowText(TreeView_GetEditControl(Self.Handle), PChar(FLastRenameName));    FRenameNode := nil;  end;end; {WMUserRename}function TDriveView.CanExpand(Node: TTreeNode): Boolean;var  SubNode: TTreeNode;  Drive: string;  SaveCursor: TCursor;begin  Result := inherited CanExpand(Node);  Drive := GetDriveToNode(Node);  if Node.HasChildren then  begin    if (not Assigned(Node.Parent)) and       (not GetDriveStatus(Drive).Scanned) and       DriveInfo.IsFixedDrive(Drive) then    begin      SubNode := Node.GetFirstChild;      if not Assigned(SubNode) then      begin        ScanDrive(Drive);        SubNode := Node.GetFirstChild;        Node.HasChildren := Assigned(SubNode);        Result := Node.HasChildren;        if not Assigned(GetDriveStatus(Drive).DiscMonitor) then          CreateWatchThread(Drive);      end;    end      else    begin      SaveCursor := Screen.Cursor;      Screen.Cursor := crHourGlass;      try        if (not TNodeData(Node.Data).Scanned) and DoScanDir(Node) then        begin          ReadSubDirs(Node);        end;      finally        Screen.Cursor := SaveCursor;      end;    end;  end;end; {CanExpand}procedure TDriveView.GetImageIndex(Node: TTreeNode);begin  if TNodeData(Node.Data).IconEmpty then    SetImageIndex(Node);  inherited;end; {GetImageIndex}procedure TDriveView.Loaded;begin  inherited;  {Create the drive nodes:}  RefreshRootNodes(dsDisplayName or dvdsFloppy);  {Set the initial directory:}  if (Length(FDirectory) > 0) and DirectoryExists(ApiPath(FDirectory)) then    Directory := FDirectory;  FCreating := False;end; {Loaded}function TDriveView.CreateNode: TTreeNode;begin  Result := TDriveTreeNode.Create(Items);end;procedure TDriveView.Delete(Node: TTreeNode);var  NodeData: TNodeData;begin  if Node = FPrevSelected then    FPrevSelected := nil;  NodeData := nil;  if Assigned(Node) and Assigned(Node.Data) then    NodeData := TNodeData(Node.Data);  Node.Data := nil;  inherited;  if Assigned(NodeData) and not (csRecreating in ControlState) then  begin    FSubDirReaderThread.Delete(Node);    if Assigned(NodeData.DelayedExclude) then    begin      CancelDelayedNode(Node);      FDelayedNodes.Delete(FDelayedNodes.IndexOfObject(Node));      UpdateDelayedNodeTimer;    end;    NodeData.Destroy;  end;end; {OnDelete}procedure TDriveView.KeyPress(var Key: Char);begin  inherited;  if Assigned(Selected) then  begin    if Pos(Key, coInvalidDosChars) <> 0 then    begin      Beep;      Key := #0;    end;  end;end; {KeyPress}function TDriveView.CanChange(Node: TTreeNode): Boolean;var  Path: string;  Drive: string;begin  Result := inherited CanChange(Node);  if not Reading and not (csRecreating in ControlState) then  begin    if Result and Assigned(Node) then    begin      Path := NodePathName(Node);      if Path <> FLastDir then      begin        Drive := DriveInfo.GetDriveKey(Path);        DriveInfo.ReadDriveStatus(Drive, dsSize or dsImageIndex);        if not DriveInfo.Get(Drive).DriveReady then        begin          MessageDlg(Format(SDriveNotReady, [Drive]), mtError, [mbOK], 0);          Result := False;        end          else        try          CheckCanOpenDirectory(Path);        except          Application.HandleException(Self);          Result := False;        end;      end;    end;    if Result and (csDestroying in ComponentState) then    begin      Result := False;    end;    if Result and       (not FCanChange) and       Assigned(Node) and       Assigned(Node.Data) and       Assigned(Selected) and       Assigned(Selected.Data) then    begin      DropTarget := Node;      Result := False;    end      else    begin      DropTarget := nil;    end;  end;end; {CanChange}procedure TDriveView.Change(Node: TTreeNode);var  Drive: string;  OldSerial: DWORD;  NewDir: string;  PrevDrive: string;begin  if not Reading and not (csRecreating in ControlState) then  begin    if Assigned(Node) then    begin      NewDir := NodePathName(Node);      if NewDir <> FLastDir then      begin        Drive := DriveInfo.GetDriveKey(NewDir);        if Length(FLastDir) > 0 then          PrevDrive := DriveInfo.GetDriveKey(FLastDir)        else          PrevDrive := '';        FChangeFlag := True;        FLastDir := NewDir;        OldSerial := DriveInfo.Get(Drive).DriveSerial;        DriveInfo.ReadDriveStatus(Drive, dsSize or dsImageIndex);        with DriveInfo.Get(Drive) do        begin          if Assigned(FDirView) and (FDirView.Path <> NewDir) then            FDirView.Path := NewDir;          if DriveReady then          begin            if not DirectoryExists(ApiPath(NewDir)) then            begin              ValidateDirectory(GetDriveStatus(Drive).RootNode);              Exit;            end;            GetDriveStatus(Drive).DefaultDir := IncludeTrailingBackslash(NewDir);            if PrevDrive <> Drive then            begin              if (PrevDrive <> '') and                 (DriveInfo.Get(PrevDrive).DriveType = DRIVE_REMOVABLE) then              begin                TerminateWatchThread(PrevDrive);              end;              {Drive serial has changed or is missing: allways reread the drive:}              if (DriveSerial <> OldSerial) or (DriveSerial = 0) then              begin                if TNodeData(GetDriveStatus(Drive).RootNode.Data).Scanned then                  ScanDrive(Drive);              end;            end;            StartWatchThread;          end            else  {Drive not ready:}          begin            GetDriveStatus(Drive).RootNode.DeleteChildren;            GetDriveStatus(Drive).DefaultDir := EmptyStr;          end;        end;      end;      if (not Assigned(FPrevSelected)) or (not FPrevSelected.HasAsParent(Node)) then        Node.Expand(False);      FPrevSelected := Node;      ValidateCurrentDirectoryIfNotMonitoring;    end;  end;  inherited;end; {Change}procedure TDriveView.SetImageIndex(Node: TTreeNode);var  FileInfo: TShFileInfo;  Drive, NodePath: string;begin  if Assigned(Node) and TNodeData(Node.Data).IconEmpty then  begin    NodePath := NodePathName(Node);    Drive := DriveInfo.GetDriveKey(NodePath);    if not Assigned(Node.Parent) then    begin      with DriveInfo.Get(Drive) do      begin        if ImageIndex = 0 then        begin          DriveInfo.ReadDriveStatus(Drive, dsImageIndex);          Node.ImageIndex := DriveInfo.Get(Drive).ImageIndex;        end          else Node.ImageIndex := ImageIndex;        Node.SelectedIndex := Node.ImageIndex;      end;    end      else    begin      if DriveInfo.Get(Drive).DriveType = DRIVE_REMOTE then      begin        Node.ImageIndex := StdDirIcon;        Node.SelectedIndex := StdDirSelIcon;      end        else      begin        try          SHGetFileInfo(PChar(NodePath), 0, FileInfo, SizeOf(FileInfo),            SHGFI_SYSICONINDEX or SHGFI_SMALLICON);          if (FileInfo.iIcon < Images.Count) and (FileInfo.iIcon > 0) then          begin            Node.ImageIndex := FileInfo.iIcon;            SHGetFileInfo(PChar(NodePath), 0, FileInfo, SizeOf(FileInfo),              SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_OPENICON);            Node.SelectedIndex := FileInfo.iIcon;          end            else          begin            Node.ImageIndex := StdDirIcon;            Node.SelectedIndex := StdDirSelIcon;          end;        except          Node.ImageIndex := StdDirIcon;          Node.SelectedIndex := StdDirSelIcon;        end;      end;    end;  end; {IconEmpty}  TNodeData(Node.Data).IconEmpty := False;end; {SetImageIndex}function TDriveView.GetDriveText(Drive: string): string;begin  if FShowVolLabel and (Length(DriveInfo.GetPrettyName(Drive)) > 0) then  begin    case FVolDisplayStyle of      doPrettyName:  Result := DriveInfo.GetPrettyName(Drive);      doDisplayName: Result := DriveInfo.GetDisplayName(Drive);    end; {Case}  end    else  begin    Result := DriveInfo.GetSimpleName(Drive);  end;end; {GetDriveText}function CompareDrive(List: TStringList; Index1, Index2: Integer): Integer;var  Drive1, Drive2: string;  RealDrive1, RealDrive2: Boolean;begin  Drive1 := List[Index1];  Drive2 := List[Index2];  RealDrive1 := DriveInfo.IsRealDrive(Drive1);  RealDrive2 := DriveInfo.IsRealDrive(Drive2);  if RealDrive1 = RealDrive2 then  begin    Result := CompareText(Drive1, Drive2);  end    else  if RealDrive1 and (not RealDrive2) then  begin    Result := -1;  end    else  begin    Result := 1;  end;end;function TDriveView.GetDrives: TStrings;var  DriveStatusPair: TDriveStatusPair;  Drives: TStringList;begin  Drives := TStringList.Create;  { We could iterate only .Keys here, but that crashes IDE for some reason }  for DriveStatusPair in FDriveStatus do  begin    Drives.Add(DriveStatusPair.Key);  end;  Drives.CustomSort(CompareDrive);  Result := Drives;end;procedure TDriveView.DriveRemoved(Drive: string);var  NewDrive: Char;begin  if (Directory <> '') and (Directory[1] = Drive) then  begin    if DriveInfo.IsRealDrive(Drive) then NewDrive := Drive[1]      else NewDrive := SystemDrive;    repeat      if NewDrive < SystemDrive then NewDrive := SystemDrive        else      if NewDrive = SystemDrive then NewDrive := LastDrive        else Dec(NewDrive);      DriveInfo.ReadDriveStatus(NewDrive, dsSize or dsImageIndex);      if NewDrive = Drive then      begin        Break;      end;      if DriveInfo.Get(NewDrive).Valid and DriveInfo.Get(NewDrive).DriveReady and Assigned(GetDriveStatus(NewDrive).RootNode) then      begin        Directory := NodePathName(GetDriveStatus(NewDrive).RootNode);        break;      end;    until False;    if not Assigned(Selected) then    begin      Directory := NodePathName(GetDriveStatus(SystemDrive).RootNode);    end;  end;end;procedure TDriveView.RefreshRootNodes(dsFlags: Integer);var  Drives: TStrings;  NewText: string;  SaveCursor: TCursor;  WasValid: Boolean;  NodeData: TNodeData;  DriveStatus: TDriveStatus;  NextDriveNode: TTreeNode;  Index: Integer;  Drive: string;begin  SaveCursor := Screen.Cursor;  Screen.Cursor := crHourGlass;  Drives := nil;  try    Drives := GetDrives;    NextDriveNode := nil;    for Index := Drives.Count - 1 downto 0 do    begin      Drive := Drives[Index];      DriveStatus := GetDriveStatus(Drive);      if ((dsFlags and dvdsFloppy) <> 0) or DriveInfo.IsFixedDrive(Drive) then      begin        with DriveInfo.Get(Drive) do        begin          WasValid := Assigned(DriveStatus.RootNode);        end;        if ((dsFlags and dvdsReReadAllways) = 0) and           (Length(DriveInfo.Get(Drive).DisplayName) > 0) then              dsFlags := dsFlags and (not dsDisplayName);        DriveInfo.ReadDriveStatus(Drive, dsFlags);        with DriveInfo.Get(Drive), DriveStatus do        begin          if Valid then          begin            if not WasValid then            {New drive has arrived: insert new rootnode:}            begin              { Create root directory node }              NodeData := TNodeData.Create;              NodeData.DirName := DriveInfo.GetDriveRoot(Drive);              if Assigned(NextDriveNode) then                RootNode := Items.InsertObject(NextDriveNode, '', NodeData)              else                RootNode := Items.AddObject(nil, '', NodeData);              RootNode.Text := GetDisplayName(RootNode);              RootNode.HasChildren := True;              Scanned := False;              Verified := False;            end              else            if RootNode.ImageIndex <> DriveInfo.Get(Drive).ImageIndex then            begin {WasValid = True}              RootNode.ImageIndex    := DriveInfo.Get(Drive).ImageIndex;              RootNode.SelectedIndex := DriveInfo.Get(Drive).ImageIndex;            end;            if Assigned(RootNode) then            begin              NewText := GetDisplayName(RootNode);              if RootNode.Text <> NewText then                RootNode.Text := NewText;            end;          end            else          if WasValid then          {Drive has been removed => delete rootnode:}          begin            DriveRemoved(Drive);            Scanned := False;            Verified := False;            RootNode.Delete;            RootNode := nil;          end;        end;      end;      if Assigned(DriveStatus.RootNode) then        NextDriveNode := DriveStatus.RootNode;    end;  finally    Screen.Cursor := SaveCursor;    Drives.Free;  end;end; {RefreshRootNodes}procedure TDriveView.AddChildNode(ParentNode: TTreeNode; ParentPath: string; SRec: TSearchRec);var  NewNode: TTreeNode;  NodeData: TNodeData;begin  NodeData := TNodeData.Create;  NodeData.Attr := SRec.Attr;  NodeData.DirName := SRec.Name;  NodeData.FIsRecycleBin :=    (SRec.Attr and faSysFile <> 0) and    (not Assigned(ParentNode.Parent)) and    (SameText(SRec.Name, 'RECYCLED') or     SameText(SRec.Name, 'RECYCLER') or     SameText(SRec.Name, '$RECYCLE.BIN'));  NodeData.Scanned := False;  NewNode := Self.Items.AddChildObject(ParentNode, '', NodeData);  NewNode.Text := GetDisplayName(NewNode);  NewNode.HasChildren := True;  if GetDriveTypeToNode(ParentNode) <> DRIVE_REMOTE then    FSubDirReaderThread.Add(NewNode, IncludeTrailingBackslash(ParentPath) + SRec.Name);end; {AddChildNode}function TDriveView.GetDriveStatus(Drive: string): TDriveStatus;begin  if not FDriveStatus.TryGetValue(Drive, Result) then  begin    Result := CreateDriveStatus;    FDriveStatus.Add(Drive, Result);    RefreshRootNodes(dsAll or dvdsRereadAllways);    DoRefreshDrives(False);  end;end; {GetDriveStatus}function TDriveView.DoScanDir(FromNode: TTreeNode): Boolean;begin  Result := not TNodeData(FromNode.Data).IsRecycleBin;end; {DoScanDir}function TDriveView.DirAttrMask: Integer;begin  Result := faDirectory or faSysFile;  if ShowHiddenDirs then    Result := Result or faHidden;end;procedure TDriveView.ScanDrive(Drive: string);begin {ScanDrive}  with Self.Items do  begin    ValidateDirectory(FindNodeToPath(DriveInfo.GetDriveRoot(Drive)));    GetDriveStatus(Drive).Scanned := True;    GetDriveStatus(Drive).Verified := False;  end;end; {ScanDrive}function TDriveView.DoFindNodeToPath(Path: string; ExistingOnly: Boolean): TTreeNode;var  SelectionHierarchy: array of TTreeNode;  SelectionHierarchyHeight: Integer;  function SearchSubDirs(ParentNode: TTreeNode; Path: string; Level: Integer): TTreeNode; forward;  function ExtractFirstName(S: string): string;  var    I: Integer;  begin    I := Pos('\', S);    if I = 0 then      I := Length(S);    Result := System.Copy(S, 1, I);  end;  function DoSearchSubDirs(ParentNode: TTreeNode; Path: string; Level: Integer): TTreeNode;  var    Node: TTreeNode;    Dir: string;  begin    {Extract first directory from path:}    Dir := ExtractFirstName(Path);    System.Delete(Path, 1, Length(Dir));    if Dir[Length(Dir)] = '\' then      SetLength(Dir, Pred(Length(Dir)));    // Optimization. Avoid iterating possibly thousands of nodes,    // when the node we are looking for is the selected node or its ancestor.    // This is often the case, when navigating under node that has lot of siblings.    // Typically, when navigating in user's profile folder, and there are many [thousands] other user profile folders.    if (SelectionHierarchyHeight > 0) and       // Change of selection might indicate that the tree was rebuilt meanwhile and       // the references in SelectionHierarchy might not be valid anymore       (Selected = SelectionHierarchy[SelectionHierarchyHeight - 1]) and       (Level < SelectionHierarchyHeight) and       (Uppercase(GetDirName(SelectionHierarchy[Level])) = Dir) then    begin      Result := SelectionHierarchy[Level];    end      else    begin      // Paths have diverted      SelectionHierarchyHeight := 0;      Node := ParentNode.GetFirstChild;      if (not Assigned(Node)) and (not ExistingOnly) then      begin        ValidateDirectoryEx(ParentNode, rsRecursiveExisting, True);        Node := ParentNode.GetFirstChild;      end;      Result := nil;      while (not Assigned(Result)) and Assigned(Node) do      begin        if UpperCase(GetDirName(Node)) = Dir then        begin          Result := Node;        end          else        begin          Node := ParentNode.GetNextChild(Node);        end;      end;    end;    if Assigned(Result) and (Length(Path) > 0) then    begin      Result := SearchSubDirs(Result, Path, Level + 1);    end;  end;  function SearchSubDirs(ParentNode: TTreeNode; Path: string; Level: Integer): TTreeNode;  var    ParentPath, SubPath: string;    SRec: TSearchRec;    ParentNodeData: TNodeData;  begin    Result := nil;    if Length(Path) > 0 then    begin      ParentNodeData := TNodeData(ParentNode.Data);      if (not ParentNodeData.Scanned) and (not ExistingOnly) then      begin        ReadSubDirs(ParentNode);      end;      // Factored out of DoSearchSubDirs is remnant of Bug 956 superceded by Bug 1320      Result := DoSearchSubDirs(ParentNode, Path, Level);      if (not Assigned(Result)) and (not ExistingOnly) then      begin        ParentPath := NodePath(ParentNode);        if DirectoryExists(ApiPath(IncludeTrailingBackslash(ParentPath) + Path)) then        begin          SubPath := IncludeTrailingBackslash(ParentPath) + ExcludeTrailingBackslash(ExtractFirstName(Path));          if FindFirstSubDir(SubPath, SRec) then          begin            AddChildNode(ParentNode, ParentPath, SRec);            if Assigned(ParentNodeData.DelayedExclude) then              ParentNodeData.DelayedExclude.Add(SRec.Name);            SortChildren(ParentNode, False);            FindClose(SRec);          end;          Result := DoSearchSubDirs(ParentNode, Path, Level);        end;      end;    end;  end; {SearchSubDirs}var  Drive: string;  P, I: Integer;  RootNode, Node: TTreeNode;begin {FindNodeToPath}  Result := nil;  if Length(Path) < 3 then    Exit;  // Particularly when used by TDirView to delegate browsing to  // hidden drive view, the handle may not be created  HandleNeeded;  Drive := DriveInfo.GetDriveKey(Path);  if (not Assigned(GetDriveStatus(Drive).RootNode)) and     // hidden or possibly recently un-hidden by other drive view (refresh is pending)     (DriveInfo.Get(Drive).Valid or DriveInfo.Get(Drive).ValidButHiddenByDrivePolicy) then  begin    if DriveInfo.Get(Drive).ValidButHiddenByDrivePolicy then      DriveInfo.OverrideDrivePolicy(Drive);    if DriveInfo.Get(Drive).Valid then    begin      CancelDriveRefresh; // cancel a possible pending refresh (see the previous comment)      RefreshRootNodes(dsAll or dvdsRereadAllways); // overkill and is likely already called by GetDriveStatus      DoRefreshDrives(False);    end;  end;  if Assigned(GetDriveStatus(Drive).RootNode) then  begin    if DriveInfo.IsRealDrive(Drive) then    begin      System.Delete(Path, 1, 3);    end      else    if IsUncPath(Path) then    begin      System.Delete(Path, 1, 2);      P := Pos('\', Path);      if P = 0 then      begin        Path := '';      end        else      begin        System.Delete(Path, 1, P);        P := Pos('\', Path);        if P = 0 then        begin          Path := '';        end          else        begin          System.Delete(Path, 1, P);        end;      end;    end      else    begin      raise EConvertError.Create(Format(ErrorInvalidDrive, [Path]))    end;    if Length(Path) > 0 then    begin      if (not GetDriveStatus(Drive).Scanned) and (not ExistingOnly) then      begin        ScanDrive(Drive);      end;      Node := Selected;      RootNode := GetDriveStatus(Drive).RootNode;      if not Assigned(Node) then      begin        SelectionHierarchyHeight := 0;      end        else      begin        SelectionHierarchyHeight := Node.Level + 1;        SetLength(SelectionHierarchy, SelectionHierarchyHeight);        for I := SelectionHierarchyHeight - 1 downto 0 do        begin          SelectionHierarchy[I] := Node;          Node := Node.Parent;        end;        Assert(Selected = SelectionHierarchy[SelectionHierarchyHeight - 1]);        // Different drive - nothing to optimize        if RootNode <> SelectionHierarchy[0] then          SelectionHierarchyHeight := 0;      end;      Result := SearchSubDirs(RootNode, UpperCase(Path), 1);    end      else Result := GetDriveStatus(Drive).RootNode;  end;end; {FindNodetoPath}function TDriveView.FindNodeToPath(Path: string): TTreeNode;begin  Result := DoFindNodeToPath(Path, False);end;function TDriveView.TryFindNodeToPath(Path: string): TTreeNode;begin  Result := DoFindNodeToPath(Path, True);end;function TDriveView.GetSubDir(var SRec: TSearchRec): Boolean;begin  Result := True;  while Result and        ((SRec.Name = '.' ) or         (SRec.Name = '..') or         ((SRec.Attr and faDirectory) = 0)) do  begin    if FindNext(SRec) <> 0 then    begin      Result := False;    end;  end;end;function TDriveView.FindFirstSubDir(Path: string; var SRec: TSearchRec): Boolean;begin  Result := (FindFirstEx(ApiPath(Path), DirAttrMask, SRec, FIND_FIRST_EX_LARGE_FETCH_PAS, FindExSearchLimitToDirectories) = 0);  if Result then  begin    Result := GetSubDir(SRec);    if not Result then FindClose(SRec);  end;end;function TDriveView.FindNextSubDir(var SRec: TSearchRec): Boolean;begin  Result := (FindNext(SRec) = 0) and GetSubDir(SRec);end;function TDriveView.ReadSubDirsBatch(Node: TTreeNode; var SRec: TSearchRec; CheckInterval, Limit: Integer): Boolean;var  Start: TDateTime;  Cont: Boolean;  Path: string;  Count: Integer;  DelayedExclude: TStringList;begin  Start := Now;  Path := NodePath(Node);  Result := True;  Count := 0;  DelayedExclude := TNodeData(Node.Data).DelayedExclude;  // At least from SetDirectory > DoFindNodeToPath and CanExpand, this is not called within BeginUpdate/EndUpdate block.  // But in any case, adding it here makes expanding (which calls CanExpand) noticeably slower, when there are lot of nodes,  // because EndUpdate triggers TVN_GETDISPINFO for all nodes in the tree.  repeat    if (not Assigned(DelayedExclude)) or       (DelayedExclude.IndexOf(SRec.Name) < 0) then    begin      AddChildNode(Node, Path, SRec);      Inc(Count);    end;    Cont := FindNextSubDir(SRec);    // There are two other directory reading loops, where this is not checked    if Cont and       ((Count mod CheckInterval) = 0) and       (Limit > 0) and       (MilliSecondsBetween(Now, Start) > Limit) then    begin      Result := False;      Cont := False;    end  until not Cont;  if Result then    FindClose(Srec);end;procedure TDriveView.DelayedNodeTimer(Sender: TObject);var  Node: TTreeNode;  NodeData: TNodeData;begin  Assert(FDelayedNodes.Count > 0);  if FDelayedNodes.Count > 0 then  begin    // Control was recreated    if not Assigned(FDelayedNodes.Objects[0]) then    begin      FDelayedNodes.Objects[0] := TryFindNodeToPath(FDelayedNodes.Strings[0]);    end;    Node := TTreeNode(FDelayedNodes.Objects[0]);    if not Assigned(Node) then    begin      FDelayedNodes.Delete(0);    end      else    begin      NodeData := TNodeData(Node.Data);      if ReadSubDirsBatch(Node, NodeData.DelayedSrec, 10, 50) then      begin        FreeAndNil(NodeData.DelayedExclude);        FDelayedNodes.Delete(0);        SortChildren(Node, False);      end;    end;  end;  UpdateDelayedNodeTimer;end;procedure TDriveView.UpdateDelayedNodeTimer;begin  FDelayedNodeTimer.Enabled := HandleAllocated and (FDelayedNodes.Count > 0);end;procedure TDriveView.ReadSubDirs(Node: TTreeNode);var  SRec: TSearchRec;  NodeData: TNodeData;  Path: string;  CheckInterval, Limit: Integer;begin  NodeData := TNodeData(Node.Data);  Path := NodePath(Node);  if not FindFirstSubDir(IncludeTrailingBackslash(Path) + '*.*', SRec) then  begin    Node.HasChildren := False;  end    else  begin    CheckInterval := 100;    Limit := DriveViewLoadingTooLongLimit * 1000;    if not Showing then    begin      Limit := Limit div 10;      CheckInterval := CheckInterval div 10;    end;    if not ReadSubDirsBatch(Node, SRec, CheckInterval, Limit) then    begin      NodeData.DelayedSrec := SRec;      NodeData.DelayedExclude := TStringList.Create;      NodeData.DelayedExclude.CaseSensitive := False;      NodeData.DelayedExclude.Sorted := True;      FDelayedNodes.AddObject(Path, Node);      Assert(FDelayedNodes.Count < 20); // if more, something went likely wrong      UpdateDelayedNodeTimer;    end;    SortChildren(Node, False);  end;  NodeData.Scanned := True;  Application.ProcessMessages;end; {ReadSubDirs}procedure TDriveView.CancelDelayedNode(Node: TTreeNode);var  NodeData: TNodeData;begin  NodeData := TNodeData(Node.Data);  FindClose(NodeData.DelayedSrec);  FreeAndNil(NodeData.DelayedExclude);end;procedure TDriveView.DeleteNode(Node: TTreeNode);var  ValidNode: TTreeNode;begin  if Assigned(Selected) and Assigned(Node.Parent) and     ((Selected = Node) or Selected.HasAsParent(Node)) then  begin    ValidNode := Node.Parent;    while (not NodePathExists(ValidNode)) and Assigned(ValidNode.Parent) do      ValidNode := ValidNode.Parent;    Selected := ValidNode;  end;  if DropTarget = Node then    DropTarget := nil;  Node.Delete;end;function TDriveView.CallBackValidateDir(var Node: TTreeNode; Data: Pointer): Boolean;var  WorkNode: TTreeNode;  DelNode: TTreeNode;  SRec: TSearchRec;  SrecList: TStringList;  SubDirList: TStringList;  R: Boolean;  Index: Integer;  NewDirFound: Boolean;  ParentDir: string;  NodeData: TNodeData;  ScanDirInfo: PScanDirInfo;begin {CallBackValidateDir}  Result := True;  if (not Assigned(Node)) or (not Assigned(Node.Data)) then    Exit;  NewDirFound := False;  ScanDirInfo := PScanDirInfo(Data);  {Check, if directory still exists: (but not with root directory) }  if Assigned(Node.Parent) and (ScanDirInfo^.StartNode = Node) and     (not NodePathExists(Node)) then  begin    DeleteNode(Node);    Node := nil;    Exit;  end;  WorkNode := Node.GetFirstChild;  NodeData := TNodeData(Node.Data);  if NodeData.Scanned and Assigned(WorkNode) then  {if node was already scanned: check wether the existing subnodes are still alive   and add all new subdirectories as subnodes:}  begin    if DoScanDir(Node) then    begin      ParentDir := IncludeTrailingBackslash(NodePath(Node));      {Build list of existing subnodes:}      SubDirList := TStringList.Create;      SubDirList.CaseSensitive := True; // We want to reflect changes in subfolder name case      while Assigned(WorkNode) do      begin        SubDirList.Add(TNodeData(WorkNode.Data).DirName);        WorkNode := Node.GetNextChild(WorkNode);      end;      // Nodes are sorted using natural sorting, while TStringList.Find uses simple sorting      SubDirList.Sort;      SRecList := TStringList.Create;      SRecList.CaseSensitive := True;      R := FindFirstSubDir(ParentDir + '*.*', SRec);      while R do      begin        SrecList.Add(Srec.Name);        if not SubDirList.Find(Srec.Name, Index) then        {Subnode does not exists: add it:}        begin          AddChildNode(Node, ParentDir, SRec);          NewDirFound  := True;        end;        R := FindNextSubDir(Srec);      end;      FindClose(Srec);      Sreclist.Sort;      {Remove not existing subnodes:}      WorkNode := Node.GetFirstChild;      while Assigned(WorkNode) do      begin        if not Assigned(WorkNode.Data) or           not SrecList.Find(TNodeData(WorkNode.Data).DirName, Index) then        begin          DelNode := WorkNode;          WorkNode := Node.GetNextChild(WorkNode);          DeleteNode(DelNode);        end          else        begin          if (SrecList[Index] <> TNodeData(WorkNode.Data).DirName) then          begin            {Case of directory letters has changed:}            TNodeData(WorkNode.Data).DirName := SrecList[Index];            WorkNode.Text := SrecList[Index];          end;          WorkNode := Node.GetNextChild(WorkNode);        end;      end;      SrecList.Free;      SubDirList.Free;      {Sort subnodes:}      if NewDirFound then        SortChildren(Node, False);    end;  end    else  {Node was not already scanned:}  if (ScanDirInfo^.SearchNewDirs or     NodeData.Scanned or     (Node = ScanDirInfo^.StartNode)) and     DoScanDir(Node) then  begin    ReadSubDirs(Node);  end;end; {CallBackValidateDir}procedure TDriveView.RebuildTree;var  Drive: string;begin  for Drive in FDriveStatus.Keys do    with GetDriveStatus(Drive) do      if Assigned(RootNode) and Scanned then        ValidateDirectory(RootNode);end;procedure TDriveView.ValidateCurrentDirectoryIfNotMonitoring;begin  if Assigned(Selected) and     not Assigned(GetDriveStatus(GetDriveToNode(Selected)).DiscMonitor) then  begin    ValidateDirectory(Selected);  end;end;procedure TDriveView.ValidateDirectoryEx(Node: TTreeNode; Recurse: TRecursiveScan;  NewDirs: Boolean);var  Info: PScanDirInfo;  SelDir: string;  SaveCursor: TCursor;  RestartWatchThread: Boolean;  SaveCanChange: Boolean;  CurrentPath: string;  Drive: string;begin  if Assigned(Node) and Assigned(Node.Data) and     (not FValidateFlag) and DoScanDir(Node) then  begin    SelDir := Directory;    SaveCursor := Screen.Cursor;    if Self.Focused and (Screen.Cursor <> crHourGlass) then      Screen.Cursor := crHourGlass;    CurrentPath := NodePath(Node);    Drive := DriveInfo.GetDriveKey(CurrentPath);    if not Assigned(Node.Parent) then      GetDriveStatus(Drive).ChangeTimer.Enabled := False;    RestartWatchThread := WatchThreadActive;    try      if WatchThreadActive then        StopWatchThread;      FValidateFlag := True;      FSysColorChangePending := False;      New(Info);      Info^.StartNode := Node;      Info^.SearchNewDirs := NewDirs;      Info^.DriveType := DriveInfo.Get(Drive).DriveType;      SaveCanChange := FCanChange;      FCanChange := True;      FChangeFlag := False;      Items.BeginUpdate;      try        IterateSubTree(Node, CallBackValidateDir, Recurse, coScanStartNode, Info);      finally        Items.EndUpdate;      end;      FValidateFlag := False;      if (not Assigned(Selected)) and (Length(SelDir) > 0) then        Directory := ExtractFileDrive(SelDir);      if (SelDir <> Directory) and (not FChangeFlag) then        Change(Selected);      FCanChange := SaveCanChange;      Dispose(Info);    finally      if RestartWatchThread and FWatchDirectory and not WatchThreadActive then        StartWatchThread;      if Screen.Cursor <> SaveCursor then        Screen.Cursor := SaveCursor;      if FSysColorChangePending then      begin        FSysColorChangePending := False;        if HandleAllocated then Perform(CM_SYSCOLORCHANGE, 0, 0);      end;    end;  end;end; {ValidateDirectoryEx}function TDriveView.GetDriveTypeToNode(Node: TTreeNode): Integer;begin  Assert(Assigned(Node));  Result := DriveInfo.Get(GetDriveToNode(Node)).DriveType;end; {GetDriveTypeToNode}procedure TDriveView.CreateWatchThread(Drive: string);begin  if csDesigning in ComponentState then    Exit;  if (not Assigned(GetDriveStatus(Drive).DiscMonitor)) and     FWatchDirectory and     (DriveInfo.Get(Drive).DriveType <> DRIVE_REMOTE) then  begin    with GetDriveStatus(Drive) do    begin      DiscMonitor := TDiscMonitor.Create(Self);      DiscMonitor.ChangeDelay := msThreadChangeDelay;      DiscMonitor.SubTree := True;      DiscMonitor.Filters := [moDirName];      DiscMonitor.OnChange := ChangeDetected;      DiscMonitor.OnInvalid := ChangeInvalid;      DiscMonitor.SetDirectory(DriveInfo.GetDriveRoot(Drive));      DiscMonitor.Open;    end;    UpdateDriveNotifications(Drive);  end;end; {CreateWatchThread}procedure TDriveView.SetWatchDirectory(Value: Boolean);begin  if FWatchDirectory <> Value then  begin    FWatchDirectory := Value;    if (not (csDesigning in ComponentState)) and Value then      StartAllWatchThreads    else      StopAllWatchThreads;  end;end; {SetAutoScan}procedure TDriveView.SetDirView(Value: TDirView);begin  if Assigned(FDirView) then    FDirView.DriveView := nil;  FDirView := Value;  if Assigned(FDirView) then    FDirView.DriveView := Self;end; {SetDirView}function TDriveView.NodeWatched(Node: TTreeNode): Boolean;var  Drive: string;begin  Drive := GetDriveToNode(Node);  Result := WatchThreadActive(Drive);end; {NodeWatched}procedure TDriveView.ChangeInvalid(Sender: TObject; const Directory: string;  const ErrorStr: string);var  Drive: string;begin  Drive := DriveInfo.GetDriveKey((Sender as TDiscMonitor).Directories[0]);  with GetDriveStatus(Drive) do  begin    DiscMonitor.Close;  end;  UpdateDriveNotifications(Drive);end; {DirWatchChangeInvalid}procedure TDriveView.ChangeDetected(Sender: TObject; const Directory: string;  var SubdirsChanged: Boolean);var  DirChanged: string;begin  if Sender is TDiscMonitor then  begin    DirChanged := (Sender as TDiscMonitor).Directories[0];    if Length(DirChanged) > 0 then    begin      with GetDriveStatus(DriveInfo.GetDriveKey(DirChanged)) do      begin        ChangeTimer.Interval := 0;        ChangeTimer.Interval := FChangeInterval;        ChangeTimer.Enabled  := True;      end;    end;  end;end; {DirWatchChangeDetected}procedure TDriveView.ChangeTimerOnTimer(Sender: TObject);var  DriveStatusPair: TDriveStatusPair;begin  if (FChangeTimerSuspended = 0) and (Sender is TTimer) then  begin    for DriveStatusPair in FDriveStatus do    begin      if DriveStatusPair.Value.ChangeTimer = Sender then      begin        // Messages are processed during ValidateDirectory, so we may detect another change while        // updating the directory. Prevent the recursion.        // But retry the update afterwards (by reenabling the timer in ChangeDetected)        SuspendChangeTimer;        try          with DriveStatusPair.Value.ChangeTimer do          begin            Interval := 0;            Enabled := False;          end;          if Assigned(DriveStatusPair.Value.RootNode) then          begin            {Check also collapsed (invisible) subdirectories:}            ValidateDirectory(DriveStatusPair.Value.RootNode);          end;        finally          ResumeChangeTimer;        end;      end;    end;  end;end; {ChangeTimerOnTimer}procedure TDriveView.UpdateDriveNotifications(Drive: string);var  NeedNotifications: Boolean;  Path: string;  DevBroadcastHandle: DEV_BROADCAST_HANDLE;  Size: Integer;begin  if DriveInfo.IsFixedDrive(Drive) then  begin    with GetDriveStatus(Drive) do    begin      NeedNotifications :=        WatchThreadActive(Drive) and        (DriveInfo.Get(Drive).DriveType <> DRIVE_REMOTE) and        DriveInfo.Get(Drive).DriveReady;      if NeedNotifications <> (DriveHandle <> INVALID_HANDLE_VALUE) then      begin        if NeedNotifications then        begin          Path := DriveInfo.GetDriveRoot(Drive);          DriveHandle :=            CreateFile(PChar(Path), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, nil,            OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS or FILE_ATTRIBUTE_NORMAL, 0);          if DriveHandle <> INVALID_HANDLE_VALUE then          begin            Size := SizeOf(DevBroadcastHandle);            ZeroMemory(@DevBroadcastHandle, Size);            DevBroadcastHandle.dbch_size := Size;            DevBroadcastHandle.dbch_devicetype := DBT_DEVTYP_HANDLE;            DevBroadcastHandle.dbch_handle := DriveHandle;            NotificationHandle :=              RegisterDeviceNotification(FInternalWindowHandle, @DevBroadcastHandle, DEVICE_NOTIFY_WINDOW_HANDLE);            if NotificationHandle = nil then            begin              CloseHandle(DriveHandle);              DriveHandle := INVALID_HANDLE_VALUE;            end;          end;        end          else        begin          UnregisterDeviceNotification(NotificationHandle);          NotificationHandle := nil;          CloseHandle(DriveHandle);          DriveHandle := INVALID_HANDLE_VALUE;        end;      end;    end;  end;end;procedure TDriveView.StartWatchThread;var  Drive: string;begin  if (csDesigning in ComponentState) or     not Assigned(Selected) or     not fWatchDirectory then Exit;  Drive := GetDriveToNode(Selected);  with GetDriveStatus(Drive) do  begin    if not Assigned(DiscMonitor) then      CreateWatchThread(Drive);    if Assigned(DiscMonitor) and not DiscMonitor.Enabled then      DiscMonitor.Enabled := True;  end;  UpdateDriveNotifications(Drive);end; {StartWatchThread}procedure TDriveView.StopWatchThread;var  Drive: string;begin  if Assigned(Selected) then  begin    Drive := GetDriveToNode(Selected);    with GetDriveStatus(Drive) do      if Assigned(DiscMonitor) then        DiscMonitor.Enabled := False;    UpdateDriveNotifications(Drive);  end;end; {StopWatchThread}procedure TDriveView.SuspendChangeTimer;begin  Inc(FChangeTimerSuspended);end;procedure TDriveView.ResumeChangeTimer;begin  Assert(FChangeTimerSuspended > 0);  Dec(FChangeTimerSuspended);end;procedure TDriveView.TerminateWatchThread(Drive: string);begin  with GetDriveStatus(Drive) do    if Assigned(DiscMonitor) then    begin      DiscMonitor.Free;      DiscMonitor := nil;    end;  UpdateDriveNotifications(Drive);end; {StopWatchThread}procedure TDriveView.StartAllWatchThreads;var  DriveStatusPair: TDriveStatusPair;  Drive: string;begin  if (csDesigning in ComponentState) or (not FWatchDirectory) then     Exit;  for DriveStatusPair in FDriveStatus do    with DriveStatusPair.Value do      if Scanned then      begin        if not Assigned(DiscMonitor) then          CreateWatchThread(DriveStatusPair.Key);        if Assigned(DiscMonitor) and (not DiscMonitor.Active) then        begin          DiscMonitor.Open;          UpdateDriveNotifications(DriveStatusPair.Key);        end;      end;  if Assigned(Selected) then  begin    Drive := GetDriveToNode(Selected);    if not DriveInfo.IsFixedDrive(Drive) then    begin      StartWatchThread;    end;  end;end; {StartAllWatchThreads}procedure TDriveView.StopAllWatchThreads;var  DriveStatusPair: TDriveStatusPair;begin  if (csDesigning in ComponentState) or (not FWatchDirectory) then     Exit;  for DriveStatusPair in FDriveStatus do    with DriveStatusPair.Value do    begin      if Assigned(DiscMonitor) then      begin        DiscMonitor.Close;        UpdateDriveNotifications(DriveStatusPair.Key);      end;    end;end; {StopAllWatchThreads}function TDriveView.WatchThreadActive(Drive: string): Boolean;begin  Result := FWatchDirectory and    Assigned(GetDriveStatus(Drive).DiscMonitor) and    GetDriveStatus(Drive).DiscMonitor.Active and    GetDriveStatus(Drive).DiscMonitor.Enabled;end; {WatchThreadActive}function TDriveView.WatchThreadActive: Boolean;var  Drive: string;begin  if not Assigned(Selected) then  begin    Result := False;    Exit;  end;  Drive := GetDriveToNode(Selected);  Result := WatchThreadActive(Drive);end; {WatchThreadActive}function TDriveView.FindPathNode(Path: string): TTreeNode;var  PossiblyHiddenPath: string;  Attrs: Integer;begin  if Assigned(FOnNeedHiddenDirectories) and     (not ShowHiddenDirs) and     DirectoryExistsFix(Path) then // do not even bother if the path does not exist  begin    PossiblyHiddenPath := ExcludeTrailingPathDelimiter(Path);    while (PossiblyHiddenPath <> '') and          (not IsRootPath(PossiblyHiddenPath)) do // Drives have hidden attribute    begin      Attrs := FileGetAttr(PossiblyHiddenPath, False);      if (Attrs and faHidden) = faHidden then      begin        if Assigned(FOnNeedHiddenDirectories) then        begin          FOnNeedHiddenDirectories(Self);        end;        Break;      end        else      begin        PossiblyHiddenPath := ExtractFileDir(PossiblyHiddenPath);      end;    end;  end;  {Find existing path or parent path of not existing path:}  repeat    Result := FindNodeToPath(Path);    if not Assigned(Result) then      Path := ExtractFilePath(ExcludeTrailingBackslash(Path));  until Assigned(Result) or (Length(Path) < 3);end;procedure TDriveView.SetDirectory(Value: string);begin  Value := IncludeTrailingBackslash(Value);  FDirectory := Value;  inherited;  if Assigned(Selected) and (not Assigned(Selected.Parent)) then  begin    if not GetDriveStatus(GetDriveToNode(Selected)).Scanned then      ScanDrive(GetDriveToNode(Selected));  end;end; {SetDirectory}function TDriveView.GetDirName(Node: TTreeNode): string;begin  if Assigned(Node) and Assigned(Node.Data) then    Result := TNodeData(Node.Data).DirName  else    Result := '';end; {GetDirName}{GetDrive: returns the drive of the Node.}function TDriveView.GetDriveToNode(Node: TTreeNode): string;var  Path: string;begin  if (not Assigned (Node)) or (not Assigned(Node.Data)) then    raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDrive']));  Path := NodePath(Node);  Result := DriveInfo.GetDriveKey(Path);end; {GetDrive}{RootNode: returns the rootnode to the Node:}function TDriveView.RootNode(Node: TTreeNode): TTreeNode;begin  Result := Node;  if not Assigned(Node) then    raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['RootNode']));  while Assigned(Result.Parent) do    Result := Result.Parent;end; {RootNode}function TDriveView.GetDisplayName(Node: TTreeNode): string;begin  Result := '';  if (not Assigned(Node)) or (not Assigned(Node.Data)) then    raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDisplayName']));  if not Assigned(Node.Parent) then Result := GetDriveText(GetDriveToNode(Node))    else  begin    Result := GetDirName(Node);  end;end; {GetDisplayName}procedure TDriveView.SetShowVolLabel(ShowIt: Boolean);begin  if ShowIt = FShowVolLabel then    Exit;  FShowVolLabel := ShowIt;  RefreshRootNodes(dvdsFloppy);end; {SetShowVolLabel}procedure TDriveView.DisplayContextMenu(Node: TTreeNode; Point: TPoint);var  Verb: string;  DirWatched: Boolean;begin  DirWatched := NodeWatched(Node) and WatchThreadActive;  Assert(Node <> nil);  if Node <> Selected then    DropTarget := Node;  Verb := EmptyStr;  if Assigned(FOnDisplayContextMenu) then    FOnDisplayContextMenu(Self);  ShellDisplayContextMenu(FParentForm.Handle, Point, NodePathName(Node),    CanEdit(Node), Verb, False);  if Verb = shcRename then Node.EditText    else  if Verb = shcCut then  begin    LastClipBoardOperation := cboCut;    LastPathCut := NodePathName(Node);  end    else  if Verb = shcCopy then LastClipBoardOperation := cboCopy    else  if Verb = shcPaste then    PasteFromClipBoard(NodePathName(Node));  DropTarget := nil;  if not DirWatched then    ValidateDirectory(Node);end; {DisplayContextMenu (2)}procedure TDriveView.DisplayPropertiesMenu(Node: TTreeNode);begin  Assert(Assigned(Node));  ShellExecuteContextCommand(FParentForm.Handle, shcProperties, NodePathName(Node));end; {ContextMenu}procedure TDriveView.SetSelected(Node: TTreeNode);begin  if Node <> Selected then  begin    FChangeFlag := False;    FCanChange := True;    inherited Selected := Node;    if not FChangeFlag then      Change(Selected);  end;end; {SetSelected}{Called by TFileDeleteThread, when a file deletion was detected by the D&D receiving application:}procedure TDriveView.SignalDirDelete(Sender: TObject; Files: TStringList);begin  if Files.Count > 0 then    ValidateDirectory(FindNodeToPath(Files[0]));end; {SignalDirDelete}function TDriveView.DDSourceEffects: TDropEffectSet;begin  if not Assigned(FDragNode.Parent) then    Result := [deLink]  else    Result := [deLink, deCopy, deMove];end;procedure TDriveView.DDChooseEffect(KeyState: Integer; var Effect: Integer; PreferredEffect: Integer);begin  if DropTarget = nil then Effect := DROPEFFECT_NONE    else  if (KeyState and (MK_CONTROL or MK_SHIFT) = 0) and (PreferredEffect = 0) then  begin    if FDragDrive <> '' then    begin      if FExeDrag and DriveInfo.IsFixedDrive(GetDriveToNode(DropTarget)) and DriveInfo.IsFixedDrive(FDragDrive) then      begin        Effect := DROPEFFECT_LINK;      end        else      if (Effect = DROPEFFECT_COPY) and         (SameText(FDragDrive, GetDriveToNode(DropTarget)) and           (FDragDropFilesEx.AvailableDropEffects and DROPEFFECT_MOVE <> 0)) then      begin        Effect := DROPEFFECT_MOVE;      end;    end;  end;  inherited;end;function TDriveView.DragCompleteFileList: Boolean;begin  Result := (GetDriveTypeToNode(FDragNode) <> DRIVE_REMOVABLE);end;function TDriveView.DDExecute: TDragResult;var  WatchThreadOK: Boolean;  DragParentPath: string;  DragPath: string;begin  WatchThreadOK := WatchThreadActive;  Result := FDragDropFilesEx.Execute(nil);  if (Result = drMove) and (not WatchThreadOK) then  begin    DragPath := NodePathName(FDragNode);    if Assigned(FDragNode.Parent) then      DragParentPath := NodePathName(FDragNode.Parent)    else      DragParentPath := DragPath;    if Assigned(FDragNode.Parent) or (DragParentPath <> NodePathName(Selected.Parent)) then    begin      FDragNode := FindNodeToPath(DragPath);      if Assigned(FDragNode) then      begin        FDragFileList.Clear;        FDragFileList.Add(DragPath);        TFileDeleteThread.Create(FDragFileList, MaxWaitTimeOut, SignalDirDelete);      end;    end;  end;end;procedure TDriveView.PerformDragDropFileOperation(Node: TTreeNode; Effect: Integer);var  Index: Integer;  SourcePath: string;  SourceParentPath: string;  SourceIsDirectory: Boolean;  SaveCursor: TCursor;  SourceNode, TargetNode: TTreeNode;  TargetPath: string;  IsRecycleBin: Boolean;begin  TargetPath := NodePathName(Node);  IsRecycleBin := NodeIsRecycleBin(Node);  if FDragDropFilesEx.FileList.Count = 0 then    Exit;  SaveCursor := Screen.Cursor;  Screen.Cursor := crHourGlass;  SourcePath := EmptyStr;  try    if (Effect = DROPEFFECT_COPY) or (Effect = DROPEFFECT_MOVE) then    begin      StopAllWatchThreads;      if Assigned(FDirView) then        FDirView.StopWatchThread;      if Assigned(DropSourceControl) and         (DropSourceControl is TDirView) and         (DropSourceControl <> FDirView) then      begin        TDirView(DropSourceControl).StopWatchThread;      end;      if DropFiles(           DragDropFilesEx, Effect, FFileOperator, TargetPath, false, IsRecycleBin, ConfirmDelete, ConfirmOverwrite, False,           Self, OnDDFileOperation, SourcePath, SourceIsDirectory) then      begin        if Assigned(FOnDDFileOperationExecuted) then          FOnDDFileOperationExecuted(Self, Effect, SourcePath, TargetPath);      end;      ClearDragFileList(FDragDropFilesEx.FileList);      // TDirView.PerformDragDropFileOperation validates the SourcePath and that actually seems correct      SourceParentPath := ExtractFilePath(ExcludeTrailingBackslash(SourcePath));    end      else    if Effect = DROPEFFECT_LINK then    { Create Link requested: }    begin      for Index := 0 to FDragDropFilesEx.FileList.Count - 1 do      begin        if not DropLink(PFDDListItem(FDragDropFilesEx.FileList[Index]), TargetPath) then        begin          DDError(DDCreateShortCutError);        end;      end;    end;    if Effect = DROPEFFECT_MOVE then      Items.BeginUpdate;    {Update source directory, if move-operation was performed:}    if ((Effect = DROPEFFECT_MOVE) or IsRecycleBin) then    begin      // See comment in corresponding operation in TDirView.PerformDragDropFileOperation      SourceNode := TryFindNodeToPath(SourceParentPath);      if Assigned(SourceNode) then        ValidateDirectory(SourceNode);    end;    {Update subdirectories of target directory:}    TargetNode := FindNodeToPath(TargetPath);    if Assigned(TargetNode) then      ValidateDirectory(TargetNode)    else      ValidateDirectory(GetDriveStatus(DriveInfo.GetDriveKey(TargetPath)).RootNode);    if Effect = DROPEFFECT_MOVE then      Items.EndUpdate;    {Update linked component TDirView:}    if Assigned(FDirView) and (not FDirView.WatchThreadActive) then    begin      case Effect of        DROPEFFECT_COPY,        DROPEFFECT_LINK:          if (IncludeTrailingBackslash(TargetPath) = IncludeTrailingBackslash(DirView.Path)) then            FDirView.Reload2;        DROPEFFECT_MOVE:          if (IncludeTrailingBackslash(TargetPath) = IncludeTrailingBackslash(DirView.Path)) or             (IncludeTrailingBackslash(SourceParentPath) = IncludeTrailingBackslash(DirView.Path)) then          begin            if FDirView <> DropSourceControl then FDirView.Reload2;          end;      end; {Case}    end;    {Update the DropSource control, if files are moved and it is a TDirView:}    if (Effect = DROPEFFECT_MOVE) and (DropSourceControl is TDirView) then    begin      TDirView(DropSourceControl).ValidateSelectedFiles;    end;  finally    FFileOperator.OperandFrom.Clear;    FFileOperator.OperandTo.Clear;    StartAllWatchThreads;    if Assigned(FDirView) and (not FDirView.WatchThreadActive) then      FDirView.StartWatchThread;    if Assigned(DropSourceControl) and (DropSourceControl is TDirView) and       (not TDirView(DropSourceControl).WatchThreadActive) then      TDirView(DropSourceControl).StartWatchThread;    Screen.Cursor := SaveCursor;  end;end; {PerformDragDropFileOperation}function TDriveView.GetCanUndoCopyMove: Boolean;begin  Result := Assigned(FFileOperator) and FFileOperator.CanUndo;end; {CanUndoCopyMove}function TDriveView.UndoCopyMove: Boolean;var  LastTarget: string;  LastSource: string;begin  Result := False;  if FFileOperator.CanUndo then  begin    Lasttarget := FFileOperator.LastOperandTo[0];    LastSource := FFileOperator.LastOperandFrom[0];    StopAllWatchThreads;    Result := FFileOperator.UndoExecute;    ValidateDirectory(FindNodeToPath(ExtractFilePath(LastTarget)));    ValidateDirectory(FindNodeToPath(ExtractFilePath(LastSource)));    StartAllWatchThreads;    if Assigned(FDirView) then      with FDirView do        if not WatchThreadActive then        begin          if (IncludeTrailingBackslash(ExtractFilePath(LastTarget)) = IncludeTrailingBackslash(Path)) or             (IncludeTrailingBackslash(ExtractFilePath(LastSource)) = IncludeTrailingBackslash(Path)) then            Reload2;        end;      end;end; {UndoCopyMove}{Clipboard operations:}procedure TDriveView.SetLastPathCut(Path: string);var  Node: TTreeNode;begin  if FLastPathCut <> Path then  begin    Node := FindNodeToPath(FLastPathCut);    if Assigned(Node) then    begin      FLastPathCut := Path;      Node.Cut := False;    end;    Node := FindNodeToPath(Path);    if Assigned(Node) then    begin      FLastPathCut := Path;      Node.Cut := True;    end;  end;end; {SetLastNodeCut}procedure TDriveView.EmptyClipboard;begin  if Windows.OpenClipBoard(0) then  begin    Windows.EmptyClipBoard;    Windows.CloseClipBoard;    LastPathCut := '';    LastClipBoardOperation := cboNone;    if Assigned(FDirView) then      FDirView.EmptyClipboard;  end;end; {EmptyClipBoard}function TDriveView.CopyToClipBoard(Node: TTreeNode): Boolean;begin  Result := Assigned(Selected);  if Result then  begin    EmptyClipBoard;    ClearDragFileList(FDragDropFilesEx.FileList);    AddToDragFileList(FDragDropFilesEx.FileList, Selected);    Result := FDragDropFilesEx.CopyToClipBoard;    LastClipBoardOperation := cboCopy;  end;end; {CopyToClipBoard}function TDriveView.CutToClipBoard(Node: TTreeNode): Boolean;begin  Result := Assigned(Node) and Assigned(Node.Parent) and CopyToClipBoard(Node);  if Result then  begin    LastPathCut := NodePathName(Node);    LastClipBoardOperation := cboCut;  end;end; {CutToClipBoard}function TDriveView.CanPasteFromClipBoard: Boolean;begin  Result := False;  if Assigned(Selected) and Windows.OpenClipboard(0) then  begin    Result := IsClipboardFormatAvailable(CF_HDROP);    Windows.CloseClipBoard;  end;end; {CanPasteFromClipBoard}function TDriveView.PasteFromClipBoard(TargetPath: String = ''): Boolean;begin  ClearDragFileList(FDragDropFilesEx.FileList);  Result := False;  if CanPasteFromClipBoard and {MP}FDragDropFilesEx.GetFromClipBoard{/MP}    then  begin    if TargetPath = '' then      TargetPath := NodePathName(Selected);    case LastClipBoardOperation of      cboCopy,      cboNone:        begin          PerformDragDropFileOperation(Selected, DROPEFFECT_COPY);          if Assigned(FOnDDExecuted) then            FOnDDExecuted(Self, DROPEFFECT_COPY);        end;      cboCut:        begin          PerformDragDropFileOperation(Selected, DROPEFFECT_MOVE);          if Assigned(FOnDDExecuted) then            FOnDDExecuted(Self, DROPEFFECT_MOVE);          EmptyClipBoard;        end;    end;    Result := True;  end;end; {PasteFromClipBoard}procedure TDriveView.CMRecreateWnd(var Msg: TMessage);var  ScheduledCount: Integer;begin  ScheduledCount := FSubDirReaderThread.Detach;  try    inherited;  finally    FSubDirReaderThread.Reattach(ScheduledCount);  end;end;procedure TDriveView.CMSysColorChange(var Message: TMessage);begin  if not FValidateFlag then  begin    inherited;  end    else  begin    // Do not recreate the handle, if we are just iterating nodes, at that invalidates the node objects.    // This is not perfect, as the handle can be recreated for other reasons.    // But system color change is by far the most common case.    FSysColorChangePending := True;  end;end;end.
 |