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

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 и FreePascal.

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

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