Nasko
asked on
GetDiskFreeSpaceEx or GetDiskFreeSpace
Hi all,
Please do tell me more about how can use GetDiskFreeSpaceEx API to obtain FreeSpace AND TotalSpace, because GetDiskFreeSpace function returns incorrect values for volumes that are larger than 2 gigabytes. Please include some code (Delphi 3) with examples. Must work on FAT16, FAT32 NTFS.
Thanks in advance
Please do tell me more about how can use GetDiskFreeSpaceEx API to obtain FreeSpace AND TotalSpace, because GetDiskFreeSpace function returns incorrect values for volumes that are larger than 2 gigabytes. Please include some code (Delphi 3) with examples. Must work on FAT16, FAT32 NTFS.
Thanks in advance
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks, many thanks, but people post comments and user selects most appropriate as answer.if you post as answer you are "locking" the q from others seeing it.
Have to watch out for the integer math, that is why my example uses double data type.
var lpspc, lpbps, lpnofc, lptnoc: Integer;
fspc, fbps, fnofc, ftnoc: Double;
fFree, fTotal: Double;
begin
if GetDiskFreeSpace('c:\', lpspc, lpbps, lpnofc, lptnoc) then
begin
// The following will perform only integer math, and will be wrong if
// results are bigger that 2GB
fFree:=lpspc * lpbps * lpnofc;
fTotal:=lpspc * lpbps * lptnoc;
MessageBox(Handle, PChar(Format('Total = %n, Free = %n', [fTotal, fFree])), nil, MB_OK);
// Correct way would be to assign to double so
// we perform floating point math
fspc:=lpspc;
fbps:=lpbps;
fnofc:=lpnofc;
ftnoc:=lptnoc;
// Floating point math
fFree:=fspc * fbps * fnofc;
fTotal:=fspc * fbps * ftnoc;
MessageBox(Handle, PChar(Format('Total = %n, Free = %n', [fTotal, fFree])), nil, MB_OK);
end;
Here is my try at this:
Let's try this...
This is THE answer you are looking for.
Like the other experts here says you need the function Mine will only work on win95osr2 and later and NT3.5 and later and 2K also.
-create a new program
add a button.
and this is the unit :
========================== ========== ==
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
btnButton1: TButton;
procedure btnButton1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
ULARGE_INTEGER = record
case Integer of
0: (
LowPart: DWORD;
HighPart: DWORD);
1: (
QuadPart: LONGLONG);
end;
PULargeInteger = ^TULargeInteger;
TULargeInteger = ULARGE_INTEGER;
var
Form1: TForm1;
GetDiskFreeSpaceEx: function(Directory: PChar; var FreeAvailable,
TotalSpace, TotalFree: ULARGE_INTEGER): Bool stdcall = nil;
implementation
{$R *.DFM}
procedure InitDriveSpacePtr;
var
Kernel: THandle;
begin
Kernel := GetModuleHandle(Windows.Ke rnel32);
if Kernel <> 0 then
@GetDiskFreeSpaceEx := GetProcAddress(Kernel, 'GetDiskFreeSpaceExA');
end;
function InternalGetDiskSpace(Drive : Byte;
var TotalSpace, FreeSpaceAvailable: ULARGE_INTEGER): Bool;
var
RootPath: array[0..4] of Char;
RootPtr: PChar;
Test: ULARGE_INTEGER;
begin
RootPtr := nil;
if Drive > 0 then
begin
RootPath[0] := Char(Drive + $40);
RootPath[1] := ':';
RootPath[2] := '\';
RootPath[3] := #0;
RootPtr := RootPath;
end;
Result := GetDiskFreeSpaceEx(RootPtr , FreeSpaceAvailable, TotalSpace, Test);
end;
//DiskFree returns the number of free bytes on the specified drive, where 0 = Current, 1 = A, 2 = B,
and so on.
//DiskFree returns -1 if the drive number is invalid.
function DiskFree(Drive: Byte): ULARGE_INTEGER;
var
TotalSpace: ULARGE_INTEGER;
begin
if not InternalGetDiskSpace(Drive , TotalSpace, Result) then
Result.QuadPart := -1;
end;
procedure TForm1.btnButton1Click(Sen der: TObject);
var
disk: byte;
freeS: ULARGE_INTEGER;
resultinMB:integer;
begin
InitDriveSpacePtr; //to get the pointer on the getdiskfreespaceEx function
disk := 2; //a:0, B:1, C:2 etc...
freeS := DiskFree(disk);
resultinMB := round(freeS.QuadPart / 1024 / 1024);
showmessage('The disk has '+intToStr(resultinMB)+' mega bytes free');
//the total size in byte of the disk is in quadpart
end;
end.
//I have tested it under D3 and it is working on my 15Gb disk
This is working for any partitions type except that
no solution can be found if you have a network mapped fat32 disk :) but, who cares ;)
Regards.
Let's try this...
This is THE answer you are looking for.
Like the other experts here says you need the function Mine will only work on win95osr2 and later and NT3.5 and later and 2K also.
-create a new program
add a button.
and this is the unit :
==========================
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
btnButton1: TButton;
procedure btnButton1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
ULARGE_INTEGER = record
case Integer of
0: (
LowPart: DWORD;
HighPart: DWORD);
1: (
QuadPart: LONGLONG);
end;
PULargeInteger = ^TULargeInteger;
TULargeInteger = ULARGE_INTEGER;
var
Form1: TForm1;
GetDiskFreeSpaceEx: function(Directory: PChar; var FreeAvailable,
TotalSpace, TotalFree: ULARGE_INTEGER): Bool stdcall = nil;
implementation
{$R *.DFM}
procedure InitDriveSpacePtr;
var
Kernel: THandle;
begin
Kernel := GetModuleHandle(Windows.Ke
if Kernel <> 0 then
@GetDiskFreeSpaceEx := GetProcAddress(Kernel, 'GetDiskFreeSpaceExA');
end;
function InternalGetDiskSpace(Drive
var TotalSpace, FreeSpaceAvailable: ULARGE_INTEGER): Bool;
var
RootPath: array[0..4] of Char;
RootPtr: PChar;
Test: ULARGE_INTEGER;
begin
RootPtr := nil;
if Drive > 0 then
begin
RootPath[0] := Char(Drive + $40);
RootPath[1] := ':';
RootPath[2] := '\';
RootPath[3] := #0;
RootPtr := RootPath;
end;
Result := GetDiskFreeSpaceEx(RootPtr
end;
//DiskFree returns the number of free bytes on the specified drive, where 0 = Current, 1 = A, 2 = B,
and so on.
//DiskFree returns -1 if the drive number is invalid.
function DiskFree(Drive: Byte): ULARGE_INTEGER;
var
TotalSpace: ULARGE_INTEGER;
begin
if not InternalGetDiskSpace(Drive
Result.QuadPart := -1;
end;
procedure TForm1.btnButton1Click(Sen
var
disk: byte;
freeS: ULARGE_INTEGER;
resultinMB:integer;
begin
InitDriveSpacePtr; //to get the pointer on the getdiskfreespaceEx function
disk := 2; //a:0, B:1, C:2 etc...
freeS := DiskFree(disk);
resultinMB := round(freeS.QuadPart / 1024 / 1024);
showmessage('The disk has '+intToStr(resultinMB)+' mega bytes free');
//the total size in byte of the disk is in quadpart
end;
end.
//I have tested it under D3 and it is working on my 15Gb disk
This is working for any partitions type except that
no solution can be found if you have a network mapped fat32 disk :) but, who cares ;)
Regards.
delphi automaticly resets the pointer reference to GetDiskFreeSpaceEx when the sysutils is initialized with the InitDriveSpacePtr procedure. Here is some code I have used when I don't want to use sysutils. You will have to call the procedure InitDriveSpacePtr; in your form create, to see which GetDiskFreeSpace function your OS supports. this will return -1 on errors. . . . .
type
TdriveSize = record
FreeS:Int64;
TotalS:Int64;
var
GetDiskFreeSpaceEx: function (Directory: PChar; var FreeAvailable,
TotalSpace: Int64; TotalFree: PLargeInteger): Boolean stdcall = nil;
function BackfillGetDiskFreeSpaceEx (Directory : PChar; var FreeAvailable,
TotalSpace: Int64; TotalFree: PLargeInteger): Boolean; stdcall;
var
SectorsPerCluster, BytesPerSector, FreeClusters, TotalClusters: LongWord;
Temp: Int64;
Dir: PChar;
begin
if Directory <> nil then
Dir := Directory
else
Dir := nil;
Result := GetDiskFreeSpaceA(Dir, SectorsPerCluster, BytesPerSector,
FreeClusters, TotalClusters);
Temp := SectorsPerCluster * BytesPerSector;
FreeAvailable := Temp * FreeClusters;
TotalSpace := Temp * TotalClusters;
end;
procedure InitDriveSpacePtr;
var
Kernel: HWND;
begin
Kernel := GetModuleHandle(Windows.Ke rnel32);
if Kernel <> 0 then
@GetDiskFreeSpaceEx := GetProcAddress(Kernel, 'GetDiskFreeSpaceExA');
if not Assigned(GetDiskFreeSpaceE x) then
GetDiskFreeSpaceEx := @BackfillGetDiskFreeSpaceE x;
end;
function DiskSpace(Drive: PChar): TdriveSize;
var
TSpace,TotalS: Int64;
Drv: array [0..4] of char;
Sizes:TdriveSize;
ErrorMode: Word;
begin
StrLCopy(Drv,Drive,3);
ErrorMode := SetErrorMode(SEM_FailCriti calErrors) ;
if GetDiskFreeSpaceEx(Drv, TSpace, TotalS, nil) then
begin
Sizes.FreeS := TSpace;
Sizes.TotalS := TotalS;
Result := Sizes;
end else
begin
Sizes.FreeS := -1;
Sizes.TotalS := -1;
Result := Sizes;
end;
SetErrorMode(ErrorMode);
end;
type
TdriveSize = record
FreeS:Int64;
TotalS:Int64;
var
GetDiskFreeSpaceEx: function (Directory: PChar; var FreeAvailable,
TotalSpace: Int64; TotalFree: PLargeInteger): Boolean stdcall = nil;
function BackfillGetDiskFreeSpaceEx
TotalSpace: Int64; TotalFree: PLargeInteger): Boolean; stdcall;
var
SectorsPerCluster, BytesPerSector, FreeClusters, TotalClusters: LongWord;
Temp: Int64;
Dir: PChar;
begin
if Directory <> nil then
Dir := Directory
else
Dir := nil;
Result := GetDiskFreeSpaceA(Dir, SectorsPerCluster, BytesPerSector,
FreeClusters, TotalClusters);
Temp := SectorsPerCluster * BytesPerSector;
FreeAvailable := Temp * FreeClusters;
TotalSpace := Temp * TotalClusters;
end;
procedure InitDriveSpacePtr;
var
Kernel: HWND;
begin
Kernel := GetModuleHandle(Windows.Ke
if Kernel <> 0 then
@GetDiskFreeSpaceEx := GetProcAddress(Kernel, 'GetDiskFreeSpaceExA');
if not Assigned(GetDiskFreeSpaceE
GetDiskFreeSpaceEx := @BackfillGetDiskFreeSpaceE
end;
function DiskSpace(Drive: PChar): TdriveSize;
var
TSpace,TotalS: Int64;
Drv: array [0..4] of char;
Sizes:TdriveSize;
ErrorMode: Word;
begin
StrLCopy(Drv,Drive,3);
ErrorMode := SetErrorMode(SEM_FailCriti
if GetDiskFreeSpaceEx(Drv, TSpace, TotalS, nil) then
begin
Sizes.FreeS := TSpace;
Sizes.TotalS := TotalS;
Result := Sizes;
end else
begin
Sizes.FreeS := -1;
Sizes.TotalS := -1;
Result := Sizes;
end;
SetErrorMode(ErrorMode);
end;
Hello
sorry Nasko for posting my comment and answer
I test my code with partition more than 2GB and with win2000, and that works fine, also try the link I gave to you, you will find full project and it will work find too
Mohammed
sorry Nasko for posting my comment and answer
I test my code with partition more than 2GB and with win2000, and that works fine, also try the link I gave to you, you will find full project and it will work find too
Mohammed
ASKER
Hi Mohammed,
Yes I found the D3DiskSpaceKludge very helpful. It works fine. Just be more patient;)... I want to see another answers. Thanks!
Nasko
Yes I found the D3DiskSpaceKludge very helpful. It works fine. Just be more patient;)... I want to see another answers. Thanks!
Nasko
Hi Nasko
I just wanted to check if that worked with you or not, I hope you find what you are looking for :)
Mohammed
I just wanted to check if that worked with you or not, I hope you find what you are looking for :)
Mohammed
ASKER
Thanks Slick812, rllibby, jeurk and Mohammed
I must edit my q...I needs a solution that will work on Win 95 too..
Nasko
I must edit my q...I needs a solution that will work on Win 95 too..
Nasko
I test my code with win95 and fat16 and it work fine too there :), the same code work with win95 and win2000 :)
Mohammed
Mohammed
procedure TForm1.Button1Click(Sender
var
FreeBytes : TLargeInteger;
FreeSize : TLargeInteger;
TotalSize : TLargeInteger;
begin
GetDiskFreeSpaceEx( 'c:',
FreeBytes,
Totalsize,
@FreeSize );
ShowMessage('Free Space = ' + IntToStr(FreeBytes)
+#13 + #10 + 'Total Drive Size ' + IntToStr(TotalSize))
end;
Mohammed