[MotoArhangel]

Код:

{>> Получение сведений о диске (метка/имя диска, файловая система, серийный номер)  
   
Получение информации о любом диске.  
Работает на FDD, HDD, CD, другие не пробовал.  
   
Создайте модуль с именем HDDInfo и полностью скопируйте в него весь текст.  
   
Copyright: Собственное написание (Осипов Евгений Анатольевич)   
***************************************************** }  
    
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;  

Источник:DRKB