Проверка на подключение нового устройства

[Алексей_2012]

Здравствуйте! Возник такой вопрос: Возможно ли средствами Delphi проверить подключение нового устройства, т.е. вставлена ли флешка в USB-разъем, и наличествует ли диск в приводе

[Stilet]

Насчет флешки ищи примеры с WM_DEVICECHANGE

[raxp]

...насчет устройств вообще, в блоге, ссылка выше.

[Алексей_2012]

в блоге, ссылка выше.

вы про это?

ищи примеры с WM_DEVICECHANGE

Если да, то дополнительный вопрос: допустим мне нужно проверить условие: если подключено новое оборудование, то работать с консолью, а wm_devicechange-это что такое? модуль, процедура, функция? как с ней обращаться и т.п.

[саша40]

Сообщение от Алексей_2012

вы про это?




Если да, то дополнительный вопрос: допустим мне нужно проверить условие: если подключено новое оборудование, то работать с консолью, а wm_devicechange-это что такое? модуль, процедура, функция? как с ней обращаться и т.п.

WM_DEVICECHANGE- это сообщение, которое система посылает, когда в USB-разъем вставляют любое устройство. Для обработки сообщений надо создавать процедуру. с параметрами (msg: TWM_DEVICECHANGE); message WM_DEVICECHANGE. Но я точно не знаю, сработает ли процедура. Если бы это событие было бы описано в messages.

[raxp]

...самый примитивный вариант c WM_DeviceChange:

//------------------------------------------
// Flash USB
// Модуль определения буквы вставленной флешки
// воспроизведения аудио при подключения
// и отключении USB
// Author: Бадло Сергей Григорьевич
// H-page: http://raxp.radioliga.com
// Cистемные требования: NT/XP/7
//------------------------------------------

program flash;

uses Messages,Classes, Windows, mmsystem; 


type

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

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

 TF = class
 protected
  FWnd: HWnd;
  constructor Create;
  destructor Destroy;
  procedure WndProcc(var Msg:TMessage); message WM_DeviceChange;
end;


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

var
  FWnd: HWnd;
  t: tf;
  Msg: tmsg;

{$R *.RES}

// СКЕЛЕТ =====================================================================
function GetDrive(pDBVol: PDevBroadcastVolume): string;
var i: Byte;
    Maske: DWORD;
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;

constructor TF.Create;
begin
 inherited Create;
 FWnd:= AllocateHWnd(WndProcc);
end;
destructor TF.Destroy;
begin
 inherited Create;
 deAllocateHWnd(fWnd)
end;

procedure tf.WndProcc(var Msg:TMessage);
begin
 with Msg do

 case wParam of
  DBT_DEVICEARRIVAL:
   if PDevBroadcastHdr(lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
    MCISendString(PChar('play ' + '1.mp3'),nil,0,0);//messagebox(fwnd,pchar(GetDrive(PDevBroadcastVolume(Msg. lParam))),'',0)

  DBT_DEVICEREMOVECOMPLETE:
   if PDevBroadcastHdr(lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
    MCISendString(PChar('play ' + '2.mp3'),nil,0,0);

 else Result:= DefWindowProc(FWnd,Msg,wParam,lParam) end
end;




begin
 t:= tf.Create;

 try while GetMessage(Msg, 0, 0, 0) do begin
  TranslateMessage(Msg);
  DispatchMessage(Msg)
 end finally t.destroy end
// END СКЕЛЕТ =================================================================

end.

То же об чем я упомянул относится к SetupAPI и одной из статей в блоге. Если плохо видно:

[kta87]

У меня на сайте в разделе разработчикам есть готовая реализация для Lazarus. В Delphi все можно и еще проще сделать, с Lazarus приходится опускаться до WinAPI.
Вот функция

function MyWndProc(my_wnd : HWND; Msg : UINT;
                   my_wparam : WPARAM; my_lparam : LPARAM) : LRESULT; stdcall;
var
  devType : Integer;
  Datos : PDevBroadcastHdr;
begin
  Result := 0;
  case Msg of
    WM_DEVICECHANGE:
    begin
      if (my_wparam = DBT_DEVICEARRIVAL) or (my_wparam = DBT_DEVICEREMOVECOMPLETE) then
      begin
        Datos := PDevBroadcastHdr(Pointer(my_lparam));
        devType := Datos^.dbch_devicetype;
        if devType = DBT_DEVTYP_DEVICEINTERFACE then
        begin
           if my_wparam = DBT_DEVICEARRIVAL then
              ShowMessage('USB устройство подключено')
           else
              ShowMessage('USB устройство отключено');
        end;
      end;
    end; 
  end; 
  Result := Windows.CallWindowProc(OldWndProc, my_wnd, Msg, my_wparam, my_lparam);
end;

[raxp]

http://www.youtube.com/watch?v=4rN87suPnmA

[Stilet]

В Delphi все можно и еще проще сделать

Это как, стесняюсь спросить?? Разве в Делфи тоже не придется до WinAPI опускаться?

[kta87]

Stilet & Др. Дышиглубжиев, проблема в Lazarus в том, что форма не получает WM_DEVICECHANGE вообще. Подробнее смотрите кому интересно тут - моя тема тогда я попытался перенести рабочий отлов USB с delphi в Lazarus.