unit CDOpenClose;

interface

uses
  Dialogs, MMSystem;

function OpenDoor: longint;
function CloseDoor: longint;
function GetDevice : word;

implementation

var   FFlags, fErrCode: longint;
      fID : Word = 0;

function GetDevice : word;
var OpenParms : TMCI_Open_Parms;
begin
  if fID=0 then 
  begin
   FFlags := 0;
   FFlags := mci_notify or mci_open_type or mci_open_shareable;
   OpenParms.lpstrDeviceType := 'CDAudio';
   OpenParms.dwCallback := 0;
   fErrCode := mciSendCommand(0, mci_open, FFlags, Longint(@OpenParms));
   if FErrCode <> 0 then {problem opening device}
      showmessage ('error opening device')
    else {device successfully opened}
     begin
      fID := OpenParms.wDeviceID;
     end;
  end;
  Result := fID;
end;


function OpenDoor: longint;
var
  SetParms: TMCI_Set_Parms;
begin
  FFlags := 0;
  FFlags := mci_notify or mci_set_door_open;
  SetParms.dwCallback := 0;
  fErrCode := mciSendCommand(GetDevice, mci_Set, FFlags, Longint(@SetParms));
  Result:= fErrCode;
end;


function CloseDoor: longint;
var
  SetParm: TMCI_Set_Parms;
begin
  FFlags := 0;
  FFlags := mci_notify or mci_set_door_closed;
  SetParm.dwCallback := 0;
  fErrCode := mciSendCommand( GetDevice, mci_Set, FFlags, Longint(@SetParm) );
  Result:= fErrCode;
end;

end.
