paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 10:40:13 +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;
PBA = ^TBA;
const FindResvdMask = $00003737; {Allowed bits in attribute
specification for DosFindFirst call.}
{Import syscall to call it nicely from assembler procedures.}
procedure syscall;external name '___SYSCALL';
@ -426,9 +430,11 @@ var args:Pbytearray;
e:extstr;
p : ppchar;
j : integer;
const
ArgsSize = 2048; (* Amount of memory reserved for arguments in bytes. *)
begin
getmem(args,2048);
getmem(args,ArgsSize);
GetMem(env, envc*sizeof(pchar)+16384);
{Now setup the arguments. The first argument should be the program
name without directory and extension.}
@ -532,7 +538,7 @@ begin
movl %eax,__RESULT
end;
freemem(args,512);
freemem(args,ArgsSize);
FreeMem(env, envc*sizeof(pchar)+16384);
{Phew! That's it. This was the most sophisticated procedure to call
a system function I ever wrote!}
@ -850,8 +856,9 @@ begin
New (F.FStat);
F.Handle := $FFFFFFFF;
Count := 1;
DosError := Integer(DosFindFirst (Path, F.Handle, Attr, F.FStat,
SizeOf (F.FStat^), Count, ilStandard));
DosError := Integer(DosFindFirst (Path, F.Handle,
Attr and FindResvdMask, F.FStat, SizeOf (F.FStat^),
Count, ilStandard));
if (DosError = 0) and (Count = 0) then DosError := 18;
end else
begin
@ -1210,7 +1217,10 @@ begin
end.
{
$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)
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}
faCreate = $00050000; {Create if file does not exist, truncate otherwise}
FindResvdMask = $00003737; {Allowed bits in attribute
specification for DosFindFirst call.}
{$ASMMODE INTEL}
function FileOpen (const FileName: string; Mode: integer): longint;
{$IFOPT H+}
@ -416,8 +419,8 @@ begin
New (FStat);
Rslt.FindHandle := $FFFFFFFF;
Count := 1;
Err := DosFindFirst (PChar (Path), Rslt.FindHandle, Attr, FStat,
SizeOf (FStat^), Count, ilStandard);
Err := DosFindFirst (Path, Rslt.FindHandle, Attr and FindResvdMask,
FStat, SizeOf (FStat^), Count, ilStandard);
if (Err = 0) and (Count = 0) then Err := 18;
FindFirst := -Err;
if Err = 0 then
@ -433,10 +436,11 @@ begin
end
else
begin
Err := DOS.DosError;
GetMem (SR, SizeOf (SearchRec));
Rslt.FindHandle := longint(SR);
DOS.FindFirst (Path, Attr, SR^);
FindFirst := -DosError;
FindFirst := -DOS.DosError;
if DosError = 0 then
begin
Rslt.Time := SR^.Time;
@ -445,6 +449,7 @@ begin
Rslt.ExcludeAttr := 0;
Rslt.Name := SR^.Name;
end;
DOS.DosError := Err;
end;
end;
@ -461,7 +466,8 @@ begin
begin
New (FStat);
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;
FindNext := -Err;
if Err = 0 then
@ -944,7 +950,10 @@ end.
{
$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
Revision 1.14 2001/12/16 19:08:20 hajny