Открытие и закрытие привода CD-ROM

Пример использования

unit drivetools;

interface

uses
  Windows, SysUtils, MMSystem; 
  
  function OpenCD(drive: char): boolean;
  function CloseCD(drive: char): boolean;

implementation

{$R *.dfm}

function opencd(drive : char) : boolean;
var
  res: MCIERROR;
  openparm: TMCI_Open_Parms;
  flags : dword;
  s : string;
  deviceid : word;
begin
  result:= false;
  s:= drive + ':';
  flags:= mci_open_type or mci_open_element;
  with openparm do
  begin
    dwcallback := 0;
    lpstrdevicetype := 'cdaudio';
    lpstrelementname := pchar(s);
  end;
  res := mcisendcommand(0, mci_open, flags, longint(@openparm));
  if res <> 0 then exit;
  deviceid:= openparm.wdeviceid;
  try
    res:= mcisendcommand(deviceid, mci_set, mci_set_door_open, 0);
    if res = 0 then exit;
    result:= true;
  finally
    mcisendcommand(deviceid, mci_close, flags, longint(@openparm));
  end;
end;

function closecd(drive : char) : boolean;
var
  res : MCIERROR;
  openparm: TMCI_Open_Parms;
  flags : dword;
  s : string;
  deviceid : word;
begin
  result:= false;
  s:= drive + ':';
  flags:= mci_open_type or mci_open_element;
  with openparm do
  begin
    dwcallback := 0;
    lpstrdevicetype := 'cdaudio';
    lpstrelementname := pchar(s);
  end;
  res := mcisendcommand(0, mci_open, flags, longint(@openparm));
  if res <> 0 then exit;
  deviceid:= openparm.wdeviceid;
  try
    res:= mcisendcommand(deviceid, mci_set, mci_set_door_closed, 0);
    if res = 0 then exit;
    result:= true;
  finally
    mcisendcommand(deviceid, mci_close, flags, longint(@openparm));
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  OpenCD('E');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  CloseCD('E');
end;

end.