Issue 2264 – Allow aborting local directory tree loading when it is taking too long

https://winscp.net/tracker/2264

Source commit: f08fad8a3c94361f9061d19b30b22a7f88f5e77a

source/forms/ScpCommander.cpp

@@ -15,6 +15,7 @@
 #include <DragDrop.hpp>
 #include <StrUtils.hpp>
 #include <IOUtils.hpp>
+#include <DateUtils.hpp>
 
 #include "Glyphs.h"
 #include "NonVisual.h"
@@ -3010,3 +3011,28 @@ void TScpCommanderForm::RestoreFocus(void * Focus)
     ActiveControl = ControlFocus;
   }
 }
+//---------------------------------------------------------------------------
+void __fastcall TScpCommanderForm::LocalDriveViewContinueLoading(
+  TObject *, TDateTime & Start, UnicodeString Path, int Count, bool & Stop)
+{
+  int Limit = WinConfiguration->LoadingTooLongLimit;
+  if ((Limit > 0) &&
+      (SecondsBetween(Now(), Start) > Limit))
+  {
+    UnicodeString Message = FMTLOAD(CONTINUE_DIR_LOADING, (Path, FormatNumber(Count)));
+    TMessageParams Params(mpNeverAskAgainCheck);
+    unsigned int Answer = MessageDialog(Message, qtConfirmation, qaOK | qaCancel, HELP_NONE, &Params);
+    if (Answer == qaCancel)
+    {
+      Stop = true;
+    }
+    else
+    {
+      if (Answer == qaNeverAskAgain)
+      {
+        WinConfiguration->LoadingTooLongLimit = 0;
+      }
+      Start = Now();
+    }
+  }
+}

source/forms/ScpCommander.dfm

@@ -1239,6 +1239,7 @@ inherited ScpCommanderForm: TScpCommanderForm
         WatchDirectory = True
         DirView = OtherLocalDirView
         OnRefreshDrives = LocalDriveViewRefreshDrives
+        OnContinueLoading = LocalDriveViewContinueLoading
         OnBusy = DirViewBusy
         OnDDDragEnter = LocalFileControlDDDragEnter
         OnDDDragLeave = FileControlDDDragLeave
@@ -1832,6 +1833,7 @@ inherited ScpCommanderForm: TScpCommanderForm
       WatchDirectory = True
       DirView = LocalDirView
       OnRefreshDrives = LocalDriveViewRefreshDrives
+      OnContinueLoading = LocalDriveViewContinueLoading
       OnBusy = DirViewBusy
       OnDDDragEnter = LocalFileControlDDDragEnter
       OnDDDragLeave = FileControlDDDragLeave

source/forms/ScpCommander.h

@@ -531,6 +531,7 @@ __published:
   void __fastcall OtherLocalDirViewUpdateStatusBar(TObject *Sender, const TStatusFileInfo &FileInfo);
   void __fastcall OtherLocalDirViewPathChange(TCustomDirView *Sender);
   void __fastcall LocalDriveViewNeedHiddenDirectories(TObject *Sender);
+  void __fastcall LocalDriveViewContinueLoading(TObject *Sender, TDateTime &Start, UnicodeString Path, int Count, bool &Stop);
 
 private:
   bool FConstructed;

source/packages/filemng/DriveView.pas

@@ -118,6 +118,7 @@ type
   end;
 
   TDriveViewRefreshDrives = procedure(Sender: TObject; Global: Boolean) of object;
+  TDriveViewContinueLoading = procedure(Sender: TObject; var Start: TDateTime; Path: string; Count: Integer; var Stop: Boolean) of object;
 
   TDriveView = class(TCustomDriveView)
   private
@@ -149,6 +150,7 @@ type
     FOnDisplayContextMenu: TNotifyEvent;
     FOnRefreshDrives: TDriveViewRefreshDrives;
     FOnNeedHiddenDirectories: TNotifyEvent;
+    FOnContinueLoading: TDriveViewContinueLoading;
 
     {used components:}
     FDirView: TDirView;
@@ -163,7 +165,7 @@ type
     procedure SignalDirDelete(Sender: TObject; Files: TStringList);
 
     function CheckForSubDirs(Path: string): Boolean;
-    function ReadSubDirs(Node: TTreeNode; DriveType: Integer): Boolean;
+    function ReadSubDirs(Node: TTreeNode; DriveType: Integer; SpecificFile: string = ''): Boolean;
 
     {Callback-functions used by iteratesubtree:}
     function CallBackValidateDir(var Node: TTreeNode; Data: Pointer): Boolean;
@@ -318,6 +320,7 @@ type
     property OnDisplayContextMenu: TNotifyEvent read FOnDisplayContextMenu
       write FOnDisplayContextMenu;
     property OnRefreshDrives: TDriveViewRefreshDrives read FOnRefreshDrives write FOnRefreshDrives;
+    property OnContinueLoading: TDriveViewContinueLoading read FOnContinueLoading write FOnContinueLoading;
     property OnBusy;
 
     property DDLinkOnExeDrag;
@@ -1653,20 +1656,26 @@ function TDriveView.DoFindNodeToPath(Path: string; ExistingOnly: Boolean): TTree
 
   function SearchSubDirs(ParentNode: TTreeNode; Path: string): TTreeNode; forward;
 
+  function ExtractFirstName(S: string): string;
+  var
+    I: Integer;
+  begin
+    I := Pos('\', S);
+
+    if I = 0 then
+      I := Length(S);
+
+    Result := System.Copy(S, 1, I);
+  end;
+
   function DoSearchSubDirs(ParentNode: TTreeNode; Path: string): 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);
+    Dir := ExtractFirstName(Path);
+    System.Delete(Path, 1, Length(Dir));
 
     if Dir[Length(Dir)] = '\' then
       SetLength(Dir, Pred(Length(Dir)));
@@ -1704,11 +1713,19 @@ function TDriveView.DoFindNodeToPath(Path: string; ExistingOnly: Boolean): TTree
     begin
       if (not TNodeData(ParentNode.Data).Scanned) and (not ExistingOnly) then
       begin
-        ReadSubDirs(ParentNode, GetDriveTypetoNode(ParentNode));
+        ReadSubDirs(ParentNode, GetDriveTypeToNode(ParentNode));
       end;
 
       // Factored out of DoSearchSubDirs is remnant of Bug 956 superceded by Bug 1320
       Result := DoSearchSubDirs(ParentNode, Path);
+
+      if (not Assigned(Result)) and
+         DirectoryExists(IncludeTrailingBackslash(NodePath(ParentNode)) + Path) and
+         (not ExistingOnly) then
+      begin
+        ReadSubDirs(ParentNode, GetDriveTypeToNode(ParentNode), ExcludeTrailingBackslash(ExtractFirstName(Path)));
+        Result := DoSearchSubDirs(ParentNode, Path);
+      end;
     end;
   end; {SearchSubDirs}
 
@@ -1817,42 +1834,74 @@ begin
   FindClose(SRec);
 end; {CheckForSubDirs}
 
-function TDriveView.ReadSubDirs(Node: TTreeNode; DriveType: Integer): Boolean;
+function TDriveView.ReadSubDirs(Node: TTreeNode; DriveType: Integer; SpecificFile: string): Boolean;
 var
-  DosError: Integer;
+  C, DosError: Integer;
   SRec: TSearchRec;
   NewNode: TTreeNode;
+  Path: string;
+  Start: TDateTime;
+  All, Stop: Boolean;
 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
+  Path := NodePath(Node);
+  All := (SpecificFile = '');
+  if All then SpecificFile := '*.*';
+  DosError := FindFirst(ApiPath(IncludeTrailingBackslash(Path) + SpecificFile), DirAttrMask, SRec);
+  Start := Now;
+  C := 0;
+  // At least from SetDirectory > DoFindNodeToPath, this is not called within BeginUpdate/EndUpdate block.
+  // No noticeable effect seen (possibly because the node is collapsed), but it makes sense in general.
+  Items.BeginUpdate;
+  try
+    while DosError = 0 do
     begin
-      NewNode := AddChildNode(Node, SRec);
-      if DoScanDir(NewNode) then
+      if (SRec.Name <> '.' ) and
+         (SRec.Name <> '..') and
+         (SRec.Attr and faDirectory <> 0) then
       begin
-        // We have seen the SFGAO_HASSUBFOLDER to be absent on C: drive $Recycle.Bin
-        NewNode.HasChildren := Bool(TNodeData(NewNode.Data).shAttr and SFGAO_HASSUBFOLDER);
+        NewNode := AddChildNode(Node, SRec);
+        Inc(C);
+        if DoScanDir(NewNode) then
+        begin
+          // We have seen the SFGAO_HASSUBFOLDER to be absent on C: drive $Recycle.Bin
+          NewNode.HasChildren := Bool(TNodeData(NewNode.Data).shAttr and SFGAO_HASSUBFOLDER);
 
-        TNodeData(NewNode.Data).Scanned := not NewNode.HasChildren;
-      end
-        else
+          TNodeData(NewNode.Data).Scanned := not NewNode.HasChildren;
+        end
+          else
+        begin
+          NewNode.HasChildren := False;
+          TNodeData(NewNode.Data).Scanned := True;
+        end;
+
+        // There are two other directory reading loops, where this is not called
+        if ((C mod 100) = 0) and Assigned(OnContinueLoading) then
+        begin
+          Stop := False;
+          OnContinueLoading(Self, Start, Path, C, Stop);
+          if Stop then DosError := 1;
+        end;
+
+        Result := True;
+      end;
+
+      if DosError = 0 then
       begin
-        NewNode.HasChildren := False;
-        TNodeData(NewNode.Data).Scanned := True;
+        DosError := FindNext(SRec);
       end;
-      Result := True;
-    end;
-    DosError := FindNext(SRec);
-  end; {While DosError = 0}
-  FindClose(Srec);
-  TNodeData(Node.Data).Scanned := True;
+    end; {While DosError = 0}
 
-  if Result then SortChildren(Node, False)
-    else Node.HasChildren := False;
+    FindClose(Srec);
+
+    if All then TNodeData(Node.Data).Scanned := True;
+
+    if Result then SortChildren(Node, False)
+      else
+    if All then Node.HasChildren := False;
+  finally
+    Items.EndUpdate;
+  end;
   Application.ProcessMessages;
 end; {ReadSubDirs}
 

source/resource/TextsWin.h

@@ -161,6 +161,7 @@
 #define CLOSE_WORKSPACE         1372
 #define TOO_MANY_SESSIONS       1373
 #define EDIT_CHANGED_EXTERNALLY 1374
+#define CONTINUE_DIR_LOADING    1375
 
 #define WIN_INFORMATION_STRINGS 1400
 #define COMPARE_NO_DIFFERENCES  1402

source/resource/TextsWin1.rc

@@ -165,6 +165,7 @@ BEGIN
         CLOSE_WORKSPACE, "Close application without saving a workspace?"
         TOO_MANY_SESSIONS, "**Do you really want to open another tab?**\nYou have %d tabs opened already. Please consider closing some tabs first to free resources of your computer."
         EDIT_CHANGED_EXTERNALLY, "The remote file has been changed while you were editing it. Do you want to overwrite it anyway?"
+        CONTINUE_DIR_LOADING, "**Directory '%s' is taking too long to load. Do you want to keep waiting?**\nAlternatively, select 'Cancel' to abort loading and continue with incomplete results. %s entries have been loaded so far.\n\nIf you are getting this on every WinSCP start, and you are not using this directory, consider browsing to a different path before closing WinSCP, not to start in this directory the next time."
 
         WIN_INFORMATION_STRINGS, "WIN_INFORMATION"
         COMPARE_NO_DIFFERENCES, "No differences found."

source/windows/WinConfiguration.cpp

@@ -636,6 +636,7 @@ void __fastcall TWinConfiguration::Default()
   HiContrast = false;
   EditorCheckNotModified = false;
   SessionTabCaptionTruncation = true;
+  LoadingTooLongLimit = 60;
   FirstRun = StandardDatestamp();
 
   FEditor.Font.FontName = DefaultFixedWidthFontName;
@@ -1101,6 +1102,7 @@ THierarchicalStorage * TWinConfiguration::CreateScpStorage(bool & SessionList)
     KEY(Bool,     HiContrast); \
     KEY(Bool,     EditorCheckNotModified); \
     KEY(Bool,     SessionTabCaptionTruncation); \
+    KEY(Integer,  LoadingTooLongLimit); \
     KEY(String,   FirstRun); \
   ); \
   BLOCK(L"Interface\\Editor", CANCREATE, \
@@ -2813,6 +2815,11 @@ void TWinConfiguration::SetSessionTabCaptionTruncation(bool value)
   SET_CONFIG_PROPERTY(SessionTabCaptionTruncation);
 }
 //---------------------------------------------------------------------------
+void TWinConfiguration::SetLoadingTooLongLimit(int value)
+{
+  SET_CONFIG_PROPERTY(LoadingTooLongLimit);
+}
+//---------------------------------------------------------------------------
 void TWinConfiguration::SetFirstRun(const UnicodeString & value)
 {
   SET_CONFIG_PROPERTY(FirstRun);

source/windows/WinConfiguration.h

@@ -484,6 +484,7 @@ private:
   bool FHiContrast;
   bool FEditorCheckNotModified;
   bool FSessionTabCaptionTruncation;
+  int FLoadingTooLongLimit;
   UnicodeString FFirstRun;
   int FDontDecryptPasswords;
   int FMasterPasswordSession;
@@ -607,6 +608,7 @@ private:
   void SetHiContrast(bool value);
   void SetEditorCheckNotModified(bool value);
   void SetSessionTabCaptionTruncation(bool value);
+  void SetLoadingTooLongLimit(int value);
   void SetFirstRun(const UnicodeString & value);
   int __fastcall GetLocaleCompletenessTreshold();
 
@@ -812,6 +814,7 @@ public:
   __property bool HiContrast = { read = FHiContrast, write = SetHiContrast };
   __property bool EditorCheckNotModified = { read = FEditorCheckNotModified, write = SetEditorCheckNotModified };
   __property bool SessionTabCaptionTruncation = { read = FSessionTabCaptionTruncation, write = SetSessionTabCaptionTruncation };
+  __property int LoadingTooLongLimit = { read = FLoadingTooLongLimit, write = SetLoadingTooLongLimit };
   __property UnicodeString FirstRun = { read = FFirstRun, write = SetFirstRun };
   __property LCID DefaultLocale = { read = FDefaultLocale };
   __property int LocaleCompletenessTreshold = { read = GetLocaleCompletenessTreshold };