paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 15:47:52 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fix for DirectoryExists - proper handling of root directory

Browse Source 
git-svn-id: trunk@18186 -
This commit is contained in:
Tomas Hajny 2011-08-13 00:06:14 +00:00
parent 4230a33272
commit 867ad94115
3 changed files with 49 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
rtl/emx/sysutils.pp
View File

@ -578,22 +578,14 @@ begin
end;
function FileExists (const FileName: string): boolean; assembler;
asm
{$IFDEF REGCALL}
mov edx, eax
{$ELSE REGCALL}
mov edx, FileName
{$ENDIF REGCALL}
mov ax, 4300h
call syscall
mov eax, 0
jc @FExistsEnd
test cx, 18h
jnz @FExistsEnd
inc eax
@FExistsEnd:
end {['eax', 'ecx', 'edx']};
function FileExists (const FileName: string): boolean;
begin
if Directory = '' then
Result := false
else
Result := FileGetAttr (ExpandFileName (Directory)) and
faDirectory = faDirectory;
end;
type TRec = record
@ -970,29 +962,32 @@ begin
end;
{$ASMMODE INTEL}
function DirectoryExists (const Directory: string): boolean; assembler;
asm
{$IFDEF REGCALL}
mov edx, eax
{$ELSE REGCALL}
mov edx, Directory
{$ENDIF REGCALL}
mov ax, 4300h
call syscall
mov eax, 0
jc @FExistsEnd
test cx, 10h
jz @FExistsEnd
inc eax
@FExistsEnd:
end {['eax', 'ecx', 'edx']};
function DirectoryExists (const Directory: string): boolean;
var
L: longint;
begin
if Directory = '' then
Result := false
else
begin
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)))
else
L := FileGetAttr (ExpandFileName (Directory));
Result := (L > 0) and (L and faDirectory = faDirectory);
end;
end;
{****************************************************************************
Time Functions
****************************************************************************}
{$ASMMODE INTEL}
procedure GetLocalTime (var SystemTime: TSystemTime); assembler;
asm
(* Expects the default record alignment (word)!!! *)

16
rtl/go32v2/sysutils.pp
View File

@ -302,7 +302,6 @@ end;
Function DirectoryExists (Const Directory : String) : Boolean;
Var
Sr : Searchrec;
Dir : String;
drive : byte;
StoredIORes : longint;
@ -334,16 +333,13 @@ begin
{$ifdef OPT_I}
{$I+}
{$endif}
if (length(dir)>1) and (dir[length(dir)] in ['/','\']) then
if (Length (Dir) > 1) and
(Dir [Length (Dir)] in AllowDirectorySeparators) and
(* Do not remove '\' after ':' (root directory of a drive)
or in '\\' (invalid path, possibly broken UNC path). *)
not (Dir [Length (Dir - 1)] in (AllowDriveSeparators + AllowDirectorySeparators)) then
dir:=copy(dir,1,length(dir)-1);
DOS.FindFirst(Dir,$3f,sr);
if DosError = 0 then
begin
Result:=(sr.attr and $10)=$10;
Dos.FindClose(sr);
end
else
Result:=false;
Result := FileGetAttr (Dir) and faDirectory = faDirectory;
end;

19
rtl/os2/sysutils.pp
View File

@ -817,11 +817,22 @@ end;
function DirectoryExists (const Directory: string): boolean;
var
SR: TSearchRec;
L: longint;
begin
DirectoryExists := (FindFirst (Directory, faAnyFile, SR) = 0) and
(SR.Attr and faDirectory <> 0);
FindClose(SR);
if Directory = '' then
Result := false
else
begin
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)))
else
L := FileGetAttr (ExpandFileName (Directory));
Result := (L > 0) and (L and faDirectory = faDirectory);
end;
end;
{****************************************************************************