Показать сообщение отдельно
  #3  
Старый 30.01.2007, 22:02
Аватар для Artem28
Artem28 Artem28 вне форума
Прохожий
 
Регистрация: 07.08.2006
Сообщения: 32
Репутация: 10
По умолчанию

Код:
unit DriveTools; 

interface 

uses 

  Windows, SysUtils, MMSystem; 

function CloseCD(Drive: Char): Boolean; 
function OpenCD(Drive: Char): Boolean; 

implementation 

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; 

end. 
Полный код...
Ответить с цитированием