mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 07:26:24 +02:00
* int64 support for diskfree,disksize
This commit is contained in:
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;
|
Function DiskFree (Drive : Byte) : Longint;
|
||||||
var
|
var
|
||||||
Regs: Registers;
|
Regs: Registers;
|
||||||
@ -41,6 +128,8 @@ begin
|
|||||||
result := -1;
|
result := -1;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
|
||||||
Function GetCurrentDir : String;
|
Function GetCurrentDir : String;
|
||||||
begin
|
begin
|
||||||
@ -77,7 +166,10 @@ end;
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* truncated log
|
||||||
|
|
||||||
Revision 1.3 2000/01/07 16:41:30 daniel
|
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 )
|
1 - '/fd0/.' (floppy drive 1 - should be adapted to local system )
|
||||||
2 - '/fd1/.' (floppy drive 2 - 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)
|
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 !
|
! Use AddDisk() to Add new drives !
|
||||||
They both return -1 when a failure occurs.
|
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;
|
Function DiskFree(Drive: Byte): Longint;
|
||||||
var
|
var
|
||||||
fs : statfs;
|
fs : statfs;
|
||||||
@ -74,6 +102,9 @@ Begin
|
|||||||
DiskSize:=-1;
|
DiskSize:=-1;
|
||||||
End;
|
End;
|
||||||
|
|
||||||
|
{$endif INT64}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
Function GetCurrentDir : String;
|
Function GetCurrentDir : String;
|
||||||
begin
|
begin
|
||||||
@ -110,7 +141,10 @@ end;
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* truncated log
|
||||||
|
|
||||||
Revision 1.5 2000/01/07 16:41:40 daniel
|
Revision 1.5 2000/01/07 16:41:40 daniel
|
||||||
|
@ -14,8 +14,13 @@
|
|||||||
|
|
||||||
**********************************************************************}
|
**********************************************************************}
|
||||||
|
|
||||||
Function DiskFree (Drive : Byte) : Longint;
|
{$ifdef Int64}
|
||||||
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}
|
||||||
Function GetCurrentDir : String;
|
Function GetCurrentDir : String;
|
||||||
Function SetCurrentDir (Const NewDir : String) : Boolean;
|
Function SetCurrentDir (Const NewDir : String) : Boolean;
|
||||||
Function CreateDir (Const NewDir : String) : Boolean;
|
Function CreateDir (Const NewDir : String) : Boolean;
|
||||||
@ -23,7 +28,10 @@ Function RemoveDir (Const Dir : String) : Boolean;
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* truncated log
|
||||||
|
|
||||||
Revision 1.3 2000/01/07 16:41:43 daniel
|
Revision 1.3 2000/01/07 16:41:43 daniel
|
||||||
|
@ -17,12 +17,21 @@
|
|||||||
function GetDiskFreeSpace(drive:pchar;var sector_cluster,bytes_sector,
|
function GetDiskFreeSpace(drive:pchar;var sector_cluster,bytes_sector,
|
||||||
freeclusters,totalclusters:longint):longbool;
|
freeclusters,totalclusters:longint):longbool;
|
||||||
external 'kernel32' name 'GetDiskFreeSpaceA';
|
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
|
var
|
||||||
disk : array[1..4] of char;
|
disk : array[1..4] of char;
|
||||||
secs,bytes,
|
secs,bytes,
|
||||||
free,total : longint;
|
free,total : longint;
|
||||||
|
qwtotal,qwfree,qwcaller : int64;
|
||||||
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if drive=0 then
|
if drive=0 then
|
||||||
begin
|
begin
|
||||||
@ -36,18 +45,30 @@ begin
|
|||||||
disk[3]:='\';
|
disk[3]:='\';
|
||||||
disk[4]:=#0;
|
disk[4]:=#0;
|
||||||
end;
|
end;
|
||||||
if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
|
if assigned(GetDiskFreeSpaceEx) then
|
||||||
result:=free*secs*bytes
|
begin
|
||||||
|
if GetDiskFreeSpaceEx(@disk,qwcaller,qwtotal,qwfree) then
|
||||||
|
diskfree:=qwfree
|
||||||
|
else
|
||||||
|
diskfree:=-1;
|
||||||
|
end
|
||||||
else
|
else
|
||||||
result:=-1;
|
begin
|
||||||
|
if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
|
||||||
|
diskfree:=int64(free)*secs*bytes
|
||||||
|
else
|
||||||
|
diskfree:=-1;
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function disksize(drive : byte) : longint;
|
function disksize(drive : byte) : int64;
|
||||||
var
|
var
|
||||||
disk : array[1..4] of char;
|
disk : array[1..4] of char;
|
||||||
secs,bytes,
|
secs,bytes,
|
||||||
free,total : longint;
|
free,total : longint;
|
||||||
|
qwtotal,qwfree,qwcaller : int64;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if drive=0 then
|
if drive=0 then
|
||||||
begin
|
begin
|
||||||
@ -61,10 +82,20 @@ begin
|
|||||||
disk[3]:='\';
|
disk[3]:='\';
|
||||||
disk[4]:=#0;
|
disk[4]:=#0;
|
||||||
end;
|
end;
|
||||||
if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
|
if assigned(GetDiskFreeSpaceEx) then
|
||||||
result:=total*secs*bytes
|
begin
|
||||||
|
if GetDiskFreeSpaceEx(@disk,qwcaller,qwtotal,qwfree) then
|
||||||
|
disksize:=qwtotal
|
||||||
|
else
|
||||||
|
disksize:=-1;
|
||||||
|
end
|
||||||
else
|
else
|
||||||
result:=-1;
|
begin
|
||||||
|
if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
|
||||||
|
disksize:=int64(total)*secs*bytes
|
||||||
|
else
|
||||||
|
disksize:=-1;
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -102,7 +133,10 @@ end;
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* truncated log
|
||||||
|
|
||||||
Revision 1.3 2000/01/07 16:41:52 daniel
|
Revision 1.3 2000/01/07 16:41:52 daniel
|
||||||
|
@ -134,9 +134,7 @@ Function FileExists (Const FileName : String) : Boolean;
|
|||||||
var
|
var
|
||||||
Handle: THandle;
|
Handle: THandle;
|
||||||
FindData: TWin32FindData;
|
FindData: TWin32FindData;
|
||||||
P : Pchar;
|
|
||||||
begin
|
begin
|
||||||
P:=Pchar(Filename);
|
|
||||||
Handle := FindFirstFile(Pchar(FileName), @FindData);
|
Handle := FindFirstFile(Pchar(FileName), @FindData);
|
||||||
Result:=Handle <> INVALID_HANDLE_VALUE;
|
Result:=Handle <> INVALID_HANDLE_VALUE;
|
||||||
If Result then
|
If Result then
|
||||||
@ -429,7 +427,10 @@ end;
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* Changed the second argument of FileWrite from "var buffer" to
|
||||||
"const buffer", like in Delphi.
|
"const buffer", like in Delphi.
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user