paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-13 11:09:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fix FileExists/DirectoryExists wrongly accepting non-existing entries with wrong path due to path normalization using ExpandFileName (correctly) accepting also non-existing paths

Browse Source 
git-svn-id: trunk@20890 -
This commit is contained in:
Tomas Hajny 2012-04-15 19:46:33 +00:00
parent 25f9c15290
commit 225cc1c1e0
4 changed files with 63 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
rtl/emx/sysutils.pp
View File

@ -638,13 +638,17 @@ end;
function FileExists (const FileName: string): boolean; function FileExists (const FileName: string): boolean;
var
L: longint;
begin begin
if FileName = '' then if FileName = '' then
Result := false Result := false
else else
Result := FileGetAttr (ExpandFileName (FileName)) and begin
(faDirectory or faVolumeID) = 0; L := FileGetAttr (FileName);
Result := (L >= 0) and (L and (faDirectory or faVolumeID) = 0);
(* Neither VolumeIDs nor directories are files. *) (* Neither VolumeIDs nor directories are files. *)
end;
end; end;
@ -1059,14 +1063,20 @@ begin
Result := false Result := false
else else
begin begin
if (Directory [Length (Directory)] in AllowDirectorySeparators) and if ((Length (Directory) = 2) or
(Length (Directory) = 3) and
(Directory [3] in AllowDirectorySeparators)) and
(Directory [2] in AllowDriveSeparators) and
(UpCase (Directory [1]) in ['A'..'Z']) then
(* Checking attributes for 'x:' is not possible but for 'x:.' it is. *)
L := FileGetAttr (Directory + '.')
else if (Directory [Length (Directory)] in AllowDirectorySeparators) and
(Length (Directory) > 1) and (Length (Directory) > 1) and
(* Do not remove '\' after ':' (root directory of a drive) (* Do not remove '\' in '\\' (invalid path, possibly broken UNC path). *)
or in '\\' (invalid path, possibly broken UNC path). *) not (Directory [Length (Directory) - 1] in AllowDirectorySeparators) then
not (Directory [Length (Directory) - 1] in AllowDriveSeparators + AllowDirectorySeparators) then L := FileGetAttr (Copy (Directory, 1, Length (Directory) - 1))
L := FileGetAttr (ExpandFileName (Copy (Directory, 1, Length (Directory) - 1)))
else else
L := FileGetAttr (ExpandFileName (Directory)); L := FileGetAttr (Directory);
Result := (L > 0) and (L and faDirectory = faDirectory); Result := (L > 0) and (L and faDirectory = faDirectory);
end; end;
end; end;

10
rtl/go32v2/sysutils.pp
View File

@ -284,14 +284,18 @@ begin
end; end;
Function FileExists (Const FileName : String) : Boolean; function FileExists (const FileName: string): boolean;
var
L: longint;
begin begin
if FileName = '' then if FileName = '' then
Result := false Result := false
else else
Result := FileGetAttr (ExpandFileName (FileName)) and begin
(faDirectory or faVolumeID) = 0; L := FileGetAttr (FileName);
Result := (L >= 0) and (L and (faDirectory or faVolumeID) = 0);
(* Neither VolumeIDs nor directories are files. *) (* Neither VolumeIDs nor directories are files. *)
end;
end; end;

27
rtl/os2/sysutils.pp
View File

@ -170,13 +170,17 @@ end;
function FileExists (const FileName: string): boolean; function FileExists (const FileName: string): boolean;
var
L: longint;
begin begin
if FileName = '' then if FileName = '' then
Result := false Result := false
else else
Result := FileGetAttr (ExpandFileName (FileName)) and begin
(faDirectory or faVolumeID) = 0; L := FileGetAttr (FileName);
Result := (L >= 0) and (L and (faDirectory or faVolumeID) = 0);
(* Neither VolumeIDs nor directories are files. *) (* Neither VolumeIDs nor directories are files. *)
end;
end; end;
@ -438,18 +442,25 @@ begin
Result := false Result := false
else else
begin begin
if (Directory [Length (Directory)] in AllowDirectorySeparators) and if ((Length (Directory) = 2) or
(Length (Directory) = 3) and
(Directory [3] in AllowDirectorySeparators)) and
(Directory [2] in AllowDriveSeparators) and
(UpCase (Directory [1]) in ['A'..'Z']) then
(* Checking attributes for 'x:' is not possible but for 'x:.' it is. *)
L := FileGetAttr (Directory + '.')
else if (Directory [Length (Directory)] in AllowDirectorySeparators) and
(Length (Directory) > 1) and (Length (Directory) > 1) and
(* Do not remove '\' after ':' (root directory of a drive) (* Do not remove '\' in '\\' (invalid path, possibly broken UNC path). *)
or in '\\' (invalid path, possibly broken UNC path). *) not (Directory [Length (Directory) - 1] in AllowDirectorySeparators) then
not (Directory [Length (Directory) - 1] in AllowDriveSeparators + AllowDirectorySeparators) then L := FileGetAttr (Copy (Directory, 1, Length (Directory) - 1))
L := FileGetAttr (ExpandFileName (Copy (Directory, 1, Length (Directory) - 1)))
else else
L := FileGetAttr (ExpandFileName (Directory)); L := FileGetAttr (Directory);
Result := (L > 0) and (L and faDirectory = faDirectory); Result := (L > 0) and (L and faDirectory = faDirectory);
end; end;
end; end;
{**************************************************************************** {****************************************************************************
Time Functions Time Functions
****************************************************************************} ****************************************************************************}

28
rtl/watcom/sysutils.pp
View File

@ -288,14 +288,18 @@ begin
end; end;
Function FileExists (Const FileName : String) : Boolean; function FileExists (const FileName: string): boolean;
var
L: longint;
begin begin
if FileName = '' then if FileName = '' then
Result := false Result := false
else else
Result := FileGetAttr (ExpandFileName (FileName)) and begin
(faDirectory or faVolumeID) = 0; L := FileGetAttr (FileName);
Result := (L >= 0) and (L and (faDirectory or faVolumeID) = 0);
(* Neither VolumeIDs nor directories are files. *) (* Neither VolumeIDs nor directories are files. *)
end;
end; end;
@ -307,14 +311,20 @@ begin
Result := false Result := false
else else
begin begin
if (Directory [Length (Directory)] in AllowDirectorySeparators) and if ((Length (Directory) = 2) or
(Length (Directory) = 3) and
(Directory [3] in AllowDirectorySeparators)) and
(Directory [2] in AllowDriveSeparators) and
(UpCase (Directory [1]) in ['A'..'Z']) then
(* Checking attributes for 'x:' is not possible but for 'x:.' it is. *)
L := FileGetAttr (Directory + '.')
else if (Directory [Length (Directory)] in AllowDirectorySeparators) and
(Length (Directory) > 1) and (Length (Directory) > 1) and
(* Do not remove '\' after ':' (root directory of a drive) (* Do not remove '\' in '\\' (invalid path, possibly broken UNC path). *)
or in '\\' (invalid path, possibly broken UNC path). *) not (Directory [Length (Directory) - 1] in AllowDirectorySeparators) then
not (Directory [Length (Directory) - 1] in AllowDriveSeparators + AllowDirectorySeparators) then L := FileGetAttr (Copy (Directory, 1, Length (Directory) - 1))
L := FileGetAttr (ExpandFileName (Copy (Directory, 1, Length (Directory) - 1)))
else else
L := FileGetAttr (ExpandFileName (Directory)); L := FileGetAttr (Directory);
Result := (L > 0) and (L and faDirectory = faDirectory); Result := (L > 0) and (L and faDirectory = faDirectory);
end; end;
end; end;