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

{ 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, PIDL, BaseUtils, ListExt, CustomDirView,
  CustomDriveView, System.Generics.Collections;

{$I ResStrings.pas}

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}

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;

  TScanDirInfo = record
    SearchNewDirs: Boolean;
    StartNode: TTreeNode;
    DriveType: Integer;
  end;

  PScanDirInfo = ^TScanDirInfo;

  TDriveView = class;

  TNodeData = class
  private
    FDirName: string;
    FShortName: string;
    FAttr: Integer;
    FScanned: Boolean;
    FData: Pointer;
    FIsRecycleBin: Boolean;
    FIconEmpty: Boolean;

  public
    shAttr: ULONG;
    PIDL: PItemIDList;
    ShellFolder: IShellFolder;

    constructor Create;
    destructor Destroy; override;

    property DirName: string read FDirName write FDirName;
    property ShortName: string read FShortName write FShortName;
    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;
  end;

  TDriveTreeNode = class(TTreeNode)
    procedure Assign(Source: TPersistent); override;
  end;

  TDriveView = class(TCustomDriveView)
  private
    FDriveStatus: TObjectDictionary<string, TDriveStatus>;

    FConfirmDelete: Boolean;
    FConfirmOverwrite: Boolean;
    FWatchDirectory: Boolean;
    FDirectory: string;
    FFullDriveScan: Boolean;
    FShowVolLabel: Boolean;
    FVolDisplayStyle: TVolumeDisplayStyle;
    FChangeFlag: Boolean;
    FLastDir: string;
    FValidateFlag: Boolean;
    FCreating: Boolean;
    FForceRename: Boolean;
    FRenameNode: TTreeNode;
    FLastRenameName: string;
    FInternalWindowHandle: HWND;
    FPrevSelected: TTreeNode;
    FPrevSelectedIndex: Integer;
    FChangeTimerSuspended: Integer;

    FDesktop: IShellFolder;
    FWorkPlace: IShellFolder;

    {Additional events:}
    FOnDisplayContextMenu: TNotifyEvent;
    FOnRefreshDrives: TNotifyEvent;

    {used components:}
    FDirView: TDirView;
    FFileOperator: TFileOperator;

    FChangeInterval: Cardinal;

    FCompressedColor: TColor;

    {Drag&drop:}
    FLastPathCut: string;

    {Drag&drop helper functions:}
    procedure SignalDirDelete(Sender: TObject; Files: TStringList);

    function CheckForSubDirs(Path: string): Boolean;
    function ReadSubDirs(Node: TTreeNode; DriveType: Integer): Boolean;

    {Callback-functions used by iteratesubtree:}
    function CallBackValidateDir(var Node: TTreeNode; Data: Pointer): Boolean;

    { 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 SetFullDriveScan(DoFullDriveScan: Boolean);
    procedure SetWatchDirectory(Value: Boolean);
    procedure SetShowVolLabel(ShowIt: Boolean);
    procedure SetDirView(Value: TDirView);
    procedure SetCompressedColor(Value: TColor);
    procedure SetDirectory(Value: string); override;
    procedure GetNodeShellAttr(ParentFolder: IShellFolder; NodeData: TNodeData;
      Path: string; ContentMask: Boolean = True);
    function  DoScanDir(FromNode: TTreeNode): Boolean;
    function  AddChildNode(ParentNode: TTreeNode; SRec: TSearchRec): TTreeNode;
    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);

    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;

    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 CreateNode: TTreeNode; override;

    function DDSourceEffects: TDropEffectSet; override;
    procedure DDChooseEffect(KeyState: Integer; var Effect: 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 WorkPlace: IShellFolder read FWorkPlace;

    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);
    procedure RefreshRootNodes(dsFlags: Integer);
    function GetDrives: TStrings;

    {Node handling:}
    procedure SetImageIndex(Node: TTreeNode); virtual;
    function FindNodeToPath(Path: string): TTreeNode;
    function RootNode(Node: TTreeNode): TTreeNode;
    function GetDirName(Node: TTreeNode): string;
    function GetDisplayName(Node: TTreeNode): string;
    function NodePathName(Node: TTreeNode): string; override;

    function GetFQPIDL(Node: TTreeNode): PItemIDList;

    {Directory update:}
    function  CreateDirectory(ParentNode: TTreeNode; NewName: string): TTreeNode; dynamic;
    function  DeleteDirectory(Node: TTreeNode; AllowUndo: Boolean): Boolean; dynamic;

    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;
    {Scan all directories in method ScanDrive:}
    property FullDriveScan: Boolean read FFullDriveScan write SetFullDriveScan default False;
    {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;
    {How to display the drives volume labels:}
    property CompressedColor: TColor read FCompressedColor write SetCompressedColor default clBlue;
    {Additional events:}
    property OnDisplayContextMenu: TNotifyEvent read FOnDisplayContextMenu
      write FOnDisplayContextMenu;
    property OnRefreshDrives: TNotifyEvent 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 OnDDMenuPopup;

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

procedure Register;

implementation

uses
  CompThread, PasTools, UITypes, Types, OperationWithTimeout, System.Generics.Defaults;

resourcestring
   SErrorInvalidDirName = 'New name contains invalid characters %s';

type
  PInt = ^Integer;

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

constructor TNodeData.Create;
begin
  inherited;

  FAttr := 0;
  FScanned := False;
  FDirName := '';
  FShortName := '';
  FIsRecycleBin := False;
  FIconEmpty := True;
  shAttr := 0;
  PIDL := nil;
  ShellFolder := nil;
end; {TNodeData.Create}

destructor TNodeData.Destroy;
begin
  SetLength(FDirName, 0);

  if Assigned(PIDL) then
    FreePIDL(PIDL);

  inherited;
end; {TNodeData.Destroy}

  { TDriveTreeNode }

procedure TDriveTreeNode.Assign(Source: TPersistent);
var
  SourceData: TNodeData;
  NewData: TNodeData;
begin
  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.ShortName := SourceData.ShortName;
    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);
  FFileOperator.ProgressTitle := coFileOperatorTitle;
  FFileOperator.Flags := [foAllowUndo, foNoConfirmMkDir];

  FCompressedColor := clBlue;
  FShowVolLabel := True;
  FChangeFlag := False;
  FLastDir := EmptyStr;
  FValidateFlag := 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);

  with FDragDropFilesEx do
  begin
    ShellExtensions.DragDropHandler := True;
  end;
end; {Create}

destructor TDriveView.Destroy;
var
  DriveStatus: TDriveStatus;
begin
  Classes.DeallocateHWnd(FInternalWindowHandle);

  for DriveStatus in FDriveStatus.Values do
  begin
    with DriveStatus do
    begin
      if Assigned(DiscMonitor) then
        DiscMonitor.Free;
      if Assigned(ChangeTimer) then
        ChangeTimer.Free;
    end;
  end;
  FDriveStatus.Free;

  if Assigned(FFileOperator) then
    FFileOperator.Free;

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

const
  DBT_CONFIGCHANGED = $0018;
  DBT_DEVICEARRIVAL = $8000;
  DBT_DEVICEREMOVEPENDING = $8003;
  DBT_DEVICEREMOVECOMPLETE = $8004;
  DBT_DEVTYP_VOLUME = $00000002;

procedure TDriveView.InternalWndProc(var Msg: TMessage);
var
  UnitMask: DWORD;
  Drive: Char;
begin
  with Msg do
  begin
    if Msg = WM_DEVICECHANGE then
    begin
       if (wParam = DBT_CONFIGCHANGED) or
          (wParam = DBT_DEVICEARRIVAL) or
          (wParam = DBT_DEVICEREMOVECOMPLETE) then
      begin
        // 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.
        SetTimer(FInternalWindowHandle, 1, MSecsPerSec, nil);
      end
        else
      if wParam = DBT_DEVICEREMOVEPENDING then
      begin
        if PDevBroadcastHdr(lParam)^.dbch_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
              // Disable disk monitor to release the handle to the drive.
              // It may happen that the dirve is not removed in the end. In this case we do not currently resume the
              // monitoring. We can watch for DBT_DEVICEQUERYREMOVEFAILED to resume the monitoring.
              // But currently we implement this for VeraCrypt, which does not send this notification.
              with GetDriveStatus(Drive) do
              begin
                if Assigned(DiscMonitor) then
                begin
                  DiscMonitor.Enabled := False;
                  DiscMonitor.Free;
                  DiscMonitor := nil;
                end;
              end;
            end;
            UnitMask := UnitMask shr 1;
            Drive := Chr(Ord(Drive) + 1);
          end;
        end;
      end;
    end
      else
    if Msg = WM_TIMER then
    begin
      KillTimer(FInternalWindowHandle, 1);
      try
        //DriveInfo.Load;
        RefreshRootNodes(dsAll or dvdsRereadAllways);
        if Assigned(OnRefreshDrives) then
          OnRefreshDrives(Self);
      except
        Application.HandleException(Self);
      end;
    end;

    Result := DefWindowProc(FInternalWindowHandle, Msg, wParam, lParam);
  end;
end;

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

  if Assigned(PopupMenu) then
    PopupMenu.Autopopup := False;

  OLECheck(shGetDesktopFolder(FDesktop));
  OLECheck(shGetSpecialFolderLocation(Self.Handle, CSIDL_DRIVES, PIDLWorkPlace));
  FDesktop.BindToObject(PIDLWorkPlace, nil, IID_IShellFolder, Pointer(FWorkPlace));
  FreePIDL(PIDLWorkPlace);

  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;
end; {CreateWnd}

procedure TDriveView.DestroyWnd;
var
  DriveStatus: TDriveStatus;
begin
  if CreateWndRestores and (Items.Count > 0) and (csRecreating in ControlState) 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.GetFQPIDL(Node: TTreeNode): PItemIDList;
var
  Eaten: ULONG;
  shAttr: ULONG;
begin
  Result := nil;
  if Assigned(Node) then
  begin
    shAttr := 0;
    FDesktop.ParseDisplayName(FParentForm.Handle, nil, PChar(NodePathName(Node)), Eaten,
      Result, shAttr);
  end;
end; {GetFQPIDL}

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
          Result := FCompressedColor
        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);
  ParentNode := Node.Parent;

  while (ParentNode <> nil) and (ParentNode.Level >= 0) do
  begin
    if ParentNode.Level > 0 then
      Result := GetDirName(ParentNode) + '\' + Result
    else
      Result := GetDirName(ParentNode) + Result;

    ParentNode := ParentNode.Parent;
  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(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
  NewDirName: string;
  SRec: TSearchRec;
  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 Assigned(OnEdited) then
      begin
        NewDirName := Node.Text;
        OnEdited(Self, Node, NewDirName);
      end;
      if Length(Item.pszText) > 0 then
        raise EInvalidDirName.CreateFmt(SErrorInvalidDirName, [Info]);
      Exit;
    end;

    StopWatchThread;
    if Assigned(DirView) then
      DirView.StopWatchThread;

    with FFileOperator do
    begin
      Flags := [foAllowUndo, 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;
        if FindFirst(ApiPath(IncludeTrailingBackslash(NodePath(Node.Parent)) + Item.pszText),
             faAnyFile, SRec) = 0 then
        begin
          TNodeData(Node.Data).ShortName := string(SRec.FindData.cAlternateFileName);
        end;
        FindClose(SRec);
        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 (Node.Level = 0) 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, DriveInfo.Get(Drive).DriveType);
        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(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
    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
        if not DirectoryExists(ApiPath(Path)) then
        begin
          MessageDlg(Format(SDirNotExists, [Path]), mtError, [mbOK], 0);
          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;
  LastDrive: 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
          LastDrive := DriveInfo.GetDriveKey(FLastDir)
        else
          LastDrive := '';

        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(NewDir) then
            begin
              ValidateDirectory(GetDriveStatus(Drive).RootNode);
              Exit;
            end;

            GetDriveStatus(Drive).DefaultDir := IncludeTrailingBackslash(NewDir);

            if LastDrive <> Drive then
            begin
              if (LastDrive <> '') and
                 (DriveInfo.Get(LastDrive).DriveType = DRIVE_REMOVABLE) then
              begin
                TerminateWatchThread(LastDrive);
              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 Node.Level = 0 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}

procedure TDriveView.GetNodeShellAttr(ParentFolder: IShellFolder;
  NodeData: TNodeData; Path: string; ContentMask: Boolean = True);
begin
  NodeData.shAttr := 0;
  if Assigned(ParentFolder) and Assigned(NodeData) then
  begin
    if not Assigned(NodeData.PIDL) then
      NodeData.PIDL := PIDL_GetFromParentFolder(ParentFolder, PChar(Path));
    if Assigned(NodeData.PIDL) then
    begin
      if ContentMask then
        NodeData.shAttr := SFGAO_DISPLAYATTRMASK or SFGAO_CONTENTSMASK
      else
        NodeData.shAttr := SFGAO_DISPLAYATTRMASK;

      if not Succeeded(ShellFolderGetAttributesOfWithTimeout(ParentFolder, 1, NodeData.PIDL, NodeData.shAttr, MSecsPerSec)) then
      begin
        NodeData.shAttr := 0;
      end;

      if not ContentMask then
        NodeData.shAttr := NodeData.shAttr or SFGAO_HASSUBFOLDER;

      if not Assigned(NodeData.ShellFolder) then
      begin
        ParentFolder.BindToObject(NodeData.PIDL, nil, IID_IShellFolder,
          Pointer(NodeData.ShellFolder));
      end;
    end
  end;

  if NodeData.shAttr = 0 then
  begin
    // If we cannot resolve attrs, we do not want to assume that the folder has no subfolders,
    // as that will make us scan the folder.
    NodeData.shAttr := SFGAO_HASSUBFOLDER;
  end;

end; {GetNodeAttr}

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: TPair<string, TDriveStatus>;
  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.RefreshRootNodes(dsFlags: Integer);
var
  Drives: TStrings;
  NewText: string;
  SaveCursor: TCursor;
  WasValid: Boolean;
  NodeData: TNodeData;
  NewDrive: Char;
  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);
              NodeData.ShortName := NodeData.DirName;

              {Get the shared attributes:}
              if DriveInfo.IsFixedDrive(Drive) and (DriveType <> DRIVE_REMOVABLE) and
                 ((DriveType <> DRIVE_REMOTE) or GetNetWorkConnected(Drive)) then
              begin
                GetNodeShellAttr(FWorkPlace, NodeData, NodeData.DirName);
              end;

              if Assigned(NextDriveNode) then
                RootNode := Items.InsertObject(NextDriveNode, '', NodeData)
              else
                RootNode := Items.AddObject(nil, '', NodeData);

              if (NodeData.shAttr and SFGAO_SHARE) <> 0 then
                RootNode.OverlayIndex := 0;

              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
            if (Directory <> '') and (Directory[1] = Drive) then
            begin
              if DriveInfo.IsRealDrive(Drive) then NewDrive := Drive[1]
                else NewDrive := FirstFixedDrive;

              repeat
                if NewDrive < FirstFixedDrive then NewDrive := FirstFixedDrive
                  else
                if NewDrive = FirstFixedDrive 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(FirstFixedDrive).RootNode);
              end;
            end;
            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}

function TDriveView.AddChildNode(ParentNode: TTreeNode; SRec: TSearchRec): TTreeNode;
var
  NewNode: TTreeNode;
  NodeData: TNodeData;
begin
  NodeData := TNodeData.Create;
  NodeData.Attr := SRec.Attr;
  NodeData.DirName := SRec.Name;
  NodeData.ShortName := SRec.FindData.cAlternateFileName;
  NodeData.FIsRecycleBin :=
    (SRec.Attr and faSysFile <> 0) and
    (ParentNode.Level = 0) and
    ((UpperCase(SRec.Name) = 'RECYCLED') or
     (UpperCase(SRec.Name) = 'RECYCLER'));

  { query content attributes ("has subfolder") only if tree view is visible }
  { to avoid unnecessary scan of subfolders (which may take some time) }
  { if tree view is not visible anyway }
  if not Assigned(TNodeData(ParentNode.Data).ShellFolder) then
  begin
    GetNodeShellAttr(FWorkPlace, TNodeData(ParentNode.Data), NodePathName(ParentNode), Visible);
    { Particularly with UNC paths, "workplace" does not work, but "desktop" does. Maybe we should use "desktop" }
    { for evetything, as we do that already in TDriveInfo.ReadDriveStatus. }
    if not Assigned(NodeData.PIDL) then
    begin
      GetNodeShellAttr(FDesktop, TNodeData(ParentNode.Data), NodePathName(ParentNode), Visible);
    end;
  end;

  GetNodeShellAttr(TNodeData(ParentNode.Data).ShellFolder, NodeData, SRec.Name, Visible);

  NewNode := Self.Items.AddChildObject(ParentNode, '', NodeData);
  NewNode.Text := GetDisplayName(NewNode);

  if (NodeData.shAttr and SFGAO_SHARE) <> 0 then
    NewNode.OverlayIndex := 0;

  Result := NewNode;
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);
    if Assigned(OnRefreshDrives) then
      OnRefreshDrives(Self);
  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);
var
  DosError: Integer;
  RootNode: TTreeNode;
  SaveCursor: TCursor;

  procedure ScanPath(const Path: string; ParentNode: TTreeNode);
  var
    SRec: TSearchRec;
    SubNode: TTreeNode;
  begin
    if not DoScanDir(ParentNode) then
      Exit;

    DosError := FindFirst(ApiPath(Path), DirAttrMask, Srec);
    while DosError = 0 do
    begin
      if (SRec.Name <> '.') and
         (SRec.Name <> '..') and
         (SRec.Attr and faDirectory <> 0) then
      begin
        if (SRec.Attr And faDirectory) <> 0 then
        begin { Scan subdirectory }
          SubNode := AddChildNode(ParentNode, SRec);
          TNodeData(SubNode.Data).Scanned := True;
          ScanPath(ExtractFilePath(Path) + SRec.Name + '\*.*', SubNode);
          if not FContinue then
            Break;
        end;
      end;
      DosError := FindNext(SRec);
    end;
    FindClose(Srec);
    if (Items.Count mod 10) = 0 then
      Application.ProcessMessages;
    if not FContinue then
      Exit;
  end; {ScanPath}

begin {ScanDrive}
  with Self.Items do
  begin
    FContinue := True;
    if not FFullDriveScan then
    begin
      ValidateDirectory(FindNodeToPath(DriveInfo.GetDriveRoot(Drive)));
      GetDriveStatus(Drive).Scanned := True;
      GetDriveStatus(Drive).Verified := False;
    end
      else
    begin
      SaveCursor := Screen.Cursor;
      Screen.Cursor := crHourGlass;
      Items.BeginUpdate;

      try
        RootNode := GetDriveStatus(Drive).RootNode;
        if not Assigned(RootNode) then Exit;

        iF RootNode.HasChildren then
          RootNode.DeleteChildren;

        ScanPath(DriveInfo.GetDriveRoot(Drive) + '*.*', RootNode);      { scan subdirectories of rootdir}
        TNodeData(RootNode.Data).Scanned := True;

        GetDriveStatus(Drive).Scanned := True;
        GetDriveStatus(Drive).Verified := True;
      finally
        SortChildren(GetDriveStatus(Drive).RootNode, True);
        EndUpdate;
      end;
      RootNode.Expand(False);

      Screen.Cursor := SaveCursor;
    end;
  end;
end; {ScanDrive}

function TDriveView.FindNodeToPath(Path: string): TTreeNode;

  function SearchSubDirs(ParentNode: TTreeNode; Path: string): TTreeNode; forward;

  function DoSearchSubDirs(ParentNode: TTreeNode; Path: string): TTreeNode;
  var
    i: Integer;
    Node: TTreeNode;
    Dir: string;
  begin
    {Extract first directory from path:}
    i := Pos('\', Path);

    if i = 0 then
      i := Length(Path);

    Dir := System.Copy(Path, 1, i);
    System.Delete(Path, 1, i);

    if Dir[Length(Dir)] = '\' then
      SetLength(Dir, Pred(Length(Dir)));

    Node := ParentNode.GetFirstChild;
    if not Assigned(Node) then
    begin
      ValidateDirectoryEx(ParentNode, rsRecursiveExisting, True);
      Node := ParentNode.GetFirstChild;
    end;

    Result := nil;
    while Assigned(Node) do
    begin
      if (UpperCase(GetDirName(Node)) = Dir) or (TNodeData(Node.Data).ShortName = Dir) then
      begin
        if Length(Path) > 0 then
        begin
          Result := SearchSubDirs(Node, Path)
        end
          else
        begin
          Result := Node;
        end;
        Exit;
      end;
      Node := ParentNode.GetNextChild(Node);
    end;
  end;

  function SearchSubDirs(ParentNode: TTreeNode; Path: string): TTreeNode;
  var
    Read: Boolean;
  begin
    Result := nil;
    if Length(Path) > 0 then
    begin
      Read := False;

      if not TNodeData(ParentNode.Data).Scanned then
      begin
        ReadSubDirs(ParentNode, GetDriveTypetoNode(ParentNode));
        Read := True;
      end;

      Result := DoSearchSubDirs(ParentNode, Path);

      // reread subfolders, just in case the directory we look for was just created
      // (as can happen when navigating to new remote directory with synchronized
      // browsing enabled and opting to create the non-existing local directory)
      if (not Assigned(Result)) and (not Read) then
      begin
        ValidateDirectoryEx(ParentNode, rsNoRecursive, True);
        Result := DoSearchSubDirs(ParentNode, Path);
      end;
    end;
  end; {SearchSubDirs}

var
  Drive: string;
  P: Integer;
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 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 then
        ScanDrive(Drive);
      Result := SearchSubDirs(GetDriveStatus(Drive).RootNode, UpperCase(Path));
    end
      else Result := GetDriveStatus(Drive).RootNode;
  end;
end; {FindNodetoPath}

function TDriveView.CheckForSubDirs(Path: string): Boolean;
var
  DosError: Integer;
  SRec: TSearchRec;
begin
  Result := False;

  DosError := FindFirst(ApiPath(IncludeTrailingBackslash(Path) + '*.'), DirAttrMask, SRec);
  while DosError = 0 do
  begin
    if (SRec.Name <> '.' ) and
       (SRec.Name <> '..') and
       (SRec.Attr and faDirectory <> 0) then
    begin
      Result := True;
      Break;
    end;
    DosError := FindNext(SRec);
  end;
  FindClose(SRec);
end; {CheckForSubDirs}

function TDriveView.ReadSubDirs(Node: TTreeNode; DriveType: Integer): Boolean;
var
  DosError: Integer;
  SRec: TSearchRec;
  NewNode: TTreeNode;
begin
  Result := False;
  DosError := FindFirst(ApiPath(IncludeTrailingBackslash(NodePath(Node)) + '*.*'), DirAttrMask, SRec);
  while DosError = 0 do
  begin
    if (SRec.Name <> '.' ) and
       (SRec.Name <> '..') and
       (SRec.Attr and faDirectory <> 0) then
    begin
      NewNode := AddChildNode(Node, SRec);
      if DoScanDir(NewNode) then
      begin
        NewNode.HasChildren := Bool(TNodeData(NewNode.Data).shAttr and SFGAO_HASSUBFOLDER);

        TNodeData(NewNode.Data).Scanned := not NewNode.HasChildren;
      end
        else
      begin
        NewNode.HasChildren := False;
        TNodeData(NewNode.Data).Scanned := True;
      end;
      Result := True;
    end;
    DosError := FindNext(SRec);
  end; {While DosError = 0}
  FindClose(Srec);
  TNodeData(Node.Data).Scanned := True;

  if Result then SortChildren(Node, False)
    else Node.HasChildren := False;
  Application.ProcessMessages;
end; {ReadSubDirs}

function TDriveView.CallBackValidateDir(Var Node: TTreeNode; Data: Pointer): Boolean;

type
  PSearchRec = ^TSearchRec;

var
  WorkNode: TTreeNode;
  DelNode: TTreeNode;
  NewNode: TTreeNode;
  SRec: TSearchRec;
  SrecList: TStringList;
  SubDirList: TStringList;
  DosError: Integer;
  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) then
    if not DirectoryExists(NodePathName(Node)) then
    begin
      WorkNode := Node.Parent;
      if Selected = Node then
        Selected := WorkNode;
      if DropTarget = Node then
        DropTarget := nil;
      Node.Delete;
      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;
    while Assigned(WorkNode) do
    begin
      SubDirList.Add(TNodeData(WorkNode.Data).DirName);
      WorkNode := Node.GetNextChild(WorkNode);
    end;
    {Sorting not required, because the subnodes are already sorted!}

    SRecList := TStringList.Create;
    DosError := FindFirst(ApiPath(ParentDir + '*.*'), DirAttrMask, SRec);
    while DosError = 0 do
    begin
      if (Srec.Name <> '.' ) and
         (Srec.Name <> '..') and
         (Srec.Attr and faDirectory <> 0) then
      begin
        SrecList.Add(Srec.Name);
        if not SubDirList.Find(Srec.Name, Index) then
        {Subnode does not exists: add it:}
        begin
          NewNode := AddChildNode(Node, SRec);
          NewNode.HasChildren := CheckForSubDirs(ParentDir + Srec.Name);
          TNodeData(NewNode.Data).Scanned := Not NewNode.HasChildren;
          NewDirFound  := True;
        end;
      end;
      DosError := FindNext(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);
        DelNode.Delete;
      end
        else
      begin
        if (SrecList[Index] <> TNodeData(WorkNode.Data).DirName) then
        begin
          {Case of directory letters has changed:}
          TNodeData(WorkNode.Data).DirName := SrecList[Index];
          TNodeData(WorkNode.Data).ShortName := ExtractShortPathName(NodePathName(WorkNode));
          WorkNode.Text := SrecList[Index];
        end;
        SrecList.Delete(Index);
        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, ScanDirInfo^.DriveType);
  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 Node.Level = 0 then
      GetDriveStatus(Drive).ChangeTimer.Enabled := False;

    RestartWatchThread := WatchThreadActive;
    try
      if WatchThreadActive then
        StopWatchThread;

      FValidateFlag := True;

      New(Info);
      Info^.StartNode := Node;
      Info^.SearchNewDirs := NewDirs;
      Info^.DriveType := DriveInfo.Get(Drive).DriveType;

      SaveCanChange := FCanChange;
      FCanChange := True;
      FChangeFlag := False;
      IterateSubTree(Node, CallBackValidateDir, Recurse, coScanStartNode, Info);
      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;
    end;
  end;
end; {ValidateDirectoryEx}

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

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

function TDriveView.CreateDirectory(ParentNode: TTreeNode; NewName: string): TTreeNode;
var
  SRec: TSearchRec;
begin
  Assert(Assigned(ParentNode));

  Result := nil;
  if not TNodeData(ParentNode.Data).Scanned then
    ValidateDirectory(ParentNode);

  StopWatchThread;

  try
    if Assigned(FDirView) then
      FDirView.StopWatchThread;

    {create phyical directory:}
    LastIOResult := 0;
    if not Windows.CreateDirectory(PChar(NodePath(ParentNode) + '\' + NewName), nil) then
      LastIOResult := GetLastError;
    if LastIOResult = 0 then
    begin
      {Create treenode:}
      FindFirst(ApiPath(NodePath(ParentNode) + '\' + NewName), faAnyFile, SRec);
      Result := AddChildNode(ParentNode, Srec);
      FindClose(Srec);
      TNodeData(Result.Data).Scanned := True;
      SortChildren(ParentNode, False);
      ParentNode.Expand(False);
    end;
  finally
    StartWatchThread;
    if Assigned(FDirView) then
    begin
      FDirView.StartWatchThread;
      FDirView.Reload2;
    end;

  end;
end; {CreateDirectory}

function TDriveView.DeleteDirectory(Node: TTreeNode; AllowUndo: Boolean): Boolean;
var
  DelDir: string;
  OperatorResult: Boolean;
  FileOperator: TFileOperator;
  SaveCursor: TCursor;
begin
  Assert(Assigned(Node));

  Result := False;
  if Assigned(Node) and (Node.Level > 0) then
  begin
    SaveCursor := Screen.Cursor;
    Screen.Cursor := crHourGlass;
    FileOperator := TFileOperator.Create(Self);
    DelDir := NodePathName(Node);
    FileOperator.OperandFrom.Add(DelDir);
    FileOperator.Operation := foDelete;
    if AllowUndo then
      FileOperator.Flags := FileOperator.Flags + [foAllowUndo]
    else
      FileOperator.Flags := FileOperator.Flags - [foAllowUndo];

    if not ConfirmDelete then
      FileOperator.Flags := FileOperator.Flags + [foNoConfirmation];

    try
      if DirectoryExists(DelDir) then
      begin
        StopWatchThread;
        OperatorResult := FileOperator.Execute;

        if OperatorResult and (not FileOperator.OperationAborted) and
           (not DirectoryExists(DelDir)) then
        begin
          Node.Delete
        end
          else
        begin
          Result := False;
          if not AllowUndo then
          begin
            {WinNT4-Bug: FindFirst still returns the directories search record, even if the
             directory was deleted:}
            ChDir(DelDir);
            if IOResult <> 0 then
              Node.Delete;
          end;
        end;
      end
        else
      begin
        Node.Delete;
        Result := True;
      end;
    finally
      StartWatchThread;
      if Assigned(DirView) and Assigned(Selected) then
        DirView.Path := NodePathName(Selected);
      FileOperator.Free;
      Screen.Cursor := SaveCursor;
    end;
  end;
end; {DeleteDirectory}

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;
  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
  Dir: string;
begin
  Dir := (Sender as TDiscMonitor).Directories[0];
  with GetDriveStatus(DriveInfo.GetDriveKey(Dir)) do
  begin
    DiscMonitor.Close;
  end;
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
  DriveStatus: TDriveStatus;
begin
  if (FChangeTimerSuspended = 0) and (Sender is TTimer) then
  begin
    for DriveStatus in FDriveStatus.Values do
    begin
      if DriveStatus.ChangeTimer = Sender then
      begin
        with DriveStatus.ChangeTimer do
        begin
          Interval := 0;
          Enabled := False;
        end;

        if Assigned(DriveStatus.RootNode) then
        begin
          {Check also collapsed (invisible) subdirectories:}
          ValidateDirectory(DriveStatus.RootNode);
        end;
      end;
    end;
  end;
end; {ChangeTimerOnTimer}

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;
end; {StartWatchThread}

procedure TDriveView.StopWatchThread;
begin
  if Assigned(Selected) then
    with GetDriveStatus(GetDriveToNode(Selected)) do
      if Assigned(DiscMonitor) then
        DiscMonitor.Enabled := False;
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;
end; {StopWatchThread}

procedure TDriveView.StartAllWatchThreads;
var
  DriveStatusPair: TPair<string, TDriveStatus>;
  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
          DiscMonitor.Open;
      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: TPair<string, TDriveStatus>;
begin
  if (csDesigning in ComponentState) or (not FWatchDirectory) then
     Exit;

  for DriveStatusPair in FDriveStatus do
    with DriveStatusPair.Value do
    begin
      if Assigned(DiscMonitor) then
        DiscMonitor.Close;
    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}

procedure TDriveView.SetFullDriveScan(DoFullDriveScan: Boolean);
begin
  FFullDriveScan := DoFullDriveScan;
end; {SetAutoScan}

function TDriveView.FindPathNode(Path: string): TTreeNode;
begin
  {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 (Selected.Level = 0) 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 Node.Level = 0 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.SetCompressedColor(Value: TColor);
begin
  if Value <> FCompressedColor then
  begin
    FCompressedColor := Value;
    Invalidate;
  end;
end; {SetCompressedColor}

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 FDragNode.Level = 0 then
    Result := [deLink]
  else
    Result := [deLink, deCopy, deMove];
end;

procedure TDriveView.DDChooseEffect(KeyState: Integer; var Effect: Integer);
begin
  if DropTarget = nil then Effect := DropEffect_None
    else
  if (KeyState and (MK_CONTROL or MK_SHIFT) = 0) 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;

  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 (FDragNode.Level > 0) 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;
  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,
           Self, OnDDFileOperation, SourcePath, SourceIsDirectory) then
      begin
        if Assigned(FOnDDFileOperationExecuted) then
          FOnDDFileOperationExecuted(Self, Effect, SourcePath, TargetPath);
      end;

      ClearDragFileList(FDragDropFilesEx.FileList);
      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
      ValidateDirectory(FindNodeToPath(SourceParentPath));
    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 (Node.Level > 0) 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}

end.