Как узнать, выдвинут, или задвинут, определённый дисковод?

[Altera]

Всем привет!
Как узнать, выдвинут, или задвинут, определённый дисковод?

[Stilet]

Delphi World:

Проверить, открыт ли CD-ROM 


Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch 

uses
   mmsystem;

   procedure TForm1.Button1Click(Sender: TObject);
 var
   s: array[0..64] of Char;
   error: Cardinal;
   Text: array[0..255] of Char;
 begin
   error := mciSendstring('open cdaudio alias geraet', nil, 0, Handle);
   if error <> 0 then
   begin
     mciGetErrorstring(error, @Text, 255);
     ShowMessage(Text);
     mciSendstring('close geraet', nil, 0, Handle);
     Exit;
   end;

   error := mciSendstring('status geraet mode', @s, SizeOf(s), Handle);
   if error <> 0 then
   begin
     mciGetErrorstring(error, @Text, 255);
     ShowMessage(Text);
     mciSendstring('close geraet', nil, 0, Handle);
     Exit;
   end;

   mciSendstring('close geraet', nil, 0, Handle);
   ShowMessage('Message: ' + s);
 end;

P.S. Люди!!!!!!!! Ау!!!! почаще у яндекса спращивайте.

[FaTaL]

Что то постоянно выдаётся сообщение что Open, хотя сидюк закрыт.

[rpy3uH]

есть хороший метод определить закрыт или нет: надо послать команду для открытия привода и засечь время его выполнения, если привод открыт, то время выполнения функции mciSendstring где-то в десять меньше, чем когда привод закрыт. Анализируя время потраченное на открытие, можно понять открыт или закрыт привод.

[FaTaL]

Но если послать команду на открытие, то он откроется. Надо знать заранее открыт ли он, а потом уже посылать комманды.

[rpy3uH]

ну после того как откроется закрыть его.

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;
  Halt;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 DriveType: UInt;
 Drive : String;
 tik1, tik2 : DWord;
begin
      Drive := Edit1.Text;
      Drive := Drive + ':\';
      DriveType := GetDriveType(PChar(Drive));
      if DriveType = DRIVE_CDROM then
         begin
             tik1 := GetTickCount;
             OpenCD(Drive);
             tik2 := GetTickCount;
             if tik2-tik1 < 250 then
               ShowMessage('открыт')
                                else
               CloseCD(Drive);
         end;

end;