//Модуль с реализацией некоторых полезных функций работы с
//дисками
unit DriveTools;

interface
uses SysUtils, Windows, Classes;

Type
  //Запись параметров (некоторых) о файловой системе
  FSOptions = record
    CaseSensitive: Boolean;      //При уравнении путей учитывает регистр
    SupportCompression: Boolean; //Файловая система поддерживает сжатие
    IsCompressed: Boolean;       //Диск сжат (compressed)
  end;
  //Запись, содержащая информацию о диске
  DriveInfo = record
    DriveLabel: String;           //Метка диска
    FileSystemName: String;       //Файловая система диска
    FileSystemOptions: FSOptions; //Параметры файловой системы
    SerialNumber: DWORD;          //Серийный номер тома
    MaxFileNameLen: Cardinal;     //Максимальная длина имени файла
  end;

function GetDriveLetters(letters: TStrings):Integer;
function GetDriveInformation(root: String; var info: DriveInfo):Boolean;
function GetDriveSize(root: String): Int64;
function GetDriveFreeSpace(root: String): Int64;
function GetDriveTypeName(root: String): String;
function SetDriveLabel(root, newLabel: String): Boolean;

implementation

//Функция заполняет  список буквами логических дисков компьютера
//Возвращает количество определенных дисков
{function GetDriveLetters(letters: TStrings):Integer;
var
  buffer: String;
  i, len, start: Integer;
begin
  SetLength(buffer, 110);
  len := GetLogicalDriveStrings(110, PAnsiChar(buffer));
  //Разбираем строку вида 'c:\#0d:\#0...#0#0', возвращаемую функцией
  //GetLogicalDriveStrings
  start := 1;
  for i := 2 to len do
    if (buffer[i] = #0) and (start <> i) then
    begin
      //Нашли обозначение очередного диска
      letters.Append(Copy(buffer, start, i-start));
      start := i+1;
    end;
  GetDriveLetters := letters.Count;
end;
 }
function GetDriveLetters(letters: TStrings):Integer;
var
  mask: DWORD;
  i: Integer;
  letter: Char;
begin
  //Получаем маску, характеризующую наличие дисков
  mask := GetLogicalDrives();
  //Разбираем маску (определяем значения первых 26 битов)
  i := 1;
  for letter := 'A' to 'Z' do
  begin
    if mask and i <> 0 then
      //Есть диск под текущей буквой
      letters.Append(letter + ':\');
    i := i * 2; //Переходим к следующему биту
  end;
  GetDriveLetters := letters.Count;
end;



//Функция определяет информацию о диске. Вовращает False, если
//возникла ошибка
function GetDriveInformation(root: String; var info: DriveInfo):Boolean;
var
  bufDriveName, bufFSNAme: String;
  SN: DWORD;
  maxFileName, fsOptions: Cardinal;
begin
  SetLength(bufDriveName, 101);
  SetLength(bufFSName, 101);
  //Определение информации о диске
  if GetVolumeInformation(PAnsiChar(root), PAnsiChar(bufDriveName), 100,
                       Addr(SN), maxFileName, fsOptions,
                       PAnsiChar(bufFSName), 100) <> FALSE then
  begin
    //Заполняем структуру информацией о диске
    with info do
    begin
      DriveLabel := bufDriveName;
      FileSystemName := bufFSName;
      SerialNumber := SN;
      MaxFileNameLen := maxFileName;
      //..параметры файловой системы
      with info.FileSystemOptions do
      begin
        CaseSensitive := fsOptions and FS_CASE_SENSITIVE <> 0;
        SupportCompression := fsOptions and FS_FILE_COMPRESSION <> 0;
        IsCompressed := fsOptions and FS_VOL_IS_COMPRESSED <> 0;
      end;
    end;
    //Функция отработала успешно
    GetDriveInformation := True;
  end
  else
    //Ошибка
    GetDriveInformation := False;
end;

//Функция возвращает полный размер диска в байтах
function GetDriveSize(root: String): Int64;
var
  freeToCaller, totalBytes, freeBytes: Int64;
begin
  if GetDiskFreeSpaceEx(PAnsiChar(root), freeToCaller, totalBytes,
                     PLargeInteger(Addr(freeBytes))) <> FALSE
  then
    GetDriveSize := totalBytes
  else
    GetDriveSize := -1;
end;

//Функция возвращает размер свобожного места на диске (в байтах)
function GetDriveFreeSpace(root: String): Int64;
var
  freeToCaller, totalBytes, freeBytes:Int64;
begin
  if GetDiskFreeSpaceEx(PAnsiChar(root), freeToCaller, totalBytes,
                     PLargeInteger(Addr(freeBytes))) <> FALSE
  then
    GetDriveFreeSpace := freeBytes
  else
    GetDriveFreeSpace := -1;
end;

//Функция определяет тип носителя диска (возвращает его название
//или пустую строку, если параметр root задан неправильно)
function GetDriveTypeName(root: String): String;
begin
  case GetDriveType(PAnsiChar(root)) of
    DRIVE_UNKNOWN: GetDriveTypeName := 'Не определен';
    DRIVE_REMOVABLE: GetDriveTypeName := 'Сменный';
    DRIVE_FIXED: GetDriveTypeName := 'Фиксированный';
    DRIVE_REMOTE: GetDriveTypeName := 'Удаленный (сетевой)';
    DRIVE_CDROM: GetDriveTypeName := 'CDROM';
    DRIVE_RAMDISK: GetDriveTypeName := 'RAM-диск';
  else
    GetDriveTypeName := ''
  end;
end;

//Функция устанавливает новую метку диска, заданного параметром root
//Возвращает True в случае успеха и False в противном случае 
function SetDriveLabel(root, newLabel: String): Boolean;
begin
  SetDriveLabel :=
   SetVolumeLabel(PAnsiChar(root), PAnsiChar(newLabel)) <> FALSE;
end;

end.
