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

* Added diskfree and disksize with AH=71 dos functions (LFN/Fat32)

Browse Source
This commit is contained in:
marco 2000-01-23 12:28:38 +00:00
parent 46ba0d434c
commit 3933be768c
1 changed files with 98 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

101
rtl/go32v2/dos.pp
View File

@ -102,8 +102,13 @@ Procedure Exec(const path: pathstr; const comline: comstr);
Function DosExitCode: word; Function DosExitCode: word;
{Disk} {Disk}
Function DiskFree(drive: byte) : longint; {$ifdef HasInt64Diskfuncs}
Function DiskSize(drive: byte) : longint; Function DiskFree(drive: byte) : int64;
Function DiskSize(drive: byte) : int64;
{$else}
Function DiskFree(drive: byte) : longint;
Function DiskSize(drive: byte) : longint;
{$endif}
Procedure FindFirst(const path: pathstr; attr: word; var f: searchRec); Procedure FindFirst(const path: pathstr; attr: word; var f: searchRec);
Procedure FindNext(var f: searchRec); Procedure FindNext(var f: searchRec);
Procedure FindClose(Var f: SearchRec); Procedure FindClose(Var f: SearchRec);
@ -442,6 +447,91 @@ end;
--- Disk --- --- Disk ---
******************************************************************************} ******************************************************************************}
{$ifdef HasInt64Diskfuncs}
TYPE ExtendedFat32FreeSpaceRec=packed Record
RetSize : WORD; { (ret) size of returned structure}
Strucversion : WORD; {(call) structure version (0000h)
(ret) actual structure version (0000h)}
SecPerClus, {number of sectors per cluster}
BytePerSec, {number of bytes per sector}
AvailClusters, {number of available clusters}
TotalClusters, {total number of clusters on the drive}
AvailPhysSect, {physical sectors available on the drive}
TotalPhysSect, {total physical sectors on the drive}
AvailAllocUnits, {Available allocation units}
TotalAllocUnits : DWORD; {Total allocation units}
Dummy,Dummy2 : DWORD; {8 bytes reserved}
END;
function do_diskdata(drive : byte; Free : BOOLEAN) : Int64;
VAR S : String;
Rec : ExtendedFat32FreeSpaceRec;
BEGIN
if (swap(dosversion)>=$070A) AND LFNSupport then
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);
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);
LoadDosError;
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;
if doserror<>0 THEN {No error clausule in int except cf}
Do_DiskData:=-1;
end
else
begin
DosError:=0;
dosregs.dl:=drive;
dosregs.ah:=$36;
msdos(dosregs);
if dosregs.ax<>$FFFF then
begin
if Free then
Do_DiskData:=dosregs.ax*dosregs.bx*dosregs.cx
else
Do_DiskData:=dosregs.ax*dosregs.cx*dosregs.dx;
end
else
do_diskdata:=-1;
end;
end;
function diskfree(drive : byte) : int64;
begin
diskfree:=Do_DiskData(drive,TRUE);
end;
function disksize(drive : byte) : int64;
begin
disksize:=Do_DiskData(drive,false);
end;
{$else}
function diskfree(drive : byte) : longint; function diskfree(drive : byte) : longint;
begin begin
DosError:=0; DosError:=0;
@ -467,6 +557,8 @@ begin
disksize:=-1; disksize:=-1;
end; end;
{$endif}
{****************************************************************************** {******************************************************************************
--- LFNFindfirst LFNFindNext --- --- LFNFindfirst LFNFindNext ---
@ -1047,7 +1139,10 @@ End;
end. end.
{ {
$Log$ $Log$
Revision 1.17 2000-01-07 16:41:30 daniel 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 * copyright 2000
Revision 1.16 2000/01/07 16:32:23 daniel Revision 1.16 2000/01/07 16:32:23 daniel