Получить объем диска и его свободного места
Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch
{
* Place a Button1 and DriveComboBox1 on your form.
* The function "SetCurrentDir" well be true if the disk in drive
* The procedure "GetDiskFreeSpaceEx" returns the free and total disk size
}
uses
SysUtils;
implementation
function GetDiskSize(drive: Char; var free_size, total_size: Int64): Boolean;
var
RootPath: array[0..4] of Char;
RootPtr: PChar;
current_dir: string;
begin
RootPath[0] := Drive;
RootPath[1] := ':';
RootPath[2] := '\';
RootPath[3] := #0;
RootPtr := RootPath;
current_dir := GetCurrentDir;
if SetCurrentDir(drive + ':\') then
begin
GetDiskFreeSpaceEx(RootPtr, Free_size, Total_size, nil);
// this to turn back to original dir
SetCurrentDir(current_dir);
Result := True;
end
else
begin
Result := False;
Free_size := -1;
Total_size := -1;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
free_size, total_size: Int64;
begin
if GetDiskSize(DriveComboBox1.Drive, free_size, total_size) then
ShowMessage('free space =' +
IntToStr(free_size) + #13 + 'total size=' +
IntToStr(total_size))
else
ShowMessage('No disk in drive!');
end;
|