Search code examples
delphiusbdevicedevice-driver

How to detect when USB device is being connected/disconnected?


I don't feel comfortable harnessing USB device with Delphi and have a next to nothing knowledge of the details of writing device driver (though I've come accross some when learning assembly with GoASM).

The device could be either an usb modem or an usb printer.

What I need is a direction to go and sample code adressing the topic.


Solution

  • This was taken from detect if usb device is connected

     unit U_Usb;
    
     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.