Recognize CD volume label

Posted in Files & folders

This task is solved in two steps. 1) definition of the letter of the existing CD-ROM drive. In these purposes GetLogicalDrives and GetDriveType functions are used. 2) obtaining of the information on the device by calling the GetVolumeInformation function. This unit shows it:

 public
    { Public declarations }
    function GetCDLetter: string;
    function GetCDLabel(Drive: string): string;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Label1.Caption:=GetCDLabel(GetCDLetter());
end;

function TForm1.GetCDLetter: string;
var
  N: Byte;
  Drv: string;
  Drives: set of 0..25;
begin
  Integer(Drives):=GetLogicalDrives;
  for N:=0 to 25 do
    if N in Drives then
    begin
      Drv:=Char(N+Ord('A'))+':\';
      if(GetDriveType(PChar(Drv))=5) then
      begin
        Result:=Drv;
        Exit;
      end;
    end;
end;

function TForm1.GetCDLabel(Drive: string): string;
var
  VolumeName: array[0..255] of Char;
  FileSystemType: array[0..255] of Char;
  SerialNum: DWORD;
  MaxFilenameLength: DWORD;
  Flags: DWORD;
begin
  if (GetVolumeInformation(
    PChar(Drive),
    VolumeName,
    256,
    @SerialNum,
    MaxFilenameLength,
    Flags,
    FileSystemType,
    256)) then Result:=VolumeName
  else Result:='No CD Present';
end;