procedure List_Drives;
const
   DRIVE_UNKNOWN = 0;
   DRIVE_NO_ROOT_DIR = 1;
   DRIVE_REMOVABLE = 2;
   DRIVE_FIXED = 3;
   DRIVE_REMOTE = 4;
   DRIVE_CDROM = 5;
   DRIVE_RAMDISK = 6;
var
   r: LongWord;
   Drives: array[0..128] of char;
   pDrive: PChar;
begin
   r := GetLogicalDriveStrings(SizeOf(Drives), Drives);
   if r = 0 then Exit;
   if r > SizeOf(Drives) then
     raise Exception.Create(SysErrorMessage(ERROR_OUTOFMEMORY));
   pDrive := Drives;
   while pDrive^ <> #0 do
   begin
     if GetDriveType(pDrive) = DRIVE_CDROM then
       Form1.ComboBox1.Items.Add(pDrive);
     Inc(pDrive, 4);
   end;
end;

function GetVolumeInfoFVS(const Dir:string;
  var FileSystemName,VolumeName:string;var Serial:longint):boolean;
{Получение информации о диске
Dir - каталог или буква требуемого диска
FileSystemName - название файловой системы
VolumeName - метка диска
Serial - серийный номер диска
В случае ошибки функция возвращает false}
var
  root:pchar;
  res:longbool;
  VolumeNameBuffer,FileSystemNameBuffer:pchar;
  VolumeNameSize,FileSystemNameSize:DWord;
  VolumeSerialNumber,MaximumComponentLength,FileSystemFlags:DWORD;
  s:string;
  n:integer;
begin
  n:=pos(':',Dir);
  if n> 0 then s:=copy(Dir,1,n+1) else s:=s+':';
  if s[length(s)]=':' then s:=s+'\';
  root:=pchar(s);
  getMem(VolumeNameBuffer,256);
  getMem(FileSystemNameBuffer,256);
  VolumeNameSize:=255;
  FileSystemNameSize:=255;
  res:=GetVolumeInformation(Root,VolumeNameBuffer,VolumeNameSize
  ,@VolumeSerialNumber,
  MaximumComponentLength, FileSystemFlags
  ,FileSystemNameBuffer,FileSystemNameSize);
  Result:=res;
  VolumeName:=VolumeNameBuffer;
  FileSystemName:=FileSystemNameBuffer;
  Serial:=VolumeSerialNumber;
  freeMem(VolumeNameBuffer,256);
  freeMem(FileSystemNameBuffer,256);
end;

procedure TForm1.Button1Click(Sender: TObject);
var s,s2,s3:string;
  ser:integer;
begin
     List_Drives;
     GetVolumeInfoFVS(combobox1.Items[1],s,s2,ser);
     label1.Caption:=ser;
end;