Home > Delphi, Object Pascal > USB device detection

USB device detection

November 19, 2014 Leave a comment Go to comments

This is a cool unit for USB device detection. Simply create an instance of the object and catch the events. Very cool for dealing with external disks.

 

unit uUsb;

interface

uses Windows, Messages, Classes;

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

type
  PDevBroadcastDeviceInterface  = ^DEV_BROADCAST_DEVICEINTERFACE;
  DEV_BROADCAST_DEVICEINTERFACE = record
    dbcc_size: DWORD;
    dbcc_devicetype: DWORD;
    dbcc_reserved: DWORD;
    dbcc_classguid: TGUID;
    dbcc_name: Char;
  end;
  TDevBroadcastDeviceInterface = DEV_BROADCAST_DEVICEINTERFACE;

const
  GUID_DEVINTERFACE_USB_DEVICE: TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';
  DBT_DEVICEARRIVAL          = $8000;
  DBT_DEVICEREMOVECOMPLETE   = $8004;
  DBT_DEVTYP_DEVICEINTERFACE = $00000005;

type
  TUsbNotifyProc = procedure(Sender: TObject; const DeviceName: String) of Object;
  TUsbNotifier = class
  private
    FWindowHandle: HWND;
    FNotificationHandle: Pointer;
    FOnUsbArrival: TUsbNotifyProc;
    FOnUsbRemoval: TUsbNotifyProc;
    procedure WndProc(var Msg: TMessage);
  public
    constructor Create;
    property OnUsbArrival: TUsbNotifyProc read FOnUsbArrival write FOnUsbArrival;
    property OnUsbRemoval: TUsbNotifyProc read FOnUsbRemoval write FOnUsbRemoval;
    destructor Destroy; override;
  end;


implementation

constructor TUsbNotifier.Create;
var
  Size: Cardinal;
  Dbi: TDevBroadcastDeviceInterface;
begin
  inherited;
  FWindowHandle := AllocateHWnd(WndProc);

  Size := SizeOf(Dbi);
  ZeroMemory(@Dbi, Size);

  Dbi.dbcc_size := Size;
  Dbi.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE;
  Dbi.dbcc_classguid := GUID_DEVINTERFACE_USB_DEVICE;

  FNotificationHandle := RegisterDeviceNotification(FWindowHandle, @Dbi,
                                              DEVICE_NOTIFY_WINDOW_HANDLE);
end;

procedure TUsbNotifier.WndProc(var Msg: TMessage);
var
  Dbi: PDevBroadcastDeviceInterface;
begin
  with Msg do
  if (Msg = WM_DEVICECHANGE)
      and ((WParam = DBT_DEVICEARRIVAL)
        or (WParam = DBT_DEVICEREMOVECOMPLETE)) then
  try
    Dbi := PDevBroadcastDeviceInterface(LParam);
    if Dbi.dbcc_devicetype = DBT_DEVTYP_DEVICEINTERFACE then
    begin
      if WParam = DBT_DEVICEARRIVAL then
      begin
        if Assigned(FOnUsbArrival) then
          FOnUsbArrival(Self, PChar(@Dbi.dbcc_name));
      end
      else
      begin
        if Assigned(FOnUsbRemoval) then
          FOnUsbRemoval(Self, PChar(@Dbi.dbcc_name));
      end;
    end;
  except
    Result := DefWindowProc(FWindowHandle, Msg, WParam, LParam);
  end
  else
    Result := DefWindowProc(FWindowHandle, Msg, WParam, LParam);
end;

destructor TUsbNotifier.Destroy;
begin
  UnregisterDeviceNotification(FNotificationHandle);
  DeallocateHWnd(FWindowHandle);
  inherited;
end;

end.
Advertisements
  1. woutervannifterick
    November 22, 2014 at 3:43 am

    You forgot to credit the author (Miguel Lucero)

  2. March 26, 2017 at 2:53 pm

    hi , i have a problem :(fpc 2.6.2)
    uusb.pas(67,52) Error: Identifier not found “RegisterDeviceNotification”

  1. No trackbacks yet.

Leave a Reply

Please log in using one of these methods to post your comment:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: