| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

отследить открытие/закрыте CD-ROM

KILLMAN ©   (2005-01-16 15:11:00) 

Здравствуйте.
Подскажите, пожалуйста, как реализовать сабж!

---

uny   (2005-01-19 18:36:00) [1]

[6]
[7]
а мой способ работает всегда! можно завидовать))

---

aus   (2005-01-17 22:25:00) [2]

remb   (17.01.05 17:50) [6]
Все это работает если на лотке сд привода есть диск.
и включен автозапуск CD-ROM

---

remb   (2005-01-17 17:50:00) [3]

Все это работает если на лотке сд привода есть диск.

---

Colonel   (2005-01-17 14:34:00) [4]

Ну или так, как тебе писали :

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    label1: TLabel;
  private
    procedure WMDeviceChange(var Msg: TMessage); message WM_DeviceChange;
    { Private declarations }
  public
    { Public declarations }
  end;

const
    DBT_DeviceArrival = $8000;
  DBT_DeviceRemoveComplete = $8004;
  DBTF_Media = $0001;
  DBT_DevTyp_Volume = $0002;

type
  PDevBroadcastHdr = ^TDevBroadcastHdr;
  TDevBroadcastHdr = packed record
    dbcd_size: DWORD;
    dbcd_devicetype: DWORD;
    dbcd_reserved: DWORD;
  end;

type
  PDevBroadcastVolume = ^TDevBroadcastVolume;
  TDevBroadcastVolume = packed record
    dbcv_size: DWORD;
    dbcv_devicetype: DWORD;
    dbcv_reserved: DWORD;
    dbcv_unitmask: DWORD;
    dbcv_flags: Word;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetDrive(pDBVol: PDevBroadcastVolume): string;
var
  i: Byte;
  Maske: DWORD;
begin
  if (pDBVol^.dbcv_flags and DBTF_Media) = DBTF_Media then
  begin
    Maske := pDBVol^.dbcv_unitmask;
    for i := 0 to 25 do
    begin
      if (Maske and 1) = 1 then
        Result := Char(i + Ord('A')) + ':';
      Maske := Maske shr 1;
    end;
  end;
end;

procedure TForm1.WMDeviceChange(var Msg: TMessage);
var
  Drive: string;
begin
  case Msg.wParam of
    DBT_DeviceArrival:
      if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
      begin
        Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
        label1.Caption := 'CD inserted in Drive ' + Drive;
      end;
    DBT_DeviceRemoveComplete:
      if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
      begin
        Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
        label1.Caption := 'CD removed from Drive ' + Drive;
      end;
  end;
end;

end.


---

Colonel   (2005-01-17 14:32:00) [5]

Попробуй так :

type
  TForm1 = class(TForm)
  private
    procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
  public

  end;

implementation

{$R *.DFM}

procedure TForm1.WMDeviceChange(var Msg: TMessage);
const
  DBT_DEVICEARRIVAL = $8000; // system detected a new device
 DBT_DEVICEREMOVECOMPLETE = $8004;  // device is gone
var
  myMsg: string;
begin
  inherited;
  case Msg.wParam of
    DBT_DEVICEARRIVAL: myMsg  := 'CD inserted!';
    DBT_DEVICEREMOVECOMPLETE: myMsg := 'CD removed!';
  end;
  ShowMessage(myMsg);
end;


---

dimaxx   (2005-01-16 21:17:00) [6]

Отлавливать WM_DEVICECHANGE

---

KILLMAN   (2005-01-16 19:34:00) [7]

программно, плиз

---

uny   (2005-01-16 15:32:00) [8]

когда происходит открытие, то такая полочка выезжает с тихим жужжанием. а когда закрытие, то полочка заезжает обратно

---

Наверх