| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754 | 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;    {Additional events:}    FOnDisplayContextMenu: TNotifyEvent;    FOnRefreshDrives: TNotifyEvent;    {used components:}    FDirView: TDirView;    FFileOperator: TFileOperator;    FChangeInterval: Cardinal;    {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 SetDirectory(Value: string); override;    procedure GetNodeShellAttr(ParentNode: TTreeNode; NodeData: TNodeData; GetAttr: Boolean);    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 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;    {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 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;implementationuses  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];  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  DriveStatus: TDriveStatus;begin  inherited;  if Assigned(PopupMenu) then    PopupMenu.Autopopup := False;  OLECheck(SHGetDesktopFolder(FDesktop));  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      begin        if SupportsDarkMode and DarkMode then Result := clSkyBlue          else Result := clBlue;      end        else      {Dimmed display, if hidden-atrribut set:}      if FDimmHiddenDirs and ((Attr and FILE_ATTRIBUTE_HIDDEN) <> 0) then          Result := clGrayText    end;end;function TDriveView.GetCustomDirView: TCustomDirView;begin  Result := DirView;end;procedure TDriveView.SetCustomDirView(Value: TCustomDirView);begin  DirView := Value as TDirView;end;function TDriveView.NodePath(Node: TTreeNode): string;var  ParentNode: TTreeNode;begin  if not Assigned(Node) then    raise ENodeNotAssigned.Create(Format(ErrorNodeNA, ['GetDirPath']));  Result := GetDirName(Node);  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(ParentNode: TTreeNode; NodeData: TNodeData; GetAttr: Boolean);var  ParentFolder: IShellFolder;  ParentData: TNodeData;begin  NodeData.shAttr := 0;  if GetAttr then  begin    if Assigned(ParentNode) then    begin      ParentData := TNodeData(ParentNode.Data);      if not Assigned(ParentData) then      begin        Assert(False);        ParentFolder := nil;      end        else      begin        if not Assigned(ParentData.ShellFolder) then        begin          GetNodeShellAttr(ParentNode.Parent, ParentData, GetAttr);        end;        ParentFolder := ParentData.ShellFolder;      end;    end      else    begin      ParentFolder := FDesktop;    end;    if Assigned(ParentFolder) and Assigned(NodeData) then    begin      if not Assigned(NodeData.PIDL) then        NodeData.PIDL := PIDL_GetFromParentFolder(ParentFolder, PChar(NodeData.DirName));      if Assigned(NodeData.PIDL) then      begin        NodeData.shAttr := SFGAO_CONTENTSMASK;        // Previously we would also make use of SFGAO_SHARE to display a share overlay.        // But for directories, Windows File Explorer does not display the overlay anymore (probably since Vista).        // And for drives (where Explorer does display the overlay), it did not work ever since we use "desktop"        // (and not "workspace" as before) to resolve drive interface (see Bug 1717).        if not Succeeded(ShellFolderGetAttributesOfWithTimeout(ParentFolder, 1, NodeData.PIDL, NodeData.shAttr, MSecsPerSec)) then        begin          NodeData.shAttr := 0;        end;        if not Assigned(NodeData.ShellFolder) then        begin          ParentFolder.BindToObject(NodeData.PIDL, nil, IID_IShellFolder, Pointer(NodeData.ShellFolder));        end;      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;  GetAttr: Boolean;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:}              GetAttr :=                DriveInfo.IsFixedDrive(Drive) and (DriveType <> DRIVE_REMOVABLE) and                ((DriveType <> DRIVE_REMOTE) or GetNetWorkConnected(Drive));              GetNodeShellAttr(nil, NodeData, GetAttr);              if Assigned(NextDriveNode) then                RootNode := Items.InsertObject(NextDriveNode, '', NodeData)              else                RootNode := Items.AddObject(nil, '', NodeData);              RootNode.Text := GetDisplayName(RootNode);              RootNode.HasChildren := True;              Scanned := False;              Verified := False;            end              else            if RootNode.ImageIndex <> DriveInfo.Get(Drive).ImageIndex then            begin {WasValid = True}              RootNode.ImageIndex    := DriveInfo.Get(Drive).ImageIndex;              RootNode.SelectedIndex := DriveInfo.Get(Drive).ImageIndex;            end;            if Assigned(RootNode) then            begin              NewText := GetDisplayName(RootNode);              if RootNode.Text <> NewText then                RootNode.Text := NewText;            end;          end            else          if WasValid then          {Drive has been removed => delete rootnode:}          begin            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;  GetAttr: Boolean;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 }  GetAttr :=    Visible and    (GetDriveTypeToNode(ParentNode) <> DRIVE_REMOTE);  GetNodeShellAttr(ParentNode, NodeData, GetAttr);  NewNode := Self.Items.AddChildObject(ParentNode, '', NodeData);  NewNode.Text := GetDisplayName(NewNode);  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;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.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 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 (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, False,           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.
 |