Получить список дисков и сведения о выбранном диске

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

Автор: Xavier Pacheco

unit MainFrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, FileCtrl;

type

  TMainForm = class(TForm)
    btnGetDriveTypes: TButton;
    lbDrives: TListBox;
    lblSectPerClust2: TLabel;
    lblBytesPerSector2: TLabel;
    lblNumFreeClusters2: TLabel;
    lblTotalClusters2: TLabel;
    lblSectPerCluster: TLabel;
    lblBytesPerSector: TLabel;
    lblNumFreeClust: TLabel;
    lblTotalClusters: TLabel;
    lblFreeSpace2: TLabel;
    lblTotalDiskSpace2: TLabel;
    lblFreeSpace: TLabel;
    lblTotalDiskSpace: TLabel;
    procedure btnGetDriveTypesClick(Sender: TObject);
    procedure lbDrivesClick(Sender: TObject);
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

procedure TMainForm.btnGetDriveTypesClick(Sender: TObject);
var
  i: Integer;
  C: string;
  DType: Integer;
  DriveString: string;
begin
  { Loop from A..Z to determine available drives }
  for i := 65 to 90 do
  begin
    // Format a string to represent the root directory.
    C := chr(i) + ':\';
    { Call the GetDriveType() function which returns an integer
      value representing one of the types shown in the case statement
      below }
    DType := GetDriveType(PChar(C));
    { Based on the drive type returned, format a string to add to
      the listbox displaying the various drive types. }
    case DType of
      0: DriveString := C + ' The drive type cannot be determined.';
      1: DriveString := C + ' The root directory does not exist.';
      DRIVE_REMOVABLE: DriveString :=
        C + ' The drive can be removed from the drive.';
      DRIVE_FIXED: DriveString :=
        C + ' The disk cannot be removed from the drive.';
      DRIVE_REMOTE: DriveString :=
        C + ' The drive is a remote (network) drive.';
      DRIVE_CDROM: DriveString := C + ' The drive is a CD-ROM drive.';
      DRIVE_RAMDISK: DriveString := C + ' The drive is a RAM disk.';
    end;
    // Only add drive types that can be determined.
    if not ((DType = 0) or (DType = 1)) then
      lbDrives.Items.AddObject(DriveString, Pointer(i));
  end;

end;

procedure TMainForm.lbDrivesClick(Sender: TObject);
var
  RootPath: string; // Holds the drive root path
  SectorsPerCluster: DWord; // Sectors per cluster
  BytesPerSector: DWord; // Bytes per sector
  NumFreeClusters: DWord; // Number of free clusters
  TotalClusters: DWord; // Total clusters
  DriveByte: Byte; // Drive byte value
  FreeSpace: Int64; // Free space on drive
  TotalSpace: Int64; // Total drive space.

begin
  with lbDrives do
  begin
    { Convert the ascii value for the drive letter to a valid drive number:
        1 = A, 2 = B, etc. by subtracting 64 from the ascii value. }
    DriveByte := Integer(Items.Objects[ItemIndex]) - 64;
    { First create the root path string }
    RootPath := chr(Integer(Items.Objects[ItemIndex])) + ':\';
    { Call GetDiskFreeSpace to obtain the drive information }
    if GetDiskFreeSpace(PChar(RootPath), SectorsPerCluster,
      BytesPerSector, NumFreeClusters, TotalClusters) then
    begin
      { If this function is successful, then update the labels to
        display the disk information. }
      lblSectPerCluster.Caption := Format('%.0n', [SectorsPerCluster * 1.0]);
      lblBytesPerSector.Caption := Format('%.0n', [BytesPerSector * 1.0]);
      lblNumFreeClust.Caption := Format('%.0n', [NumFreeClusters * 1.0]);
      lblTotalClusters.Caption := Format('%.0n', [TotalClusters * 1.0]);
      // Obtain the available disk space
      FreeSpace := DiskFree(DriveByte);
      TotalSpace := DiskSize(DriveByte);
      lblFreeSpace.Caption := Format('%.0n', [FreeSpace * 1.0]);
      { Calculate the total disk space }
      lblTotalDiskSpace.Caption := Format('%.0n', [TotalSpace * 1.0]);
    end
    else
    begin
      { Set labels to display nothing }
      lblSectPerCluster.Caption := 'X';
      lblBytesPerSector.Caption := 'X';
      lblNumFreeClust.Caption := 'X';
      lblTotalClusters.Caption := 'X';
      lblFreeSpace.Caption := 'X';
      lblTotalDiskSpace.Caption := 'X';
      ShowMessage('Cannot get disk info');
    end;
  end;

end;

end.

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

Для использования кода выполните следующие шаги:

1. Запустите приложение.
2. Нажмите кнопку "Get Drive Types", чтобы отобразить список доступных диск в списке.
3. Выберите диск из списка.
4. Нажмите выбранный диск снова, чтобы отобразить его детали.

Обратите внимание, что код использует функцию GetDriveType Delphi для определения типа каждого диска (например, removable, fixed, CD-ROM и т.д.). Он также использует два пользовательских функции, DiskFree и DiskSize, которые не определены в этом фрагменте кода. Эти функции должны быть реализованы для получения доступного пространства на диске и общего размера диска для заданного диска.

Вот пример реализации этих функций:

function DiskFree(DriveByte: Byte): Int64;
var
  SectorsPerCluster: DWord;
  BytesPerSector: DWord;
  NumFreeClusters: DWord;
  TotalClusters: DWord;
begin
  GetDiskFreeSpace(Format('c:\', [chr(DriveByte)]), SectorsPerCluster, BytesPerSector, NumFreeClusters, TotalClusters);
  Result := (NumFreeClusters * SectorsPerCluster * BytesPerSector) / 1024 / 1024; // Convert to megabytes
end;

function DiskSize(DriveByte: Byte): Int64;
var
  SectorsPerCluster: DWord;
  BytesPerSector: DWord;
  NumFreeClusters: DWord;
  TotalClusters: DWord;
begin
  GetDiskFreeSpace(Format('c:\', [chr(DriveByte)]), SectorsPerCluster, BytesPerSector, NumFreeClusters, TotalClusters);
  Result := (TotalClusters * SectorsPerCluster * BytesPerSector) / 1024 / 1024; // Convert to megabytes
end;

Функции DiskFree и DiskSize используют функцию GetDiskFreeSpace из Windows API для получения информации о диске. Результаты затем конвертируются в мегабайты для более удобного отображения.

Вы можете модифицировать эти функции, чтобы они соответствовали вашим конкретным потребностям и реализовать их в вашем коде Delphi.

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

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

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

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