Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2005.03.06;
Скачать: [xml.tar.bz2];

Вниз

отследить открытие/закрыте CD-ROM   Найти похожие ветки 

 
KILLMAN ©   (2005-01-16 15:11) [0]

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


 
uny ©   (2005-01-16 15:32) [1]

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


 
KILLMAN ©   (2005-01-16 19:34) [2]

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


 
dimaxx ©   (2005-01-16 21:17) [3]

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


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

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

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;


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

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

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.


 
remb   (2005-01-17 17:50) [6]

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


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

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

и включен автозапуск CD-ROM


 
uny ©   (2005-01-19 18:36) [8]

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



Страницы: 1 вся ветка

Форум: "WinAPI";
Текущий архив: 2005.03.06;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.47 MB
Время: 0.031 c
6-1104411289
Sveta_cc
2004-12-30 15:54
2005.03.06
Server Socket ClientSocket


1-1108965198
xOn
2005-02-21 08:53
2005.03.06
Процедуры и функции Delphi


3-1107868627
Ч_А_Й_Н_И_К
2005-02-08 16:17
2005.03.06
Получение имени сервера как параметр


1-1108928714
ionn
2005-02-20 22:45
2005.03.06
TXMLDocument. Вылетает ошибка при завершении программы


1-1108894737
XES
2005-02-20 13:18
2005.03.06
Не запускается





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский