paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-24 05:19:37 +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

26
rtl/emx/sysutils.pp
View File

@ -638,13 +638,17 @@ end;
function FileExists (const FileName: string): boolean;
var
L: longint;
begin
if FileName = '' then
Result := false
else
Result := FileGetAttr (ExpandFileName (FileName)) and
(faDirectory or faVolumeID) = 0;
begin
L := FileGetAttr (FileName);
Result := (L >= 0) and (L and (faDirectory or faVolumeID) = 0);
(* Neither VolumeIDs nor directories are files. *)
end;
end;
@ -1059,14 +1063,20 @@ begin
Result := false
else
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
(* Do not remove '\' after ':' (root directory of a drive)
or in '\\' (invalid path, possibly broken UNC path). *)
not (Directory [Length (Directory) - 1] in AllowDriveSeparators + AllowDirectorySeparators) then
L := FileGetAttr (ExpandFileName (Copy (Directory, 1, Length (Directory) - 1)))
(* Do not remove '\' in '\\' (invalid path, possibly broken UNC path). *)
not (Directory [Length (Directory) - 1] in AllowDirectorySeparators) then
L := FileGetAttr (Copy (Directory, 1, Length (Directory) - 1))
else
L := FileGetAttr (ExpandFileName (Directory));
L := FileGetAttr (Directory);
Result := (L > 0) and (L and faDirectory = faDirectory);
end;
end;

10
rtl/go32v2/sysutils.pp
View File

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

27
rtl/os2/sysutils.pp
View File

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

28
rtl/watcom/sysutils.pp
View File

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