Drives de CD-ROM

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
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.