winscp/source/packages/filemng/DriveView.pas

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

{$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;

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
  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);
    function DetachList(List: TEnumerable<TSubDirReaderSchedule>): Integer;
    procedure DestroyScheduleList(List: TEnumerable<TSubDirReaderSchedule>);
  end;

  TTreeNodeArray = array of TTreeNode;

  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;
    FPrevSelected: TTreeNode;
    FPrevSelectedIndex: Integer;
    FChangeTimerSuspended: Integer;
    FSubDirReaderThread: TSubDirReaderThread;
    FDelayedNodes: TStringList;
    FDelayedNodeTimer: TTimer;
    FRecreateScheduledCount: Integer;

    // Additional events:
    FOnDisplayContextMenu: TNotifyEvent;
    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;
    function DoSearchSubDirs(
      ParentNode: TTreeNode; Path: string; Level: Integer; ExistingOnly: Boolean;
      var SelectionHierarchy: TTreeNodeArray; var SelectionHierarchyHeight: Integer): TTreeNode;
    function SearchSubDirs(
      ParentNode: TTreeNode; Path: string; Level: Integer; ExistingOnly: Boolean;
      var SelectionHierarchy: TTreeNodeArray; var SelectionHierarchyHeight: Integer): TTreeNode;

    // 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 SubscribeDriveNotifications(Drive: string);
    procedure DriveRemoved(Drive: string);
    procedure DriveRemoving(Drive: string);
    procedure RefreshRootNodes(Floppy: Boolean = False);
    procedure DriveNotification(Notification: TDriveNotification; Drive: string);

    function DirAttrMask: Integer;
    function CreateDriveStatus: TDriveStatus;

    procedure ValidateDirectoryEx(Node: TTreeNode; Recurse: TRecursiveScan;
      NewDirs: Boolean); override;
    procedure RebuildTree; override;

    procedure CreateWnd; override;
    procedure DestroyWnd; override;
    procedure Edit(const Item: TTVItem); override;

    procedure WMUserRename(var Message: TMessage); message WM_USER_RENAME;
    procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;

    function GetCustomDirView: TCustomDirView; override;
    procedure SetCustomDirView(Value: TCustomDirView); override;

    function NodePath(Node: TTreeNode): string; 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;

    function CanPasteFromClipBoard: Boolean;
    procedure PasteFromClipBoard(Node: TTreeNode);
    procedure PerformDragDropFileOperation(Node: TTreeNode; Effect: Integer); override;
    procedure ClearCutState;

  public
    property Images;
    property StateImages;
    property Items stored False;
    property Selected Write SetSelected stored False;

    property DragImageList: TDragImageList read FDragImageList;

    procedure EmptyClipboard; dynamic;
    procedure EmptyClipboardIfCut; 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;

    // Node handling:
    procedure SetImageIndex(Node: TTreeNode); virtual;
    function FindNodeToPath(Path: string): TTreeNode; override;
    function TryFindNodeToPath(Path: string): TTreeNode; override;
    function RootNode(Node: TTreeNode): TTreeNode;
    function GetDirName(Node: TTreeNode): string;
    function GetDisplayName(Node: TTreeNode): string;
    function NodePathName(Node: TTreeNode): string; override;
    function NodeIsRecycleBin(Node: TTreeNode): Boolean; override;
    procedure DirHasNoChildren(Path: 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; override;
    procedure StopWatchThread; override;
    procedure SuspendChangeTimer; override;
    procedure ResumeChangeTimer; override;
    procedure StartAllWatchThreads;
    procedure StopAllWatchThreads;
    procedure ValidateCurrentDirectoryIfNotMonitoring; override;

    (* 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 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;

implementation

uses
  PasTools, UITypes, SyncObjs, IOUtils, System.DateUtils;

const
  msThreadChangeDelay = 50;

  ErrorNodeNA = '%s: Node not assigned';

  WM_USER_SUBDIRREADER = WM_USER_SHCHANGENOTIFY + 1;

procedure Register;
begin
  RegisterComponents('DriveDir', [TDriveView]);
end;

constructor TNodeData.Create;
begin
  inherited;

  FAttr := 0;
  FScanned := False;
  FDirName := '';
  FIsRecycleBin := False;
  FIconEmpty := True;
  FSchedule := nil;
  DelayedExclude := nil;
end;

destructor TNodeData.Destroy;
begin
  Assert(not Assigned(FSchedule));
  SetLength(FDirName, 0);
  inherited;
end;

// 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;

procedure TSubDirReaderThread.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;

destructor TSubDirReaderThread.Destroy;
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.DetachList(List: TEnumerable<TSubDirReaderSchedule>): Integer;
var
  Schedule: TSubDirReaderSchedule;
begin
  Result := 0;
  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;

function TSubDirReaderThread.Detach: Integer;
begin
  // block thread while handle is being recreated
  FSection.Enter;
  try
    Result :=
      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 when "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;
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;
  FRecreateScheduledCount := -1;

  FConfirmOverwrite := True;
  FLastPathCut := '';
  FStartPos.X := -1;
  FStartPos.Y := -1;
  FDragPos := FStartPos;

  DriveInfo.AddHandler(DriveNotification);

  FDragDropFilesEx.ShellExtensions.DragDropHandler := True;
end; // Create

destructor TDriveView.Destroy;
var
  DriveStatusPair: TDriveStatusPair;
begin

  DriveInfo.RemoveHandler(DriveNotification);

  for DriveStatusPair in FDriveStatus do
  begin
    var DriveStatus := DriveStatusPair.Value;
    if Assigned(DriveStatus.DiscMonitor) then
      FreeAndNil(DriveStatus.DiscMonitor);
    if Assigned(DriveStatus.ChangeTimer) then
      FreeAndNil(DriveStatus.ChangeTimer);
  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;
  Result.Scanned := False;
  Result.Verified := False;
  Result.RootNode := nil;
  Result.RootNodeIndex := -1;
  Result.DiscMonitor := nil;
  Result.DefaultDir := EmptyStr;
  // ChangeTimer:
  Result.ChangeTimer := TTimer.Create(Self);
  Result.ChangeTimer.Interval := 0;
  Result.ChangeTimer.Enabled := False;
  Result.ChangeTimer.OnTimer := ChangeTimerOnTimer;
end;

procedure TDriveView.DriveRemoving(Drive: string);
begin
  DriveRemoved(Drive);
  TerminateWatchThread(Drive);
end;

procedure TDriveView.CreateWnd;
var
  DriveStatus: TDriveStatus;
begin
  inherited;

  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
  begin
    if DriveStatus.RootNodeIndex >= 0 then
    begin
      DriveStatus.RootNode := Items[DriveStatus.RootNodeIndex];
      DriveStatus.RootNodeIndex := -1;
    end;
  end;

  UpdateDelayedNodeTimer;

  if FRecreateScheduledCount >= 0 then
  begin
    FSubDirReaderThread.Reattach(FRecreateScheduledCount);
    FRecreateScheduledCount := -1;
  end;
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 then
  begin

    Assert(FRecreateScheduledCount < 0);
    // Have to use field, instead of local variable in CM_RECREATEWND handler,
    // as CM_RECREATEWND is not invoked, when the recreation is trigerred recursivelly from parent
    // control/form.
    FRecreateScheduledCount := FSubDirReaderThread.Detach;

    if Items.Count > 0 then // redundant test?
    begin
      FPrevSelectedIndex := -1;
      if Assigned(FPrevSelected) then
      begin
        FPrevSelectedIndex := FPrevSelected.AbsoluteIndex;
        FPrevSelected := nil;
      end;

      for DriveStatus in FDriveStatus.Values do
      begin
        DriveStatus.RootNodeIndex := -1;
        if Assigned(DriveStatus.RootNode) then
        begin
          DriveStatus.RootNodeIndex := DriveStatus.RootNode.AbsoluteIndex;
          DriveStatus.RootNode := nil;
        end;
      end;
    end;
  end;
  inherited;
end;

function TDriveView.NodeColor(Node: TTreeNode): TColor;
begin
  Result := clDefaultItemColor;
  var NodeData := TNodeData(Node.Data);
  if not Node.Selected then
  begin
    // Colored display of compressed directories:
    if (NodeData.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 ((NodeData.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;

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;

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;

    FFileOperator.Flags := FileOperatorDefaultFlags + [foNoConfirmation];
    FFileOperator.Operation := foRename;
    FFileOperator.OperandFrom.Clear;
    FFileOperator.OperandTo.Clear;
    FFileOperator.OperandFrom.Add(NodePath(Node));
    FFileOperator.OperandTo.Add(IncludeTrailingBackslash(NodePath(Node.Parent)) + Item.pszText);

    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;

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;

procedure TDriveView.Loaded;
begin
  inherited;
  // Create the drive nodes:
  RefreshRootNodes(True);
  // Set the initial directory:
  if (Length(FDirectory) > 0) and DirectoryExists(ApiPath(FDirectory)) then
    Directory := FDirectory;

  FCreating := False;
end;

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;

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;

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;

        // Most of this is done already in CanChange and possibly redundant here
        OldSerial := DriveInfo.Get(Drive).DriveSerial;
        DriveInfo.ReadDriveStatus(Drive, dsSize or dsImageIndex);
        if Assigned(FDirView) and (FDirView.Path <> NewDir) then
          FDirView.Path := NewDir;

        var DriveInfoRec := DriveInfo.Get(Drive);
        if DriveInfoRec.DriveReady then
        begin
          if not DirectoryExists(ApiPath(NewDir)) then
          begin
            // Unlikely to ever happen, as CanChange already tests the directory
            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 (DriveInfoRec.DriveSerial <> OldSerial) or (DriveInfoRec.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;

      if (not Assigned(FPrevSelected)) or (not FPrevSelected.HasAsParent(Node)) then
        Node.Expand(False);
      FPrevSelected := Node;

      ValidateCurrentDirectoryIfNotMonitoring;
    end;
  end;

  inherited;
end;

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
      var ImageIndex := DriveInfo.Get(Drive).ImageIndex;
      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
      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;
  end
    else
  begin
    Result := DriveInfo.GetSimpleName(Drive);
  end;
end;

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.DriveNotification(Notification: TDriveNotification; Drive: string);
begin
  case Notification of
    dnRefresh:
      RefreshRootNodes;

    dnRemoving:
      // Lame way to reduce rick, we modify the treee while it's being updated already.
      // It might be better to post an update message to the message loop.
      if WatchThreadActive(Drive) then
        DriveRemoving(Drive);
  end;
end;

procedure TDriveView.RefreshRootNodes(Floppy: Boolean);
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 Floppy or DriveInfo.IsFixedDrive(Drive) then
      begin
        WasValid := Assigned(DriveStatus.RootNode);
        if DriveInfo.Get(Drive).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
              DriveStatus.RootNode := Items.InsertObject(NextDriveNode, '', NodeData)
            else
              DriveStatus.RootNode := Items.AddObject(nil, '', NodeData);

            DriveStatus.RootNode.Text := GetDisplayName(DriveStatus.RootNode);
            DriveStatus.RootNode.HasChildren := True;

            DriveStatus.Scanned := False;
            DriveStatus.Verified := False;
          end
            else
          if DriveStatus.RootNode.ImageIndex <> DriveInfo.Get(Drive).ImageIndex then
          begin
            DriveStatus.RootNode.ImageIndex    := DriveInfo.Get(Drive).ImageIndex;
            DriveStatus.RootNode.SelectedIndex := DriveInfo.Get(Drive).ImageIndex;
          end;


          if Assigned(DriveStatus.RootNode) then
          begin
            NewText := GetDisplayName(DriveStatus.RootNode);
            if DriveStatus.RootNode.Text <> NewText then
              DriveStatus.RootNode.Text := NewText;
          end;
        end
          else
        if WasValid then
        // Drive has been removed => delete rootnode:
        begin
          DriveRemoved(Drive);
          DriveStatus.Scanned := False;
          DriveStatus.Verified := False;
          DriveStatus.RootNode.Delete;
          DriveStatus.RootNode := nil;
        end;
      end;

      if Assigned(DriveStatus.RootNode) then
        NextDriveNode := DriveStatus.RootNode;

    end;
  finally
    Screen.Cursor := SaveCursor;
    Drives.Free;
  end;
end;

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;

function TDriveView.GetDriveStatus(Drive: string): TDriveStatus;
begin
  if not FDriveStatus.TryGetValue(Drive, Result) then
  begin
    Result := CreateDriveStatus;
    FDriveStatus.Add(Drive, Result);
  end;
end;

function TDriveView.DoScanDir(FromNode: TTreeNode): Boolean;
begin
  Result := not TNodeData(FromNode.Data).IsRecycleBin;
end;

function TDriveView.DirAttrMask: Integer;
begin
  Result := faDirectory or faSysFile;
  if ShowHiddenDirs then
    Result := Result or faHidden;
end;

procedure TDriveView.ScanDrive(Drive: string);
begin
  ValidateDirectory(FindNodeToPath(DriveInfo.GetDriveRoot(Drive)));
  GetDriveStatus(Drive).Scanned := True;
  GetDriveStatus(Drive).Verified := False;
end;

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 TDriveView.DoSearchSubDirs(
  ParentNode: TTreeNode; Path: string; Level: Integer; ExistingOnly: Boolean;
  var SelectionHierarchy: TTreeNodeArray; var SelectionHierarchyHeight: 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, ExistingOnly, SelectionHierarchy, SelectionHierarchyHeight);
  end;
end;

function TDriveView.SearchSubDirs(
  ParentNode: TTreeNode; Path: string; Level: Integer; ExistingOnly: Boolean;
  var SelectionHierarchy: TTreeNodeArray; var SelectionHierarchyHeight: 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;

    Result := DoSearchSubDirs(ParentNode, Path, Level, ExistingOnly, SelectionHierarchy, SelectionHierarchyHeight);

    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, ExistingOnly, SelectionHierarchy, SelectionHierarchyHeight);
      end;
    end;
  end;
end; // SearchSubDirs

function TDriveView.DoFindNodeToPath(Path: string; ExistingOnly: Boolean): TTreeNode;
var
  SelectionHierarchy: TTreeNodeArray;
  SelectionHierarchyHeight: Integer;
  Drive: string;
  P, I: Integer;
  RootNode, Node: TTreeNode;
begin
  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);
  // Likely a network drive
  if (not Assigned(GetDriveStatus(Drive).RootNode)) and
     // Side effect of this is drive refresh that adds the network drive to the trees
     DriveInfo.Get(Drive).ValidButHiddenByDrivePolicy then
  begin
    // This refreshes the drives again
    DriveInfo.OverrideDrivePolicy(Drive);
  end;

  // if not assigned now, it must be that the drive already existed in DriveInfo, but it didn't make it to this view
  // (possible a network drive opened in another panel before)
  if not Assigned(GetDriveStatus(Drive).RootNode) then
  begin
    // Refresh the view drives to add the new drive and also explorer's drive drop down.
    // Overkill, as we know exactly what drive to add (so not need to check all drives)
    DriveInfo.DriveRefresh;
  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, ExistingOnly, SelectionHierarchy, SelectionHierarchyHeight);
    end
      else Result := GetDriveStatus(Drive).RootNode;
  end;
end;

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;

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
  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;

procedure TDriveView.RebuildTree;
var
  Drive: string;
begin
  for Drive in FDriveStatus.Keys do
  begin
    var DriveStatus := GetDriveStatus(Drive);
    if Assigned(DriveStatus.RootNode) and DriveStatus.Scanned then
       ValidateDirectory(DriveStatus.RootNode);
  end;
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;

function TDriveView.GetDriveTypeToNode(Node: TTreeNode): Integer;
begin
  Assert(Assigned(Node));

  Result := DriveInfo.Get(GetDriveToNode(Node)).DriveType;
end;

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
    var DiscMonitor := TDiscMonitor.Create(Self);
    GetDriveStatus(Drive).DiscMonitor := DiscMonitor;
    DiscMonitor.ChangeDelay := msThreadChangeDelay;
    DiscMonitor.SubTree := True;
    DiscMonitor.Filters := [moDirName];
    DiscMonitor.OnChange := ChangeDetected;
    DiscMonitor.OnInvalid := ChangeInvalid;
    DiscMonitor.SetDirectory(DriveInfo.GetDriveRoot(Drive));
    DiscMonitor.Open;
    SubscribeDriveNotifications(Drive);
  end;
end;

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;

procedure TDriveView.SetDirView(Value: TDirView);
begin
  if Assigned(FDirView) then
    FDirView.DriveView := nil;

  FDirView := Value;

  if Assigned(FDirView) then
    FDirView.DriveView := Self;
end;

function TDriveView.NodeWatched(Node: TTreeNode): Boolean;
var
  Drive: string;
begin
  Drive := GetDriveToNode(Node);
  Result := WatchThreadActive(Drive);
end;

procedure TDriveView.ChangeInvalid(Sender: TObject; const Directory: string;
  const ErrorStr: string);
var
  Drive: string;
begin
  Drive := DriveInfo.GetDriveKey((Sender as TDiscMonitor).Directories[0]);
  GetDriveStatus(Drive).DiscMonitor.Close;
end;

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
      var ChangeTimer := GetDriveStatus(DriveInfo.GetDriveKey(DirChanged)).ChangeTimer;
      ChangeTimer.Interval := 0;
      ChangeTimer.Interval := FChangeInterval;
      ChangeTimer.Enabled  := True;
    end;
  end;
end;

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
          var ChangeTimer := DriveStatusPair.Value.ChangeTimer;
          ChangeTimer.Interval := 0;
          ChangeTimer.Enabled := False;

          if Assigned(DriveStatusPair.Value.RootNode) then
          begin
            // Check also collapsed (invisible) subdirectories:
            ValidateDirectory(DriveStatusPair.Value.RootNode);
          end;
        finally
          ResumeChangeTimer;
        end;
      end;
    end;
  end;
end;

procedure TDriveView.SubscribeDriveNotifications(Drive: string);
begin
  // As previously, subscribe drive notification only once the drive is at least once visited.
  // Shouldn't do much harm to subscribe always, but just in case.
  DriveInfo.SubscribeDriveNotifications(Drive);
end;

procedure TDriveView.StartWatchThread;
var
  Drive: string;
begin
  if (csDesigning in ComponentState) or
     not Assigned(Selected) or
     not FWatchDirectory then Exit;

  Drive := GetDriveToNode(Selected);

  var DriveStatus := GetDriveStatus(Drive);
  if not Assigned(DriveStatus.DiscMonitor) then
    CreateWatchThread(Drive);
  if Assigned(DriveStatus.DiscMonitor) and (not DriveStatus.DiscMonitor.Enabled) then
    DriveStatus.DiscMonitor.Enabled := True;
  SubscribeDriveNotifications(Drive);
end;

procedure TDriveView.StopWatchThread;
var
  Drive: string;
begin
  if Assigned(Selected) then
  begin
    Drive := GetDriveToNode(Selected);
    var DriveStatus := GetDriveStatus(Drive);
    if Assigned(DriveStatus.DiscMonitor) then
      DriveStatus.DiscMonitor.Enabled := False;
  end;
end;

procedure TDriveView.SuspendChangeTimer;
begin
  Inc(FChangeTimerSuspended);
end;

procedure TDriveView.ResumeChangeTimer;
begin
  Assert(FChangeTimerSuspended > 0);
  Dec(FChangeTimerSuspended);
end;

procedure TDriveView.TerminateWatchThread(Drive: string);
begin
  var DriveStatus := GetDriveStatus(Drive);
  if Assigned(DriveStatus.DiscMonitor) then
  begin
    DriveStatus.DiscMonitor.Free;
    DriveStatus.DiscMonitor := nil;
  end;
end;

procedure TDriveView.StartAllWatchThreads;
var
  DriveStatusPair: TDriveStatusPair;
  Drive: string;
begin
  if (csDesigning in ComponentState) or (not FWatchDirectory) then
     Exit;

  for DriveStatusPair in FDriveStatus do
  begin
    var DriveStatus := DriveStatusPair.Value;
    if DriveStatus.Scanned then
    begin
      if not Assigned(DriveStatus.DiscMonitor) then
        CreateWatchThread(DriveStatusPair.Key);
      if Assigned(DriveStatus.DiscMonitor) and (not DriveStatus.DiscMonitor.Active) then
      begin
        DriveStatus.DiscMonitor.Open;
        SubscribeDriveNotifications(DriveStatusPair.Key);
      end;
    end;
  end;

  if Assigned(Selected) then
  begin
    Drive := GetDriveToNode(Selected);
    if not DriveInfo.IsFixedDrive(Drive) then
    begin
      StartWatchThread;
    end;
  end;
end;

procedure TDriveView.StopAllWatchThreads;
var
  DriveStatusPair: TDriveStatusPair;
begin
  if (csDesigning in ComponentState) or (not FWatchDirectory) then
     Exit;

  for DriveStatusPair in FDriveStatus do
  begin
    var DriveStatus := DriveStatusPair.Value;
    if Assigned(DriveStatus.DiscMonitor) then
    begin
      DriveStatus.DiscMonitor.Close;
    end;
  end;
end;

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;

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;

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;

function TDriveView.GetDirName(Node: TTreeNode): string;
begin
  if Assigned(Node) and Assigned(Node.Data) then
    Result := TNodeData(Node.Data).DirName
  else
    Result := '';
end;

// 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;

// 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;

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;

procedure TDriveView.SetShowVolLabel(ShowIt: Boolean);
begin
  if ShowIt = FShowVolLabel then
    Exit;
  FShowVolLabel := ShowIt;
  RefreshRootNodes(True);
end;

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
    ClearCutState;
    FLastPathCut := NodePathName(Node);
    Node.Cut := True;
  end
    else
  if Verb = shcCopy then
  begin
    ClearCutState;
  end
    else
  if Verb = shcPaste then
    PasteFromClipBoard(Node);

  DropTarget := nil;

  if not DirWatched then
    ValidateDirectory(Node);
end;

procedure TDriveView.DisplayPropertiesMenu(Node: TTreeNode);
begin
  Assert(Assigned(Node));
  ShellExecuteContextCommand(FParentForm.Handle, shcProperties, NodePathName(Node));
end;

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;

// 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;

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, IsRecycleBin, ConfirmDelete, ConfirmOverwrite,
           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;
    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;

// Clipboard operations:
procedure TDriveView.ClearCutState;
begin
  if FLastPathCut <> '' then
  begin
    var Node := FindNodeToPath(FLastPathCut);
    if Assigned(Node) then
    begin
      Node.Cut := False;
    end;
    FLastPathCut := '';
  end;
  if Assigned(FDirView) and
     FDirView.AnyCut then // prevent recursion
  begin
    FDirView.EmptyClipboard;
  end;
end;

procedure TDriveView.EmptyClipboard;
begin
  if Windows.OpenClipBoard(0) then
  begin
    Windows.EmptyClipBoard;
    Windows.CloseClipBoard;
    ClearCutState;
  end;
end;

procedure TDriveView.EmptyClipboardIfCut;
begin
  // interface for TDirView - prevent recursion
  if FLastPathCut <> '' then
  begin
    EmptyClipboard;
  end;
end;

function TDriveView.CanPasteFromClipBoard: Boolean;
begin
  Result := False;
  if Assigned(Selected) and Windows.OpenClipboard(0) then
  begin
    Result := IsClipboardFormatAvailable(CF_HDROP);
    Windows.CloseClipBoard;
  end;
end;

procedure TDriveView.PasteFromClipBoard(Node: TTreeNode);
var
  Effect: LongInt;
begin
  ClearDragFileList(FDragDropFilesEx.FileList);
  if CanPasteFromClipBoard and FDragDropFilesEx.GetFromClipBoard(Effect) then
  begin
    PerformDragDropFileOperation(Node, Effect);
    if Assigned(FOnDDExecuted) then
      FOnDDExecuted(Self, Effect);
    if Effect = DROPEFFECT_MOVE then
      EmptyClipBoard;
  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;

procedure TDriveView.DirHasNoChildren(Path: string);
begin
  var Node := FindNodeToPath(Path);
  if Assigned(Node) and Assigned(Node.Data) and (not TNodeData(Node.Data).Scanned) then
  begin
    Node.HasChildren := False;
    TNodeData(Node.Data).Scanned := True;
  end;
end;

end.