Мастера DELPHI, Delphi programming community Рейтинг@Mail.ru Титульная страница Поиск, карта сайта Написать письмо 
| Новости |
Новости сайта
Поиск |
Поиск по лучшим сайтам о Delphi
FAQ |
Огромная база часто задаваемых вопросов и, конечно же, ответы к ним ;)
Статьи |
Подборка статей на самые разные темы. Все о DELPHI
Книги |
Новинки книжного рынка
Новости VCL
Обзор свежих компонент со всего мира, по-русски!
|
| Форумы
Здесь вы можете задать свой вопрос и наверняка получите ответ
| ЧАТ |
Место для общения :)
Орешник |
Коллекция курьезных вопросов из форумов
KOL и MCK |
KOL и MCK - Компактные программы на Delphi
Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / rsdn.org

 
Чтобы не потерять эту дискуссию, сделайте закладку « предыдущая ветвь | форум | следующая ветвь »

delphi Отловить подключение usb [D7]


Vlad   (24.08.17 11:50

Нашел на просторах рунета код для отлова подключения к усб порту

unit usb_utils;

//http://www.swissdelphicenter.ch/en/tipsindex.php

interface

uses
 Windows, Messages, SysUtils, Classes, Forms;

type

 PDevBroadcastHdr  = ^DEV_BROADCAST_HDR;
 DEV_BROADCAST_HDR = packed record
   dbch_size: DWORD;
   dbch_devicetype: DWORD;
   dbch_reserved: DWORD;
 end;

 PDevBroadcastDeviceInterface  = ^DEV_BROADCAST_DEVICEINTERFACE;
 DEV_BROADCAST_DEVICEINTERFACE = record
   dbcc_size: DWORD;
   dbcc_devicetype: DWORD;
   dbcc_reserved: DWORD;
   dbcc_classguid: TGUID;
   dbcc_name: short;
 end;

const
 GUID_DEVINTERFACE_USB_DEVICE: TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';
 DBT_DEVICEARRIVAL          = $8000;          // system detected a new device
 DBT_DEVICEREMOVECOMPLETE   = $8004;          // device is gone
 DBT_DEVTYP_DEVICEINTERFACE = $00000005;      // device interface class

type

 TComponentUSB = class(TComponent)
 private
   FWindowHandle: HWND;
   FOnUSBArrival: TNotifyEvent;
   FOnUSBRemove: TNotifyEvent;
   procedure WndProc(var Msg: TMessage);
   function USBRegister: Boolean;
 protected
   procedure WMDeviceChange(var Msg: TMessage); dynamic;
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
 published
   property OnUSBArrival: TNotifyEvent read FOnUSBArrival write FOnUSBArrival;
   property OnUSBRemove: TNotifyEvent read FOnUSBRemove write FOnUSBRemove;
 end;

implementation

constructor TComponentUSB.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FWindowHandle := AllocateHWnd(WndProc);
 USBRegister;
end;

destructor TComponentUSB.Destroy;
begin
 DeallocateHWnd(FWindowHandle);
 inherited Destroy;
end;

procedure TComponentUSB.WndProc(var Msg: TMessage);
begin
 if (Msg.Msg = WM_DEVICECHANGE) then  
 begin
   try
     WMDeviceChange(Msg);
   except
     Application.HandleException(Self);
   end;
 end
 else
   Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
end;

procedure TComponentUSB.WMDeviceChange(var Msg: TMessage);
var
 devType: Integer;
 Datos: PDevBroadcastHdr;
begin
 if (Msg.wParam = DBT_DEVICEARRIVAL) or (Msg.wParam = DBT_DEVICEREMOVECOMPLETE) then  
 begin
   Datos := PDevBroadcastHdr(Msg.lParam);
   devType := Datos^.dbch_devicetype;
   if devType = DBT_DEVTYP_DEVICEINTERFACE then  
   begin // USB Device
     if Msg.wParam = DBT_DEVICEARRIVAL then  
     begin
       if Assigned(FOnUSBArrival) then
         FOnUSBArrival(Self);
     end  
     else  
     begin
       if Assigned(FOnUSBRemove) then
         FOnUSBRemove(Self);
     end;
   end;
 end;
end;

function TComponentUSB.USBRegister: Boolean;
var
 dbi: DEV_BROADCAST_DEVICEINTERFACE;
 Size: Integer;
 r: Pointer;
begin
 Result := False;
 Size := SizeOf(DEV_BROADCAST_DEVICEINTERFACE);
 ZeroMemory(@dbi, Size);
 dbi.dbcc_size := Size;
 dbi.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE;
 dbi.dbcc_reserved := 0;
 dbi.dbcc_classguid  := GUID_DEVINTERFACE_USB_DEVICE;
 dbi.dbcc_name := 0;

 r := RegisterDeviceNotification(FWindowHandle, @dbi,
   DEVICE_NOTIFY_WINDOW_HANDLE
   );
 if Assigned(r) then Result := True;
end;

end.

Все бы хорошо, но вот не особо у меня получается его совместить с dll (хочу потом заинжектить длл в процесс). Тобищь, нужно чтоб длл отлавливала подключения флешки, как я использовал код выше

library dll;

uses
 SysUtils,
 Classes,windows,dialogs,messages;

type

PDevBroadcastHdr  = ^DEV_BROADCAST_HDR;
DEV_BROADCAST_HDR = packed record
  dbch_size: DWORD;
  dbch_devicetype: DWORD;
  dbch_reserved: DWORD;
end;

PDevBroadcastDeviceInterface  = ^DEV_BROADCAST_DEVICEINTERFACE;
DEV_BROADCAST_DEVICEINTERFACE = record
  dbcc_size: DWORD;
  dbcc_devicetype: DWORD;
  dbcc_reserved: DWORD;
  dbcc_classguid: TGUID;
  dbcc_name: short;
end;

const
GUID_DEVINTERFACE_USB_DEVICE: TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';
DBT_DEVICEARRIVAL          = $8000;          // system detected a new device
DBT_DEVICEREMOVECOMPLETE   = $8004;          // device is gone
DBT_DEVTYP_DEVICEINTERFACE = $00000005;      // device interface class

type

TComponentUSB = class(TComponent)
private
  FWindowHandle: HWND;
  FOnUSBArrival: TNotifyEvent;
  FOnUSBRemove: TNotifyEvent;
  procedure WndProc(var Msg: TMessage);
  function USBRegister: Boolean;
protected
  procedure WMDeviceChange(var Msg: TMessage); dynamic;
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
published
  property OnUSBArrival: TNotifyEvent read FOnUSBArrival write FOnUSBArrival;
  property OnUSBRemove: TNotifyEvent read FOnUSBRemove write FOnUSBRemove;
end;

{$R *.res}

constructor TComponentUSB.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FWindowHandle := AllocateHWnd(WndProc);
USBRegister;
end;

destructor TComponentUSB.Destroy;
begin
DeallocateHWnd(FWindowHandle);
inherited Destroy;
end;

procedure TComponentUSB.WndProc(var Msg: TMessage);
begin
if (Msg.Msg = WM_DEVICECHANGE) then
begin
  try
    WMDeviceChange(Msg);
  except
  showmessage('error');
 //   Application.HandleException(Self);
  end;
end
else
  Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
end;

procedure TComponentUSB.WMDeviceChange(var Msg: TMessage);
var
devType: Integer;
Datos: PDevBroadcastHdr;
begin
if (Msg.wParam = DBT_DEVICEARRIVAL) or (Msg.wParam = DBT_DEVICEREMOVECOMPLETE) then
begin
  Datos := PDevBroadcastHdr(Msg.lParam);
  devType := Datos^.dbch_devicetype;
  if devType = DBT_DEVTYP_DEVICEINTERFACE then
  begin // USB Device
    if Msg.wParam = DBT_DEVICEARRIVAL then
    begin
    showmessage('tada!');
      if Assigned(FOnUSBArrival) then
        FOnUSBArrival(Self);
    end
    else
    begin
      if Assigned(FOnUSBRemove) then
        FOnUSBRemove(Self);
    end;
  end;
end;
end;

function TComponentUSB.USBRegister: Boolean;
var
dbi: DEV_BROADCAST_DEVICEINTERFACE;
Size: Integer;
r: Pointer;
begin
Result := False;
Size := SizeOf(DEV_BROADCAST_DEVICEINTERFACE);
ZeroMemory(@dbi, Size);
dbi.dbcc_size := Size;
dbi.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE;
dbi.dbcc_reserved := 0;
dbi.dbcc_classguid  := GUID_DEVINTERFACE_USB_DEVICE;
dbi.dbcc_name := 0;

r := RegisterDeviceNotification(FWindowHandle, @dbi,
  DEVICE_NOTIFY_WINDOW_HANDLE
  );
if Assigned(r) then Result := True
else
showmessage('bad');

end;

begin
showmessage('good');
TComponentUSB.Create(nil);
while true do
sleep(100);
end.

Инжектю длл, выходит сообщение good, значит заинжектилось норм, но вот при вставке флэшки не выходит сообщение tada!, хотя на форме все работает хорошо. Я думаю, что проблема в регистрации (USBRegister) мб хэндл не тот, можете мне подсказать ?


Leonid Troyanovsky ©   (26.08.17 10:39[1]


> Vlad   (24.08.17 11:50) 

> Инжектю длл, выходит сообщение good, значит заинжектилось
> норм, но вот при вставке флэшки не выходит сообщение tada!

Ну, в оном коде предполагался цикл обработки сообщений.

Можно попробовать установить хук WH_CALLWNDPROC(RET),
бо библиотека уже есть.

--
Regards, LVT.


версия для печати

Написать ответ

Ваше имя (регистрация  E-mail 







Разрешается использование тегов форматирования текста:
<b>жирный</b> <i>наклонный</i> <u>подчеркнутый</u>,
а для выделения текста программ, используйте <code> ... </code>
и не забывайте закрывать теги! </b></i></u></code> :)


Наверх

  Рейтинг@Mail.ru     Титульная страница Поиск, карта сайта Написать письмо