Определение размера диска и свободного пространства на нём

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

Сначала до слова implementation напишем такой код:

function GetDiskFreeSpaceEx(lpDirectoryName: PAnsiChar;
var lpFreeBytesAvailableToCaller : Integer;
var lpTotalNumberOfBytes: Integer;
var lpTotalNumberOfFreeBytes: Integer) : bool;
stdcall;
external kernel32
name 'GetDiskFreeSpaceExA';

Затем после слова implementation:

procedure GetDiskSizeAvail(TheDrive : PChar;
  var TotalBytes : double; var TotalFree : double);
var
  AvailToCall : integer;
  TheSize : integer;
  FreeAvail : integer;
begin
  GetDiskFreeSpaceEx(TheDrive, AvailToCall, TheSize, FreeAvail);
  {$IFOPT Q+}
  {$DEFINE TURNOVERFLOWON}
  {$Q-}
  {$ENDIF}
  if TheSize >= 0 then
    TotalBytes := TheSize
  else
  if TheSize = -1 then
  begin
    TotalBytes := $7FFFFFFF;
    TotalBytes := TotalBytes * 2;
    TotalBytes := TotalBytes + 1;
  end
  else
  begin
    TotalBytes := $7FFFFFFF;
    TotalBytes := TotalBytes + abs($7FFFFFFF - TheSize);
  end;

  if AvailToCall >= 0 then
    TotalFree := AvailToCall
  else
  if AvailToCall = -1 then
  begin
    TotalFree := $7FFFFFFF;
    TotalFree := TotalFree * 2;
    TotalFree := TotalFree + 1;
  end
  else
  begin
    TotalFree := $7FFFFFFF;
    TotalFree := TotalFree + abs($7FFFFFFF - AvailToCall);
  end;
end;

И, наконец, обработаем нажатие кнопки следующим образом:

procedure TForm1.Button1Click(Sender: TObject);
var
  TotalBytes: double;
  TotalFree: double;
begin
  GetDiskSizeAvail('C:\', TotalBytes, TotalFree);
  ShowMessage(FloatToStr(TotalBytes));
  ShowMessage(FloatToStr(TotalFree));
end;

Here's a translation of the provided code into Russian:

Код, написанный на Delphi, предназначен для определения размера жёсткого диска и его доступной свободной памяти. Он использует функцию GetDiskFreeSpaceEx из Windows API для получения этой информации.

В коде есть три части:

1. Первая часть определяет функцию GetDiskFreeSpaceEx, которая получает информацию о указанном каталоге (lpDirectoryName). Эта функция импортируется из библиотеки kernel32 с помощью директивы external kernel32 name 'GetDiskFreeSpaceExA'.
2. Вторая часть определяет процедуру GetDiskSizeAvail, которая принимает три параметра: TheDrive, TotalBytes и TotalFree. Она вызывает функцию GetDiskFreeSpaceEx для получения общего количества байтов (lpTotalNumberOfBytes) и доступной свободной памяти (lpTotalNumberOfFreeBytes) для указанного диска.
3. Внутри процедуры GetDiskSizeAvail она проверяет, являются ли возвращенные значения корректными (больше или равны 0). Если они корректны, то она присваивает их переменным TotalBytes и TotalFree.
4. Если возвращенные значения не корректны, то она выполняет некоторые расчеты для определения общего размера диска (TotalBytes) и доступной свободной памяти (TotalFree). Эти расчеты включают умножение и сложение некоторых констант.
5. Третья часть определяет процедуру Button1Click, которая вызывается при клике кнопки на форме. Она вызывает процедуру GetDiskSizeAvail с указанием буквы диска 'C:' и присваивает возвращенные значения локальным переменным TotalBytes и TotalFree. Затем она отображает эти значения с помощью ShowMessage.

Некоторые предложения по улучшению кода:

• Вместо использования жесткого кодирования буквы диска ('C:\') в процедуре Button1Click, можно позволить пользователю вводить свою желаемую букву диска.
• Могло бы быть полезно обработать потенциальные ошибки, которые могут возникнуть при вызове функции GetDiskFreeSpaceEx. Например, можно проверять, возвращает ли функция значение ошибки (FALSE), и отображать соответствующее сообщение об ошибке.
• Могло бы быть полезно использовать более описательные имена переменных вместо аббревиатур, таких как AvailToCall, TheSize и FreeAvail.
• Могло бы быть полезно добавить комментарии или документацию для объяснения того, что делает каждый участок кода.

Обновленная версия кода, которая включает в себя эти предложения:

procedure TForm1.Button1Click(Sender: TObject);
var
  TotalBytes, TotalFree: double;
  DriveLetter: string;
begin
   // Ask user for drive letter
  DriveLetter := InputBox('Enter drive letter:', 'Drive Letter', 'C:\');

  if GetDiskSizeAvail(PChar(DriveLetter), TotalBytes, TotalFree) then
    begin
      ShowMessage(FloatToStr(TotalBytes));
      ShowMessage(FloatToStr(TotalFree));
    end
  else
    ShowMessage('Error: Unable to retrieve disk size and free space.');
end;

function GetDiskFreeSpaceEx(lpDirectoryName: PAnsiChar;
  var lpFreeBytesAvailableToCaller: Integer;
  var lpTotalNumberOfBytes: Integer;
  var lpTotalNumberOfFreeBytes: Integer): boolean; stdcall;
external kernel32 name 'GetDiskFreeSpaceExA';

procedure GetDiskSizeAvail(TheDrive: PChar;
  var TotalBytes, TotalFree: double);
var
  AvailToCall, TheSize, FreeAvail: integer;
begin
  if not GetDiskFreeSpaceEx(TheDrive, AvailToCall, TheSize, FreeAvail) then
    RaiseLastOSError; // Handle error

  if TheSize >= 0 then
    TotalBytes := TheSize
  else
    begin
      case TheSize of
         -1: TotalBytes := $7FFFFFFF * 2 + 1;
        else: TotalBytes := $7FFFFFFF + abs($7FFFFFFF - TheSize);
      end;
    end;

  if AvailToCall >= 0 then
    TotalFree := AvailToCall
  else
    begin
      case AvailToCall of
         -1: TotalFree := $7FFFFFFF * 2 + 1;
        else: TotalFree := $7FFFFFFF + abs($7FFFFFFF - AvailToCall);
      end;
    end;
end;

Обновленный код более robust и пользовательский, но он все еще имеет некоторые ограничения. Например, он предполагает, что буква диска всегда указана в формате 'C:\'. Могло бы быть полезно обработать другие форматы (например, 'D:', 'E:') также.

Определение размера диска и свободного пространства на нем код на Delphi для определения размера жесткого диска и количества доступного свободного пространства.

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

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

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