瀏覽代碼

SysUtils: add ExpandFileName with a BasePath overload

git-svn-id: trunk@43928 -
ondrej 5 年之前
父節點
當前提交
34fecf90f3
共有 3 個文件被更改,包括 33 次插入3 次删除
  1. 23 3
      rtl/inc/fexpand.inc
  2. 9 0
      rtl/objpas/sysutils/fina.inc
  3. 1 0
      rtl/objpas/sysutils/finah.inc

+ 23 - 3
rtl/inc/fexpand.inc

@@ -103,7 +103,7 @@ end;
 {$ENDIF FPC_FEXPAND_VOLUMES}
 {$ENDIF FPC_FEXPAND_VOLUMES}
 
 
 
 
-function FExpand (const Path: PathStr): PathStr;
+function FExpand (const Path, BasePath: PathStr): PathStr;
 
 
 (* LFNSupport boolean constant, variable or function must be declared for all
 (* LFNSupport boolean constant, variable or function must be declared for all
    the platforms, at least locally in the Dos unit implementation part.
    the platforms, at least locally in the Dos unit implementation part.
@@ -299,8 +299,15 @@ begin
 {$ENDIF FPC_FEXPAND_DRIVES}
 {$ENDIF FPC_FEXPAND_DRIVES}
         begin
         begin
 
 
-(* Get current directory on selected drive/volume. *)
-            GetDirIO (0, S);
+(* Get base path *)
+{$IF defined(FPC_FEXPAND_SYSUTILS) and not defined(SYSUTILSUNICODE)}
+            S := ToSingleByteFileSystemEncodedFileName (BasePath);
+{$ELSE FPC_FEXPAND_SYSUTILS and not SYSUTILSUNICODE}
+            S := BasePath;
+{$ENDIF FPC_FEXPAND_SYSUTILS and not SYSUTILSUNICODE}
+            if not FileNameCasePreserving then
+              S := UpCase(S);
+
 {$IFDEF FPC_FEXPAND_VOLUMES}
 {$IFDEF FPC_FEXPAND_VOLUMES}
  {$IFDEF FPC_FEXPAND_DRIVESEP_IS_ROOT}
  {$IFDEF FPC_FEXPAND_DRIVESEP_IS_ROOT}
             PathStart := Pos (DriveSeparator, S);
             PathStart := Pos (DriveSeparator, S);
@@ -612,6 +619,19 @@ begin
     FExpand := Pa;
     FExpand := Pa;
 end;
 end;
 
 
+function FExpand (const Path: PathStr): PathStr;
+var
+  BaseDir: {$IF defined(FPC_FEXPAND_SYSUTILS) and not defined(SYSUTILSUNICODE)}RawByteString{$else}PathStr{$endif};
+begin
+  GetDirIO(0, BaseDir);
+{$IF defined(FPC_FEXPAND_SYSUTILS) and not defined(SYSUTILSUNICODE)}
+  { convert BaseDir to expected code page }
+  SetCodePage(BaseDir,DefaultRTLFileSystemCodePage);
+{$ENDIF FPC_FEXPAND_SYSUTILS and not SYSUTILSUNICODE}
+  FExpand := FExpand(Path, PathStr(BaseDir));
+end;
+
+
 (* Description of individual conditional defines supported for FExpand
 (* Description of individual conditional defines supported for FExpand
    (disregard the used directory separators in examples, constant
    (disregard the used directory separators in examples, constant
    System.DirectorySeparator is used in the real implemenation, of course):
    System.DirectorySeparator is used in the real implemenation, of course):

+ 9 - 0
rtl/objpas/sysutils/fina.inc

@@ -167,6 +167,15 @@ Begin
  Result:=Fexpand(S);
  Result:=Fexpand(S);
 end;
 end;
 
 
+function ExpandFileName (Const FileName, BasePath : PathStr): PathStr;
+
+Var S : PathStr;
+
+Begin
+ S:=FileName;
+ DoDirSeparators(S);
+ Result:=Fexpand(S,BasePath);
+end;
 
 
 {$ifndef HASEXPANDUNCFILENAME}
 {$ifndef HASEXPANDUNCFILENAME}
 function ExpandUNCFileName (Const FileName : PathStr): PathStr;
 function ExpandUNCFileName (Const FileName : PathStr): PathStr;

+ 1 - 0
rtl/objpas/sysutils/finah.inc

@@ -27,6 +27,7 @@ function ExtractFileExt(const FileName: PathStr): PathStr;
 function ExtractFileDir(Const FileName : PathStr): PathStr;
 function ExtractFileDir(Const FileName : PathStr): PathStr;
 function ExtractShortPathName(Const FileName : PathStr) : PathStr;
 function ExtractShortPathName(Const FileName : PathStr) : PathStr;
 function ExpandFileName (Const FileName : PathStr): PathStr;
 function ExpandFileName (Const FileName : PathStr): PathStr;
+function ExpandFileName (Const FileName, BasePath : PathStr): PathStr;
 function ExpandFileNameCase (const FileName: PathStr; out MatchFound: TFilenameCaseMatch): PathStr;
 function ExpandFileNameCase (const FileName: PathStr; out MatchFound: TFilenameCaseMatch): PathStr;
 function ExpandUNCFileName (Const FileName : PathStr): PathStr;
 function ExpandUNCFileName (Const FileName : PathStr): PathStr;
 function ExtractRelativePath (Const BaseName,DestName : PathStr): PathStr;
 function ExtractRelativePath (Const BaseName,DestName : PathStr): PathStr;