VPF::состояние лотка cd-rom - Форум программистов

mntek

Дата 27.11.2004, 05:16 (ссылка)

(нет голосов)

Загрузка ...

freakin_brain

Профиль
Группа: Участник
Сообщений: 57
Регистрация: 15.8.2004
Где: saint-petersburg

Репутация: 1
Всего: 1

довольно-таки интересно узнать положение лотка cd-rom - открыт он в данный момент или закрыт.

вероятно надо использовать mciSendCommand с MCI_STATUS, но не уверен точно, у самого не получилось smile

Это сообщение отредактировал(а) mntek - 27.11.2004, 05:21

Akella

Дата 27.11.2004, 11:08 (ссылка)

(нет голосов)

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: нет
Всего: 329

Код


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;

mntek

Дата 28.11.2004, 04:01 (ссылка)

(нет голосов)

Загрузка ...

freakin_brain

Профиль
Группа: Участник
Сообщений: 57
Регистрация: 15.8.2004
Где: saint-petersburg

Репутация: 1
Всего: 1

если нет компакта. но лоток закрыт - Message: Open.

p0s0l

Дата 28.11.2004, 17:42 (ссылка)

(нет голосов)

Загрузка ...

Г-н Посол

Профиль
Группа: Экс. модератор
Сообщений: 3668
Регистрация: 13.7.2003
Где: 58°38' с.ш. 4 9°41' в.д.

Репутация: 14
Всего: 112

Перенесенно из раздела Delphi

--------------------

С уважением, г-н Посол.

Akella

Дата 2.12.2004, 14:22 (ссылка)

(нет голосов)

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: нет
Всего: 329

поверни голову и посмотри глазами smile

Droll

Дата 21.12.2004, 13:24 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 61
Регистрация: 10.11.2004

Репутация: нет
Всего: 3

Ента штука возвращает мне "Message: Open" в любом случае, если в лотке нет диска! Если же диск в лотке присутствует, то возвращает "Message: stopped"... Где-то тут не совсем правильно работает smile

+++ Как же быть, если у тебя 2 привода или даже 3??? Каждый раз устанавливать ему мастер, чтобы процедура работала?

mntek

Дата 4.1.2005, 15:36 (ссылка)

(нет голосов)

Загрузка ...

freakin_brain

Профиль
Группа: Участник
Сообщений: 57
Регистрация: 15.8.2004
Где: saint-petersburg

Репутация: 1
Всего: 1

с так понял, что узнать именно состояние лотка низзя, а можно только отловить вставку/вынимание диска. и код имеем:

Код


TForm1 = class(TForm)
    procedure ReceiveMessage (var Msg: TMessage); message WM_DEVICECHANGE;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

...

procedure TForm1.ReceiveMessage(var Msg: TMessage);
begin
  if Msg.WParam=32772 then
    ShowMessage('CD-ROM Open');

  if Msg.WParam=32768 then
    ShowMessage('CD-ROM Close');
end;

это с сообщениями, а вот это - по желанию:

Код


procedure TForm1.Button1Click(Sender: TObject);
Var
  Err: MciError;
  Flags: DWord;
  S: String;
  DeviceID: Word;
  OpenParm: TMCI_Open_Parms;
  StatusParm: TMCI_Status_Parms;
begin
  S := 'E:';
  Flags := MCI_OPEN_ELEMENT or MCI_OPEN_TYPE;
  with OpenParm do
    begin
      dwCallback := 0;
      lpstrDeviceType := 'CDAudio';
      lpstrElementName := PChar(S);
    end;
  Err := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
  if Err <> 0 then exit;
  DeviceID := OpenParm.wDeviceID;
  try
    with StatusParm do
      begin
        dwItem := MCI_STATUS_READY;
      end;
    Err := mciSendCommand(DeviceID, MCI_STATUS, MCI_WAIT or MCI_STATUS_ITEM, Longint(@StatusParm));
    IF Err = 0 Then exit;
  finally
    case StatusParm.dwReturn of
      0                 : form1.Caption := 'NOT READY';
      1                 : form1.Caption := 'READY';
      else                form1.Caption := 'ERROR';
    end;
    mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));
  end;
end;

Droll

Дата 5.1.2005, 16:32 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 61
Регистрация: 10.11.2004

Репутация: нет
Всего: 3

узнать состояние лотка может и низзя, но вот отследить момент его вынимания и задвигания можно, об этом говорит появляющийся при открытии/закрытии лотка курсор в виде вращающегося диска со стрелкой!
т.о. можно (надо только знать как отлавливать эти сигналы о том, что состояние лотка было изменено) при запуске проги закрыть лоток, а затем вести своеобразный счетчик (пришел сигнал, значит открылся лоток, пришел еще один - закрылся)

mntek

Дата 5.1.2005, 20:46 (ссылка)

(нет голосов)

Загрузка ...

freakin_brain

Профиль
Группа: Участник
Сообщений: 57
Регистрация: 15.8.2004
Где: saint-petersburg

Репутация: 1
Всего: 1

отслеживай изменение курсора мыши smile

)
как только поменялся - вперед и с песней smile

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: WinAPI и системное программирование \| Следующая тема »