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

* yet another fix for DiskFree/DiskSize

Browse Source 
git-svn-id: trunk@8516 -
This commit is contained in:
Tomas Hajny 2007-09-16 20:17:27 +00:00
parent 0040eecf9f
commit f0959c1b1d
4 changed files with 172 additions and 140 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
rtl/go32v2/dos.pp
View File

@ -342,40 +342,8 @@ function do_diskdata(drive : byte; Free : BOOLEAN) : Int64;
VAR VAR
S : String; S : String;
Rec : ExtendedFat32FreeSpaceRec; Rec : ExtendedFat32FreeSpaceRec;
BEGIN
if {(swap(dosversion)>=$070A) AND} LFNSupport then procedure OldDosDiskData; inline;
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);
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 begin
dosregs.dl:=drive; dosregs.dl:=drive;
dosregs.ah:=$36; dosregs.ah:=$36;
@ -390,6 +358,46 @@ BEGIN
else else
do_diskdata:=-1; do_diskdata:=-1;
end; end;
BEGIN
if 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;
Rec.RetSize := 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 Rec.RetSize = 0 then (* Error - "FAT32" function not supported! *)
OldDosDiskData
else
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
OldDosDiskData;
end; end;
function diskfree(drive : byte) : int64; function diskfree(drive : byte) : int64;

78
rtl/go32v2/sysutils.pp
View File

@ -502,43 +502,9 @@ function do_diskdata(drive : byte; Free : BOOLEAN) : Int64;
VAR S : String; VAR S : String;
Rec : ExtendedFat32FreeSpaceRec; Rec : ExtendedFat32FreeSpaceRec;
regs : registers; regs : registers;
BEGIN
if {(swap(dosversion)>=$070A) AND} LFNSupport then procedure OldDosDiskData;
begin begin
DosError:=0;
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);
regs.dx:=tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1;
regs.ds:=tb_segment;
regs.di:=tb_offset;
regs.es:=tb_segment;
regs.cx:=Sizeof(ExtendedFat32FreeSpaceRec);
regs.ax:=$7303;
msdos(regs);
if regs.ax<>$ffff then
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
DosError:=0;
regs.dl:=drive; regs.dl:=drive;
regs.ah:=$36; regs.ah:=$36;
msdos(regs); msdos(regs);
@ -552,6 +518,46 @@ BEGIN
else else
do_diskdata:=-1; do_diskdata:=-1;
end; end;
BEGIN
if 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;
Rec.RetSize := 0;
dosmemput(tb_segment,tb_offset,Rec,SIZEOF(ExtendedFat32FreeSpaceRec));
dosmemput(tb_segment,tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1,S[1],4);
regs.dx:=tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1;
regs.ds:=tb_segment;
regs.di:=tb_offset;
regs.es:=tb_segment;
regs.cx:=Sizeof(ExtendedFat32FreeSpaceRec);
regs.ax:=$7303;
msdos(regs);
if (regs.flags and fcarry) = 0 then {No error clausule in int except cf}
begin
copyfromdos(rec,Sizeof(ExtendedFat32FreeSpaceRec));
if Rec.RetSize = 0 then (* Error - "FAT32" function not supported! *)
OldDosDiskData
else
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
OldDosDiskData;
end; end;

78
rtl/watcom/dos.pp
View File

@ -332,44 +332,13 @@ TYPE ExtendedFat32FreeSpaceRec=packed Record
Dummy,Dummy2 : DWORD; {8 bytes reserved} Dummy,Dummy2 : DWORD; {8 bytes reserved}
END; END;
function do_diskdata(drive : byte; Free : BOOLEAN) : Int64; function do_diskdata(drive : byte; Free : BOOLEAN) : Int64;
VAR VAR
S : String; S : String;
Rec : ExtendedFat32FreeSpaceRec; Rec : ExtendedFat32FreeSpaceRec;
BEGIN
if {(swap(dosversion)>=$070A)} AND LFNSupport then procedure OldDosDiskData; inline;
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);
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 begin
dosregs.dl:=drive; dosregs.dl:=drive;
dosregs.ah:=$36; dosregs.ah:=$36;
@ -384,8 +353,49 @@ BEGIN
else else
do_diskdata:=-1; do_diskdata:=-1;
end; end;
BEGIN
if 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;
Rec.RetSize := 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 Rec.RetSize = 0 then (* Error - "FAT32" function not supported! *)
OldDosDiskData
else
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
OldDosDiskData;
end; end;
function diskfree(drive : byte) : int64; function diskfree(drive : byte) : int64;
begin begin
diskfree:=Do_DiskData(drive,TRUE); diskfree:=Do_DiskData(drive,TRUE);

80
rtl/watcom/sysutils.pp
View File

@ -503,47 +503,14 @@ TYPE ExtendedFat32FreeSpaceRec=packed Record
Dummy,Dummy2 : DWORD; {8 bytes reserved} Dummy,Dummy2 : DWORD; {8 bytes reserved}
END; END;
function do_diskdata(drive : byte; Free : BOOLEAN) : Int64; function do_diskdata(drive : byte; Free : BOOLEAN) : Int64;
VAR S : String; VAR S : String;
Rec : ExtendedFat32FreeSpaceRec; Rec : ExtendedFat32FreeSpaceRec;
regs : registers; regs : registers;
BEGIN
if {(swap(dosversion)>=$070A)} AND LFNSupport then procedure OldDosDiskData;
begin begin
DosError:=0;
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);
regs.dx:=tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1;
regs.ds:=tb_segment;
regs.di:=tb_offset;
regs.es:=tb_segment;
regs.cx:=Sizeof(ExtendedFat32FreeSpaceRec);
regs.ax:=$7303;
msdos(regs);
if regs.ax<>$ffff then
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
DosError:=0;
regs.dl:=drive; regs.dl:=drive;
regs.ah:=$36; regs.ah:=$36;
msdos(regs); msdos(regs);
@ -557,9 +524,50 @@ BEGIN
else else
do_diskdata:=-1; do_diskdata:=-1;
end; end;
BEGIN
if 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;
Rec.RetSize := 0;
dosmemput(tb_segment,tb_offset,Rec,SIZEOF(ExtendedFat32FreeSpaceRec));
dosmemput(tb_segment,tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1,S[1],4);
regs.dx:=tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1;
regs.ds:=tb_segment;
regs.di:=tb_offset;
regs.es:=tb_segment;
regs.cx:=Sizeof(ExtendedFat32FreeSpaceRec);
regs.ax:=$7303;
msdos(regs);
if (regs.flags and fcarry) = 0 then {No error clausule in int except cf}
begin
copyfromdos(rec,Sizeof(ExtendedFat32FreeSpaceRec));
if Rec.RetSize = 0 then (* Error - "FAT32" function not supported! *)
OldDosDiskData
else
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
OldDosDiskData;
end; end;
function diskfree(drive : byte) : int64; function diskfree(drive : byte) : int64;
begin begin
diskfree:=Do_DiskData(drive,TRUE); diskfree:=Do_DiskData(drive,TRUE);