Browse Source

* int64 support for diskfree,disksize

peter 25 years ago
parent
commit
01e98ff122
5 changed files with 187 additions and 18 deletions
  1. 93 1
      rtl/go32v2/disk.inc
  2. 36 2
      rtl/linux/disk.inc
  3. 11 3
      rtl/objpas/diskh.inc
  4. 43 9
      rtl/win32/disk.inc
  5. 4 3
      rtl/win32/filutil.inc

+ 93 - 1
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;
 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

+ 36 - 2
rtl/linux/disk.inc

@@ -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

+ 11 - 3
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 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

+ 43 - 9
rtl/win32/disk.inc

@@ -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
-   result:=free*secs*bytes
+  if assigned(GetDiskFreeSpaceEx) then
+    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
-   result:=total*secs*bytes
+  if assigned(GetDiskFreeSpaceEx) then
+    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

+ 4 - 3
rtl/win32/filutil.inc

@@ -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.