Как получить инфу о жестком диске?

Материал из DRKB

Как получить инфу о жестком диске?[править | править код]

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Получение сведений о диске (метка/имя диска, файловая система, серийный номер)

Получение информации о любом диске.
Работает на FDD, HDD, CD, другие не пробовал.

Создайте модуль с именем HDDInfo и полностью скопируйте в него весь текст.

Зависимости: Все Windows (32S,95,NT)
Автор: cyborg, cyborg1979@newmail.ru, ICQ:114205759, Бузулук
Copyright: Собственное написание (Осипов Евгений Анатольевич)
Дата: 23 мая 2002 г.
***************************************************** }

unit HDDInfo;

interface

uses Windows;

const { Константы для TypeOfDisk функции GetDisks }
  DiskUnknown = 0;           { Неизвестные диски }
  DiskNone = 1;              { Отсутствующие диски }
  DiskFDD = DRIVE_REMOVABLE; { Съёмные диски, дискеты }
  DiskHDD = DRIVE_FIXED;     { Не съёиные диски, жёсткие диски }
  DiskNet = DRIVE_REMOTE;    { Сетевые диски }
  DiskCDROM = DRIVE_CDROM;   { CD ROM }
  DiskRAM = DRIVE_RAMDISK;   { Диски в ОЗУ }

{ Получить имена нужных дисков }
function GetDisks(TypeOfDisk: word): string;

{ Функция получения информации о диске (HDD,FDD,CD) с буквой Disk }
{
Передаваемые значения:
Disk - Буква диска

Получаемые значения:
VolumeName - Метка/Имя тома
FileSystemName - Файловая система
VolumeSerialNo - Серийный номер диска (можно привязывать к диску программы)
MaxComponentLength - Максимальная длинна имени файла
FileSystemFlags - Флаги смотрите в справке Delphi по GetVolumeInformation

Функция возвращает true, если всё прошло успешно (диск нашёлся),
и false, если возникли проблемы, например диска нет в дисководе,
либо дисковода такого вообще нет
}
function GetHDDInfo(Disk: char; var VolumeName, FileSystemName: string;
  var VolumeSerialNo, MaxComponentLength, FileSystemFlags: LongWord): boolean;

implementation

{ Получить имена нужных дисков }
function GetDisks(TypeOfDisk: word): string;
var
  DriveArray: array[1..26] of char;
  I: integer;
begin
  DriveArray := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  for I := 1 to 26 do
    if GetDriveType(PChar(DriveArray[I] + ':\')) = TypeOfDisk then
      Result := Result + DriveArray[I];
end;

function GetHDDInfo(Disk: char;
  var VolumeName, FileSystemName: string;
  var VolumeSerialNo, MaxComponentLength, FileSystemFlags: LongWord): boolean;
var
  _VolumeName, _FileSystemName: array [0..MAX_PATH - 1] of char;
  _VolumeSerialNo, _MaxComponentLength, _FileSystemFlags: LongWord;
begin
  if GetVolumeInformation(PChar(Disk + ':\'), _VolumeName, MAX_PATH, @_VolumeSerialNo,
    _MaxComponentLength, _FileSystemFlags, _FileSystemName, MAX_PATH) then
  begin
    VolumeName := _VolumeName;
    VolumeSerialNo := _VolumeSerialNo;
    MaxComponentLength := _MaxComponentLength;
    FileSystemFlags := _FileSystemFlags;
    FileSystemName := _FileSystemName;
    Result := True;
  end
  else
    Result := False;
end;

end.


Пример использования:


uses HDDInfo; { Добавляем наш модуль }

{ Нужно создать на форме компонент TLabel , Name которого ставим в Disks }
{ И в событии главной формы OnActicate написать это: }

procedure TMyForm.FormActivate(Sender: TObject);
var
  S, SOut: string;
  I: Integer;
  VolumeName, FileSystemName: string;
  VolumeSerialNo, MaxComponentLength, FileSystemFlags: LongWord;
begin
  S := GetDisks(DiskHDD); { Получаем список Жёстких дисков (Параметр DiskHDD) }
  SOut := '';
  for I:=1 to Length(S) do { Получаем информацию о всех дисках и пишем в TLabel на форме }
  begin
    { Если диск существует/вставлен ... }
    if GetHDDInfo(S[I], VolumeName, FileSystemName, VolumeSerialNo,
      MaxComponentLength, FileSystemFlags) then { ... тогда собираем информацию }
    SOut := SOut 
          + 'Диск: ' + S[I] + #13#10
          + 'Метка: ' + VolumeName + #13#10
          + 'Файловая система: ' + FileSystemName + #13+#10
          + 'Серийный номер: ' + IntToHex(VolumeSerialNo, 8) + #13+#10
          + 'Макс. длина имени файла: ' + IntToStr(MaxComponentLength) + #13+#10
          + 'Flags: ' + IntToHex(FileSystemFlags, 4) + #13#10
          + #13#10;
  end;
  Disks.Caption := SOut; { Выводим в компонент TLabel полученные данные о дисках }
end;


Author: Pegas
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01368



Присутствует неточность в топике "Как получить инфу о жестком диске?". Неточность заключается в том, что функция "GetVolumeInformation" выдает совершенно разный номер диска под системами 9х и NT. Я долго бился над этой проблемой т. к. в своей программе привязываются к номеру в своей программе для определения какой диск вставил пользователь. Пару раз задавал этот вопрос в форумах, но ответа так и не получил. Но недавно я нашел решение этой проблемы. Вот код моей функции для корректного определения серийного номера диска под любой ОС:


// Определяем серийный номер диска
function SirealNumberDisk(disk: string): string;
var
  VolumeName         : array [0..MAX_PATH-1] of Char;
  FileSystemName     : array [0..MAX_PATH-1] of Char;
  VolumeSerialNo     : DWord;
  MaxComponentLength : DWord;
  FileSystemFlags    : DWord;

  function GetReplaceCDNumber(num: String): String;
  var
    i, len: Integer;
  begin
    Result := '';
    len := Length(num);
    if len <> 8 then exit;
    for i := 1 to (len div 2) do
    begin
       Dec(len);
       Result := Result + num[len];
       Result := Result + num[len + 1];
       Dec(len);
    end;
  end;

begin
  GetVolumeInformation(PChar(disk), VolumeName, MAX_PATH, @VolumeSerialNo, MaxComponentLength, 
    FileSystemFlags, FileSystemName, MAX_PATH);
  Result := IntToHex(Integer(VolumeSerialNo), 8);
  if Win32Platform <> VER_PLATFORM_WIN32_NT then
    Result := GetReplaceCDNumber(Result);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Label1.Caption:= SirealNumberDisk('f:\');
end;


Source: http://alex-co.com.ru
Author: Alex&Co
ID: 01369