mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-19 23:39:31 +02:00
* completely merged from fixes branch
This commit is contained in:
carl
parent
2de56ad75e
commit
edb0740421
@ -403,7 +403,6 @@ end;
|
||||
|
||||
procedure getcbreak(var breakvalue : boolean);
|
||||
begin
|
||||
DosError:=0;
|
||||
dosregs.ax:=$3300;
|
||||
msdos(dosregs);
|
||||
breakvalue:=dosregs.dl<>0;
|
||||
@ -412,7 +411,6 @@ end;
|
||||
|
||||
procedure setcbreak(breakvalue : boolean);
|
||||
begin
|
||||
DosError:=0;
|
||||
dosregs.ax:=$3301;
|
||||
dosregs.dl:=ord(breakvalue);
|
||||
msdos(dosregs);
|
||||
@ -421,7 +419,6 @@ end;
|
||||
|
||||
procedure getverify(var verify : boolean);
|
||||
begin
|
||||
DosError:=0;
|
||||
dosregs.ah:=$54;
|
||||
msdos(dosregs);
|
||||
verify:=dosregs.al<>0;
|
||||
@ -430,7 +427,6 @@ end;
|
||||
|
||||
procedure setverify(verify : boolean);
|
||||
begin
|
||||
DosError:=0;
|
||||
dosregs.ah:=$2e;
|
||||
dosregs.al:=ord(verify);
|
||||
msdos(dosregs);
|
||||
@ -464,55 +460,53 @@ VAR
|
||||
BEGIN
|
||||
if (swap(dosversion)>=$070A) AND LFNSupport then
|
||||
begin
|
||||
S:='C:\'#0;
|
||||
if Drive=0 then
|
||||
begin
|
||||
GetDir(Drive,S);
|
||||
Setlength(S,4);
|
||||
S[4]:=#0;
|
||||
end
|
||||
else
|
||||
S[1]:=chr(Drive+64);
|
||||
Rec.Strucversion:=0;
|
||||
dosmemput(tb_segment,tb_offset,Rec,SIZEOF(ExtendedFat32FreeSpaceRec));
|
||||
dosmemput(tb_segment,tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1,S[1],4);
|
||||
dosregs.dx:=tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1;
|
||||
dosregs.ds:=tb_segment;
|
||||
dosregs.di:=tb_offset;
|
||||
dosregs.es:=tb_segment;
|
||||
dosregs.cx:=Sizeof(ExtendedFat32FreeSpaceRec);
|
||||
dosregs.ax:=$7303;
|
||||
msdos(dosregs);
|
||||
copyfromdos(rec,Sizeof(ExtendedFat32FreeSpaceRec));
|
||||
if (dosregs.flags and fcarry) = 0 then {No error clausule in int except cf}
|
||||
begin
|
||||
copyfromdos(rec,Sizeof(ExtendedFat32FreeSpaceRec));
|
||||
if Free then
|
||||
Do_DiskData:=int64(rec.AvailAllocUnits)*rec.SecPerClus*rec.BytePerSec
|
||||
else
|
||||
Do_DiskData:=int64(rec.TotalAllocUnits)*rec.SecPerClus*rec.BytePerSec;
|
||||
end
|
||||
else
|
||||
Do_DiskData:=-1;
|
||||
S:='C:\'#0;
|
||||
if Drive=0 then
|
||||
begin
|
||||
GetDir(Drive,S);
|
||||
Setlength(S,4);
|
||||
S[4]:=#0;
|
||||
end
|
||||
else
|
||||
S[1]:=chr(Drive+64);
|
||||
Rec.Strucversion:=0;
|
||||
dosmemput(tb_segment,tb_offset,Rec,SIZEOF(ExtendedFat32FreeSpaceRec));
|
||||
dosmemput(tb_segment,tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1,S[1],4);
|
||||
dosregs.dx:=tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1;
|
||||
dosregs.ds:=tb_segment;
|
||||
dosregs.di:=tb_offset;
|
||||
dosregs.es:=tb_segment;
|
||||
dosregs.cx:=Sizeof(ExtendedFat32FreeSpaceRec);
|
||||
dosregs.ax:=$7303;
|
||||
msdos(dosregs);
|
||||
if (dosregs.flags and fcarry) = 0 then {No error clausule in int except cf}
|
||||
begin
|
||||
copyfromdos(rec,Sizeof(ExtendedFat32FreeSpaceRec));
|
||||
if Free then
|
||||
Do_DiskData:=int64(rec.AvailAllocUnits)*rec.SecPerClus*rec.BytePerSec
|
||||
else
|
||||
Do_DiskData:=int64(rec.TotalAllocUnits)*rec.SecPerClus*rec.BytePerSec;
|
||||
end
|
||||
else
|
||||
Do_DiskData:=-1;
|
||||
end
|
||||
else
|
||||
begin
|
||||
dosregs.dl:=drive;
|
||||
dosregs.ah:=$36;
|
||||
msdos(dosregs);
|
||||
if dosregs.ax<>$FFFF then
|
||||
begin
|
||||
if Free then
|
||||
Do_DiskData:=int64(dosregs.ax)*dosregs.bx*dosregs.cx
|
||||
else
|
||||
Do_DiskData:=int64(dosregs.ax)*dosregs.cx*dosregs.dx;
|
||||
end
|
||||
else
|
||||
do_diskdata:=-1;
|
||||
dosregs.dl:=drive;
|
||||
dosregs.ah:=$36;
|
||||
msdos(dosregs);
|
||||
if dosregs.ax<>$FFFF then
|
||||
begin
|
||||
if Free then
|
||||
Do_DiskData:=int64(dosregs.ax)*dosregs.bx*dosregs.cx
|
||||
else
|
||||
Do_DiskData:=int64(dosregs.ax)*dosregs.cx*dosregs.dx;
|
||||
end
|
||||
else
|
||||
do_diskdata:=-1;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function diskfree(drive : byte) : int64;
|
||||
begin
|
||||
diskfree:=Do_DiskData(drive,TRUE);
|
||||
@ -545,7 +539,7 @@ type
|
||||
shortname : array[0..13] of byte;
|
||||
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
|
||||
Len : longint;
|
||||
begin
|
||||
@ -561,6 +555,8 @@ begin
|
||||
d.Time:=lmTime;
|
||||
d.Size:=Size;
|
||||
d.Attr:=Attr and $FF;
|
||||
if (DosError<>0) and from_findfirst then
|
||||
hdl:=-1;
|
||||
Move(hdl,d.Fill,4);
|
||||
end;
|
||||
end;
|
||||
@ -589,7 +585,7 @@ begin
|
||||
msdos(dosregs);
|
||||
LoadDosError;
|
||||
copyfromdos(w,sizeof(LFNSearchRec));
|
||||
LFNSearchRec2Dos(w,dosregs.ax,s);
|
||||
LFNSearchRec2Dos(w,dosregs.ax,s,true);
|
||||
end;
|
||||
|
||||
|
||||
@ -607,7 +603,7 @@ begin
|
||||
msdos(dosregs);
|
||||
LoadDosError;
|
||||
copyfromdos(w,sizeof(LFNSearchRec));
|
||||
LFNSearchRec2Dos(w,hdl,s);
|
||||
LFNSearchRec2Dos(w,hdl,s,false);
|
||||
end;
|
||||
|
||||
|
||||
@ -616,6 +612,12 @@ var
|
||||
hdl : longint;
|
||||
begin
|
||||
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.ax:=$71a1;
|
||||
msdos(dosregs);
|
||||
@ -727,9 +729,9 @@ procedure swapvectors;
|
||||
begin
|
||||
if _exception_exit<>nil then
|
||||
if _v2prt0_exceptions_on then
|
||||
_swap_in()
|
||||
_swap_out()
|
||||
else
|
||||
_swap_out();
|
||||
_swap_in();
|
||||
end;
|
||||
|
||||
|
||||
@ -1047,37 +1049,108 @@ End;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.13 2001-10-12 16:04:15 peter
|
||||
* fix error return in disksize (merged)
|
||||
Revision 1.14 2001-11-23 00:18:54 carl
|
||||
* completely merged from fixes branch
|
||||
|
||||
Revision 1.12 2001/03/16 20:09:58 hajny
|
||||
* universal FExpand
|
||||
Revision 1.1.2.15 2001/10/04 11:23:22 pierre
|
||||
* fix failure check for do_diskdata with LFN support
|
||||
|
||||
Revision 1.11 2000/12/16 15:27:15 peter
|
||||
* fixed disksize to return -1 on error
|
||||
Revision 1.1.2.14 2001/06/13 22:13:15 hajny
|
||||
* universal FExpand merged
|
||||
|
||||
Revision 1.10 2000/10/11 15:38:03 peter
|
||||
* diskfree doserror fix (merged)
|
||||
Revision 1.1.2.13 2001/06/06 11:05:27 pierre
|
||||
* 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
|
||||
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
|
||||
* fixed previous commit (merged)
|
||||
Revision 1.1.2.7 2000/09/04 20:15:22 peter
|
||||
* fixed previous commit
|
||||
|
||||
Revision 1.7 2000/09/04 19:38:12 peter
|
||||
* fsplit with .. fix from Thomas (merged)
|
||||
Revision 1.1.2.6 2000/09/04 19:36:24 peter
|
||||
* fsplit with .. fix from Thomas
|
||||
|
||||
Revision 1.6 2000/08/04 21:45:39 peter
|
||||
* getenv case insensitive (merged)
|
||||
Revision 1.1.2.5 2000/08/04 21:40:25 peter
|
||||
* getenv is case insentive, needed for windir and winbootdir envs
|
||||
|
||||
Revision 1.4 2000/07/22 12:24:55 jonas
|
||||
* merged dossearchrec2searchrec() fix from fixes branch
|
||||
Revision 1.1.2.4 2000/08/02 19:34:14 peter
|
||||
* more doserror fixes
|
||||
|
||||
Revision 1.3 2000/07/14 10:33:09 michael
|
||||
+ Conditionals fixed
|
||||
Revision 1.1.2.3 2000/07/30 17:06:23 peter
|
||||
* 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
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user