// Der Name und die Seriennummer eines Laufwerks (CD, DVD) wird ermittelt.
// Siehe dazu auch Den Typ eines Laufwerkes ermitteln
// Vorher könnte man prüfen, ob überhaupt eine CD eingelegt ist.
// Siehe dazu auch Prüfen, ob eine Diskette im Laufwerk ist

// Getestet mit D4 unter WinME und D2010 unter W10

function LWLesen(lw: char; var VolumeName, Seriennummer: string): boolean; 
var 
  FileNameLen, Seriennr, SystemFlags: longword; 
  CDName, FileSys: array [0 .. max_path - 1] of char; 
begin 
  result := GetVolumeInformation(PChar(lw + ':\'), @CDName, max_path, 
    @Seriennr, FileNameLen, SystemFlags, @FileSys, max_path); 
  VolumeName := string(CDName); 
  if VolumeName = '' then 
    VolumeName := '-- kein --'; 
  Seriennummer := IntToHex(Seriennr, 8); 
end; 
 
// Beispielaufruf für Laufwerk D: 
procedure TForm1.Button2Click(Sender: TObject); 
var 
  sname, snummer: string; 
begin 
  if not LWLesen('D', sname, snummer) then 
    showmessage('Fehler') 
  else 
  begin 
    Label1.caption := 'Laufwerksname: ' + sname; 
    Label2.caption := 'Seriennummer: ' + snummer; 
  end; 
end;