ufrmdrive.pas

磁盘驱动器管理程序,通过它可以清楚的看到你的电脑驱动器情况,适合程序初学使用!

unit uFrmDrive;

interface

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

type
  TFrmDrive = class(TForm)
    lstDrives: TListBox;
    pnlInfo: TPanel;
    btnGetDrive: TButton;
    btnClose: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    lblSectPerCluster: TLabel;
    lblBytesPerSector: TLabel;
    lblFreeClusters: TLabel;
    lblTotalClusters: TLabel;
    lblFreeSpace: TLabel;
    lblTotalSpace: TLabel;
    procedure btnGetDriveClick(Sender: TObject);
    procedure lstDrivesClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmDrive: TFrmDrive;

implementation

{$R *.dfm}

procedure TFrmDrive.btnGetDriveClick(Sender: TObject);
var
  I: Integer;
  C: string;
  DriveType: Integer;
  DriveString: string;
begin
  for I := 65 to 90 do  // 从A到Z
  begin
    C := Chr(I) + ':\';  // 形成根目录
    DriveType := GetDriveType(PChar(C));
    case DriveType of
      0: DriveString := C + ' 驱动器类型不确定';
      1: DriveString := C + ' 驱动器根目录不存在';
      DRIVE_REMOVABLE: DriveString := C + ' 是可移动驱动器';
      DRIVE_FIXED: DriveString := C+' 是固定驱动器';
      DRIVE_REMOTE: DriveString := C+' 是网络驱动器';
      DRIVE_CDROM: DriveString := C+' 是光盘驱动器';
      DRIVE_RAMDISK: DriveString := C+' 是RAM驱动器';
    end;
    // 将可确定的驱动器添加到窗体中的列表框中
    if not((DriveType = 0) or (DriveType = 1)) then
      lstDrives.Items.AddObject(DriveString, Pointer(I)) 
  end;
end;


procedure TFrmDrive.lstDrivesClick(Sender: TObject);
var
  RootPath: String;
  SectorsPerCluster: DWord;
  BytesPerSector: DWord;     
  NumFreeClusters: DWord;    
  TotalClusters: DWord;      
  DriveByte: Byte;           
  FreeSpace: Int64;          
  TotalSpace: Int64;         
begin
  with lstDrives do  // 对列表框中当前选择项进行处理
  begin
    DriveByte := Integer(Items.Objects[ItemIndex]) - 64; // 将字符改为数字
    RootPath := chr(Integer(Items.Objects[ItemIndex])) + ':\'; // 形成根目录
    // 获取驱动器各项信息
    if GetDiskFreeSpace(PChar(RootPath), SectorsPerCluster,
      BytesPerSector, NumFreeClusters, TotalClusters) then
    begin
      // 若成功获取信息
      lblSectPerCluster.Caption := Format('%.0n', [SectorsPerCluster * 1.0]);
      lblBytesPerSector.Caption := Format('%.0n', [BytesPerSector * 1.0]);
      lblFreeClusters.Caption := Format('%.0n', [NumFreeClusters * 1.0]);
      lblTotalClusters.Caption := Format('%.0n', [TotalClusters * 1.0]);
      FreeSpace  := DiskFree(DriveByte);
      TotalSpace := DiskSize(DriveByte);
      lblFreeSpace.Caption := Format('%.0n', [FreeSpace * 1.0]);
      lblTotalSpace.Caption := Format('%.0n', [TotalSpace * 1.0]);
    end
    else begin
      lblSectPerCluster.Caption := 'X';
      lblBytesPerSector.Caption := 'X';
      lblFreeClusters.Caption := 'X';
      lblTotalClusters.Caption := 'X';
      lblFreeSpace.Caption := 'X';
      lblTotalSpace.Caption := 'X';
      ShowMessage('不能获取驱动器信息');
    end;
  end;
end;


procedure TFrmDrive.btnCloseClick(Sender: TObject);
begin
  Close;
end;

end.