How to eject and close a CD-ROM drive

Problem/Question/Abstract:

How to eject and close a CD-ROM drive

Answer:

Solve 1:

To open the CD-ROM:


mciSendString('Set cdaudio door open wait', nil, 0, handle);


To close the CD-ROM:


mciSendString('Set cdaudio door closed wait', nil, 0, handle);


Remember to include the MMSystem unit in your uses clause. Also note that you will get a Blue Screen on certain hardware, if you use this code.


Solve 2:

function CdClose(const Value: char): integer;
var
  strCommand: string;
  strError: array[0..MAX_PATH] of char;
begin
  strCommand := 'open ' + Value + ': type cdaudio alias xxx';
  MCISendString(PChar(strCommand), nil, 0, 0);
  strCommand := 'set xxx door closed';
  Result := MCISendString(PChar(strCommand), nil, 0, 0);
  strCommand := 'close xxx';
  MCISendString(PChar(strCommand), nil, 0, 0);
  if Result <> 0 then
    MCIGetErrorString(Result, strError, 255);
  MessageDlg(strError, mtError, [mbOK], 0);
end;

function CdOpen(const Value: char): integer;
var
  strCommand: string;
  strError: array[0..MAX_PATH] of char;
begin
  strCommand := 'open ' + Value + ': type cdaudio alias xxx';
  MCISendString(PChar(strCommand), nil, 0, 0);
  strCommand := 'set xxx door open';
  Result := MCISendString(PChar(strCommand), nil, 0, 0);
  strCommand := 'close xxx';
  MCISendString(PChar(strCommand), nil, 0, 0);
  if Result <> 0 then
    MCIGetErrorString(Result, strError, 255);
  MessageDlg(strError, mtError, [mbOK], 0);
end;


Solve 3:

procedure mcicheck(R: Cardinal);
var
  S: array[0..1023] of Char;
begin
  if R = 0 then
    exit;
  mciGetErrorString(R, S, SizeOf(S) - 1);
  raise Exception.Create(S);
end;

procedure MoveCDDoor(const Drive: string; Open: Boolean);
const
  Direction: array[Boolean] of Cardinal = (MCI_SET_DOOR_CLOSED, MCI_SET_DOOR_OPEN);
var
  OP: TMCI_Open_Parms;
  id: Cardinal;
begin
  Fillchar(OP, SizeOf(OP), 0);
  OP.lpstrDeviceType := PChar(MCI_DEVTYPE_CD_AUDIO);
  OP.lpstrElementName := PChar(Drive);
  mcicheck(mciSendCommand(0, MCI_OPEN, MCI_WAIT or MCI_OPEN_TYPE or
    MCI_OPEN_TYPE_ID or MCI_OPEN_ELEMENT, Cardinal(@OP)));
  id := OP.wDeviceID;
  try
    mcicheck(mciSendCommand(id, MCI_SET, MCI_WAIT or Direction[Open], 0));
  finally
    mcicheck(mciSendCommand(id, MCI_CLOSE, MCI_WAIT, 0));
  end;
end;


Solve 4:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
  private
    { Private declarations }
    procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  DBT_DEVICEARRIVAL = $8000;
  DBT_DEVICEREMOVECOMPLETE = $8004;
  DBT_DEVTYP_VOLUME = 2; {logical volume}

type
  _DEV_BROADCAST_VOLUME = record
    dbcv_size,
      dbcv_devicetype,
      dbcv_reserved,
      dbcv_unitmask: DWORD;
    dbcv_flags: WORD;
  end;
  TDevBroadcastVolume = _DEV_BROADCAST_VOLUME;
  PDevBroadcastVolume = ^TDevBroadcastVolume;

procedure TForm1.WMDeviceChange(var Msg: TMessage);
var
  Disques: set of 0..25;
  nDisque: Integer;
  sMsg: string;
  Volume: PDevBroadcastVolume;
begin
  inherited;
  case Msg.WParam of
    DBT_DEVICEARRIVAL:
      sMsg := 'Disk inserted :';
    DBT_DEVICEREMOVECOMPLETE:
      sMsg := 'Disk ejected :';
  else
    Exit;
  end;
  Volume := PDevBroadcastVolume(Msg.LParam);
  if Volume^.dbcv_devicetype <> DBT_DEVTYP_VOLUME then
    Exit;
  DWORD(Disques) := Volume^.dbcv_unitmask;
  for nDisque := 0 to 25 do
  begin
    if not (nDisque in Disques) then
      Continue;
    sMsg := sMsg + #13 + Char(nDisque + Ord('A')) + ':\';
  end;
  ShowMessage(sMsg);
end;

end.