
08.02.2007, 17:39
|
Прохожий
|
|
Регистрация: 08.02.2007
Сообщения: 44
Репутация: 10
|
|
попробуй вот так
Код:
uses
MMSystem;
//...
//функция на открытие привода
function OpenCD(Drive: string): 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: string): 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.addmainitem(s: string);
var
newitem: Tmenuitem;
begin
newitem := tmenuitem.create(Mainmenu1);
newitem.caption := s;
mainmenu1.items.insert(mainmenu1.items.count, newitem);
end;
//Инициализация приводов в системе
procedure TForm1.FormCreate(Sender: TObject);
var
w:dword;
Root:string;
I, K:integer;
Driv: array [1..25] of string;
begin
k:=0;
w:=GetLogicalDrives;
Root := '#:';
for i := 0 to 25 do
begin
Root[1] := Char(Ord('A')+i);
if (W and (1 shl i))>0 then
if GetDriveType(Pchar(Root)) = DRIVE_CDROM then
begin
k:=k+1;
Driv[k] := Root;
addmainitem(Driv[k]);
end;
end;
end;
|