Delphi Brasil - Nosso esporte é desenvolver!

Biblioteca para operações com DiskDrives PDF Imprimir E-mail
Bibliotecas
{
  Objeto...: Biblioteca para operações com disk-drives.
  Categoria: Open-Source
  Autor....: Daniel Pereira Guimarães
  E-mail...: Este endereço de e-mail está protegido contra SpamBots. Você precisa ter o JavaScript habilitado para vê-lo.
  Home-Page: www.ulbrajp.com.br/~tecnobyte
  Revisão..: 21 de Fevereiro de 2001
}
 
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.
< Anterior   Próximo >