Biblioteca para operações com DiskDrives

{

  Objeto...: Biblioteca para operações com disk-drives.

  Categoria: Open-Source

  Autor....: Daniel Pereira Guimarães

  E-mail...: tecnobyte@ulbrajp.com.br

  Home-Page: www.ulbrajp.com.br/~tecnobyte

  }

unit tbDskDrv;

interface

uses Windows, SysUtils;

type

  TtbDriveType = (dtUnknown, dtNotExist, dtRemovable, dtFixed,

  dtRemote, dtCdRom, dtRamDisk, dtError);

  TtbVolInfo = record

  Name: string;

  Serial: Cardinal;

  IsCompressed: boolean;

  MaxCompLen: Cardinal;

  FileSysName: string;

  end;

{ Retorna o número do drive: A=1, B=2, C=3, etc. }

function tbDriveByte(const Drive: Char): byte;

{ Retorna true se o drive existe }

function tbDriveExists(const Drive: Char): boolean;

{ Retorna true se o drive está preparado }

function tbDriveIsOk(const Drive: Char): boolean;

{ Retorna uma string contendo as letras de unidades de existentes }

function tbDriveLetters: string;

{ Retorna o tipo do drive. Veja TtbDriveType }

function tbDriveType(const Drive: Char; Path: PChar): TtbDriveType;

{ Retorna o nome de volume de uma unidade }

function tbVolName(const Drive: Char; Path: PChar): string;

{ Retorna o número serial de uma unidade }

function tbVolSerial(const Drive: Char; Path: PChar): Cardinal;

{ Retorna informações diversas sobre uma unidade. Veja TtbVolInfo }

function tbVolInfo(const Drive: Char; Path: PChar): TtbVolInfo;

implementation

{ *** Drives *** }

function tbDriveByte(const Drive: Char): byte;

  { Uso: X := tbDriveByte('C') }

begin

  if Drive = #0 then

  Result := 0

  else

  Result := Ord(UpCase(Drive)) - 64;

end;

function tbDriveExists(const Drive: Char): boolean;

  { Uso: if tbDriveExists('A') then ... }

begin

  Result := Pos(UpCase(Drive), tbDriveLetters) > 0;

end;

function tbDriveIsOk(const Drive: Char): boolean;

 { Uso: if tbDriveIsOk('A') then ... }

begin

  Result := SysUtils.DiskSize(tbDriveByte(Drive)) >= 0;

end;

function tbDriveLetters: string;

  { Uso: S := tbDriveLetters; - retorna 'ACD' se existir as unidades

  A:, C: e D: }

var

  Drives: LongWord;

  I: byte;

begin

  Result := '';

  Drives := GetLogicalDrives;

  if Drives <> 0 then

  for I := 65 to 90 do

  if ((Drives shl (31 - (I - 65))) shr 31) = 1 then

  Result := Result + Char(I);

end;

function tbDriveType(const Drive: Char; Path: PChar): TtbDriveType;

  { Uso: T := tbDriveType; --- T é do tipo TtbDriveType }

begin

  if Path = nil then

  Path := PChar(Drive + ':\');

  case Windows.GetDriveType(PChar(Path)) of

  0: Result := dtUnknown;

  1: Result := dtNotExist;

  DRIVE_REMOVABLE: Result := dtRemovable;

  DRIVE_FIXED: Result := dtFixed;

  DRIVE_REMOTE: Result := dtRemote;

  DRIVE_CDROM: Result := dtCdRom;

  DRIVE_RAMDISK: Result := dtRamDisk;

  else

  Result := dtError;

  end;

end;

function tbVolName(const Drive: Char; Path: PChar): string;

  { Uso: S := tbVolName('A', nil); ou

  S := tbVolName(#0, '\\computador\c\'); }

var

  MaxCompLen, FileSysFlag, PrevErrorMode: Cardinal;

begin

  if Path = nil then

  Path := PChar(Drive + ':\');

  SetLength(Result, 255);

  PrevErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);

  try

  if GetVolumeInformation( PChar(Path), PChar(Result), 255,

  nil, MaxCompLen, FileSysFlag, nil, 0) then

  Result := string(PChar(Result))

  else

  Result := '';

  finally

  SetErrorMode(PrevErrorMode);

  end;

end;

function tbVolSerial(const Drive: Char; Path: PChar): Cardinal;

  { Uso: S := tbVolSerial('A', nil); ou

  S := tbVolSerial(#0, '\\computador\c\'); }

var

  MaxCompLen, FileSysFlag, PrevErrorMode: Cardinal;

begin

  if Path = nil then

  Path := PChar(Drive + ':\');

  PrevErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);

  try

  if not GetVolumeInformation(PChar(Path), nil, 0,

  @Result, MaxCompLen, FileSysFlag, nil, 0) then

  Result := 0;

  finally

  SetErrorMode(PrevErrorMode);

  end;

end;

function tbVolInfo(const Drive: Char; Path: PChar): TtbVolInfo;

  { Uso: Info := tbVolInfo('A', nil); ou

  Info := tbVolInfo(#0, '\\computador\c\'); }

const

  cVolNameLen = 255;

  cSysNameLen = 255;

var

  Flags, PrevErrorMode: Cardinal;

begin

  if Path = nil then

  Path := PChar(Drive + ':\');

  SetLength(Result.Name, cVolNameLen);

  SetLength(Result.FileSysName, cSysNameLen);

  PrevErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);

  try

  if GetVolumeInformation(Path, PChar(Result.Name), cVolNameLen,

  @Result.Serial, Result.MaxCompLen, Flags,

  PChar(Result.FileSysName), cSysNameLen) then

  begin

  Result.Name := string(PChar(Result.Name));

  Result.FileSysName := string(PChar(Result.FileSysName));

  Result.IsCompressed := (Flags and FS_VOL_IS_COMPRESSED) > 0;

  end else begin

  Result.Name := '';

  Result.Serial := 0;

  Result.IsCompressed := false;

  Result.MaxCompLen := 0;

  Result.FileSysName := '';

  end;

  finally

  SetErrorMode(PrevErrorMode);

  end;

end;

end.