Obtenir le numéro de série et le nom d'un CD

....
procedure TForm1.Button1Click(Sender: TObject);
var
VolumeLabel, FileSystem: Array[0..$FF] of Char;
SerialNumber, DW, SysFlags: DWord;
SerialNumStr: string;

function DecToHex(aValue: LongInt): String;
var
w: Array[1..2] of Word absolute aValue;
function HexByte(b: Byte): String;
const
Hex: Array[$0..$F] of Char = '0123456789ABCDEF';
begin
HexByte := Hex[b shr 4] + Hex[b and $F];
end;
function HexWord(w: Word): String;
begin
HexWord := HexByte(Hi(w)) + HexByte(Lo(w));
end;
begin
Result := HexWord(w[2]) + HexWord(w[1]);
end;
begin
GetVolumeInformation(
PChar('E:'), {lettre du lecteur de CD}
VolumeLabel,
SizeOf(VolumeLabel),
@SerialNumber,
DW,
SysFlags,
FileSystem,
SizeOf(FileSystem));
SerialNumStr := DecToHex(SerialNumber);

with ListBox1.Items do
begin
Add('E: Volume Information');
Add('');
Add(' Volume Label: '+VolumeLabel);
Add(' Serial Number: '+SerialNumStr);
Add(' File System: '+FileSystem);
end;
end;