浏览代码

FExpand: always uppercase drive letter also in BasePath

git-svn-id: trunk@46353 -
ondrej 5 年之前
父节点
当前提交
cfff96f44c
共有 1 个文件被更改,包括 6 次插入1 次删除
  1. 6 1
      rtl/inc/fexpand.inc

+ 6 - 1
rtl/inc/fexpand.inc

@@ -306,7 +306,12 @@ begin
             S := BasePath;
             S := BasePath;
 {$ENDIF FPC_FEXPAND_SYSUTILS and not SYSUTILSUNICODE}
 {$ENDIF FPC_FEXPAND_SYSUTILS and not SYSUTILSUNICODE}
             if not FileNameCasePreserving then
             if not FileNameCasePreserving then
-              S := UpCase(S);
+              S := UpCase(S)
+            else
+            { Always uppercase driveletter }
+            if (Length (S) > 1) and CharInSet(S [1], ['a'..'z']) and
+              (S [2] = DriveSeparator) and (DriveSeparator <> DirectorySeparator) then
+                S [1] := Chr (Ord (S [1]) and not ($20));
 
 
 {$IFDEF FPC_FEXPAND_VOLUMES}
 {$IFDEF FPC_FEXPAND_VOLUMES}
  {$IFDEF FPC_FEXPAND_DRIVESEP_IS_ROOT}
  {$IFDEF FPC_FEXPAND_DRIVESEP_IS_ROOT}