getdrive.pas

Delphi7高级应用开发随书源码

unit GetDrive;

interface

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

type
  TForm1 = class(TForm)
    btnGetDriveType: TButton;
    lbDrives: TListBox;
    Label1: TLabel;
    lbSectorOfCluster: TLabel;
    Label3: TLabel;
    lbFreeSpace: TLabel;
    Label5: TLabel;
    lbByteOfSector: TLabel;
    Label7: TLabel;
    lbTotalSpace: TLabel;
    Label9: TLabel;
    lbFreeCluster: TLabel;
    Label11: TLabel;
    lbTotalCluster: TLabel;
    procedure btnGetDriveTypeClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure lbDriveClick(Sender: TObject);
  private
    procedure ClearForm;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btnGetDriveTypeClick(Sender: TObject);

var
  i: Integer;
	c: String;
	DType: Integer;
	DriveString: String;
begin
	for i := 65 to 90 do
	begin
		c := chr(i) + ':\';
		DType := GetDriveType(Pchar(c));
		case DType of
			0: DriveString := c + '该驱动器类型不能确定。';
			1: DriveString := c + '该驱动器不存在。';
			DRIVE_REMOVABLE: DriveString := c + '该驱动器可移动。';
			DRIVE_FIXED: DriveString := c + '该驱动器不可移动。';
			DRIVE_REMOTE: DriveString := c + '该驱动器为远程网络驱动器。';
			DRIVE_CDROM: DriveString := c + '该驱动器为CD-ROM驱动器。';
			DRIVE_RAMDISK: DriveString := c + '该驱动器驱动器为RAM磁盘。';
		end;
		if not ((DType = 0) or (DType = 1)) then
			lbDrives.Items.AddObject(DriveString, Pointer(i));
	end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    ClearForm;
end;

procedure TForm1.ClearForm;
begin
    lbSectorOfCluster.Caption := '';
    lbByteOfSector.Caption := '';
    lbFreeCluster.Caption := '';
    lbTotalCluster.Caption := '';
    lbFreeSpace.Caption := '';
    lbTotalSpace.Caption := '';
end;

procedure TForm1.lbDriveClick(Sender: TObject);
var
	RootPath: String;
	SectorsPerCluster: DWord;
	BytesPerSector: DWord;
	NumFreeClusters: DWord;
	TotalClusters: DWord;
	DriveByte: Byte;
	FreeSpace: int64;
	TotalSpace: int64;
	DriveNum: Integer;

begin
   with lbDrives do
	 begin
		  DriveByte := Integer(Items.Objects[ItemIndex]) - 64;
		  RootPath := chr(Integer(Items. Objects[ItemIndex])) + ':\';
		  If GetDiskFreeSpace(Pchar(RootPath),SectorsPerCluster,
       BytesPerSector, NumFreeClusters, TotalClusters) then
	    begin
		      lbSectorOfCluster.Caption := Format('%.0n',[SectorsPerCluster*1.0]);
          lbByteOfSector.Caption := Format('%.0n',[BytesPerSector*1.0]);
          lbFreeCluster.Caption := Format('%.0n',[NumFreeClusters*1.0]);
          lbTotalCluster.Caption := Format('%.0n',[TotalClusters*1.0]);
          FreeSpace := DiskFree(DriveByte);
          TotalSpace := DiskSize(DriveByte);
          lbFreeSpace.Caption := Format('%.0n',[FreeSpace*1.0]);
          lbTotalSpace.Caption := Format('%.0n',[TotalSpace*1.0]);
      end
      else begin
          ShowMessage('不能够获得磁盘信息');
        ClearForm;
      end;
    end;
end;

end.