[DELPHI] HD INFO

Neste exemplo irei mostrar como obter informações do HD, tais como:

-> Lista de todos os drives do seu PC e seus tipos (Disquete, CD-ROM, HD, etc);
-> Obter a capacidade total, o espeço utilizado e livre do Driver selecionado;
-> Converter Bytes em Gigabyte;

Segue abaixo a Unit completa:

unit uPrincipal;

interface

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

type
  TForm2 = class(TForm)
    lblLinkBlog: TLabel;
    HD: TButton;
    Memo1: TMemo;
    cbxDriver: TComboBox;
    Label1: TLabel;
    procedure lblLinkBlogClick(Sender: TObject);
    procedure lblLinkBlogMouseEnter(Sender: TObject);
    procedure lblLinkBlogMouseLeave(Sender: TObject);
    procedure HDClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function BytesToGB(const Bytes: Int64): Double;
    function ListaDrives: TStringList;
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

function DiskSpaceInfo(const Drive: string; out AvailBytes, TotalBytes,
  FreeBytes: Int64): Boolean;
begin
  Result := SysUtils.GetDiskFreeSpaceEx(PChar(Drive), AvailBytes, TotalBytes,
    @FreeBytes);
  if not Result then
  begin
    AvailBytes := 0;
    TotalBytes := 0;
    FreeBytes := 0;
  end;
end;

// Lista todos os drives do seu PC e seus tipos (Disquete, CD-ROM, HD, etc)
// Uses FileCtrl
function TForm2.ListaDrives: TStringList;
var
  Lista: TStringList;
  DriveNum: Integer;
  LetraDrive: Char;
  DriveBits: set of 0 .. 25;
  TipoDrive: TDriveType;
begin
  Lista := TStringList.Create;
  Integer(DriveBits) := GetLogicalDrives;
  for DriveNum := 0 to 25 do
  begin
    if not(DriveNum in DriveBits) then
      Continue;
    LetraDrive := UpCase(Char(DriveNum + ord('a')));
    TipoDrive := TDriveType(GetDriveType(PChar(LetraDrive + ':')));
    case TipoDrive of
      dtFloppy:
        Lista.Add(LetraDrive + ': - Disco flexível');
      dtFixed:
        Lista.Add(LetraDrive + ': - Disco rígido');
      dtCDROM:
        Lista.Add(LetraDrive + ': - CD-ROM');
      dtRAM:
        Lista.Add(LetraDrive + ': - RAM Disk');
      dtNetwork:
        Lista.Add(LetraDrive + ': - Drive de rede');
    end;
  end;
  Result := Lista;
end;

// Converte bytes em Gigabyte
function TForm2.BytesToGB(const Bytes: Int64): Double;
const
  cOneGB = 1024 * 1024 * 1024;
begin
  Result := Trunc(Bytes / cOneGB * 100) / 100;
end;

procedure TForm2.HDClick(Sender: TObject);
var
  AvailBytes, TotalBytes, FreeBytes: Int64;
begin
  Memo1.Clear;
  if cbxDriver.Text = EmptyStr then
  begin
    Memo1.Text := 'Selecione um Driver.';
    exit;
  end;
  // recupera as informações do Driver selecionado
  DiskSpaceInfo(copy(cbxDriver.Text, 1, 2), AvailBytes, TotalBytes, FreeBytes);
  //
  Memo1.Lines.Add('BYTES:');
  Memo1.Lines.Add('Capacidade: ' + FormatFloat('###,###,##',
      TotalBytes) + ' bytes');
  Memo1.Lines.Add('Espaço usado: ' + FormatFloat('###,###,##',
      (TotalBytes - AvailBytes)) + ' bytes');
  Memo1.Lines.Add('Espaço livre: ' + FormatFloat('###,###,##',
      FreeBytes) + ' bytes');
  //
  Memo1.Lines.Add('');
  Memo1.Lines.Add('GIGABYTE (GB):');
  Memo1.Lines.Add('Capacidade: ' + floatToStr(BytesToGB(TotalBytes)) + ' GB');
  Memo1.Lines.Add('Espaço usado: ' + floatToStr
      (BytesToGB(TotalBytes - AvailBytes)) + ' GB');
  Memo1.Lines.Add('Espaço livre: ' + floatToStr(BytesToGB(FreeBytes)) + ' GB');
  //
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  cbxDriver.Items := ListaDrives;
end;

procedure TForm2.lblLinkBlogClick(Sender: TObject);
begin
  { Abre o link indicado no caption do TLabel }
  ShellExecute(Application.Handle, 'open', PChar(TLabel(Sender).Caption), nil,
    nil, SW_SHOW);
end;

procedure TForm2.lblLinkBlogMouseEnter(Sender: TObject);
begin
  { Alter a cor da fonta para Azul }
  TLabel(Sender).Font.Color := clBlue;
  { Alter o estilo para Sublihado }
  TLabel(Sender).Font.Style := [fsUnderline];
  { Alter o cursor do Mouse }
  Cursor := crHandPoint;
end;

procedure TForm2.lblLinkBlogMouseLeave(Sender: TObject);
begin
  { Alter a cor da fonta para Preta }
  TLabel(Sender).Font.Color := clBlack;
  { Limpa o estilo do texto }
  TLabel(Sender).Font.Style := [];
  { Alter o cursor do Mouse }
  Cursor := crDefault;
end;

end.

Download

Gostou? Deixe seu comentário... Convido você a seguir meu blog, sua presença é bem vinda!【ツ】