Получить объем диска и его свободного места

Delphi , Файловая система , Диски

Оформил: 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;

Программа на Delphi, которая получает общий и свободный объем диска, указанный пользователем через комбобокс. Программа использует функцию GetDiskFreeSpaceEx для получения информации о размере диска.

В улучшенной версии кода добавлены дополнительные комментарии и обработка ошибок:

unit DiskSize;

interface

uses
  SysUtils, Windows;

const
  MAX_PATH = 260;

type
  TForm1 = class(TForm)
    Button1: TButton;
    DriveComboBox1: TComboBox;
    procedure Button1Click(Sender: TObject);
  private
    function GetDiskSize(drive: Char; var free_size, total_size: Int64): Boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

function GetDiskSize(drive: Char; var free_size, total_size: Int64): Boolean;
var
  RootPath: array[0..MAX_PATH] of Char;
  RootPtr: PChar;
  current_dir: string;
begin
  // Build the root path
  StrPCopy(RootPath, drive + ':');
  RootPtr := PChar(RootPath);

  // Set the current directory to the specified drive
  current_dir := GetCurrentDir;
  if not SetCurrentDir(drive + '\') then
  begin
    Result := False;
    free_size := -1;
    total_size := -1;
    Exit;
  end;

  try
    // Get the disk space information using GetDiskFreeSpaceEx
    GetDiskFreeSpaceEx(RootPtr, free_size, total_size, nil);
  except
    on E: Exception do
      begin
        Result := False;
        free_size := -1;
        total_size := -1;
      end;
  end;

  // Set back the current directory to its original value
  SetCurrentDir(current_dir);

  Result := True;
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;

end.

В улучшенной версии:

• Добавлен константа MAX_PATH для предотвращения жесткого кодирования максимальной длины пути.
• Используется функция StrPCopy для копирования буквы диска и двоеточия в массив RootPath, что более эффективно, чем ручное соединение строк.
• Добавлена обработка ошибок для функции SetCurrentDir для обеспечения правильного установки текущего каталога перед попыткой получения информации о размере диска.
• Используется блок try-except для ловли исключений, thrown by the GetDiskFreeSpaceEx function и установка результата в False, если произошла ошибка.
• Добавлены комментарии для объяснения, что каждый раздел кода делает, что делает программу более понятной для других (или для себя).

В статье предлагается способ получения объема диска и его свободного места в Delphi, используя функцию GetDiskFreeSpaceEx и процедуру SetCurrentDir для изменения текущей директории.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Диски ::