1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:

function IsAudioCD(Drive: Char): Boolean; 
var 
  DrivePath: string; 
  MaximumComponentLength: DWORD; 
  FileSystemFlags: DWORD; 
  VolumeName: string; 
  OldErrorMode: UINT; 
  DriveType: UINT; 
begin 
  Result := False; 
  DrivePath := Drive + ':\'; 
  OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS); 
  try 
    DriveType := GetDriveType(PChar(DrivePath)); 
  finally 
    SetErrorMode(OldErrorMode); 
  end; 
  if DriveType <> DRIVE_CDROM then 
    Exit; 
  SetLength(VolumeName, 64); 
  GetVolumeInformation(PChar(DrivePath), 
    PChar(VolumeName), 
    Length(VolumeName), 
    nil, 
    MaximumComponentLength, 
    FileSystemFlags, 
    nil, 
    0); 
  if lStrCmp(PChar(VolumeName), 'Audio-CD') = 0 then Result := True; 
end; 


procedure TForm1.Button1Click(Sender: TObject); 
begin 
  if IsAudioCD('D') then 
    ShowMessage('Audio-CD found in drive D.') 
  else 
    ShowMessage('No Audio-CD found in drive D.'); 
end;