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

* FindFirst fix (invalid attribute bits masked out)

Browse Source
This commit is contained in:
Tomas Hajny 2002-07-11 16:00:05 +00:00
parent acda890496
commit 0a29a5632f
2 changed files with 29 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
rtl/os2/dos.pas
View File

@ -186,6 +186,10 @@ var LastSR: SearchRec;
type TBA = array [1..SizeOf (SearchRec)] of byte; type TBA = array [1..SizeOf (SearchRec)] of byte;
PBA = ^TBA; PBA = ^TBA;
const FindResvdMask = $00003737; {Allowed bits in attribute
specification for DosFindFirst call.}
{Import syscall to call it nicely from assembler procedures.} {Import syscall to call it nicely from assembler procedures.}
procedure syscall;external name '___SYSCALL'; procedure syscall;external name '___SYSCALL';
@ -426,9 +430,11 @@ var args:Pbytearray;
e:extstr; e:extstr;
p : ppchar; p : ppchar;
j : integer; j : integer;
const
ArgsSize = 2048; (* Amount of memory reserved for arguments in bytes. *)
begin begin
getmem(args,2048); getmem(args,ArgsSize);
GetMem(env, envc*sizeof(pchar)+16384); GetMem(env, envc*sizeof(pchar)+16384);
{Now setup the arguments. The first argument should be the program {Now setup the arguments. The first argument should be the program
name without directory and extension.} name without directory and extension.}
@ -532,7 +538,7 @@ begin
movl %eax,__RESULT movl %eax,__RESULT
end; end;
freemem(args,512); freemem(args,ArgsSize);
FreeMem(env, envc*sizeof(pchar)+16384); FreeMem(env, envc*sizeof(pchar)+16384);
{Phew! That's it. This was the most sophisticated procedure to call {Phew! That's it. This was the most sophisticated procedure to call
a system function I ever wrote!} a system function I ever wrote!}
@ -850,8 +856,9 @@ begin
New (F.FStat); New (F.FStat);
F.Handle := $FFFFFFFF; F.Handle := $FFFFFFFF;
Count := 1; Count := 1;
DosError := Integer(DosFindFirst (Path, F.Handle, Attr, F.FStat, DosError := Integer(DosFindFirst (Path, F.Handle,
SizeOf (F.FStat^), Count, ilStandard)); Attr and FindResvdMask, F.FStat, SizeOf (F.FStat^),
Count, ilStandard));
if (DosError = 0) and (Count = 0) then DosError := 18; if (DosError = 0) and (Count = 0) then DosError := 18;
end else end else
begin begin
@ -1210,7 +1217,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.17 2002-07-07 18:00:48 hajny Revision 1.18 2002-07-11 16:00:05 hajny
* FindFirst fix (invalid attribute bits masked out)
Revision 1.17 2002/07/07 18:00:48 hajny
* DosGetInfoBlock modification to allow overloaded version (in DosCalls) * DosGetInfoBlock modification to allow overloaded version (in DosCalls)
Revision 1.16 2002/03/03 11:19:20 hajny Revision 1.16 2002/03/03 11:19:20 hajny

19
rtl/os2/sysutils.pp
View File

@ -223,6 +223,9 @@ const
faOpenReplace = $00040000; {Truncate if file exists} faOpenReplace = $00040000; {Truncate if file exists}
faCreate = $00050000; {Create if file does not exist, truncate otherwise} faCreate = $00050000; {Create if file does not exist, truncate otherwise}
FindResvdMask = $00003737; {Allowed bits in attribute
specification for DosFindFirst call.}
{$ASMMODE INTEL} {$ASMMODE INTEL}
function FileOpen (const FileName: string; Mode: integer): longint; function FileOpen (const FileName: string; Mode: integer): longint;
{$IFOPT H+} {$IFOPT H+}
@ -416,8 +419,8 @@ begin
New (FStat); New (FStat);
Rslt.FindHandle := $FFFFFFFF; Rslt.FindHandle := $FFFFFFFF;
Count := 1; Count := 1;
Err := DosFindFirst (PChar (Path), Rslt.FindHandle, Attr, FStat, Err := DosFindFirst (Path, Rslt.FindHandle, Attr and FindResvdMask,
SizeOf (FStat^), Count, ilStandard); FStat, SizeOf (FStat^), Count, ilStandard);
if (Err = 0) and (Count = 0) then Err := 18; if (Err = 0) and (Count = 0) then Err := 18;
FindFirst := -Err; FindFirst := -Err;
if Err = 0 then if Err = 0 then
@ -433,10 +436,11 @@ begin
end end
else else
begin begin
Err := DOS.DosError;
GetMem (SR, SizeOf (SearchRec)); GetMem (SR, SizeOf (SearchRec));
Rslt.FindHandle := longint(SR); Rslt.FindHandle := longint(SR);
DOS.FindFirst (Path, Attr, SR^); DOS.FindFirst (Path, Attr, SR^);
FindFirst := -DosError; FindFirst := -DOS.DosError;
if DosError = 0 then if DosError = 0 then
begin begin
Rslt.Time := SR^.Time; Rslt.Time := SR^.Time;
@ -445,6 +449,7 @@ begin
Rslt.ExcludeAttr := 0; Rslt.ExcludeAttr := 0;
Rslt.Name := SR^.Name; Rslt.Name := SR^.Name;
end; end;
DOS.DosError := Err;
end; end;
end; end;
@ -461,7 +466,8 @@ begin
begin begin
New (FStat); New (FStat);
Count := 1; Count := 1;
Err := DosFindNext (Rslt.FindHandle, FStat, SizeOf (FStat), Count); Err := DosFindNext (Rslt.FindHandle, FStat, SizeOf (FStat^),
Count);
if (Err = 0) and (Count = 0) then Err := 18; if (Err = 0) and (Count = 0) then Err := 18;
FindNext := -Err; FindNext := -Err;
if Err = 0 then if Err = 0 then
@ -944,7 +950,10 @@ end.
{ {
$Log$ $Log$
Revision 1.15 2002-01-25 16:23:03 peter Revision 1.16 2002-07-11 16:00:05 hajny
* FindFirst fix (invalid attribute bits masked out)
Revision 1.15 2002/01/25 16:23:03 peter
* merged filesearch() fix * merged filesearch() fix
Revision 1.14 2001/12/16 19:08:20 hajny Revision 1.14 2001/12/16 19:08:20 hajny