Bug 1533: Prevent slow startup when there are some special folders

https://winscp.net/tracker/1533

Source commit: b6d342e1f87d3847a10186eb7a80ee7ebf410c4c

source/DragDropP.cbproj

@@ -50,13 +50,14 @@
 		<DCC_EXPLICIT_STRING_CAST>true</DCC_EXPLICIT_STRING_CAST>
 		<DCC_EXPLICIT_STRING_CAST_LOSS>true</DCC_EXPLICIT_STRING_CAST_LOSS>
 		<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;$(DCC_Namespace)</DCC_Namespace>
+		<DCC_UnitSearchPath>packages\my;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
 		<DCC_UNSAFE_TYPE>true</DCC_UNSAFE_TYPE>
 		<FinalOutputDir>$(INTERM_PATH)\$(Platform)\$(Config)</FinalOutputDir>
 		<ILINK_Description>Drag and Drop Components</ILINK_Description>
 		<ILINK_GenerateImportLibrary>true</ILINK_GenerateImportLibrary>
 		<ILINK_GenerateLibFile>true</ILINK_GenerateLibFile>
-		<ILINK_LibraryPath>packages\dragndrop\;$(BDS)\lib;$(BDS)\lib\obj;$(BDS)\lib\psdk;$(ILINK_LibraryPath)</ILINK_LibraryPath>
-		<IncludePath>packages\dragndrop\;$(BDS)\include;$(BDS)\include\windows\vcl;$(IncludePath)</IncludePath>
+		<ILINK_LibraryPath>packages\dragndrop\;packages\my;$(BDS)\lib;$(BDS)\lib\obj;$(BDS)\lib\psdk;$(ILINK_LibraryPath)</ILINK_LibraryPath>
+		<IncludePath>packages\dragndrop\;packages\my;$(BDS)\include;$(BDS)\include\windows\vcl;$(IncludePath)</IncludePath>
 		<IntermediateOutputDir>$(INTERM_PATH)\$(Platform)\$(Config)</IntermediateOutputDir>
 		<Multithreaded>true</Multithreaded>
 		<OutputExt>bpl</OutputExt>
@@ -114,6 +115,9 @@
 		<DelphiCompile Include="packages\dragndrop\PIDL.pas">
 			<BuildOrder>7</BuildOrder>
 		</DelphiCompile>
+		<PackageImport Include="Moje.bpi">
+			<BuildOrder>24</BuildOrder>
+		</PackageImport>
 		<PackageImport Include="rtl.bpi">
 			<BuildOrder>1</BuildOrder>
 		</PackageImport>

source/packages/dragndrop/PIDL.pas

@@ -50,6 +50,8 @@ function PIDL_GetFromParentFolder(pParentFolder: IShellFolder; pszFile: PChar):
 procedure PIDL_Free(PIDL:PItemIDList);
 function PIDL_Equal(PIDL1,PIDL2:PItemIDList):boolean;
 
+procedure ParseDisplayNameWithTimeout(ParentFolder: IShellFolder; Path: string; var PIDL: PItemIDList);
+
 var ShellMalloc: IMalloc;
 
     CF_FILECONTENTS:UInt; // don't modify value
@@ -69,6 +71,8 @@ var ShellMalloc: IMalloc;
 
 implementation
 
+uses SysUtils, CompThread;
+
 const NullTerm=2;
 
 function PIDL_GetNextItem(PIDL: PItemIDList):PItemIDList;
@@ -280,6 +284,60 @@ begin
      //piDesktopFolder._Release; -> automaticly done by D4
 end;
 
+type
+  TParseDisplayNameThread = class(TCompThread)
+  private
+    FParentFolder: IShellFolder;
+    FPath: string;
+    FPIDL: PItemIDList;
+
+  protected
+    procedure Execute; override;
+
+  public
+    constructor Create(ParentFolder: IShellFolder; Path: string);
+
+    property PIDL: PItemIDList read FPIDL;
+  end;
+
+constructor TParseDisplayNameThread.Create(ParentFolder: IShellFolder; Path: string);
+begin
+  inherited Create(True);
+  FParentFolder := ParentFolder;
+  FPath := Path;
+end;
+
+procedure TParseDisplayNameThread.Execute;
+var
+  Eaten: ULONG;
+  ShAttr: ULONG;
+begin
+  ShAttr := 0;
+  if Failed(FParentFolder.ParseDisplayName(0, nil, PChar(FPath), Eaten, FPIDL, ShAttr)) then
+  begin
+    FPIDL := nil;
+  end;
+end;
+
+procedure ParseDisplayNameWithTimeout(ParentFolder: IShellFolder; Path: string; var PIDL: PItemIDList);
+var
+  Thread: TParseDisplayNameThread;
+begin
+  Thread := TParseDisplayNameThread.Create(ParentFolder, Path);
+  Thread.Resume;
+  if Thread.WaitFor(2 * MSecsPerSec) then
+  begin
+    PIDL := Thread.PIDL;
+    Thread.Free;
+  end
+    else
+  begin
+    // There's a chance for memory leak, if thread is terminated
+    // between WaitFor() and this line
+    Thread.FreeOnTerminate := True;
+  end;
+end;
+
 function PIDL_GetFromParentFolder(pParentFolder: IShellFolder; pszFile: PChar): PItemIDList;
 //  PURPOSE:    This routine takes a Shell folder for the parent and the FileName in the folder
 //  and converts that to a relative ITEMIDLIST.
@@ -289,19 +347,8 @@ function PIDL_GetFromParentFolder(pParentFolder: IShellFolder; pszFile: PChar):
 //      pszFile       - file name in the folder.
 //  RETURN VALUE:
 //      Returns a relative ITEMIDLIST, or NULL if an error occurs.
-var chEaten, dwAttributes: ULONG;
-    NotResult: Boolean;
-    ErrorMode: Word;
 begin
-     ErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS or SEM_NOOPENFILEERRORBOX);
-     try
-       dwAttributes := 0;
-       NotResult := Failed(pParentFolder.ParseDisplayName(0, nil, pszFile, chEaten, Result,
-          dwAttributes));
-     finally
-       SetErrorMode(ErrorMode);
-     end;
-     if NotResult then Result:=nil;
+     ParseDisplayNameWithTimeout(pParentFolder, pszFile, Result);
 end;
 
 procedure PIDL_Free(PIDL:PItemIDList);

source/packages/filemng/IEDriveInfo.pas

@@ -113,7 +113,7 @@ resourceString
 implementation
 
 uses
-  Math, CompThread;
+  Math, PIDL;
 
 constructor TDriveInfo.Create;
 begin
@@ -300,45 +300,12 @@ begin
   Result := @FData[Upcase(Drive)];
 end; {TDriveInfo.GetData}
 
-type
-  TParseDisplayNameThread = class(TCompThread)
-  private
-    FDesktop: IShellFolder;
-    FDrive: TDrive;
-    FPIDL: PItemIDList;
-
-  protected
-    procedure Execute; override;
-
-  public
-    constructor Create(Desktop: IShellFolder; Drive: TDrive);
-
-    property PIDL: PItemIDList read FPIDL;
-  end;
-
-constructor TParseDisplayNameThread.Create(Desktop: IShellFolder; Drive: TDrive);
-begin
-  inherited Create(True);
-  FDesktop := Desktop;
-  FDrive := Drive;
-end;
-
-procedure TParseDisplayNameThread.Execute;
-var
-  Eaten: ULONG;
-  ShAttr: ULONG;
-begin
-  ShAttr := 0;
-  FDesktop.ParseDisplayName(Application.Handle, nil, PChar(FDrive + ':\'), Eaten, FPIDL, ShAttr);
-end;
-
 function TDriveInfo.ReadDriveStatus(Drive: TDrive; Flags: Integer): Boolean;
 var
   ErrorMode: Word;
   FileInfo: TShFileInfo;
   DriveID: string;
   CPos: Integer;
-  Thread: TParseDisplayNameThread;
   Eaten: ULONG;
   ShAttr: ULONG;
   MaxFileNameLength: DWORD;
@@ -362,19 +329,7 @@ begin
       begin
         if DriveType = DRIVE_REMOTE then
         begin
-          Thread := TParseDisplayNameThread.Create(FDesktop, Drive);
-          Thread.Resume;
-          if Thread.WaitFor(2 * MSecsPerSec) then
-          begin
-            PIDL := Thread.PIDL;
-            Thread.Free;
-          end
-            else
-          begin
-            // There's a chance for memory leak, if thread is terminated
-            // between WaitFor() and this line
-            Thread.FreeOnTerminate := True;
-          end;
+          ParseDisplayNameWithTimeout(FDesktop, Drive + ':\', PIDL);
         end
           else
         begin