Este ejemplo muestra cómo obtener información de las unidades del sistema (etiqueta, capacidad, número de serie, sistema de archivos, tamaño máximo del nombre del fichero, espacio libre, espacio total, cluster, sectores, bytes por cluster, ...), a continuación mostramos el código fuente/Source code completo en Delphi 6:

unit UnidadMenuPrincipal;

interface

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

type
  TformMenuPrincipal = class(TForm)
    bInfo: TButton;
    Label2: TLabel;
    lInfo: TMemo;
    txtUnidad: TComboBox;
    Button1: TButton;
    dlGuardar: TSaveDialog;
    procedure bInfoClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  formMenuPrincipal: TformMenuPrincipal;
  etiqueta, tipoFicheros, numeroSerie : string;
  longitudMaximaFichero : DWORD;
  sectoresPorCluster : DWORD;
  bytesPorSector : DWORD;
  numeroClusterLibres : DWORD;
  numeroTotalCluster : DWORD;
  espacioLibreDisco : double;
  espacioOcupadoDisco : double;
  espacioTotalDisco : double;
implementation

{$R *.dfm}

function obtenerUnidades () : TStrings;
var
  N: Byte;
  Drv: string;
  Drives: set of 0..25;
  lista : TStrings;
begin
  lista := TStringList.Create;
  Integer(Drives) := GetLogicalDrives;
  for N := 0 to 25 do
  begin
    if N in Drives then
    begin
      Drv := Char(N + Ord ('A')) + ':\';
      lista.Add(Drv);
      //para filtrar un tipo de unidad en concreto (5 = CD)
      {if(GetDriveType(PChar(Drv)) = 5) then
      begin
        Result := Drv;
        Exit;
      end;}
    end;
  end;
  Result := lista;
end;


procedure obtenerDatosUnidad (unidad : string);
var
  VolumeName : array [0..255] of Char;
  FileSystemType : array [0..255] of Char;
  SerialNum : DWORD;
  MaxFilenameLength : DWORD;
  Flags : DWORD;
  vNumeroClusterLibres, vbytesPorSector, vsectoresPorCluster, vnumeroTotalCluster : Double;
begin
  //etiqueta, número serie, sistema archivos, longitud máxima fichero
  if (GetVolumeInformation(PChar(unidad), VolumeName,  256,  @SerialNum,
      MaxFilenameLength, Flags, FileSystemType, 256))then
  begin
    etiqueta := VolumeName;
    tipoFicheros := FileSystemType;
    numeroSerie := IntToHex(HiWord(SerialNum), 4) + ' - ' +
        IntToHex(LoWord(SerialNum), 4) ;
    LongitudMaximaFichero := MaxFilenameLength;
  end
  else
  begin
    etiqueta := '';
    tipoFicheros := '';
    LongitudMaximaFichero := 0;
  end;

  //sectores, cluster, ...
  if Windows.GetDiskFreeSpace(pchar(unidad), sectoresPorCluster, bytesPorSector,
      numeroClusterLibres, numeroTotalCluster) then
  begin
    vNumeroClusterLibres := numeroClusterLibres;
    vbytesPorSector := bytesPorSector;
    vsectoresPorCluster := sectoresPorCluster;
    vnumeroTotalCluster := numeroTotalCluster;
    espacioLibreDisco := vNumeroClusterLibres * vbytesPorSector * vsectoresPorCluster;
    espacioTotalDisco := vnumeroTotalCluster * vbytesPorSector * vsectoresPorCluster;
    espacioOcupadoDisco := espacioTotalDisco - espacioLibreDisco;
  end
  else
  begin
    espacioLibreDisco := 0;
    espacioTotalDisco := 0;
    espacioOcupadoDisco := 0;
    sectoresPorCluster := 0;
    bytesPorSector := 0;
    numeroClusterLibres := 0;
    numeroTotalCluster := 0;
  end;
end;


procedure TformMenuPrincipal.bInfoClick(Sender: TObject);
begin
  lInfo.Clear;
  etiqueta := '';
  numeroSerie := '';
  tipoFicheros := '';
  longitudMaximaFichero := 0;
  obtenerDatosUnidad(txtUnidad.Text);
  lInfo.Lines.Add ('Unidad: ' + txtUnidad.Text);
  lInfo.Lines.Add ('Etiqueta: ' + etiqueta);
  lInfo.Lines.Add ('Nº de serie: ' + numeroSerie);
  lInfo.Lines.Add ('Sistema de archivo: ' + tipoFicheros);
  lInfo.Lines.Add ('Longitud máxima nombre fichero: ' + IntToStr(longitudMaximaFichero));
  lInfo.Lines.Add ('Sectores por cluster: ' + FormatFloat('#,###', sectoresPorCluster));
  lInfo.Lines.Add ('Bytes por sector: ' + FormatFloat('#,###', bytesPorSector));
  lInfo.Lines.Add ('Nº total de cluster: ' + FormatFloat('#,###', numeroTotalCluster));
  lInfo.Lines.Add ('Nº de cluster libres: ' + FormatFloat('#,###', numeroClusterLibres));
  lInfo.Lines.Add ('Espacio total de disco: ' +  FormatFloat('#,###" Bytes"', espacioTotalDisco));
  lInfo.Lines.Add ('Espacio ocupado en disco: ' + FormatFloat('#,###" Bytes"', espacioOcupadoDisco));
  lInfo.Lines.Add ('Espacio libre en disco: ' + FormatFloat('#,###" Bytes"', espacioLibreDisco));
end;

procedure TformMenuPrincipal.FormCreate(Sender: TObject);
begin
  txtUnidad.Items := obtenerUnidades();
end;

procedure TformMenuPrincipal.Button1Click(Sender: TObject);
begin
  dlGuardar.Title := 'Guardar resultados';
  dlGuardar.DefaultExt := 'txt';
  dlGuardar.Filter := 'Ficheros de texto (*.txt)|*.txt|Todos los archivos (*.*)|*.*';
  dlGuardar.FileName := 'InfoUnidad';
  if dlGuardar.Execute then
    lInfo.Lines.SaveToFile (dlGuardar.FileName);
end;

end.

Publicado el: 2005-03-26