FIX: Freeze on entering unreachable network paths

components/doublecmd/dcosutils.pas

@@ -1144,22 +1144,15 @@ var
   Handle: THandle;
   wsNewDir: UnicodeString;
   FindData: TWin32FindDataW;
-  NetResource: TNetResourceW;
 begin
-  // Function WNetAddConnection2W works very slow
-  // when the final character is a backslash ('\')
-  wsNewDir:= UTF8Decode(ExcludeTrailingPathDelimiter(NewDir));
-  if Pos('\\', wsNewDir) = 1 then
-  begin
-    FillChar(NetResource, SizeOf(NetResource), #0);
-    NetResource.dwType:= RESOURCETYPE_ANY;
-    NetResource.lpRemoteName:= PWideChar(wsNewDir);
-    WNetAddConnection2W(NetResource, nil, nil, CONNECT_INTERACTIVE);
+  if (Pos('\\', NewDir) = 1) then
+    Result:= True
+  else begin
+    wsNewDir:= UTF16LongName(IncludeTrailingBackslash(NewDir)) + '*';
+    Handle:= FindFirstFileW(PWideChar(wsNewDir), FindData);
+    Result:= (Handle <> INVALID_HANDLE_VALUE) or (GetLastError = ERROR_FILE_NOT_FOUND);
+    if (Handle <> INVALID_HANDLE_VALUE) then FindClose(Handle);
   end;
-  wsNewDir:= UTF16LongName(IncludeTrailingBackslash(NewDir)) + '*';
-  Handle:= FindFirstFileW(PWideChar(wsNewDir), FindData);
-  Result:= (Handle <> INVALID_HANDLE_VALUE) or (GetLastError = ERROR_FILE_NOT_FOUND);
-  if (Handle <> INVALID_HANDLE_VALUE) then FindClose(Handle);
   if Result then CurrentDirectory:= NewDir;
 end;
 {$ELSE}

src/filesources/winnet/uwinnetlistoperation.pas

@@ -29,7 +29,7 @@ implementation
 
 uses
   LazUTF8, uFile, Windows, JwaWinNetWk, JwaLmCons, JwaLmShare, JwaLmApiBuf,
-  DCStrUtils, uShowMsg, DCOSUtils, uOSUtils;
+  DCStrUtils, uShowMsg, DCOSUtils, uOSUtils, uNetworkThread;
 
 procedure TWinNetListOperation.WorkgroupEnum;
 var
@@ -96,13 +96,23 @@ procedure TWinNetListOperation.ShareEnum;
 var
   I: DWORD;
   aFile: TFile;
-  ServerPath: UnicodeString;
   dwResult: NET_API_STATUS;
   dwEntriesRead: DWORD = 0;
   dwTotalEntries: DWORD = 0;
+  ServerPath: UnicodeString;
   BufPtr, nFileList: PShareInfo1;
 begin
   ServerPath:= UTF8Decode(ExcludeTrailingPathDelimiter(Path));
+
+  dwResult:= TNetworkThread.Connect(nil, PWideChar(ServerPath), RESOURCETYPE_ANY);
+  if dwResult <> NO_ERROR then
+  begin
+    if dwResult <> ERROR_CANCELLED then
+      msgError(Thread, mbSysErrorMessage(dwResult));
+    Exit;
+  end;
+
+  BufPtr:= nil;
   repeat
     // Call the NetShareEnum function
     dwResult:= NetShareEnum (PWideChar(ServerPath), 1, PByte(BufPtr), MAX_PREFERRED_LENGTH, @dwEntriesRead, @dwTotalEntries, nil);

src/platform/uOSUtils.pas

@@ -230,7 +230,7 @@ uses
   fConfirmCommandLine, uLog, DCConvertEncoding, LazUTF8
   {$IF DEFINED(MSWINDOWS)}
   , JwaWinCon, Windows, uMyWindows, JwaWinNetWk,
-    uShlObjAdditional, shlobj, DCWindows
+    uShlObjAdditional, ShlObj, DCWindows, uNetworkThread
   {$ENDIF}
   {$IF DEFINED(UNIX)}
   , BaseUnix, Unix, uMyUnix, dl
@@ -897,11 +897,7 @@ begin
     begin
       wsLocalName  := UTF8Decode(ExtractFileDrive(Drive^.Path));
       wsRemoteName := UTF8Decode(Drive^.DriveLabel);
-      FillChar(NetResource, SizeOf(NetResource), #0);
-      NetResource.dwType:= RESOURCETYPE_DISK;
-      NetResource.lpLocalName:= PWideChar(wsLocalName);
-      NetResource.lpRemoteName:= PWideChar(wsRemoteName);
-      WNetAddConnection2W(NetResource, nil, nil, CONNECT_INTERACTIVE);
+      TNetworkThread.Connect(PWideChar(wsLocalName), PWideChar(wsRemoteName), RESOURCETYPE_DISK);
     end;
   Result:= mbDriveReady(Drv);
 end;

src/platform/win/umywindows.pas

@@ -114,6 +114,11 @@ function mbGetCompressedFileSize(const FileName: String): Int64;
    Retrieves the time the file was changed.
 }
 function mbGetFileChangeTime(const FileName: String; out ChangeTime: TFileTime): Boolean;
+{en
+   Determines whether a key is up or down at the time the function is called,
+   and whether the key was pressed after a previous call to GetAsyncKeyStateEx.
+}
+function GetAsyncKeyStateEx(vKey: Integer): Boolean;
 {en
    This routine returns @true if the caller's
    process is a member of the Administrators local group.
@@ -587,6 +592,23 @@ begin
   ChangeTime:= TFileTime(FileInformation.ChangeTime);
 end;
 
+function GetAsyncKeyStateEx(vKey: Integer): Boolean;
+var
+  Handle: HWND;
+  dwProcessId: DWORD = 0;
+begin
+  if (GetAsyncKeyState(vKey) < 0) then
+  begin
+    Handle:= GetForegroundWindow;
+    if (Handle <> 0) then
+    begin
+      GetWindowThreadProcessId(Handle, @dwProcessId);
+      Exit(GetCurrentProcessId = dwProcessId);
+    end;
+  end;
+  Result:= False;
+end;
+
 function IsUserAdmin: LongBool;
 var
   ReturnLength: DWORD = 0;

src/platform/win/unetworkthread.pas

@@ -0,0 +1,92 @@
+unit uNetworkThread;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, SyncObjs, JwaWinNetWk, Windows;
+
+type
+
+  { TNetworkThread }
+
+  TNetworkThread = class(TThread)
+  private
+    FWaitFinish: TSimpleEvent;
+    FWaitConnect: TSimpleEvent;
+    NetResource: TNetResourceW;
+  protected
+    procedure Execute; override;
+  public
+    constructor Create(lpLocalName, lpRemoteName: LPWSTR; dwType: DWORD); reintroduce;
+    destructor Destroy; override;
+  public
+    class function Connect(lpLocalName, lpRemoteName: LPWSTR; dwType: DWORD): Integer;
+  end;
+
+implementation
+
+uses
+  uMyWindows;
+
+{ TNetworkThread }
+
+procedure TNetworkThread.Execute;
+begin
+  // Function WNetAddConnection2W works very slow
+  // when the final character is a backslash ('\')
+  ReturnValue:= WNetAddConnection2W(@NetResource, nil, nil, CONNECT_INTERACTIVE);
+  FWaitConnect.SetEvent;
+  FWaitFinish.WaitFor(INFINITE);
+end;
+
+constructor TNetworkThread.Create(lpLocalName, lpRemoteName: LPWSTR; dwType: DWORD);
+begin
+  inherited Create(True);
+  FreeOnTerminate:= True;
+  FWaitFinish:= TSimpleEvent.Create;
+  FWaitConnect:= TSimpleEvent.Create;
+  ZeroMemory(@NetResource, SizeOf(TNetResourceW));
+  if Assigned(lpLocalName) then begin
+    NetResource.lpLocalName:= StrNew(lpLocalName);
+  end;
+  if Assigned(lpRemoteName) then begin
+    NetResource.lpRemoteName:= StrNew(lpRemoteName);
+  end;
+  NetResource.dwType:= dwType;
+end;
+
+destructor TNetworkThread.Destroy;
+begin
+  FWaitConnect.Free;
+  FWaitFinish.Free;
+  StrDispose(NetResource.lpLocalName);
+  StrDispose(NetResource.lpRemoteName);
+  inherited Destroy;
+end;
+
+class function TNetworkThread.Connect(lpLocalName, lpRemoteName: LPWSTR; dwType: DWORD): Integer;
+var
+  Timeout: Integer = 10000;
+begin
+  with TNetworkThread.Create(lpLocalName, lpRemoteName, dwType) do
+  begin
+    Start;
+    try
+      while True do
+      begin
+        if (Timeout = 0) then Exit(WAIT_TIMEOUT);
+        if (GetAsyncKeyStateEx(VK_ESCAPE)) then Exit(ERROR_CANCELLED);
+        if (FWaitConnect.WaitFor(1) <> wrTimeout) then Exit(ReturnValue);
+        Dec(Timeout);
+      end;
+    finally
+      WriteLn(Result);
+      FWaitFinish.SetEvent;
+    end;
+  end;
+end;
+
+end.
+