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

* completely merged from fixes branch

Browse Source
This commit is contained in:
carl 2001-11-23 00:18:54 +00:00
parent 2de56ad75e
commit edb0740421
1 changed files with 147 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

221
rtl/go32v2/dos.pp
View File

@ -403,7 +403,6 @@ end;
procedure getcbreak(var breakvalue : boolean); procedure getcbreak(var breakvalue : boolean);
begin begin
DosError:=0;
dosregs.ax:=$3300; dosregs.ax:=$3300;
msdos(dosregs); msdos(dosregs);
breakvalue:=dosregs.dl<>0; breakvalue:=dosregs.dl<>0;
@ -412,7 +411,6 @@ end;
procedure setcbreak(breakvalue : boolean); procedure setcbreak(breakvalue : boolean);
begin begin
DosError:=0;
dosregs.ax:=$3301; dosregs.ax:=$3301;
dosregs.dl:=ord(breakvalue); dosregs.dl:=ord(breakvalue);
msdos(dosregs); msdos(dosregs);
@ -421,7 +419,6 @@ end;
procedure getverify(var verify : boolean); procedure getverify(var verify : boolean);
begin begin
DosError:=0;
dosregs.ah:=$54; dosregs.ah:=$54;
msdos(dosregs); msdos(dosregs);
verify:=dosregs.al<>0; verify:=dosregs.al<>0;
@ -430,7 +427,6 @@ end;
procedure setverify(verify : boolean); procedure setverify(verify : boolean);
begin begin
DosError:=0;
dosregs.ah:=$2e; dosregs.ah:=$2e;
dosregs.al:=ord(verify); dosregs.al:=ord(verify);
msdos(dosregs); msdos(dosregs);
@ -464,55 +460,53 @@ VAR
BEGIN BEGIN
if (swap(dosversion)>=$070A) AND LFNSupport then if (swap(dosversion)>=$070A) AND LFNSupport then
begin begin
S:='C:\'#0; S:='C:\'#0;
if Drive=0 then if Drive=0 then
begin begin
GetDir(Drive,S); GetDir(Drive,S);
Setlength(S,4); Setlength(S,4);
S[4]:=#0; S[4]:=#0;
end end
else else
S[1]:=chr(Drive+64); S[1]:=chr(Drive+64);
Rec.Strucversion:=0; Rec.Strucversion:=0;
dosmemput(tb_segment,tb_offset,Rec,SIZEOF(ExtendedFat32FreeSpaceRec)); dosmemput(tb_segment,tb_offset,Rec,SIZEOF(ExtendedFat32FreeSpaceRec));
dosmemput(tb_segment,tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1,S[1],4); dosmemput(tb_segment,tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1,S[1],4);
dosregs.dx:=tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1; dosregs.dx:=tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1;
dosregs.ds:=tb_segment; dosregs.ds:=tb_segment;
dosregs.di:=tb_offset; dosregs.di:=tb_offset;
dosregs.es:=tb_segment; dosregs.es:=tb_segment;
dosregs.cx:=Sizeof(ExtendedFat32FreeSpaceRec); dosregs.cx:=Sizeof(ExtendedFat32FreeSpaceRec);
dosregs.ax:=$7303; dosregs.ax:=$7303;
msdos(dosregs); msdos(dosregs);
copyfromdos(rec,Sizeof(ExtendedFat32FreeSpaceRec)); if (dosregs.flags and fcarry) = 0 then {No error clausule in int except cf}
if (dosregs.flags and fcarry) = 0 then {No error clausule in int except cf} begin
begin copyfromdos(rec,Sizeof(ExtendedFat32FreeSpaceRec));
copyfromdos(rec,Sizeof(ExtendedFat32FreeSpaceRec)); if Free then
if Free then Do_DiskData:=int64(rec.AvailAllocUnits)*rec.SecPerClus*rec.BytePerSec
Do_DiskData:=int64(rec.AvailAllocUnits)*rec.SecPerClus*rec.BytePerSec else
else Do_DiskData:=int64(rec.TotalAllocUnits)*rec.SecPerClus*rec.BytePerSec;
Do_DiskData:=int64(rec.TotalAllocUnits)*rec.SecPerClus*rec.BytePerSec; end
end else
else Do_DiskData:=-1;
Do_DiskData:=-1;
end end
else else
begin begin
dosregs.dl:=drive; dosregs.dl:=drive;
dosregs.ah:=$36; dosregs.ah:=$36;
msdos(dosregs); msdos(dosregs);
if dosregs.ax<>$FFFF then if dosregs.ax<>$FFFF then
begin begin
if Free then if Free then
Do_DiskData:=int64(dosregs.ax)*dosregs.bx*dosregs.cx Do_DiskData:=int64(dosregs.ax)*dosregs.bx*dosregs.cx
else else
Do_DiskData:=int64(dosregs.ax)*dosregs.cx*dosregs.dx; Do_DiskData:=int64(dosregs.ax)*dosregs.cx*dosregs.dx;
end end
else else
do_diskdata:=-1; do_diskdata:=-1;
end; end;
end; end;
function diskfree(drive : byte) : int64; function diskfree(drive : byte) : int64;
begin begin
diskfree:=Do_DiskData(drive,TRUE); diskfree:=Do_DiskData(drive,TRUE);
@ -545,7 +539,7 @@ type
shortname : array[0..13] of byte; shortname : array[0..13] of byte;
end; end;
procedure LFNSearchRec2Dos(const w:LFNSearchRec;hdl:longint;var d:Searchrec); procedure LFNSearchRec2Dos(const w:LFNSearchRec;hdl:longint;var d:Searchrec;from_findfirst : boolean);
var var
Len : longint; Len : longint;
begin begin
@ -561,6 +555,8 @@ begin
d.Time:=lmTime; d.Time:=lmTime;
d.Size:=Size; d.Size:=Size;
d.Attr:=Attr and $FF; d.Attr:=Attr and $FF;
if (DosError<>0) and from_findfirst then
hdl:=-1;
Move(hdl,d.Fill,4); Move(hdl,d.Fill,4);
end; end;
end; end;
@ -589,7 +585,7 @@ begin
msdos(dosregs); msdos(dosregs);
LoadDosError; LoadDosError;
copyfromdos(w,sizeof(LFNSearchRec)); copyfromdos(w,sizeof(LFNSearchRec));
LFNSearchRec2Dos(w,dosregs.ax,s); LFNSearchRec2Dos(w,dosregs.ax,s,true);
end; end;
@ -607,7 +603,7 @@ begin
msdos(dosregs); msdos(dosregs);
LoadDosError; LoadDosError;
copyfromdos(w,sizeof(LFNSearchRec)); copyfromdos(w,sizeof(LFNSearchRec));
LFNSearchRec2Dos(w,hdl,s); LFNSearchRec2Dos(w,hdl,s,false);
end; end;
@ -616,6 +612,12 @@ var
hdl : longint; hdl : longint;
begin begin
Move(s.Fill,hdl,4); Move(s.Fill,hdl,4);
{ Do not call MsDos if FindFirst returned with an error }
if hdl=-1 then
begin
DosError:=0;
exit;
end;
dosregs.ebx:=hdl; dosregs.ebx:=hdl;
dosregs.ax:=$71a1; dosregs.ax:=$71a1;
msdos(dosregs); msdos(dosregs);
@ -727,9 +729,9 @@ procedure swapvectors;
begin begin
if _exception_exit<>nil then if _exception_exit<>nil then
if _v2prt0_exceptions_on then if _v2prt0_exceptions_on then
_swap_in() _swap_out()
else else
_swap_out(); _swap_in();
end; end;
@ -1047,37 +1049,108 @@ End;
end. end.
{ {
$Log$ $Log$
Revision 1.13 2001-10-12 16:04:15 peter Revision 1.14 2001-11-23 00:18:54 carl
* fix error return in disksize (merged) * completely merged from fixes branch
Revision 1.12 2001/03/16 20:09:58 hajny Revision 1.1.2.15 2001/10/04 11:23:22 pierre
* universal FExpand * fix failure check for do_diskdata with LFN support
Revision 1.11 2000/12/16 15:27:15 peter Revision 1.1.2.14 2001/06/13 22:13:15 hajny
* fixed disksize to return -1 on error * universal FExpand merged
Revision 1.10 2000/10/11 15:38:03 peter Revision 1.1.2.13 2001/06/06 11:05:27 pierre
* diskfree doserror fix (merged) * correct SwapVectors behavior
Revision 1.9 2000/09/06 20:47:34 peter Revision 1.1.2.12 2000/12/16 15:34:28 peter
* fixed disksize return -1 for error
Revision 1.1.2.11 2000/10/11 15:38:17 peter
* diskfree doserror fix
Revision 1.1.2.10 2000/09/22 10:09:42 pierre
* fix LFN handle problem if FindFirst fails
Revision 1.1.2.9 2000/09/22 08:42:51 pierre
* fix wrong DiskSize report
Revision 1.1.2.8 2000/09/06 20:46:18 peter
* removed previous fsplit() patch as it's not the correct behaviour for * removed previous fsplit() patch as it's not the correct behaviour for
LFNs. The code showing the bug could easily be adapted (merged) LFNs. The code showing the bug could easily be adapted
Revision 1.8 2000/09/04 20:17:53 peter Revision 1.1.2.7 2000/09/04 20:15:22 peter
* fixed previous commit (merged) * fixed previous commit
Revision 1.7 2000/09/04 19:38:12 peter Revision 1.1.2.6 2000/09/04 19:36:24 peter
* fsplit with .. fix from Thomas (merged) * fsplit with .. fix from Thomas
Revision 1.6 2000/08/04 21:45:39 peter Revision 1.1.2.5 2000/08/04 21:40:25 peter
* getenv case insensitive (merged) * getenv is case insentive, needed for windir and winbootdir envs
Revision 1.4 2000/07/22 12:24:55 jonas Revision 1.1.2.4 2000/08/02 19:34:14 peter
* merged dossearchrec2searchrec() fix from fixes branch * more doserror fixes
Revision 1.3 2000/07/14 10:33:09 michael Revision 1.1.2.3 2000/07/30 17:06:23 peter
+ Conditionals fixed * removed dos lf
Revision 1.1.2.2 2000/07/30 16:35:44 peter
* don't set doserror in gettime/settime/getdate/setdate, tp compatible
Revision 1.1.2.1 2000/07/22 12:21:30 jonas
* fixed buffer overrun error in dossearchrec2searchrec when a file
is not found (at least it happened in OS/2's VDM)
Revision 1.1 2000/07/13 06:30:35 michael
+ Initial import
Revision 1.24 2000/05/30 04:41:05 jonas
* fixed compiling problem with formal expression passed as var
parameter
Revision 1.23 2000/03/22 08:00:42 pierre
+ allow double backslash for network drives
Revision 1.22 2000/02/09 16:59:28 peter
* truncated log
Revision 1.21 2000/02/09 13:00:32 peter
+ getlongname
Revision 1.20 2000/02/02 17:34:49 pierre
* use int64 typecast to avoid overflows in diskfree and disksize
Revision 1.19 2000/01/23 16:31:23 peter
* hasint64diskspace define changed to int64 so it's default now
Revision 1.18 2000/01/23 12:28:38 marco
* Added diskfree and disksize with AH=71 dos functions (LFN/Fat32)
Revision 1.17 2000/01/07 16:41:30 daniel
* copyright 2000
Revision 1.16 2000/01/07 16:32:23 daniel
* copyright 2000 added
Revision 1.15 1999/12/06 18:26:49 peter
* fpcmake updated for win32 commandline
Revision 1.14 1999/11/09 11:07:50 pierre
* SwapVectors does not reset DosError anymore
+ DosError is set to ax regsiter value if extended doserror function
retruns zero.
+ Support for LFN in EXEC function using
function 7160 to get short filename counterpart
Revision 1.13 1999/11/06 14:38:23 peter
* truncated log
Revision 1.12 1999/09/10 17:14:09 peter
* better errorcode returning using int21h,5900
Revision 1.11 1999/09/08 18:55:49 peter
* pointer fixes
Revision 1.10 1999/08/13 21:23:15 peter
* fsearch checks first if the specified file exists and returns that
if it was found
Revision 1.2 2000/07/13 11:33:39 michael
+ removed logs
} }