mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 15:49:26 +02:00
* int64 support for diskfree,disksize
This commit is contained in:
peter
parent
c7d29d81a0
commit
01e98ff122
@ -14,6 +14,93 @@
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{$ifdef Int64}
|
||||
|
||||
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;
|
||||
regs : registers;
|
||||
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);
|
||||
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.ah:=$36;
|
||||
msdos(regs);
|
||||
if regs.ax<>$FFFF then
|
||||
begin
|
||||
if Free then
|
||||
Do_DiskData:=int64(regs.ax)*regs.bx*regs.cx
|
||||
else
|
||||
Do_DiskData:=int64(regs.ax)*regs.cx*regs.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;
|
||||
var
|
||||
Regs: Registers;
|
||||
@ -41,6 +128,8 @@ begin
|
||||
result := -1;
|
||||
end;
|
||||
|
||||
{$endif}
|
||||
|
||||
|
||||
Function GetCurrentDir : String;
|
||||
begin
|
||||
@ -77,7 +166,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 2000-02-09 16:59:28 peter
|
||||
Revision 1.5 2000-05-15 19:28:41 peter
|
||||
* int64 support for diskfree,disksize
|
||||
|
||||
Revision 1.4 2000/02/09 16:59:28 peter
|
||||
* truncated log
|
||||
|
||||
Revision 1.3 2000/01/07 16:41:30 daniel
|
||||
|
||||
@ -22,7 +22,7 @@
|
||||
1 - '/fd0/.' (floppy drive 1 - should be adapted to local system )
|
||||
2 - '/fd1/.' (floppy drive 2 - should be adapted to local system )
|
||||
3 - '/' (C: equivalent of dos is the root partition)
|
||||
4..26 (can be set by your own applications)
|
||||
4..26 (can be set by you're own applications)
|
||||
! Use AddDisk() to Add new drives !
|
||||
They both return -1 when a failure occurs.
|
||||
}
|
||||
@ -50,6 +50,34 @@ end;
|
||||
|
||||
|
||||
|
||||
{$ifdef INT64}
|
||||
|
||||
Function DiskFree(Drive: Byte): int64;
|
||||
var
|
||||
fs : statfs;
|
||||
Begin
|
||||
if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and fsstat(StrPas(fixdrivestr[drive]),fs)) or
|
||||
((not (drivestr[Drive]=nil)) and fsstat(StrPas(drivestr[drive]),fs)) then
|
||||
Diskfree:=int64(fs.bavail)*int64(fs.bsize)
|
||||
else
|
||||
Diskfree:=-1;
|
||||
End;
|
||||
|
||||
|
||||
|
||||
Function DiskSize(Drive: Byte): int64;
|
||||
var
|
||||
fs : statfs;
|
||||
Begin
|
||||
if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and fsstat(StrPas(fixdrivestr[drive]),fs)) or
|
||||
((not (drivestr[Drive]=nil)) and fsstat(StrPas(drivestr[drive]),fs)) then
|
||||
DiskSize:=int64(fs.blocks)*int64(fs.bsize)
|
||||
else
|
||||
DiskSize:=-1;
|
||||
End;
|
||||
|
||||
{$else}
|
||||
|
||||
Function DiskFree(Drive: Byte): Longint;
|
||||
var
|
||||
fs : statfs;
|
||||
@ -74,6 +102,9 @@ Begin
|
||||
DiskSize:=-1;
|
||||
End;
|
||||
|
||||
{$endif INT64}
|
||||
|
||||
|
||||
|
||||
Function GetCurrentDir : String;
|
||||
begin
|
||||
@ -110,7 +141,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.6 2000-02-09 16:59:31 peter
|
||||
Revision 1.7 2000-05-15 19:28:41 peter
|
||||
* int64 support for diskfree,disksize
|
||||
|
||||
Revision 1.6 2000/02/09 16:59:31 peter
|
||||
* truncated log
|
||||
|
||||
Revision 1.5 2000/01/07 16:41:40 daniel
|
||||
|
||||
@ -14,8 +14,13 @@
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
Function DiskFree (Drive : Byte) : Longint;
|
||||
Function DiskSize (Drive : Byte) : Longint;
|
||||
{$ifdef Int64}
|
||||
Function DiskFree(drive: byte) : int64;
|
||||
Function DiskSize(drive: byte) : int64;
|
||||
{$else}
|
||||
Function DiskFree(drive: byte) : longint;
|
||||
Function DiskSize(drive: byte) : longint;
|
||||
{$endif}
|
||||
Function GetCurrentDir : String;
|
||||
Function SetCurrentDir (Const NewDir : String) : Boolean;
|
||||
Function CreateDir (Const NewDir : String) : Boolean;
|
||||
@ -23,7 +28,10 @@ Function RemoveDir (Const Dir : String) : Boolean;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 2000-02-09 16:59:32 peter
|
||||
Revision 1.5 2000-05-15 19:28:41 peter
|
||||
* int64 support for diskfree,disksize
|
||||
|
||||
Revision 1.4 2000/02/09 16:59:32 peter
|
||||
* truncated log
|
||||
|
||||
Revision 1.3 2000/01/07 16:41:43 daniel
|
||||
|
||||
@ -17,12 +17,21 @@
|
||||
function GetDiskFreeSpace(drive:pchar;var sector_cluster,bytes_sector,
|
||||
freeclusters,totalclusters:longint):longbool;
|
||||
external 'kernel32' name 'GetDiskFreeSpaceA';
|
||||
type
|
||||
TGetDiskFreeSpaceEx = function(drive:pchar;var availableforcaller,
|
||||
total,free):longbool;stdcall;
|
||||
|
||||
function diskfree(drive : byte) : longint;
|
||||
var
|
||||
GetDiskFreeSpaceEx : TGetDiskFreeSpaceEx;
|
||||
|
||||
function diskfree(drive : byte) : int64;
|
||||
var
|
||||
disk : array[1..4] of char;
|
||||
secs,bytes,
|
||||
free,total : longint;
|
||||
qwtotal,qwfree,qwcaller : int64;
|
||||
|
||||
|
||||
begin
|
||||
if drive=0 then
|
||||
begin
|
||||
@ -36,18 +45,30 @@ begin
|
||||
disk[3]:='\';
|
||||
disk[4]:=#0;
|
||||
end;
|
||||
if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
|
||||
result:=free*secs*bytes
|
||||
if assigned(GetDiskFreeSpaceEx) then
|
||||
begin
|
||||
if GetDiskFreeSpaceEx(@disk,qwcaller,qwtotal,qwfree) then
|
||||
diskfree:=qwfree
|
||||
else
|
||||
diskfree:=-1;
|
||||
end
|
||||
else
|
||||
result:=-1;
|
||||
begin
|
||||
if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
|
||||
diskfree:=int64(free)*secs*bytes
|
||||
else
|
||||
diskfree:=-1;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function disksize(drive : byte) : longint;
|
||||
function disksize(drive : byte) : int64;
|
||||
var
|
||||
disk : array[1..4] of char;
|
||||
secs,bytes,
|
||||
free,total : longint;
|
||||
qwtotal,qwfree,qwcaller : int64;
|
||||
|
||||
begin
|
||||
if drive=0 then
|
||||
begin
|
||||
@ -61,10 +82,20 @@ begin
|
||||
disk[3]:='\';
|
||||
disk[4]:=#0;
|
||||
end;
|
||||
if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
|
||||
result:=total*secs*bytes
|
||||
if assigned(GetDiskFreeSpaceEx) then
|
||||
begin
|
||||
if GetDiskFreeSpaceEx(@disk,qwcaller,qwtotal,qwfree) then
|
||||
disksize:=qwtotal
|
||||
else
|
||||
disksize:=-1;
|
||||
end
|
||||
else
|
||||
result:=-1;
|
||||
begin
|
||||
if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
|
||||
disksize:=int64(total)*secs*bytes
|
||||
else
|
||||
disksize:=-1;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -102,7 +133,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 2000-02-09 16:59:34 peter
|
||||
Revision 1.5 2000-05-15 19:28:41 peter
|
||||
* int64 support for diskfree,disksize
|
||||
|
||||
Revision 1.4 2000/02/09 16:59:34 peter
|
||||
* truncated log
|
||||
|
||||
Revision 1.3 2000/01/07 16:41:52 daniel
|
||||
|
||||
@ -134,9 +134,7 @@ Function FileExists (Const FileName : String) : Boolean;
|
||||
var
|
||||
Handle: THandle;
|
||||
FindData: TWin32FindData;
|
||||
P : Pchar;
|
||||
begin
|
||||
P:=Pchar(Filename);
|
||||
Handle := FindFirstFile(Pchar(FileName), @FindData);
|
||||
Result:=Handle <> INVALID_HANDLE_VALUE;
|
||||
If Result then
|
||||
@ -429,7 +427,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.15 2000-02-17 22:16:05 sg
|
||||
Revision 1.16 2000-05-15 19:28:41 peter
|
||||
* int64 support for diskfree,disksize
|
||||
|
||||
Revision 1.15 2000/02/17 22:16:05 sg
|
||||
* Changed the second argument of FileWrite from "var buffer" to
|
||||
"const buffer", like in Delphi.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user