Procházet zdrojové kódy

Bug 133: Browse local UNC paths

https://winscp.net/tracker/133

BrowsedUncPath counter

Source commit: d791cfa372e4bf3e579473683a6df82604415f17
Martin Prikryl před 7 roky
rodič
revize
f03f0e10e6

+ 1 - 0
source/DriveDir.cbproj

@@ -58,6 +58,7 @@
 		<OutputExt>bpl</OutputExt>
 		<ProjectType>CppPackage</ProjectType>
 		<SanitizedProjectName>DriveDir</SanitizedProjectName>
+		<TLIB_PageSize>32</TLIB_PageSize>
 		<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
 		<VerInfo_Locale>1033</VerInfo_Locale>
 	</PropertyGroup>

+ 23 - 8
source/forms/ScpCommander.cpp

@@ -1886,6 +1886,7 @@ void __fastcall TScpCommanderForm::UpdateImages()
 //---------------------------------------------------------------------------
 void __fastcall TScpCommanderForm::LocalPathComboUpdateDrives()
 {
+  FLocalSpecialPaths = 0;
   TStrings* Strings = LocalPathComboBox->Strings;
   Strings->BeginUpdate();
   try
@@ -1895,17 +1896,27 @@ void __fastcall TScpCommanderForm::LocalPathComboUpdateDrives()
     Strings->Add(LoadStr(SPECIAL_FOLDER_MY_DOCUMENTS));
     FLocalPathComboBoxPaths->AddObject(GetPersonalFolder(),
       (TObject *)DriveInfo->SpecialFolder[CSIDL_PERSONAL]->ImageIndex);
+    FLocalSpecialPaths++;
     Strings->Add(LoadStr(SPECIAL_FOLDER_DESKTOP));
     FLocalPathComboBoxPaths->AddObject(GetDesktopFolder(),
       (TObject *)DriveInfo->SpecialFolder[CSIDL_DESKTOP]->ImageIndex);
+    FLocalSpecialPaths++;
 
-    for (TDrive Drive = FirstDrive; Drive <= LastDrive; Drive++)
+    std::unique_ptr<TStrings> Drives(LocalDriveView->GetDrives());
+    for (int Index = 0; Index < Drives->Count; Index++)
     {
-      if (DriveInfo->Data[Drive]->Valid)
+      UnicodeString Drive = Drives->Strings[Index];
+      if (DriveInfo->Get(Drive)->Valid)
       {
-        Strings->Add(UnicodeString(L"&") + DriveInfo->GetPrettyName(Drive));
-        FLocalPathComboBoxPaths->AddObject(UnicodeString(Drive) + L":\\",
-          (TObject *)DriveInfo->GetImageIndex(Drive));
+        UnicodeString Caption = DriveInfo->GetPrettyName(Drive);
+        if (DriveInfo->IsRealDrive(Drive))
+        {
+          Caption.Insert(L"&", 0);
+        }
+        Strings->Add(Caption);
+        UnicodeString RootPath = DriveInfo->GetDriveRoot(Drive);
+        int ImageIndex = DriveInfo->GetImageIndex(Drive);
+        FLocalPathComboBoxPaths->AddObject(RootPath, reinterpret_cast<TObject *>(ImageIndex));
       }
     }
   }
@@ -1942,6 +1953,10 @@ void __fastcall TScpCommanderForm::LocalPathComboUpdate()
 void __fastcall TScpCommanderForm::LocalDirViewPathChange(TCustomDirView * /*Sender*/)
 {
   LocalPathComboUpdate();
+  if (IsUncPath(LocalDirView->Path))
+  {
+    Configuration->Usage->Inc(L"BrowsedUncPath");
+  }
 }
 //---------------------------------------------------------------------------
 void __fastcall TScpCommanderForm::LocalPathComboBoxCancel(TObject * /*Sender*/)
@@ -1978,13 +1993,13 @@ void __fastcall TScpCommanderForm::LocalPathComboBoxItemClick(TObject * /*Sender
   DebugAssert((LocalPathComboBox->ItemIndex >= 0) && (LocalPathComboBox->ItemIndex < FLocalPathComboBoxPaths->Count));
 
   UnicodeString Path = FLocalPathComboBoxPaths->Strings[LocalPathComboBox->ItemIndex];
-  if (Path.Length() == 3)
+  if (LocalPathComboBox->ItemIndex >= FLocalSpecialPaths)
   {
-    LocalDirView->ExecuteDrive(Path[1]);
+    LocalDirView->ExecuteDrive(DriveInfo->GetDriveKey(Path));
   }
   else
   {
-    LocalDirView->Path = FLocalPathComboBoxPaths->Strings[LocalPathComboBox->ItemIndex];
+    LocalDirView->Path = Path;
   }
 }
 //---------------------------------------------------------------------------

+ 1 - 0
source/forms/ScpCommander.h

@@ -496,6 +496,7 @@ private:
   UnicodeString FDDExtTarget;
   bool FCommandLineComboPopulated;
   TStrings* FLocalPathComboBoxPaths;
+  int FLocalSpecialPaths;
   unsigned int FSpecialFolders;
   TEdit * FCommandLineComboEdit;
   TWndMethod FToolbarEditOldWndProc;

+ 2 - 9
source/packages/filemng/BaseUtils.pas

@@ -27,7 +27,7 @@ unit BaseUtils;
 interface
 
 uses
-  SysUtils, Windows, Forms, ShlObj, PIDL, Classes, Controls;
+  SysUtils, Windows, Forms, ShlObj, PIDL, Classes, Controls, DragDropFilesEx;
 
 type
   TDateTimePrecision = (tpNone, tpDay, tpMinute, tpSecond, tpMillisecond);
@@ -41,7 +41,6 @@ function FormatBytes(Bytes: Int64; Style: TFormatBytesStyle = fbShort; UseUnitsF
 function FormatPanelBytes(Bytes: Int64; Style: TFormatBytesStyle): string;
 procedure FreePIDL(var PIDL: PItemIDList);
 function StrContains(Str1, Str2: string): Boolean;
-function IsUncPath(Path: string): Boolean;
 
 procedure ReduceDateTimePrecision(var DateTime: TDateTime;
   Precision: TDateTimePrecision);
@@ -53,7 +52,6 @@ function FormatLastOSError(Message: string): string;
 
 resourcestring
   SNoValidPath = 'Can''t find any valid path.';
-  SUcpPathsNotSupported = 'UNC paths are not supported.';
   SByte = 'B';
   SKiloByte = 'KB';
   SMegaByte = 'MB';
@@ -62,12 +60,7 @@ resourcestring
 implementation
 
 uses
-  IEDriveInfo, DateUtils, ShellApi, SysConst, PasTools, Math;
-
-function IsUncPath(Path: string): Boolean;
-begin
-  Result := (Copy(Path, 1, 2) = '\\') or (Copy(Path, 1, 2) = '//');
-end;
+  IEDriveInfo, DateUtils, ShellApi, SysConst, PasTools, Math, CustomDirView, FileOperator, DragDrop;
 
 function StrContains(Str1, Str2: string): Boolean;
 var

+ 4 - 5
source/packages/filemng/CustomDirView.pas

@@ -109,7 +109,6 @@ type
     FUseSystemContextMenu: Boolean;
     FOnStartLoading: TNotifyEvent;
     FOnLoaded: TNotifyEvent;
-    FDragDrive: TDrive;
     FExeDrag: Boolean;
     FDDLinkOnExeDrag: Boolean;
     FOnDDDragEnter: TDDOnDragEnter;
@@ -215,6 +214,7 @@ type
     FSelectFile: string;
     FWatchForChanges: Boolean;
     FInvalidNameChars: string;
+    FDragDrive: string;
 
     procedure AddToDragFileList(FileList: TFileList; Item: TListItem); virtual;
     function CanEdit(Item: TListItem): Boolean; override;
@@ -400,7 +400,6 @@ type
     property IsRecycleBin: Boolean read FIsRecycleBin;
     property DDLinkOnExeDrag: Boolean read FDDLinkOnExeDrag
       write FDDLinkOnExeDrag default False;
-    property DragDrive: TDrive read FDragDrive;
     property DragOnDriveIsMove: Boolean read FDragOnDriveIsMove write FDragOnDriveIsMove;
     property DragSourceEffects: TDropEffectSet read GetDragSourceEffects{ write FDragSourceEffects};
     property ExeDrag: Boolean read FExeDrag;
@@ -863,7 +862,7 @@ begin
   FDragEnabled := False;
   FDDOwnerIsSource := False;
   FDDLinkOnExeDrag := False;
-  FDragDrive := #0;
+  FDragDrive := '';
   FExeDrag := False;
   FMask := '';
   FNaturalOrderNumericalSorting := True;
@@ -2054,7 +2053,7 @@ begin
      (Length(TFDDListItem(DragDropFilesEx.FileList[0]^).Name) > 0) and
      (not IsRecycleBin or not DragDropFilesEx.FileNamesAreMapped) then
   begin
-    FDragDrive := Upcase(TFDDListItem(DragDropFilesEx.FileList[0]^).Name[1]);
+    FDragDrive := DriveInfo.GetDriveKey(TFDDListItem(DragDropFilesEx.FileList[0]^).Name);
     FExeDrag := FDDLinkOnExeDrag and
       (deLink in DragDropFilesEx.TargetEffects) and
       ((DragDropFilesEx.AvailableDropEffects and DropEffect_Link) <> 0);
@@ -2071,7 +2070,7 @@ begin
   end
     else
   begin
-    FDragDrive := #0;
+    FDragDrive := '';
   end;
 
   FScrollOnDragOver.StartDrag;

+ 18 - 14
source/packages/filemng/CustomDriveView.pas

@@ -26,7 +26,7 @@ type
     FDragFileList: TStringList;
     FDragDropFilesEx: TCustomizableDragDropFilesEx;
     FDragImageList: TDragImageList;
-    FDragDrive: TDrive;
+    FDragDrive: string;
     FExeDrag: Boolean;
     FDDLinkOnExeDrag: Boolean;
     FDragNode: TTreeNode;
@@ -238,7 +238,7 @@ begin
 
   DragMode := dmAutomatic;
   FDragFileList := TStringList.Create;
-  FDragDrive := #0;
+  FDragDrive := '';
   FExeDrag := False;
   FDDLinkOnExeDrag := True;
   FContextMenu := False;
@@ -414,7 +414,7 @@ begin
   if (FDragDropFilesEx.FileList.Count > 0) and
      (Length(TFDDListItem(FDragDropFilesEx.FileList[0]^).Name) > 0) Then
   begin
-    FDragDrive := Upcase(TFDDListItem(FDragDropFilesEx.FileList[0]^).Name[1]);
+    FDragDrive := DriveInfo.GetDriveKey(TFDDListItem(FDragDropFilesEx.FileList[0]^).Name);
     FExeDrag := FDDLinkOnExeDrag and
       (deLink in DragDropFilesEx.TargetEffects) and
       ((DragDropFilesEx.AvailableDropEffects and DropEffect_Link) <> 0);
@@ -431,7 +431,7 @@ begin
   end
     else
   begin
-    FDragDrive := #0;
+    FDragDrive := '';
   end;
 
   FScrollOnDragOver.StartDrag;
@@ -695,7 +695,7 @@ begin
       Exit;
     end;
 
-    FDragDrive := #0;
+    FDragDrive := '';
 
     ClearDragFileList(FDragDropFilesEx.FileList);
     FDragDropFilesEx.CompleteFileList := DragCompleteFileList;
@@ -761,7 +761,7 @@ begin
     finally
       ClearDragFileList(FDragDropFilesEx.FileList);
 
-      FDragDrive := #0;
+      FDragDrive := '';
       DropTarget := nil;
 
       try
@@ -1157,15 +1157,19 @@ function TCustomDriveView.IterateSubTree(var StartNode : TTreeNode;
 begin {IterateSubTree}
   Result := False;
   FContinue := True;
-  if not Assigned(CallBackFunc) then Exit;
-
-  if ScanStartNode = coScanStartNode then
-    CallBackFunc(StartNode, Data);
-
-  if Assigned(StartNode) then
-    if (not FContinue) or (not ScanSubTree(StartNode)) then Exit;
+  if Assigned(CallBackFunc) then
+  begin
+    if ScanStartNode = coScanStartNode then
+    begin
+      CallBackFunc(StartNode, Data);
+    end;
 
-  Result := True;
+    if (not Assigned(StartNode)) or
+       FContinue and ScanSubTree(StartNode) then
+    begin
+      Result := True;
+    end;
+  end;
 end; {IterateSubTree}
 
 procedure TCustomDriveView.ClearDragFileList(FileList: TFileList);

+ 188 - 148
source/packages/filemng/DirView.pas

@@ -41,7 +41,7 @@ uses
   Windows, ShlObj, ComCtrls, CompThread, CustomDirView, ListExt,
   ExtCtrls, Graphics, FileOperator, DiscMon, Classes, DirViewColProperties,
   DragDrop, Messages, ListViewColProperties, CommCtrl, DragDropFilesEx,
-  FileCtrl, SysUtils, BaseUtils, Controls, CustomDriveView;
+  FileCtrl, SysUtils, BaseUtils, Controls, CustomDriveView, System.Generics.Collections;
 
 {$I ResStrings.pas }
 
@@ -64,8 +64,6 @@ type
   EInvalidFileName = class(Exception);
   ERenameFileFailed = class(Exception);
 
-  TDriveLetter = 'A'..'Z';
-
   TClipboardOperation = (cboNone, cboCut, cboCopy);
 
   {Record for each file item:}
@@ -167,7 +165,7 @@ type
     iRecycleFolder: iShellFolder;
     PIDLRecycle: PItemIDList;
 
-    FLastPath: array[TDriveLetter] of string;
+    FLastPath: TDictionary<string, string>;
 
     {Drag&Drop:}
     function GetDirColProperties: TDirViewColProperties;
@@ -175,7 +173,7 @@ type
 
     {Drag&drop helper functions:}
     procedure SignalFileDelete(Sender: TObject; Files: TStringList);
-    procedure PerformDragDropFileOperation(TargetPath: string; dwEffect: Integer;
+    procedure PerformDragDropFileOperation(TargetPath: string; Effect: Integer;
       RenameOnCollision: Boolean);
     procedure SetDirColProperties(Value: TDirViewColProperties);
 
@@ -305,13 +303,12 @@ type
 
     function FormatFileTime(FileTime: TFileTime): string; virtual;
     function GetAttrString(Attr: Integer): string; virtual;
-    procedure FetchAllDisplayData;
 
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure ExecuteHomeDirectory; override;
     procedure ReloadDirectory; override;
-    procedure ExecuteDrive(Drive: TDriveLetter);
+    procedure ExecuteDrive(Drive: string);
     property HomeDirectory: string read GetHomeDirectory write FHomeDirectory;
 
   published
@@ -399,6 +396,13 @@ procedure Register;
 {Returns True, if the specified extension matches one of the extensions in ExtList:}
 function MatchesFileExt(Ext: string; const FileExtList: string): Boolean;
 
+function DropLink(Item: PFDDListItem; TargetPath: string): Boolean;
+function DropFiles(
+  DragDropFilesEx: TCustomizableDragDropFilesEx; Effect: Integer; FileOperator: TFileOperator; TargetPath: string;
+  RenameOnCollision: Boolean; IsRecycleBin: Boolean; ConfirmDelete: Boolean; ConfirmOverwrite: Boolean;
+  Sender: TObject; OnDDFileOperation: TDDFileOperationEvent;
+  out SourcePath: string; out SourceIsDirectory: Boolean): Boolean;
+
 var
   LastClipBoardOperation: TClipBoardOperation;
   LastIOResult: DWORD;
@@ -477,6 +481,123 @@ begin
   end;
 end;
 
+function DropLink(Item: PFDDListItem; TargetPath: string): Boolean;
+var
+  Drive: string;
+  SourcePath: string;
+  SourceFile: string;
+begin
+  SourceFile := Item.Name;
+  if IsRootPath(SourceFile) then
+  begin
+    Drive := DriveInfo.GetDriveKey(SourceFile);
+    SourcePath := Copy(DriveInfo.Get(Drive).PrettyName, 4, 255) + ' (' + Drive + ')'
+  end
+    else
+  begin
+    SourcePath := ExtractFileName(SourceFile);
+  end;
+
+  Result :=
+    CreateFileShortCut(SourceFile,
+      IncludeTrailingBackslash(TargetPath) + ChangeFileExt(SourcePath, '.lnk'),
+      ExtractFileNameOnly(SourceFile));
+end;
+
+function DropFiles(
+  DragDropFilesEx: TCustomizableDragDropFilesEx; Effect: Integer; FileOperator: TFileOperator; TargetPath: string;
+  RenameOnCollision: Boolean; IsRecycleBin: Boolean; ConfirmDelete: Boolean; ConfirmOverwrite: Boolean;
+  Sender: TObject; OnDDFileOperation: TDDFileOperationEvent;
+  out SourcePath: string; out SourceIsDirectory: Boolean): Boolean;
+var
+  Index: Integer;
+  DoFileOperation: Boolean;
+begin
+  SourcePath := '';
+
+  {Set the source filenames:}
+  for Index := 0 to DragDropFilesEx.FileList.Count - 1 do
+  begin
+    FileOperator.OperandFrom.Add(
+      TFDDListItem(DragDropFilesEx.FileList[Index]^).Name);
+    if DragDropFilesEx.FileNamesAreMapped then
+      FileOperator.OperandTo.Add(IncludeTrailingPathDelimiter(TargetPath) +
+        TFDDListItem(DragDropFilesEx.FileList[Index]^).MappedName);
+
+    if SourcePath = '' then
+    begin
+      if DirectoryExists(TFDDListItem(DragDropFilesEx.FileList[Index]^).Name) then
+      begin
+        SourcePath := TFDDListItem(DragDropFilesEx.FileList[Index]^).Name;
+        SourceIsDirectory := True;
+      end
+        else
+      begin
+        SourcePath := ExtractFilePath(TFDDListItem(DragDropFilesEx.FileList[Index]^).Name);
+        SourceIsDirectory := False;
+      end;
+    end;
+  end;
+
+  FileOperator.Flags := [foAllowUndo, foNoConfirmMkDir];
+  if RenameOnCollision then
+  begin
+    FileOperator.Flags := FileOperator.Flags + [foRenameOnCollision];
+    FileOperator.WantMappingHandle := True;
+  end
+    else FileOperator.WantMappingHandle := False;
+
+  {Set the target directory or the target filenames:}
+  if DragDropFilesEx.FileNamesAreMapped and (not IsRecycleBin) then
+  begin
+    FileOperator.Flags := FileOperator.Flags + [foMultiDestFiles];
+  end
+    else
+  begin
+    FileOperator.Flags := FileOperator.Flags - [foMultiDestFiles];
+    FileOperator.OperandTo.Clear;
+    FileOperator.OperandTo.Add(TargetPath);
+  end;
+
+  {if the target directory is the recycle bin, then delete the selected files:}
+  if IsRecycleBin then
+  begin
+    FileOperator.Operation := foDelete;
+  end
+    else
+  begin
+    case Effect of
+      DropEffect_Copy: FileOperator.Operation := foCopy;
+      DropEffect_Move: FileOperator.Operation := foMove;
+    end;
+  end;
+
+  if IsRecycleBin then
+  begin
+    if not ConfirmDelete then
+      FileOperator.Flags := FileOperator.Flags + [foNoConfirmation];
+  end
+    else
+  begin
+    if not ConfirmOverwrite then
+      FileOperator.Flags := FileOperator.Flags + [foNoConfirmation];
+  end;
+
+  DoFileOperation := True;
+  if Assigned(OnDDFileOperation) then
+  begin
+    OnDDFileOperation(Sender, Effect, SourcePath, TargetPath, DoFileOperation);
+  end;
+
+  Result := DoFileOperation and (FileOperator.OperandFrom.Count > 0);
+  if Result then
+  begin
+    FileOperator.Execute;
+    if DragDropFilesEx.FileNamesAreMapped then
+      FileOperator.ClearUndo;
+  end;
+end;
+
 { TIconUpdateThread }
 
 constructor TIconUpdateThread.Create(Owner: TDirView);
@@ -654,8 +775,6 @@ end; {TIconUpdateThread.Terminate}
 { TDirView }
 
 constructor TDirView.Create(AOwner: TComponent);
-var
-  D: TDriveLetter;
 begin
   inherited Create(AOwner);
 
@@ -699,14 +818,14 @@ begin
     ShellExtensions.DropHandler := True;
   end;
 
-  for D := Low(FLastPath) to High(FLastPath) do
-    FLastPath[D] := '';
+  FLastPath := nil;
 end; {Create}
 
 destructor TDirView.Destroy;
 begin
   if Assigned(PIDLRecycle) then FreePIDL(PIDLRecycle);
 
+  FLastPath.Free;
   FInfoCacheList.Free;
   FFileOperator.Free;
   FChangeTimer.Free;
@@ -749,8 +868,8 @@ begin
     else
   begin
     Result := UserDocumentDirectory;
-    if (Result = '') or // in rare case the CSIDL_PERSONAL cannot be resolved
-       IsUNCPath(Result) then
+    // in rare case the CSIDL_PERSONAL cannot be resolved
+    if Result = '' then
     begin
       Result := DriveInfo.AnyValidPath;
     end;
@@ -759,7 +878,7 @@ end; { GetHomeDirectory }
 
 function TDirView.GetIsRoot: Boolean;
 begin
-  Result := (Length(Path) = 2) and (Path[2] = ':');
+  Result := IsRootPath(Path);
 end;
 
 function TDirView.GetPath: string;
@@ -777,8 +896,11 @@ begin
   // ExpandFileName resolves to current working directory
   // on the drive, not to root path
   Expanded := ExpandFileName(PathName);
-  Assert(Pos(':', Expanded) = 2);
-  FLastPath[UpCase(Expanded[1])] := Expanded;
+  if not Assigned(FLastPath) then
+  begin
+    FLastPath := TDictionary<string, string>.Create;
+  end;
+  FLastPath.AddOrSetValue(DriveInfo.GetDriveKey(Expanded), Expanded);
 end;
 
 procedure TDirView.SetPath(Value: string);
@@ -787,8 +909,6 @@ begin
   // it would truncate non-existing directory to first superior existing
   Value := ReplaceStr(Value, '/', '\');
 
-  if IsUncPath(Value) then
-    raise Exception.CreateFmt(SUcpPathsNotSupported, [Value]);
   if not DirectoryExists(ApiPath(Value)) then
     raise Exception.CreateFmt(SDirNotExists, [Value]);
 
@@ -834,7 +954,7 @@ end; {SetCompressedColor}
 
 function TDirView.GetPathName: string;
 begin
-  if (Length(Path) = 2) and (Path[2] = ':') then Result := Path + '\'
+  if IsRoot then Result := IncludeTrailingBackslash(Path)
     else Result := Path;
 end; {GetPathName}
 
@@ -1178,6 +1298,7 @@ var
   DirsCount: Integer;
   SelTreeNode: TTreeNode;
   Node: TTreeNode;
+  Drive: string;
 begin
   FHiddenCount := 0;
   FFilteredCount := 0;
@@ -1185,13 +1306,16 @@ begin
   try
     if Length(FPath) > 0 then
     begin
-      DriveInfo.ReadDriveStatus(FPath[1], dsSize);
-      FDriveType := DriveInfo[FPath[1]].DriveType;
+      Drive := DriveInfo.GetDriveKey(FPath);
+      DriveInfo.ReadDriveStatus(Drive, dsSize);
+      FDriveType := DriveInfo.Get(Drive).DriveType;
+      FDirOK := DriveInfo.Get(Drive).DriveReady and DirectoryExists(FPath);
     end
-      else FDriveType := DRIVE_UNKNOWN;
-
-    FDirOK := (Length(FPath) > 0) and
-      DriveInfo[FPath[1]].DriveReady and DirectoryExists(FPath);
+      else
+    begin
+      FDriveType := DRIVE_UNKNOWN;
+      FDirOK := False;
+    end;
 
     if DirOK then
     begin
@@ -1229,7 +1353,7 @@ begin
         end;
         SysUtils.FindClose(SRec);
 
-        if AddParentDir and (Length(FPath) > 2) then
+        if AddParentDir and (not IsRoot) then
         begin
           AddParentDirItem;
         end;
@@ -2098,7 +2222,7 @@ var
   Item: TListItem;
 begin
   // keep absolute path as is
-  if Copy(DirName, 2, 1) <> ':' then
+  if ExtractFileDrive(DirName) <> '' then
     DirName := Path + '\' + DirName;
 
   if WatchForChanges then StopWatchThread;
@@ -2658,20 +2782,32 @@ begin
   end;
 end;
 
-procedure TDirView.ExecuteDrive(Drive: TDriveLetter);
+procedure TDirView.ExecuteDrive(Drive: string);
 var
   APath: string;
 begin
-  if FLastPath[Drive] <> '' then
+  if Assigned(FLastPath) and FLastPath.ContainsKey(Drive) then
   begin
     APath := FLastPath[Drive];
     if not DirectoryExists(ApiPath(APath)) then
-      APath := Format('%s:', [Drive]);
+    begin
+      if DriveInfo.IsRealDrive(Drive) then
+        APath := Format('%s:', [Drive])
+      else
+        APath := Drive;
+    end;
   end
     else
   begin
-    GetDir(Integer(Drive) - Integer('A') + 1, APath);
-    APath := ExcludeTrailingPathDelimiter(APath);
+    if DriveInfo.IsRealDrive(Drive) then
+    begin
+      GetDir(Integer(Drive) - Integer('A') + 1, APath);
+      APath := ExcludeTrailingPathDelimiter(APath);
+    end
+      else
+    begin
+      APath := Drive;
+    end;
   end;
 
   if Path <> APath then
@@ -2981,8 +3117,7 @@ begin
     else
   if (grfKeyState and (MK_CONTROL or MK_SHIFT) = 0) then
   begin
-    if ExeDrag and (Path[1] >= FirstFixedDrive) and
-      (DragDrive >= FirstFixedDrive) then
+    if ExeDrag and DriveInfo.IsFixedDrive(DriveInfo.GetDriveKey(Path)) and DriveInfo.IsFixedDrive(FDragDrive) then
     begin
       dwEffect := DropEffect_Link
     end
@@ -2990,7 +3125,7 @@ begin
     begin
       if DragOnDriveIsMove and
          (not DDOwnerIsSource or Assigned(DropTarget)) and
-         (((DragDrive = Upcase(Path[1])) and (dwEffect = DropEffect_Copy) and
+         ((SameText(FDragDrive, DriveInfo.GetDriveKey(Path)) and (dwEffect = DropEffect_Copy) and
          (DragDropFilesEx.AvailableDropEffects and DropEffect_Move <> 0))
            or IsRecycleBin) then
       begin
@@ -3003,14 +3138,12 @@ begin
 end;
 
 procedure TDirView.PerformDragDropFileOperation(TargetPath: string;
-  dwEffect: Integer; RenameOnCollision: Boolean);
+  Effect: Integer; RenameOnCollision: Boolean);
 var
   Index: Integer;
   SourcePath: string;
-  SourceFile: string;
   OldCursor: TCursor;
   OldWatchForChanges: Boolean;
-  DoFileOperation: Boolean;
   IsRecycleBin: Boolean;
   SourceIsDirectory: Boolean;
   Node: TTreeNode;
@@ -3037,7 +3170,7 @@ begin
           Screen.Cursor := crHourGlass;
           WatchForChanges := False;
 
-          if (dwEffect in [DropEffect_Copy, DropEffect_Move]) then
+          if Effect in [DropEffect_Copy, DropEffect_Move] then
           begin
             StopWatchThread;
 
@@ -3048,113 +3181,26 @@ begin
                (DropSourceControl is TDirView) then
                 TDirView(DropSourceControl).StopWatchThread;
 
-            SourcePath := '';
-
-            {Set the source filenames:}
-            for Index := 0 to DragDropFilesEx.FileList.Count - 1 do
-            begin
-              FFileOperator.OperandFrom.Add(
-                TFDDListItem(DragDropFilesEx.FileList[Index]^).Name);
-              if DragDropFilesEx.FileNamesAreMapped then
-                FFileOperator.OperandTo.Add(IncludeTrailingPathDelimiter(TargetPath) +
-                  TFDDListItem(DragDropFilesEx.FileList[Index]^).MappedName);
-
-              if SourcePath = '' then
-              begin
-                if DirectoryExists(TFDDListItem(DragDropFilesEx.FileList[Index]^).Name) then
-                begin
-                  SourcePath := TFDDListItem(DragDropFilesEx.FileList[Index]^).Name;
-                  SourceIsDirectory := True;
-                end
-                  else
-                begin
-                  SourcePath := ExtractFilePath(TFDDListItem(DragDropFilesEx.FileList[Index]^).Name);
-                  SourceIsDirectory := False;
-                end;
-              end;
-            end;
-
-            FFileOperator.Flags := [foAllowUndo, foNoConfirmMkDir];
-            if RenameOnCollision then
-            begin
-              FFileOperator.Flags := FFileOperator.Flags + [foRenameOnCollision];
-              FFileOperator.WantMappingHandle := True;
-            end
-              else FFileOperator.WantMappingHandle := False;
-
-            {Set the target directory or the target filenames:}
-            if DragDropFilesEx.FileNamesAreMapped and (not IsRecycleBin) then
-            begin
-              FFileOperator.Flags := FFileOperator.Flags + [foMultiDestFiles];
-            end
-              else
+            if DropFiles(
+                 DragDropFilesEx, Effect, FFileOperator, TargetPath, RenameOnCollision, IsRecycleBin, ConfirmDelete, ConfirmOverwrite,
+                 Self, OnDDFileOperation, SourcePath, SourceIsDirectory) then
             begin
-              FFileOperator.Flags := FFileOperator.Flags - [foMultiDestFiles];
-              FFileOperator.OperandTo.Clear;
-              FFileOperator.OperandTo.Add(TargetPath);
-            end;
-
-            {if the target directory is the recycle bin, then delete the selected files:}
-            if IsRecycleBin then
-            begin
-              FFileOperator.Operation := foDelete;
-            end
-              else
-            begin
-              case dwEffect of
-                DropEffect_Copy: FFileOperator.Operation := foCopy;
-                DropEffect_Move: FFileOperator.Operation := foMove;
-              end;
-            end;
-
-            if IsRecycleBin then
-            begin
-              if not ConfirmDelete then
-                FFileOperator.Flags := FFileOperator.Flags + [foNoConfirmation];
-            end
-              else
-            begin
-              if not ConfirmOverwrite then
-                FFileOperator.Flags := FFileOperator.Flags + [foNoConfirmation];
-            end;
-
-            DoFileOperation := True;
-            if Assigned(OnDDFileOperation) then
-            begin
-              OnDDFileOperation(Self, dwEffect, SourcePath, TargetPath,
-                DoFileOperation);
-            end;
-
-            if DoFileOperation and (FFileOperator.OperandFrom.Count > 0) then
-            begin
-              FFileOperator.Execute;
               ReLoad2;
-              if DragDropFilesEx.FileNamesAreMapped then
-                FFileOperator.ClearUndo;
               if Assigned(OnDDFileOperationExecuted) then
-                OnDDFileOperationExecuted(Self, dwEffect, SourcePath, TargetPath);
+                OnDDFileOperationExecuted(Self, Effect, SourcePath, TargetPath);
             end;
           end
             else
-          if dwEffect = DropEffect_Link then
+          if Effect = DropEffect_Link then
           (* Create Link requested: *)
           begin
             StopWatchThread;
             for Index := 0 to DragDropFilesEx.FileList.Count - 1 do
             begin
-              SourceFile := TFDDListItem(DragDropFilesEx.FileList[Index]^).Name;
-
-              if Length(SourceFile) = 3 then
-                {Create a link to a drive:}
-                SourcePath := Copy(DriveInfo[SourceFile[1]].PrettyName, 4, 255) + '(' + SourceFile[1] + ')'
-              else
-                {Create a link to a file or directory:}
-                SourcePath := ExtractFileName(SourceFile);
-
-              if not CreateFileShortCut(SourceFile, IncludeTrailingPathDelimiter(TargetPath) +
-                ChangeFileExt(SourcePath,'.lnk'),
-                ExtractFileNameOnly(SourceFile)) then
-                  DDError(DDCreateShortCutError);
+              if not DropLink(PFDDListItem(DragDropFilesEx.FileList[Index]), TargetPath) then
+              begin
+                DDError(DDCreateShortCutError);
+              end;
             end;
             ReLoad2;
           end;
@@ -3162,10 +3208,13 @@ begin
           if Assigned(DropSourceControl) and
              (DropSourceControl is TDirView) and
              (DropSourceControl <> Self) and
-             (dwEffect = DropEffect_Move) then
-                TDirView(DropSourceControl).ValidateSelectedFiles;
+             (Effect = DropEffect_Move) then
+          begin
+            TDirView(DropSourceControl).ValidateSelectedFiles;
+          end;
 
           if Assigned(FDriveView) and SourceIsDirectory then
+          begin
             with TDriveView(FDriveView) do
             begin
               try
@@ -3173,7 +3222,7 @@ begin
               except
               end;
 
-              if (dwEffect = DropEffect_Move) or IsRecycleBin then
+              if (Effect = DropEffect_Move) or IsRecycleBin then
               try
                 Node := FindNodeToPath(SourcePath);
                 if Assigned(Node) and Assigned(Node.Parent) then
@@ -3182,6 +3231,7 @@ begin
               except
               end;
             end;
+          end;
         finally
           FFileOperator.OperandFrom.Clear;
           FFileOperator.OperandTo.Clear;
@@ -3375,16 +3425,6 @@ begin
   EmptyClipBoard;
 end; {DuplicateFiles}
 
-procedure TDirView.FetchAllDisplayData;
-var
-  Index: Integer;
-begin
-  for Index := 0 to Items.Count - 1 do
-    if Assigned(Items[Index]) and Assigned(Items[Index].Data) then
-      if PFileRec(Items[Index].Data)^.Empty then
-        GetDisplayData(Items[Index], False);
-end; {FetchAllDisplayData}
-
 function TDirView.NewColProperties: TCustomListViewColProperties;
 begin
   Result := TDirViewColProperties.Create(Self);

Rozdílová data souboru nebyla zobrazena, protože soubor je příliš velký
+ 332 - 237
source/packages/filemng/DriveView.pas


+ 212 - 110
source/packages/filemng/IEDriveInfo.pas

@@ -25,12 +25,13 @@ unit IEDriveInfo;
 
 {Required compiler options:}
 {$A+,B-,X+,H+,P+}
+{$WARN SYMBOL_PLATFORM OFF}
 
 interface
 
 uses
   Windows, Registry, SysUtils, Classes, ComCtrls, ShellApi, ShlObj, CommCtrl, Forms,
-  BaseUtils;
+  BaseUtils, System.Generics.Collections;
 
 const
   {Flags used by TDriveInfo.ReadDriveStatus and TDriveView.RefreshRootNodes:}
@@ -46,9 +47,7 @@ const
   LastSpecialFolder   = CSIDL_PRINTHOOD;
 
 type
-  TDrive    = Char;
-  PDriveInfoRec = ^TDriveInfoRec;
-  TDriveInfoRec = record
+  TDriveInfoRec = class
     PIDL        : PItemIDList; {Fully qualyfied PIDL}
     Init        : Boolean;     {Drivestatus was updated once}
     Valid       : Boolean;     {Drivestatus is valid}
@@ -61,6 +60,7 @@ type
     ImageIndex  : Integer;     {Drive imageIndex}
   end;
 
+  TRealDrive = char;
   TSpecialFolder = FirstSpecialFolder..LastSpecialFolder;
   PSpecialFolderRec = ^TSpecialFolderRec;
   TSpecialFolderRec = record
@@ -73,29 +73,34 @@ type
 
   TDriveInfo = class(TObject)
   private
-    FData: array[FirstDrive..LastDrive] of TDriveInfoRec;
+    FData: TObjectDictionary<string, TDriveInfoRec>;
     FNoDrives: DWORD;
     FDesktop: IShellFolder;
     FFolders: array[TSpecialFolder] of TSpecialFolderRec;
     FHonorDrivePolicy: Boolean;
     FLoaded: Boolean;
-    function GetData(Drive: TDrive): PDriveInfoRec;
     function GetFolder(Folder: TSpecialFolder): PSpecialFolderRec;
-    procedure ReadDriveBasicStatus(Drive: TDrive);
-    procedure ResetDrive(Drive: TDrive);
+    procedure ReadDriveBasicStatus(Drive: string);
+    procedure ResetDrive(Drive: string);
     procedure SetHonorDrivePolicy(Value: Boolean);
     procedure NeedData;
     procedure Load;
+    function AddDrive(Drive: string): TDriveInfoRec;
 
   public
-    property Data[Drive: TDrive]: PDriveInfoRec read GetData; default;
+    function Get(Drive: string): TDriveInfoRec;
     property SpecialFolder[Folder: TSpecialFolder]: PSpecialFolderRec read GetFolder;
 
     function AnyValidPath: string;
-    function GetImageIndex(Drive: TDrive): Integer;
-    function GetDisplayName(Drive: TDrive): string;
-    function GetPrettyName(Drive: TDrive): string;
-    function ReadDriveStatus(Drive: TDrive; Flags: Integer): Boolean;
+    function GetDriveKey(Path: string): string;
+    function GetDriveRoot(Drive: string): string;
+    function IsRealDrive(Drive: string): Boolean;
+    function IsFixedDrive(Drive: string): Boolean;
+    function GetImageIndex(Drive: string): Integer;
+    function GetSimpleName(Drive: string): string;
+    function GetDisplayName(Drive: string): string;
+    function GetPrettyName(Drive: string): string;
+    function ReadDriveStatus(Drive: string; Flags: Integer): Boolean;
     property HonorDrivePolicy: Boolean read FHonorDrivePolicy write SetHonorDrivePolicy;
     constructor Create;
     destructor Destroy; override;
@@ -103,8 +108,9 @@ type
 
 function GetShellFileName(const Name: string): string; overload;
 function GetShellFileName(PIDL: PItemIDList): string; overload;
-function GetNetWorkName(Drive: Char): string;
-function GetNetWorkConnected(Drive: Char): Boolean;
+function GetNetWorkName(Drive: string): string;
+function GetNetWorkConnected(Drive: string): Boolean;
+function IsRootPath(Path: string): Boolean;
 
 {Central drive information object instance of TDriveInfo}
 var
@@ -124,20 +130,12 @@ begin
 
   FHonorDrivePolicy := True;
   FLoaded := False;
+  FData := TObjectDictionary<string, TDriveInfoRec>.Create([doOwnsValues]);
 end; {TDriveInfo.Create}
 
 destructor TDriveInfo.Destroy;
-var
-  Drive: TDrive;
 begin
-  for Drive := FirstDrive to LastDrive do
-    with FData[Drive] do
-    begin
-      SetLength(DisplayName, 0);
-      SetLength(PrettyName, 0);
-      // This causes access violation
-      // FreePIDL(PIDL);
-    end;
+  FData.Free;
   inherited;
 end; {TDriveInfo.Destroy}
 
@@ -152,27 +150,70 @@ end;
 
 function TDriveInfo.AnyValidPath: string;
 var
-  Drive: TDrive;
+  Drive: TRealDrive;
 begin
-  for Drive := 'C' to 'Z' do
-    if GetData(Drive).Valid and
-       (GetData(Drive).DriveType = DRIVE_FIXED) and
-       DirectoryExists(ApiPath(Drive + ':\')) then
+  for Drive := FirstFixedDrive to LastDrive do
+    if Get(Drive).Valid and
+       (Get(Drive).DriveType = DRIVE_FIXED) and
+       DirectoryExists(ApiPath(DriveInfo.GetDriveRoot(Drive))) then
     begin
-      Result := Drive + ':\';
+      Result := DriveInfo.GetDriveRoot(Drive);
       Exit;
     end;
-  for Drive := 'C' to 'Z' do
-    if GetData(Drive).Valid and
-       (GetData(Drive).DriveType = DRIVE_REMOTE) and
-       DirectoryExists(ApiPath(Drive + ':\')) then
+  for Drive := FirstFixedDrive to LastDrive do
+    if Get(Drive).Valid and
+       (Get(Drive).DriveType = DRIVE_REMOTE) and
+       DirectoryExists(ApiPath(DriveInfo.GetDriveRoot(Drive))) then
     begin
-      Result := Drive + ':\';
+      Result := DriveInfo.GetDriveRoot(Drive);
       Exit;
     end;
   raise Exception.Create(SNoValidPath);
 end;
 
+function TDriveInfo.IsRealDrive(Drive: string): Boolean;
+begin
+  Result := (Length(Drive) = 1);
+  Assert((not Result) or ((Drive[1] >= FirstDrive) and (Drive[1] <= LastDrive)));
+end;
+
+function TDriveInfo.IsFixedDrive(Drive: string): Boolean;
+begin
+  Result := True;
+  if IsRealDrive(Drive) and (Drive[1] < FirstFixedDrive) then Result := False;
+end;
+
+function TDriveInfo.GetDriveKey(Path: string): string;
+begin
+  Result := ExtractFileDrive(Path);
+  if (Length(Result) = 2) and (Result[2] = DriveDelim) then
+  begin
+    Result := Upcase(Result[1]);
+  end
+    else
+  if IsUncPath(Path) then
+  begin
+    Result := LowerCase(Result);
+  end
+    else
+  begin
+    raise EConvertError.Create(Format(ErrorInvalidDrive, [Path]))
+  end;
+end;
+
+function TDriveInfo.GetDriveRoot(Drive: string): string;
+begin
+  if IsRealDrive(Drive) then
+  begin
+    Result := Drive + ':\'
+  end
+    else
+  begin
+    Assert(IsUncPath(Drive));
+    Result := IncludeTrailingBackslash(Drive);
+  end;
+end;
+
 function TDriveInfo.GetFolder(Folder: TSpecialFolder): PSpecialFolderRec;
 var
   FileInfo: TShFileInfo;
@@ -211,7 +252,7 @@ end;
 
 procedure TDriveInfo.SetHonorDrivePolicy(Value: Boolean);
 var
-  Drive: TDrive;
+  Drive: TRealDrive;
 begin
   if HonorDrivePolicy <> Value then
   begin
@@ -226,18 +267,19 @@ begin
   end;
 end;
 
-procedure TDriveInfo.ReadDriveBasicStatus(Drive: TDrive);
+procedure TDriveInfo.ReadDriveBasicStatus(Drive: string);
 begin
+  Assert(FData.ContainsKey(Drive));
   with FData[Drive] do
   begin
-    DriveType := Windows.GetDriveType(PChar(Drive + ':\'));
+    DriveType := Windows.GetDriveType(PChar(DriveInfo.GetDriveRoot(Drive)));
     Valid :=
-      ((not FHonorDrivePolicy) or (not Bool((1 shl (Ord(Drive) - 65)) and FNoDrives))) and
+      ((not IsRealDrive(Drive)) or (not FHonorDrivePolicy) or (not Bool((1 shl (Ord(Drive[1]) - 65)) and FNoDrives))) and
       (DriveType in [DRIVE_REMOVABLE, DRIVE_FIXED, DRIVE_CDROM, DRIVE_RAMDISK, DRIVE_REMOTE]);
   end;
 end;
 
-procedure TDriveInfo.ResetDrive(Drive: TDrive);
+procedure TDriveInfo.ResetDrive(Drive: string);
 begin
   with FData[Drive] do
   begin
@@ -252,7 +294,7 @@ end;
 
 procedure TDriveInfo.Load;
 var
-  Drive: TDrive;
+  Drive: TRealDrive;
   Reg: TRegistry;
   Folder: TSpecialFolder;
 begin
@@ -273,112 +315,121 @@ begin
 
   for Drive := FirstDrive to LastDrive do
   begin
-    with FData[Drive] do
-    begin
-      ReadDriveBasicStatus(Drive);
-      Init := False;
-      PIDL := nil;
-      ResetDrive(Drive);
-    end;
+    AddDrive(Drive);
   end;
 
   for Folder := Low(FFolders) to High(FFolders) do
     FFolders[Folder].Valid := False;
 end;
 
-function TDriveInfo.GetImageIndex(Drive: TDrive): Integer;
+function TDriveInfo.AddDrive(Drive: string): TDriveInfoRec;
+begin
+  Result := TDriveInfoRec.Create;
+  FData.Add(Drive, Result);
+  ResetDrive(Drive);
+  ReadDriveBasicStatus(Drive);
+end;
+
+function TDriveInfo.GetImageIndex(Drive: string): Integer;
 begin
   NeedData;
-  if (Drive < FirstDrive) or (Drive > LastDrive) then
-    raise EConvertError.Create(Format(ErrorInvalidDrive, [Drive]));
 
   Result := 0;
 
-  if FData[Drive].Valid then
+  if Get(Drive).Valid then
   begin
-    if FData[Drive].ImageIndex = 0 then
+    if Get(Drive).ImageIndex = 0 then
       ReadDriveStatus(Drive, dsImageIndex);
-    Result := FData[Drive].ImageIndex;
+    Result := Get(Drive).ImageIndex;
   end;
 end; {TDriveInfo.GetImageIndex}
 
-function TDriveInfo.GetDisplayName(Drive: TDrive): string;
+function TDriveInfo.GetDisplayName(Drive: string): string;
 begin
-  NeedData;
-  if (Drive < FirstDrive) or (Drive > LastDrive) then
-    raise EConvertError.Create(Format(ErrorInvalidDrive, [Drive]));
-
-  Result := Drive + ':';
-
-  if FData[Drive].Valid then
+  if Get(Drive).Valid then
   begin
-    if Length(FData[Drive].DisplayName) = 0 then
+    if Length(Get(Drive).DisplayName) = 0 then
       ReadDriveStatus(Drive, dsDisplayName);
-    Result := FData[Drive].DisplayName;
+    Result := Get(Drive).DisplayName;
+  end
+    else
+  begin
+    Result := GetSimpleName(Drive);
   end;
 end; {TDriveInfo.GetDisplayname}
 
-function TDriveInfo.GetPrettyName(Drive: TDrive): string;
+function TDriveInfo.GetPrettyName(Drive: string): string;
 begin
-  NeedData;
-  if (Drive < FirstDrive) or (Drive > LastDrive) then
-    raise EConvertError.Create(Format(ErrorInvalidDrive, [Drive]));
-
-  Result := Drive + ':';
-
-  if FData[Drive].Valid then
+  if Get(Drive).Valid then
   begin
-    if Length(FData[Drive].PrettyName) = 0 then
+    if Length(Get(Drive).PrettyName) = 0 then
       ReadDriveStatus(Drive, dsDisplayName);
-    Result := FData[Drive].PrettyName;
+    Result := Get(Drive).PrettyName;
+  end
+    else
+  begin
+    Result := GetSimpleName(Drive);
   end;
 end; {TDriveInfo.GetPrettyName}
 
-function TDriveInfo.GetData(Drive: TDrive): PDriveInfoRec;
+function TDriveInfo.GetSimpleName(Drive: string): string;
 begin
-  NeedData;
-  if not CharInSet(Upcase(Drive), ['A'..'Z']) then
-    raise EConvertError.Create(Format(ErrorInvalidDrive, [Drive]));
+  Result := Drive;
+  if IsRealDrive(Result) then Result := Result + ':';
+end;
 
-  Result := @FData[Upcase(Drive)];
+function TDriveInfo.Get(Drive: string): TDriveInfoRec;
+begin
+  NeedData;
+  if not FData.TryGetValue(Drive, Result) then
+  begin
+    Assert(IsUncPath(Drive));
+    Result := AddDrive(Drive);
+  end;
 end; {TDriveInfo.GetData}
 
-function TDriveInfo.ReadDriveStatus(Drive: TDrive; Flags: Integer): Boolean;
+function TDriveInfo.ReadDriveStatus(Drive: string; Flags: Integer): Boolean;
 var
   ErrorMode: Word;
   FileInfo: TShFileInfo;
+  DriveRoot: string;
   DriveID: string;
   CPos: Integer;
   Eaten: ULONG;
   ShAttr: ULONG;
   MaxFileNameLength: DWORD;
   FileSystemFlags: DWORD;
+  FreeSpace: Int64;
+  SimpleName: string;
+  DriveInfoRec: TDriveInfoRec;
+  S: string;
 begin
   if not Assigned(FDesktop) then
     SHGetDesktopFolder(FDesktop);
 
-  Drive := Upcase(Drive);
-  if (Drive < FirstDrive) or (Drive > LastDrive) then
-    raise EConvertError.Create(Format(ErrorInvalidDrive, [Drive]));
+  DriveRoot := DriveInfo.GetDriveRoot(Drive);
 
-  with FData[Drive] do
+  // When this method is called, the entry always exists already
+  Assert(FData.ContainsKey(Drive));
+  DriveInfoRec := FData[Drive];
+  with DriveInfoRec do
   begin
     Init := True;
     ReadDriveBasicStatus(Drive);
 
     if Valid then
     begin
-      if (not Assigned(PIDL)) and (Drive >= FirstFixedDrive) then
+      if (not Assigned(PIDL)) and IsFixedDrive(Drive) then
       begin
         ShAttr := 0;
         if DriveType = DRIVE_REMOTE then
         begin
           ShellFolderParseDisplayNameWithTimeout(
-            FDesktop, Application.Handle, nil, PChar(Drive + ':\'), Eaten, PIDL, ShAttr, 2 * MSecsPerSec);
+            FDesktop, Application.Handle, nil, PChar(DriveRoot), Eaten, PIDL, ShAttr, 2 * MSecsPerSec);
         end
           else
         begin
-          FDesktop.ParseDisplayName(Application.Handle, nil, PChar(Drive + ':\'), Eaten, PIDL, ShAttr);
+          FDesktop.ParseDisplayName(Application.Handle, nil, PChar(DriveRoot), Eaten, PIDL, ShAttr);
         end;
       end;
 
@@ -388,14 +439,11 @@ begin
         { turn off critical errors }
         ErrorMode := SetErrorMode(SEM_FailCriticalErrors or SEM_NOOPENFILEERRORBOX);
         try
-          { drive 1 = a, 2 = b, 3 = c, etc. }
-
-          Size := DiskSize(Ord(Drive) - $40);
-          DriveReady := (Size >= 0);
+          DriveReady := GetDiskFreeSpaceEx(PChar(DriveRoot), FreeSpace, Size, nil);
           if DriveReady then
           begin
             {Access the physical drive:}
-            if GetVolumeInformation(PChar(Drive + ':\'), nil, 0,
+            if GetVolumeInformation(PChar(DriveRoot), nil, 0,
                  @DriveSerial, MaxFileNameLength, FileSystemFlags,
                  nil, 0) then
             begin
@@ -419,27 +467,36 @@ begin
       if (Flags and dsDisplayName <> 0) then
       begin
         {Fetch drives displayname:}
+        SimpleName := GetSimpleName(Drive);
         if Assigned(PIDL) then DisplayName := GetShellFileName(PIDL)
           else
-        if Drive < FirstFixedDrive then DisplayName := GetShellFileName(Drive + ':\')
+        begin
           // typical reason we do not have PIDL is that it took too long to
           // call ParseDisplayName, in what case calling SHGetFileInfo with
           // path (instead of PIDL) will take long too, avoiding that and using
           // fallback
-          else DisplayName := '(' + Drive + ':)';
+          DisplayName := '(' + SimpleName + ')';
+        end;
 
         if DriveType <> DRIVE_REMOTE then
         begin
-          PrettyName := Drive + ': ' + DisplayName;
+          PrettyName := SimpleName + ' ' + DisplayName;
 
-          CPos := Pos(' (' + Drive + ':)', PrettyName);
+          S := ' (' + SimpleName + ')';
+          CPos := Pos(S, PrettyName);
           if CPos > 0 then
-            Delete(PrettyName, CPos, 5);
+            Delete(PrettyName, CPos, Length(S));
         end
           else
+        if IsRealDrive(Drive) then
         begin
           DriveID := GetNetWorkName(Drive);
-          PrettyName := Format('%s: %s (%s)', [Drive, ExtractFileName(DriveID), ExtractFileDir(DriveID)]);
+          PrettyName := Format('%s %s (%s)', [SimpleName, ExtractFileName(DriveID), ExtractFileDir(DriveID)]);
+        end
+          else
+        begin
+          Assert(IsUncPath(DriveRoot));
+          PrettyName := SimpleName;
         end;
       end;
 
@@ -452,7 +509,7 @@ begin
         end
           else
         begin
-          SHGetFileInfo(PChar(Drive + ':\'), 0, FileInfo, SizeOf(FileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
+          SHGetFileInfo(PChar(DriveRoot), 0, FileInfo, SizeOf(FileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
         end;
         ImageIndex := FileInfo.iIcon;
       end;
@@ -495,13 +552,15 @@ begin
   end;
 end; {GetShellFileName}
 
-function GetNetWorkName(Drive: Char): string;
+function GetNetWorkName(Drive: string): string;
 var
+  Path: string;
   P: array[0..MAX_PATH] of Char;
   MaxLen : DWORD;
 begin
+  Path := ExcludeTrailingBackslash(DriveInfo.GetDriveRoot(Drive));
   MaxLen := MAX_PATH;
-  if WNetGetConnection(PChar(string(Drive + ':')), P, MaxLen) = NO_ERROR then
+  if WNetGetConnection(PChar(Path), P, MaxLen) = NO_ERROR then
     Result := P
   else
     Result := '';
@@ -536,25 +595,68 @@ const
 function NetUseGetInfo(UncServerName: LMSTR; UseName: LMSTR; Level: DWORD; var BufPtr: LPBYTE): NET_API_STATUS; stdcall; external 'netapi32.dll';
 function NetApiBufferFree(Buffer: Pointer): DWORD; stdcall; external 'netapi32.dll';
 
-function GetNetWorkConnected(Drive: Char): Boolean;
+function GetNetWorkConnected(Drive: string): Boolean;
 var
   BufPtr: LPBYTE;
   NetResult: Integer;
+  ServerName: string;
+  PServerName: PChar;
+  Name: string;
+  P: Integer;
 begin
-  NetResult := NetUseGetInfo(nil, PChar(Drive + ':'), 1, BufPtr);
-  if NetResult = 0 then
+  Name := '';
+  PServerName := nil;
+  if DriveInfo.IsRealDrive(Drive) then
   begin
-    Result := (PUSE_INFO_1(BufPtr)^.ui1_status = USE_OK);
-    NetApiBufferFree(LPVOID(BufPtr));
+    Name := Drive + ':';
   end
     else
+  if IsUncPath(Drive) then
   begin
-    // NetUseGetInfo works for DFS shares only, hence when it fails
-    // we suppose different share type and fallback to "connected"
-    Result := True;
+    Name := Copy(Drive, 3, Length(Drive) - 2);
+    P := Pos('\', Name);
+    if P > 0 then
+    begin
+      ServerName := Copy(Name, P + 1, Length(Name) - P);
+      PServerName := PChar(ServerName);
+      SetLength(Name, P - 1);
+    end
+      else
+    begin
+      Assert(False);
+    end;
+  end
+    else
+  begin
+    Assert(False);
+  end;
+
+  if Name = '' then
+  begin
+    Result := False;
+  end
+    else
+  begin
+    NetResult := NetUseGetInfo(PServerName, PChar(Name), 1, BufPtr);
+    if NetResult = 0 then
+    begin
+      Result := (PUSE_INFO_1(BufPtr)^.ui1_status = USE_OK);
+      NetApiBufferFree(LPVOID(BufPtr));
+    end
+      else
+    begin
+      // NetUseGetInfo works for DFS shares only, hence when it fails
+      // we suppose different share type and fallback to "connected"
+      Result := True;
+    end;
   end;
 end;
 
+function IsRootPath(Path: string): Boolean;
+begin
+  Result := SameText(ExcludeTrailingBackslash(ExtractFileDrive(Path)), ExcludeTrailingBackslash(Path));
+end;
+
 initialization
   if not Assigned(DriveInfo) then
     DriveInfo := TDriveInfo.Create;

+ 7 - 0
source/packages/my/PasTools.pas

@@ -76,6 +76,8 @@ procedure SetAppMainForm(Value: TForm);
 
 procedure ForceColorChange(Control: TWinControl);
 
+function IsUncPath(Path: string): Boolean;
+
 type
   TApiPathEvent = function(Path: string): string;
 
@@ -955,6 +957,11 @@ begin
   end;
 end;
 
+function IsUncPath(Path: string): Boolean;
+begin
+  Result := (Copy(Path, 1, 2) = '\\') or (Copy(Path, 1, 2) = '//');
+end;
+
 var
   Lib: THandle;
 initialization

+ 19 - 7
source/packages/my/PathLabel.pas

@@ -147,7 +147,7 @@ implementation
 
 uses
   { SysUtils must overload deprecated FileCtrl (implements MinimizeName) }
-  FileCtrl, SysUtils, Math;
+  FileCtrl, SysUtils, Math, PasTools;
 
 const
   // magic value
@@ -695,16 +695,28 @@ begin
         repeat
           Assert(Path <> '');
 
-          DelimPos := Pos(GetSeparator, Path);
-          if DelimPos > 0 then
+          if (not FUnixPath) and (Result = '') and IsUncPath(Path) then
           begin
-            Result := Result + Copy(Path, 1, DelimPos);
-            Delete(Path, 1, DelimPos);
+            Result := ExtractFileDrive(Path);
+            if Copy(Path, Length(Result) + 1, 1) = GetSeparator then
+            begin
+              Result := Result + GetSeparator;
+            end;
+            Delete(Path, 1, Length(Result));
           end
             else
           begin
-            Result := Result + Path;
-            Path := '';
+            DelimPos := Pos(GetSeparator, Path);
+            if DelimPos > 0 then
+            begin
+              Result := Result + Copy(Path, 1, DelimPos);
+              Delete(Path, 1, DelimPos);
+            end
+              else
+            begin
+              Result := Result + Path;
+              Path := '';
+            end;
           end;
 
         until (Canvas.TextWidth(Result) >= Len) or (Path = '');

Některé soubory nejsou zobrazeny, neboť je v těchto rozdílových datech změněno mnoho souborů