diff --git a/rtl/go32v2/disk.inc b/rtl/go32v2/disk.inc index 6615d4a8c1..7236da95f1 100644 --- a/rtl/go32v2/disk.inc +++ b/rtl/go32v2/disk.inc @@ -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 diff --git a/rtl/linux/disk.inc b/rtl/linux/disk.inc index b7016539ff..33dd96a395 100644 --- a/rtl/linux/disk.inc +++ b/rtl/linux/disk.inc @@ -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 diff --git a/rtl/objpas/diskh.inc b/rtl/objpas/diskh.inc index 6c37e09d24..58c99dd225 100644 --- a/rtl/objpas/diskh.inc +++ b/rtl/objpas/diskh.inc @@ -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 diff --git a/rtl/win32/disk.inc b/rtl/win32/disk.inc index a3b0cdbb67..6bf9412838 100644 --- a/rtl/win32/disk.inc +++ b/rtl/win32/disk.inc @@ -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 diff --git a/rtl/win32/filutil.inc b/rtl/win32/filutil.inc index cc2043a0db..05d2803739 100644 --- a/rtl/win32/filutil.inc +++ b/rtl/win32/filutil.inc @@ -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.