* made fexpand unicodestring-safe (use charinset instead of "in" --

"widechar in set" compiles, but results in a runtime conversion of
    the widechar into an ansistring and then getting the first character
    of that ansistring, which is horribly slow -- and Delphi-incompatible,
    but introduced a long time ago because of bug #7758)
  * replaced all "in" operations in sysutils fina.inc with CharInSet for
    the same reason
  * replaced all "string" declarations in finah.inc/fina.inc with "PathStr"
    and "pchar" with "PathPChar", and include them twice in sysutilh.inc/
    sysutils.inc, once with PathStr=UnicodeString/PathPChar=PWideChar and
    once with PathStr=AnsiString/PathPChar=PAnsiChar (not rawbytestring
    because there are several routines with var-parameters and then the
    string type has to match exactly; the "rtlproc" modifier could circumvent
    this, but should be used sparingly, and additionally the routine's
    internals would then first also have to be reviewed to ensure that at
    no point they start mixing in strings with the defaultsystemcodepage
    (e.g. directory separators) without first adjusting their codepage)
  * call GetShortPathNameA or GetShortPathNameW in ExtractShortPathName on
    Windows depending on whether we are parsing the RawByteString/UnicodeString
    version of fina.inc
  + ExpandUNCFileName(unicode) version for Windows, let its
    ExpandUNCFileName(ansistring) call the unicode version (avoid data loss
    due to ansi conversion) and convert the result to
    DefaultRTLFileSystemCodePage (to have no more data loss than what's
    specified by the user)

git-svn-id: branches/cpstrrtl@24999 -
This commit is contained in:
Jonas Maebe 2013-06-27 21:38:10 +00:00
parent 746546ed09
commit b08d8091b2
6 changed files with 137 additions and 92 deletions

View File

@ -50,7 +50,25 @@
{$DEFINE FPC_FEXPAND_UPDIR_HELPER} {$DEFINE FPC_FEXPAND_UPDIR_HELPER}
{$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR} {$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
procedure GetDirIO (DriveNr: byte; var Dir: String); { this code is used both in sysutils and in the dos unit, and the dos
unit does not have a charinset routine }
{$if not defined(FPC_FEXPAND_SYSUTILS) and not defined(FPC_FEXPAND_HAS_CHARINSET)}
{$define FPC_FEXPAND_HAS_CHARINSET}
type
TFExpandSysCharSet = set of ansichar;
Function CharInSet(Ch:AnsiChar;Const CSet : TFExpandSysCharSet) : Boolean; inline;
begin
CharInSet:=ch in CSet;
end;
Function CharInSet(Ch:WideChar;Const CSet : TFExpandSysCharSet) : Boolean;
begin
CharInSet:=(Ch<=#$FF) and (ansichar(byte(ch)) in CSet);
end;
{$endif}
procedure GetDirIO (DriveNr: byte; var Dir: PathStr);
(* GetDirIO is supposed to return the root of the given drive *) (* GetDirIO is supposed to return the root of the given drive *)
(* in case of an error for compatibility of FExpand with TP/BP. *) (* in case of an error for compatibility of FExpand with TP/BP. *)
@ -67,7 +85,7 @@ end;
{$IFDEF FPC_FEXPAND_VOLUMES} {$IFDEF FPC_FEXPAND_VOLUMES}
{$IFNDEF FPC_FEXPAND_NO_DEFAULT_PATHS} {$IFNDEF FPC_FEXPAND_NO_DEFAULT_PATHS}
procedure GetDirIO (const VolumeName: OpenString; var Dir: string); procedure GetDirIO (const VolumeName: OpenString; var Dir: PathStr);
var var
OldInOutRes: word; OldInOutRes: word;
@ -128,7 +146,7 @@ begin
(* by converting all to the native one. *) (* by converting all to the native one. *)
{$warnings off} {$warnings off}
for I := 1 to Length (Pa) do for I := 1 to Length (Pa) do
if Pa [I] in AllowDirectorySeparators then if CharInSet(Pa [I], AllowDirectorySeparators) then
Pa [I] := DirectorySeparator; Pa [I] := DirectorySeparator;
{$warnings on} {$warnings on}
@ -176,7 +194,7 @@ begin
{$IFDEF FPC_FEXPAND_VOLUMES} {$IFDEF FPC_FEXPAND_VOLUMES}
if PathStart > 1 then if PathStart > 1 then
{$ELSE FPC_FEXPAND_VOLUMES} {$ELSE FPC_FEXPAND_VOLUMES}
if (Length (Pa) > 1) and (Pa [1] in ['A'..'Z', 'a'..'z']) and if (Length (Pa) > 1) and CharInSet(Pa [1], ['A'..'Z', 'a'..'z']) and
(Pa [2] = DriveSeparator) and (DriveSeparator <> DirectorySeparator) then (Pa [2] = DriveSeparator) and (DriveSeparator <> DirectorySeparator) then
{$ENDIF FPC_FEXPAND_VOLUMES} {$ENDIF FPC_FEXPAND_VOLUMES}
begin begin
@ -189,7 +207,7 @@ begin
GetDirIO (Copy (Pa, 1, PathStart - 2), S); GetDirIO (Copy (Pa, 1, PathStart - 2), S);
{$ELSE FPC_FEXPAND_VOLUMES} {$ELSE FPC_FEXPAND_VOLUMES}
{ Always uppercase driveletter } { Always uppercase driveletter }
if (Pa [1] in ['a'..'z']) then if CharInSet(Pa [1], ['a'..'z']) then
Pa [1] := Chr (Ord (Pa [1]) and not ($20)); Pa [1] := Chr (Ord (Pa [1]) and not ($20));
GetDirIO (Ord (Pa [1]) - Ord ('A') + 1, S); GetDirIO (Ord (Pa [1]) - Ord ('A') + 1, S);
{$ENDIF FPC_FEXPAND_VOLUMES} {$ENDIF FPC_FEXPAND_VOLUMES}

View File

@ -14,7 +14,7 @@
System Utilities For Free Pascal System Utilities For Free Pascal
} }
function ChangeFileExt(const FileName, Extension: string): string; function ChangeFileExt(const FileName, Extension: PathStr): PathStr;
var var
i : longint; i : longint;
EndSep : Set of Char; EndSep : Set of Char;
@ -28,14 +28,14 @@ begin
Result := Copy(FileName, 1, I - 1) + Extension; Result := Copy(FileName, 1, I - 1) + Extension;
end; end;
function ExtractFilePath(const FileName: string): string; function ExtractFilePath(const FileName: PathStr): PathStr;
var var
i : longint; i : longint;
EndSep : Set of Char; EndSep : Set of Char;
begin begin
i := Length(FileName); i := Length(FileName);
EndSep:=AllowDirectorySeparators+AllowDriveSeparators; EndSep:=AllowDirectorySeparators+AllowDriveSeparators;
while (i > 0) and not (FileName[i] in EndSep) do while (i > 0) and not CharInSet(FileName[i],EndSep) do
Dec(i); Dec(i);
If I>0 then If I>0 then
Result := Copy(FileName, 1, i) Result := Copy(FileName, 1, i)
@ -43,22 +43,22 @@ begin
Result:=''; Result:='';
end; end;
function ExtractFileDir(const FileName: string): string; function ExtractFileDir(const FileName: PathStr): PathStr;
var var
i : longint; i : longint;
EndSep : Set of Char; EndSep : Set of Char;
begin begin
I := Length(FileName); I := Length(FileName);
EndSep:=AllowDirectorySeparators+AllowDriveSeparators; EndSep:=AllowDirectorySeparators+AllowDriveSeparators;
while (I > 0) and not (FileName[I] in EndSep) do while (I > 0) and not CharInSet(FileName[I],EndSep) do
Dec(I); Dec(I);
if (I > 1) and (FileName[I] in AllowDirectorySeparators) and if (I > 1) and CharInSet(FileName[I],AllowDirectorySeparators) and
not (FileName[I - 1] in EndSep) then not CharInSet(FileName[I - 1],EndSep) then
Dec(I); Dec(I);
Result := Copy(FileName, 1, I); Result := Copy(FileName, 1, I);
end; end;
function ExtractFileDrive(const FileName: string): string; function ExtractFileDrive(const FileName: PathStr): PathStr;
var var
i,l: longint; i,l: longint;
begin begin
@ -70,45 +70,45 @@ begin
i:=Pos(DriveSeparator,FileName); i:=Pos(DriveSeparator,FileName);
if (i > 0) then Result:=Copy(FileName,1,i); if (i > 0) then Result:=Copy(FileName,1,i);
{$ELSE} {$ELSE}
If (FileName[2] in AllowDriveSeparators) then If CharInSet(FileName[2],AllowDriveSeparators) then
result:=Copy(FileName,1,2) result:=Copy(FileName,1,2)
else if (FileName[1] in AllowDirectorySeparators) and else if CharInSet(FileName[1],AllowDirectorySeparators) and
(FileName[2] in AllowDirectorySeparators) then CharInSet(FileName[2],AllowDirectorySeparators) then
begin begin
i := 2; i := 2;
{ skip share } { skip share }
While (i<l) and Not (Filename[i+1] in AllowDirectorySeparators) do While (i<l) and Not CharInSet(Filename[i+1],AllowDirectorySeparators) do
inc(i); inc(i);
inc(i); inc(i);
While (i<l) and Not (Filename[i+1] in AllowDirectorySeparators) do While (i<l) and Not CharInSet(Filename[i+1],AllowDirectorySeparators) do
inc(i); inc(i);
Result:=Copy(FileName,1,i); Result:=Copy(FileName,1,i);
end; end;
{$ENDIF} {$ENDIF}
end; end;
function ExtractFileName(const FileName: string): string; function ExtractFileName(const FileName: PathStr): PathStr;
var var
i : longint; i : longint;
EndSep : Set of Char; EndSep : Set of Char;
begin begin
I := Length(FileName); I := Length(FileName);
EndSep:=AllowDirectorySeparators+AllowDriveSeparators; EndSep:=AllowDirectorySeparators+AllowDriveSeparators;
while (I > 0) and not (FileName[I] in EndSep) do while (I > 0) and not CharInSet(FileName[I],EndSep) do
Dec(I); Dec(I);
Result := Copy(FileName, I + 1, MaxInt); Result := Copy(FileName, I + 1, MaxInt);
end; end;
function ExtractFileExt(const FileName: string): string; function ExtractFileExt(const FileName: PathStr): PathStr;
var var
i : longint; i : longint;
EndSep : Set of Char; EndSep : Set of Char;
begin begin
I := Length(FileName); I := Length(FileName);
EndSep:=AllowDirectorySeparators+AllowDriveSeparators+[ExtensionSeparator]; EndSep:=AllowDirectorySeparators+AllowDriveSeparators+[ExtensionSeparator];
while (I > 0) and not (FileName[I] in EndSep) do while (I > 0) and not CharInSet(FileName[I],EndSep) do
Dec(I); Dec(I);
if (I > 0) and (FileName[I] = ExtensionSeparator) then if (I > 0) and (FileName[I] = ExtensionSeparator) then
Result := Copy(FileName, I, MaxInt) Result := Copy(FileName, I, MaxInt)
@ -116,28 +116,26 @@ begin
Result := ''; Result := '';
end; end;
function ExtractShortPathName(Const FileName : String) : String; function ExtractShortPathName(Const FileName : PathStr) : PathStr;
begin begin
{$ifdef MSWINDOWS} {$ifdef MSWINDOWS}
SetLength(Result,Max_Path); SetLength(Result,Max_Path);
SetLength(Result,GetShortPathName(PChar(FileName), Pchar(Result),Length(Result))); if sizeof(FileName[1])=1 then
SetLength(Result,GetShortPathNameA(PChar(FileName), PChar(Result),Length(Result)))
else
SetLength(Result,GetShortPathNameW(PWideChar(FileName), PWideChar(Result),Length(Result)));
{$else} {$else}
Result:=FileName; Result:=FileName;
{$endif} {$endif}
end; end;
type
PathStr=string;
{$DEFINE FPC_FEXPAND_SYSUTILS} {$DEFINE FPC_FEXPAND_SYSUTILS}
{$I fexpand.inc} {$I fexpand.inc}
function ExpandFileName (Const FileName : PathStr): PathStr;
function ExpandFileName (Const FileName : string): String; Var S : PathStr;
Var S : String;
Begin Begin
S:=FileName; S:=FileName;
@ -147,7 +145,7 @@ end;
{$ifndef HASEXPANDUNCFILENAME} {$ifndef HASEXPANDUNCFILENAME}
function ExpandUNCFileName (Const FileName : string): String; function ExpandUNCFileName (Const FileName : PathStr): PathStr;
begin begin
Result:=ExpandFileName (FileName); Result:=ExpandFileName (FileName);
//!! Here should follow code to replace the drive: part with UNC... //!! Here should follow code to replace the drive: part with UNC...
@ -155,38 +153,38 @@ end;
{$endif HASEXPANDUNCFILENAME} {$endif HASEXPANDUNCFILENAME}
function ExpandFileNameCase (const FileName: string; out MatchFound: TFilenameCaseMatch): string; function ExpandFileNameCase (const FileName: PathStr; out MatchFound: TFilenameCaseMatch): PathStr;
var var
SR: TSearchRec; SR: TSearchRec;
ItemsFound: byte; ItemsFound: byte;
FoundPath: string; FoundPath: PathStr;
RestPos: SizeUInt; RestPos: SizeUInt;
Root: string; Root: PathStr;
procedure TryCase (const Base, Rest: string); procedure TryCase (const Base, Rest: PathStr);
var var
SR: TSearchRec; SR: TSearchRec;
RC: longint; RC: longint;
NextDirPos: SizeUInt; NextDirPos: SizeUInt;
NextPart: string; NextPart: PathStr;
NextRest: string; NextRest: PathStr;
SearchBase: string; SearchBase: PathStr;
begin begin
NextDirPos := 1; NextDirPos := 1;
while (NextDirPos <= Length (Rest)) and while (NextDirPos <= Length (Rest)) and
not (Rest [NextDirPos] in (AllowDirectorySeparators)) do not CharInSet(Rest[NextDirPos],(AllowDirectorySeparators)) do
Inc (NextDirPos); Inc (NextDirPos);
NextPart := Copy (Rest, 1, Pred (NextDirPos)); NextPart := Copy (Rest, 1, Pred (NextDirPos));
{$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR} {$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR}
if (Length (Rest) >= NextDirPos) and if (Length (Rest) >= NextDirPos) and
(Rest [NextDirPos] in AllowDirectorySeparators) then CharInSet(Rest[NextDirPos],AllowDirectorySeparators) then
{$ELSE FPC_FEXPAND_DIRSEP_IS_UPDIR} {$ELSE FPC_FEXPAND_DIRSEP_IS_UPDIR}
while (Length (Rest) >= NextDirPos) and while (Length (Rest) >= NextDirPos) and
(Rest [NextDirPos] in AllowDirectorySeparators) do CharInSet(Rest[NextDirPos],AllowDirectorySeparators) do
{$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR} {$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
Inc (NextDirPos); Inc (NextDirPos);
NextRest := Copy (Rest, NextDirPos, Length (Rest) - Pred (NextDirPos)); NextRest := Copy (Rest, NextDirPos, Length (Rest) - Pred (NextDirPos));
if (Base = '') or (Base [Length (Base)] in AllowDirectorySeparators) then if (Base = '') or CharInSet(Base[Length (Base)],AllowDirectorySeparators) then
SearchBase := Base SearchBase := Base
else else
SearchBase := Base + DirectorySeparator; SearchBase := Base + DirectorySeparator;
@ -238,10 +236,10 @@ begin
begin begin
{$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR} {$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR}
if (Length (FileName) >= RestPos) and if (Length (FileName) >= RestPos) and
(FileName [RestPos] in AllowDirectorySeparators) then CharInSet(FileName[RestPos],AllowDirectorySeparators) then
{$ELSE FPC_FEXPAND_DIRSEP_IS_UPDIR} {$ELSE FPC_FEXPAND_DIRSEP_IS_UPDIR}
while (Length (FileName) >= RestPos) and while (Length (FileName) >= RestPos) and
(FileName [RestPos] in AllowDirectorySeparators) do CharInSet(FileName[RestPos],AllowDirectorySeparators) do
{$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR} {$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
Inc (RestPos); Inc (RestPos);
Root := Copy (FileName, 1, Pred (RestPos)); Root := Copy (FileName, 1, Pred (RestPos));
@ -265,11 +263,11 @@ Const
MaxDirs = 129; MaxDirs = 129;
{$endif} {$endif}
function ExtractRelativepath (Const BaseName,DestName : String): String; function ExtractRelativepath (Const BaseName,DestName : PathStr): PathStr;
Var Source, Dest : String; Var Source, Dest : PathStr;
Sc,Dc,I,J : Longint; Sc,Dc,I,J : Longint;
SD,DD : Array[1..MaxDirs] of PChar; SD,DD : Array[1..MaxDirs] of PathPChar;
Const OneLevelBack = '..'+DirectorySeparator; Const OneLevelBack = '..'+DirectorySeparator;
@ -297,18 +295,18 @@ begin
Result:=Result+ExtractFileName(DestNAme); Result:=Result+ExtractFileName(DestNAme);
end; end;
Procedure DoDirSeparators (Var FileName : String); Procedure DoDirSeparators (Var FileName : PathStr);
VAr I : longint; VAr I : longint;
begin begin
For I:=1 to Length(FileName) do For I:=1 to Length(FileName) do
If FileName[I] in AllowDirectorySeparators then If CharInSet(FileName[I],AllowDirectorySeparators) then
FileName[i]:=DirectorySeparator; FileName[i]:=DirectorySeparator;
end; end;
Function SetDirSeparators (Const FileName : string) : String; Function SetDirSeparators (Const FileName : PathStr) : PathStr;
begin begin
Result:=FileName; Result:=FileName;
@ -322,7 +320,7 @@ end;
if none were found. if none were found.
} }
Function GetDirs (Var DirName : String; Var Dirs : Array of pchar) : Longint; Function GetDirs (Var DirName : PathStr; Var Dirs : Array of PathPChar) : Longint;
Var I : Longint; Var I : Longint;
@ -331,7 +329,7 @@ begin
Result:=-1; Result:=-1;
While I<=Length(DirName) do While I<=Length(DirName) do
begin begin
If (DirName[i] in AllowDirectorySeparators) and If CharInSet(DirName[i],AllowDirectorySeparators) and
{ avoid error in case last char=pathdelim } { avoid error in case last char=pathdelim }
(length(dirname)>i) then (length(dirname)>i) then
begin begin
@ -344,7 +342,7 @@ begin
If Result>-1 then inc(Result); If Result>-1 then inc(Result);
end; end;
function IncludeTrailingPathDelimiter(Const Path : String) : String; function IncludeTrailingPathDelimiter(Const Path : PathStr) : PathStr;
Var Var
l : Integer; l : Integer;
@ -352,35 +350,35 @@ Var
begin begin
Result:=Path; Result:=Path;
l:=Length(Result); l:=Length(Result);
If (L=0) or not(Result[l] in AllowDirectorySeparators) then If (L=0) or not CharInSet(Result[l],AllowDirectorySeparators) then
Result:=Result+DirectorySeparator; Result:=Result+DirectorySeparator;
end; end;
function IncludeTrailingBackslash(Const Path : String) : String; function IncludeTrailingBackslash(Const Path : PathStr) : PathStr;
begin begin
Result:=IncludeTrailingPathDelimiter(Path); Result:=IncludeTrailingPathDelimiter(Path);
end; end;
function ExcludeTrailingBackslash(Const Path: string): string; function ExcludeTrailingBackslash(Const Path: PathStr): PathStr;
begin begin
Result:=ExcludeTrailingPathDelimiter(Path); Result:=ExcludeTrailingPathDelimiter(Path);
end; end;
function ExcludeTrailingPathDelimiter(Const Path: string): string; function ExcludeTrailingPathDelimiter(Const Path: PathStr): PathStr;
Var Var
L : Integer; L : Integer;
begin begin
L:=Length(Path); L:=Length(Path);
If (L>0) and (Path[L] in AllowDirectorySeparators) then If (L>0) and CharInSet(Path[L],AllowDirectorySeparators) then
Dec(L); Dec(L);
Result:=Copy(Path,1,L); Result:=Copy(Path,1,L);
end; end;
function IncludeLeadingPathDelimiter(Const Path : String) : String; function IncludeLeadingPathDelimiter(Const Path : PathStr) : PathStr;
Var Var
l : Integer; l : Integer;
@ -388,11 +386,11 @@ Var
begin begin
Result:=Path; Result:=Path;
l:=Length(Result); l:=Length(Result);
If (L=0) or not(Result[1] in AllowDirectorySeparators) then If (L=0) or not CharInSet(Result[1],AllowDirectorySeparators) then
Result:=DirectorySeparator+Result; Result:=DirectorySeparator+Result;
end; end;
function ExcludeLeadingPathDelimiter(Const Path: string): string; function ExcludeLeadingPathDelimiter(Const Path: PathStr): PathStr;
Var Var
L : Integer; L : Integer;
@ -400,17 +398,17 @@ Var
begin begin
Result:=Path; Result:=Path;
L:=Length(Result); L:=Length(Result);
If (L>0) and (Result[1] in AllowDirectorySeparators) then If (L>0) and CharInSet(Result[1],AllowDirectorySeparators) then
Delete(Result,1,1); Delete(Result,1,1);
end; end;
function IsPathDelimiter(Const Path: string; Index: Integer): Boolean; function IsPathDelimiter(Const Path: PathStr; Index: Integer): Boolean;
begin begin
Result:=(Index>0) and (Index<=Length(Path)) and (Path[Index] in AllowDirectorySeparators); Result:=(Index>0) and (Index<=Length(Path)) and CharInSet(Path[Index],AllowDirectorySeparators);
end; end;
function ConcatPaths(const Paths: array of String): String; function ConcatPaths(const Paths: array of PathStr): PathStr;
var var
I: Integer; I: Integer;
begin begin

View File

@ -19,26 +19,26 @@ type
TFilenameCaseMatch = (mkNone, mkExactMatch, mkSingleMatch, mkAmbiguous); TFilenameCaseMatch = (mkNone, mkExactMatch, mkSingleMatch, mkAmbiguous);
{$endif} {$endif}
function ChangeFileExt(const FileName, Extension: string): string; function ChangeFileExt(const FileName, Extension: PathStr): PathStr;
function ExtractFilePath(const FileName: string): string; function ExtractFilePath(const FileName: PathStr): PathStr;
function ExtractFileDrive(const FileName: string): string; function ExtractFileDrive(const FileName: PathStr): PathStr;
function ExtractFileName(const FileName: string): string; function ExtractFileName(const FileName: PathStr): PathStr;
function ExtractFileExt(const FileName: string): string; function ExtractFileExt(const FileName: PathStr): PathStr;
function ExtractFileDir(Const FileName : string): string; function ExtractFileDir(Const FileName : PathStr): PathStr;
function ExtractShortPathName(Const FileName : String) : String; function ExtractShortPathName(Const FileName : PathStr) : PathStr;
function ExpandFileName (Const FileName : string): String; function ExpandFileName (Const FileName : PathStr): PathStr;
function ExpandFileNameCase (const FileName: string; out MatchFound: TFilenameCaseMatch): string; function ExpandFileNameCase (const FileName: PathStr; out MatchFound: TFilenameCaseMatch): PathStr;
function ExpandUNCFileName (Const FileName : string): String; function ExpandUNCFileName (Const FileName : PathStr): PathStr;
function ExtractRelativepath (Const BaseName,DestNAme : String): String; function ExtractRelativepath (Const BaseName,DestNAme : PathStr): PathStr;
function IncludeTrailingPathDelimiter(Const Path : String) : String; function IncludeTrailingPathDelimiter(Const Path : PathStr) : PathStr;
function IncludeTrailingBackslash(Const Path : String) : String; function IncludeTrailingBackslash(Const Path : PathStr) : PathStr;
function ExcludeTrailingBackslash(Const Path: string): string; function ExcludeTrailingBackslash(Const Path: PathStr): PathStr;
function ExcludeTrailingPathDelimiter(Const Path: string): string; function ExcludeTrailingPathDelimiter(Const Path: PathStr): PathStr;
function IncludeLeadingPathDelimiter(Const Path : String) : String; function IncludeLeadingPathDelimiter(Const Path : PathStr) : PathStr;
function ExcludeLeadingPathDelimiter(Const Path: string): string; function ExcludeLeadingPathDelimiter(Const Path: PathStr): PathStr;
function IsPathDelimiter(Const Path: string; Index: Integer): Boolean; function IsPathDelimiter(Const Path: PathStr; Index: Integer): Boolean;
Procedure DoDirSeparators (Var FileName : String); Procedure DoDirSeparators (Var FileName : PathStr);
Function SetDirSeparators (Const FileName : String) : String; Function SetDirSeparators (Const FileName : PathStr) : PathStr;
Function GetDirs (Var DirName : String; Var Dirs : Array of pchar) : Longint; Function GetDirs (Var DirName : PathStr; Var Dirs : Array of PathPChar) : Longint;
function ConcatPaths(const Paths: array of String): String; function ConcatPaths(const Paths: array of PathStr): PathStr;

View File

@ -288,8 +288,17 @@ Type
{$i sysencodingh.inc} {$i sysencodingh.inc}
{$endif FPC_HAS_UNICODESTRING} {$endif FPC_HAS_UNICODESTRING}
{$macro on}
{$define PathStr:=UnicodeString}
{$define PathPChar:=PWideChar}
{ Read filename handling functions declaration } { Read filename handling functions declaration }
{$i finah.inc} {$i finah.inc}
{$define PathStr:=AnsiString}
{$define PathPChar:=PAnsiChar}
{ Read filename handling functions declaration }
{$i finah.inc}
{$undef PathStr}
{$undef PathPChar}
{ Read other file handling function declarations } { Read other file handling function declarations }
{$i filutilh.inc} {$i filutilh.inc}

View File

@ -12,8 +12,17 @@
**********************************************************************} **********************************************************************}
{$macro on}
{$define PathStr:=UnicodeString}
{$define PathPChar:=PWideChar}
{ Read filename handling functions implementation } { Read filename handling functions implementation }
{$i fina.inc} {$i fina.inc}
{$define PathStr:=AnsiString}
{$define PathPChar:=PAnsiChar}
{ Read filename handling functions implementation }
{$i fina.inc}
{$undef PathStr}
{$undef PathPChar}
{ Read file utility functions implementation } { Read file utility functions implementation }
{$i filutil.inc} {$i filutil.inc}

View File

@ -181,10 +181,21 @@ end;
function ExpandUNCFileName (const filename:string) : string; function ExpandUNCFileName (const filename:string) : string;
{ returns empty string on errors } { returns empty string on errors }
var var
s : ansistring; u: unicodestring;
begin
{ prevent data loss due to unsupported characters in ansi code page }
u:=ExpandUNCFileName(filename);
widestringmanager.Unicode2AnsiMoveProc(punicodechar(u),result,DefaultRTLFileSystemCodePage,length(u));
end;
function ExpandUNCFileName (const filename:unicodestring) : unicodestring;
{ returns empty string on errors }
var
s : unicodestring;
size : dword; size : dword;
rc : dword; rc : dword;
buf : pchar; buf : pwidechar;
begin begin
s := ExpandFileName (filename); s := ExpandFileName (filename);
@ -194,12 +205,12 @@ begin
getmem(buf,size); getmem(buf,size);
try try
rc := WNetGetUniversalName (pchar(s), UNIVERSAL_NAME_INFO_LEVEL, buf, @size); rc := WNetGetUniversalNameW (pwidechar(s), UNIVERSAL_NAME_INFO_LEVEL, buf, @size);
if rc=ERROR_MORE_DATA then if rc=ERROR_MORE_DATA then
begin begin
buf:=reallocmem(buf,size); buf:=reallocmem(buf,size);
rc := WNetGetUniversalName (pchar(s), UNIVERSAL_NAME_INFO_LEVEL, buf, @size); rc := WNetGetUniversalNameW (pwidechar(s), UNIVERSAL_NAME_INFO_LEVEL, buf, @size);
end; end;
if rc = NO_ERROR then if rc = NO_ERROR then
Result := PRemoteNameInfo(buf)^.lpUniversalName Result := PRemoteNameInfo(buf)^.lpUniversalName