Get AudioCD ID Number

uses MMSystem

//

function GetCDAudioID(const szDrive: string): string;
var
  res : MciError;
  op : TMCI_Open_Parms;
  info : TMCI_Info_Parms;
  close : TMCI_Generic_Parms;
begin
  Result := '';

  // Zugriff auf das Laufwerk herstellen
  // "szDrive" muss einen String wie "I:\" enthalten
  ZeroMemory(@op,sizeof(op));
  op.dwCallback := 0;
  op.lpstrDeviceType := 'CDAudio';
  op.lpstrElementName := pchar(szDrive);
  // btw: Die im System bekannten Laufwerksbuchstaben
  // kann man mit "GetLogicalDriveStrings" ermitteln,
  // und ob es ein CD-Laufwerk ist, erfährt man dann
  // mit "GetDriveType". :o)

  res := mciSendCommand(0,MCI_OPEN,
    MCI_OPEN_TYPE or MCI_OPEN_ELEMENT,dword(@op));
  if(res = 0) then
  try
    // Ergebnis der Funktion auf 17 Zeichen setzen
    // Woher hast du die Zahl, @Delphi Star?
    SetLength(Result,17);

    // Record füllen, ...
    info.dwCallback := 0;
    info.lpstrReturn := @Result[1];
    info.dwRetSize := length(Result);

    // ... & Zugriff versuchen; sprich: ID auslesen
    res := mciSendCommand(op.wDeviceID,
      MCI_INFO,MCI_INFO_MEDIA_IDENTITY,dword(@info));

    // Im Erfolgsfall evtl. überschüssige #0 entfernen
    if(res = 0) then
      SetLength(Result,StrLen(pchar(Result)))
    // Im Fehlerfall, einen Leerstring setzen
    else
      Result := '';
  finally
    // und Laufwerk "freigeben", damit´s auch ein zweites Mal
    // klappt
    close.dwCallback := 0;
    mciSendCommand(op.wDeviceID,MCI_CLOSE,MCI_WAIT,dword(@close));

    // Im SwissDelphiCenter habe ich gesehen, dass hier auch das
    // "TMCI_Open_Parms"-Record benutzt wurde. Im PSDK steht aber
    // was vom "TMCI_Generic_Parms"-Record. Also habe ich das
    // auch benutzt.
  end;
end;

Beispiel :

procedure TForm1.Button1Click(Sender: TObject);
begin
  Label1.Caption := GetCDAudioID('H:')
end;