Using large fetch and not reading short names when reading directories for file panel

No noticeable effect seen neither for local drives (where it is apparently expected), nor for local network drives

Source commit: 98b0b7181b7c3da4540fbb967fa46120ac546115

source/packages/filemng/DirView.pas

@@ -896,11 +896,21 @@ begin
 end;
 
 procedure TDirView.SetPath(Value: string);
+var
+  LongPath: string;
+  Len: Integer;
 begin
   // do checks before passing directory to drive view, because
   // it would truncate non-existing directory to first superior existing
   Value := ReplaceStr(Value, '/', '\');
 
+  // Convert to long path
+  Len := GetLongPathName(PChar(ApiPath(Value)), nil, 0);
+  SetLength(LongPath, Len);
+  Len := GetLongPathName(PChar(ApiPath(Value)), PChar(LongPath), Len);
+  if Len > 0 then
+    Value := Copy(LongPath, 1, Len);
+
   CheckCanOpenDirectory(Value);
 
   if Assigned(FDriveView) and
@@ -1346,8 +1356,8 @@ begin
       begin
         FParentFolder := GetShellFolder(PathName);
 
-        DosError := SysUtils.FindFirst(ApiPath(IncludeTrailingPathDelimiter(FPath) + '*.*'),
-          FileAttr, SRec);
+        DosError :=
+          FindFirstEx(ApiPath(IncludeTrailingPathDelimiter(FPath) + '*.*'), FileAttr, SRec, FIND_FIRST_EX_LARGE_FETCH_PAS);
         while (DosError = 0) and (not AbortLoading) do
         begin
           if (SRec.Attr and faDirectory) = 0 then
@@ -1368,8 +1378,8 @@ begin
 
         {Search for directories:}
         DirsCount := 0;
-        DosError := SysUtils.FindFirst(ApiPath(IncludeTrailingPathDelimiter(FPath) + '*.*'),
-          DirAttrMask, SRec);
+        DosError :=
+          FindFirstEx(ApiPath(IncludeTrailingPathDelimiter(FPath) + '*.*'), DirAttrMask, SRec, FIND_FIRST_EX_LARGE_FETCH_PAS);
         while (DosError = 0) and (not AbortLoading) do
         begin
           if (SRec.Name <> '.') and (SRec.Name <> '..') and
@@ -1506,8 +1516,8 @@ begin
           end;
           EItems.Sort;
 
-          DosError := SysUtils.FindFirst(ApiPath(IncludeTrailingPathDelimiter(FPath) + '*.*'),
-            FileAttr, SRec);
+          DosError :=
+            FindFirstEx(ApiPath(IncludeTrailingPathDelimiter(FPath) + '*.*'), FileAttr, SRec, FIND_FIRST_EX_LARGE_FETCH_PAS);
           while DosError = 0 do
           begin
             if (SRec.Attr and faDirectory) = 0 then
@@ -1562,7 +1572,8 @@ begin
           SysUtils.FindClose(Srec);
 
           {Search new directories:}
-          DosError := SysUtils.FindFirst(ApiPath(FPath + '\*.*'), DirAttrMask, SRec);
+          DosError :=
+            FindFirstEx(ApiPath(FPath + '\*.*'), DirAttrMask, SRec, FIND_FIRST_EX_LARGE_FETCH_PAS);
           while DosError = 0 do
           begin
             if (Srec.Attr and faDirectory) <> 0 then

source/packages/filemng/DriveView.pas

@@ -89,7 +89,6 @@ type
   TNodeData = class
   private
     FDirName: string;
-    FShortName: string;
     FAttr: Integer;
     FScanned: Boolean;
     FData: Pointer;
@@ -105,7 +104,6 @@ type
     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;
@@ -164,6 +162,9 @@ type
     procedure SignalDirDelete(Sender: TObject; Files: TStringList);
 
     function CheckForSubDirs(Path: string): Boolean;
+    function GetSubDir(var SRec: TSearchRec): Boolean;
+    function FindFirstSubDir(Path: string; var SRec: TSearchRec): Boolean;
+    function FindNextSubDir(var SRec: TSearchRec): Boolean;
     function ReadSubDirs(Node: TTreeNode; DriveType: Integer; SpecificFile: string = ''): Boolean;
 
     {Callback-functions used by iteratesubtree:}
@@ -426,7 +427,6 @@ begin
   FAttr := 0;
   FScanned := False;
   FDirName := '';
-  FShortName := '';
   FIsRecycleBin := False;
   FIconEmpty := True;
   shAttr := 0;
@@ -458,7 +458,6 @@ 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;
@@ -885,7 +884,6 @@ end; {CanEdit}
 
 procedure TDriveView.Edit(const Item: TTVItem);
 var
-  SRec: TSearchRec;
   Node: TTreeNode;
   Info: string;
   i: Integer;
@@ -923,12 +921,6 @@ begin
       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;
@@ -1456,7 +1448,6 @@ begin
               { Create root directory node }
               NodeData := TNodeData.Create;
               NodeData.DirName := DriveInfo.GetDriveRoot(Drive);
-              NodeData.ShortName := NodeData.DirName;
 
               {Get the shared attributes:}
               GetAttr :=
@@ -1522,7 +1513,6 @@ 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
@@ -1618,7 +1608,7 @@ function TDriveView.DoFindNodeToPath(Path: string; ExistingOnly: Boolean): TTree
     Result := nil;
     while Assigned(Node) do
     begin
-      if (UpperCase(GetDirName(Node)) = Dir) or (TNodeData(Node.Data).ShortName = Dir) then
+      if UpperCase(GetDirName(Node)) = Dir then
       begin
         if Length(Path) > 0 then
         begin
@@ -1762,62 +1752,85 @@ begin
   FindClose(SRec);
 end; {CheckForSubDirs}
 
+function TDriveView.GetSubDir(var SRec: TSearchRec): Boolean;
+begin
+  Result := True;
+  while Result and
+        ((SRec.Name = '.' ) or
+         (SRec.Name = '..') or
+         ((SRec.Attr and faDirectory) = 0)) do
+  begin
+    if FindNext(SRec) <> 0 then
+    begin
+      Result := False;
+    end;
+  end;
+end;
+
+function TDriveView.FindFirstSubDir(Path: string; var SRec: TSearchRec): Boolean;
+begin
+  Result :=
+    (FindFirstEx(ApiPath(Path), DirAttrMask, SRec, FIND_FIRST_EX_LARGE_FETCH_PAS, FindExSearchLimitToDirectories) = 0) and
+    GetSubDir(SRec);
+end;
+
+function TDriveView.FindNextSubDir(var SRec: TSearchRec): Boolean;
+begin
+  Result := (FindNext(SRec) = 0) and GetSubDir(SRec);
+end;
+
 function TDriveView.ReadSubDirs(Node: TTreeNode; DriveType: Integer; SpecificFile: string): Boolean;
 var
-  C, DosError: Integer;
+  C: Integer;
   SRec: TSearchRec;
   NewNode: TTreeNode;
   Path: string;
   Start: TDateTime;
-  All, Stop: Boolean;
+  R, All, Stop: Boolean;
+  Seconds: Integer;
 begin
   Result := False;
   Path := NodePath(Node);
   All := (SpecificFile = '');
   if All then SpecificFile := '*.*';
-  DosError := FindFirst(ApiPath(IncludeTrailingBackslash(Path) + SpecificFile), DirAttrMask, SRec);
+  R := FindFirstSubDir(IncludeTrailingBackslash(Path) + SpecificFile, SRec);
   Start := Now;
   C := 0;
   // At least from SetDirectory > DoFindNodeToPath and CanExpand, this is not called within BeginUpdate/EndUpdate block.
-  // But in any case, addinf it here makes expanding (which calls CanExpand) noticeably slower, when there are lot of nodes,
+  // But in any case, adding it here makes expanding (which calls CanExpand) noticeably slower, when there are lot of nodes,
   // because EndUpdate triggers TVN_GETDISPINFO for all nodes in the tree.
-  while DosError = 0 do
+  while R do
   begin
-    if (SRec.Name <> '.' ) and
-       (SRec.Name <> '..') and
-       (SRec.Attr and faDirectory <> 0) then
+    NewNode := AddChildNode(Node, SRec);
+    Inc(C);
+    if DoScanDir(NewNode) then
     begin
-      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);
+      // 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
-      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;
+      TNodeData(NewNode.Data).Scanned := not NewNode.HasChildren;
+    end
+      else
+    begin
+      NewNode.HasChildren := False;
+      TNodeData(NewNode.Data).Scanned := True;
+    end;
 
-      Result := True;
+    // 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 R := False;
     end;
 
-    if DosError = 0 then
+    Result := True;
+
+    if R then
     begin
-      DosError := FindNext(SRec);
+      R := FindNextSubDir(SRec);
     end;
-  end; {While DosError = 0}
+  end;
 
   FindClose(Srec);
 
@@ -1857,7 +1870,7 @@ var
   SRec: TSearchRec;
   SrecList: TStringList;
   SubDirList: TStringList;
-  DosError: Integer;
+  R: Boolean;
   Index: Integer;
   NewDirFound: Boolean;
   ParentDir: string;
@@ -1903,24 +1916,20 @@ begin {CallBackValidateDir}
 
       SRecList := TStringList.Create;
       SRecList.CaseSensitive := True;
-      DosError := FindFirst(ApiPath(ParentDir + '*.*'), DirAttrMask, SRec);
-      while DosError = 0 do
+      R := FindFirstSubDir(ParentDir + '*.*', SRec);
+      while R do
       begin
-        if (Srec.Name <> '.' ) and
-           (Srec.Name <> '..') and
-           (Srec.Attr and faDirectory <> 0) then
+        SrecList.Add(Srec.Name);
+        if not SubDirList.Find(Srec.Name, Index) then
+        {Subnode does not exists: add it:}
         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;
+          NewNode := AddChildNode(Node, SRec);
+          // Why doesn't this use shAttr consistently with other code?
+          NewNode.HasChildren := CheckForSubDirs(ParentDir + Srec.Name);
+          TNodeData(NewNode.Data).Scanned := Not NewNode.HasChildren;
+          NewDirFound  := True;
         end;
-        DosError := FindNext(Srec);
+        R := FindNextSubDir(Srec);
       end;
       FindClose(Srec);
       Sreclist.Sort;
@@ -1942,7 +1951,6 @@ begin {CallBackValidateDir}
           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;
           WorkNode := Node.GetNextChild(WorkNode);

source/packages/my/PasTools.pas

@@ -3,7 +3,7 @@ unit PasTools;
 interface
 
 uses
-  Windows, Types, Classes, ComCtrls, ExtCtrls, Controls, Dialogs, Forms, Messages, Graphics;
+  Windows, Types, Classes, ComCtrls, ExtCtrls, Controls, Dialogs, Forms, Messages, Graphics, SysUtils;
 
 function Construct(ComponentClass: TComponentClass; Owner: TComponent): TComponent;
 
@@ -77,6 +77,12 @@ function IsUncPath(Path: string): Boolean;
 function FileExistsFix(Path: string): Boolean;
 function DirectoryExistsFix(Path: string): Boolean;
 
+const
+  FIND_FIRST_EX_LARGE_FETCH_PAS = 2; // VCLCOPY (actually should be part of Winapi)
+function FindFirstEx(
+  const Path: string; Attr: Integer; var F: TSearchRec; AdditionalFlags: DWORD = 0;
+  SearchOp: _FINDEX_SEARCH_OPS = FindExSearchNameMatch): Integer;
+
 function SupportsDarkMode: Boolean;
 procedure AllowDarkModeForWindow(Control: TWinControl; Allow: Boolean); overload;
 procedure AllowDarkModeForWindow(Handle: THandle; Allow: Boolean); overload;
@@ -153,7 +159,7 @@ type
 implementation
 
 uses
-  SysUtils, StdCtrls, MultiMon, ShellAPI, Generics.Collections, CommCtrl, ImgList, Registry;
+  StdCtrls, MultiMon, ShellAPI, Generics.Collections, CommCtrl, ImgList, Registry;
 
 const
   DDExpandDelay = 15000000;
@@ -1045,6 +1051,57 @@ begin
   Result := DoExists(DirectoryExists(ApiPath(Path)), Path);
 end;
 
+// VCLCOPY
+function FindMatchingFileEx(var F: TSearchRec): Integer;
+var
+  LocalFileTime: TFileTime;
+begin
+  while F.FindData.dwFileAttributes and F.ExcludeAttr <> 0 do
+    if not FindNextFile(F.FindHandle, F.FindData) then
+    begin
+      Result := GetLastError;
+      Exit;
+    end;
+  FileTimeToLocalFileTime(F.FindData.ftLastWriteTime, LocalFileTime);
+{$WARN SYMBOL_DEPRECATED OFF}
+  FileTimeToDosDateTime(LocalFileTime, LongRec(F.Time).Hi,
+    LongRec(F.Time).Lo);
+{$WARN SYMBOL_DEPRECATED ON}
+  F.Size := F.FindData.nFileSizeLow or Int64(F.FindData.nFileSizeHigh) shl 32;
+  F.Attr := F.FindData.dwFileAttributes;
+  F.Name := F.FindData.cFileName;
+  Result := 0;
+end;
+
+var
+  FindexAdvancedSupport: Boolean = False;
+
+// VCLCOPY (with FindFirstFile replaced by FindFirstFileEx)
+function FindFirstEx(
+  const Path: string; Attr: Integer; var F: TSearchRec; AdditionalFlags: DWORD; SearchOp: _FINDEX_SEARCH_OPS): Integer;
+const
+  faSpecial = faHidden or faSysFile or faDirectory;
+var
+  FindexInfoLevel: TFindexInfoLevels;
+begin
+  F.ExcludeAttr := not Attr and faSpecial;
+  // FindExInfoBasic = do not retrieve cAlternateFileName, which we do not use
+  if FindexAdvancedSupport then FindexInfoLevel := FindExInfoBasic
+    else
+  begin
+    FindexInfoLevel := FindExInfoStandard;
+    AdditionalFlags := AdditionalFlags and (not FIND_FIRST_EX_LARGE_FETCH_PAS);
+  end;
+  F.FindHandle := FindFirstFileEx(PChar(Path), FindexInfoLevel, @F.FindData, SearchOp, nil, AdditionalFlags);
+  if F.FindHandle <> INVALID_HANDLE_VALUE then
+  begin
+    Result := FindMatchingFileEx(F);
+    if Result <> 0 then FindClose(F);
+  end
+  else
+    Result := GetLastError;
+end;
+
 type TPreferredAppMode = (pamDefault, pamAllowDark, pamForceDark, pamForceLight, pamMax);
 
 var
@@ -1139,6 +1196,7 @@ var
   OSVersionInfo: TOSVersionInfoEx;
   SetDefaultDllDirectories: function(DirectoryFlags: DWORD): BOOL; stdcall;
 initialization
+  FindexAdvancedSupport := IsWin7;
   // Translated from PuTTY's dll_hijacking_protection().
   // Inno Setup does not use LOAD_LIBRARY_SEARCH_USER_DIRS and falls back to SetDllDirectory.
   Lib := LoadLibrary(kernel32);