paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-14 10:20:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

SysUtils: add ExpandFileName with a BasePath overload

Browse Source 
git-svn-id: trunk@43928 -
This commit is contained in:
ondrej 2020-01-13 12:36:35 +00:00
parent 9926eb8dc6
commit 34fecf90f3
3 changed files with 33 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
rtl/inc/fexpand.inc
View File

@ -103,7 +103,7 @@ end;
{$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
the platforms, at least locally in the Dos unit implementation part.
@ -299,8 +299,15 @@ begin
{$ENDIF FPC_FEXPAND_DRIVES}
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_DRIVESEP_IS_ROOT}
PathStart := Pos (DriveSeparator, S);
@ -612,6 +619,19 @@ begin
FExpand := Pa;
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
(disregard the used directory separators in examples, constant
System.DirectorySeparator is used in the real implemenation, of course):

9
rtl/objpas/sysutils/fina.inc
View File

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

1
rtl/objpas/sysutils/finah.inc
View File

@ -27,6 +27,7 @@ function ExtractFileExt(const FileName: PathStr): PathStr;
function ExtractFileDir(Const FileName : PathStr): PathStr;
function ExtractShortPathName(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 ExpandUNCFileName (Const FileName : PathStr): PathStr;
function ExtractRelativePath (Const BaseName,DestName : PathStr): PathStr;