Создадим приложение с двумя кнопками. Нажатие первой из них будет выдвигать лоток привода, а второй - задвигать.
Функция управляющая CD-приводом, определенна в модуле MMSystem, который нужно добавить в секцию Uses:
Код
uses
..., MMSystem;
procedure TForm1.Button1Click(Sender: TObject);
begin
mciSendString('Set cdaudio door open wait', nil, 0, handle);
end;
procedureTForm1.Button2Click(Sender: TObject);
begin
mciSendString('Set cdaudio door closed wait', nill, 0, handle);
end;
Функция Windows API mciSendString служит для посылки команд мультимедийным устройствам. Команда 'Set cdaudio door closed wait' приводит к выдвижению лотка устройства "аудио-CD", команда 'Set cdaudio door closed wait' - к его закрытию.
Аналог:
Код
uses ..., MMSystem;
procedure CloseEject(Drv:string;DoEject:boolean);
var OpenParm:TMCI_OPEN_PARMS;
SetParm:TMCI_Set_Parms;
GenParm:TMCI_GENERIC_PARMS;
ID:integer;
begin
openparm.lpstrDeviceType:=pchar('CDAudio');
openparm.lpstrElementName:=pchar(Drv);
if mciSendCommand(0, MCI_OPEN,MCI_OPEN_TYPE or MCI_WAIT or MCI_OPEN_ELEMENT, LongInt(@OpenParm))=0
then
begin
ID:=openparm.wDeviceID;
if DoEject then
mciSendCommand(ID,MCI_SET,MCI_WAIT or MCI_SET_DOOR_OPEN,LongInt(@SetParm))
else
mciSendCommand(ID,MCI_SET,MCI_WAIT or MCI_SET_DOOR_CLOSED,LongInt(@SetParm));
mciSendCommand(ID,MCI_CLOSE,0,LongInt(@GenParm));
end;
end;
Обращение к процедуре:
CloseEject('E:',true); //В данном случае 'E:' - это буква дисковода, true - означает открыть привод(false- закрыть дисковод)
Получение списка CD/DVD-ROMS(не проверял):Код
procedure CDROMsList(var DrvLst:TStringList);
var buf:array[0..255] of char;
tmp:string;
begin
if DrvLst=nil then DrvLst:=TStringList.Create;
DrvLst.Clear;
GetLogicalDriveStrings(256,buf);
tmp:='';
for i:=0 to 254 do
begin
if buf[i]<>#0 then
tmp:=tmp+buf[i]
else
begin
if GetDriveType(pchar(tmp))=DRIVE_CDROM then
DrvLst.Add(tmp);
tmp:='';
if buf[i+1]=#0 then break;
end;
end;
end; | 
|