USB - detectar quando entra e sai

Top  Previous  Next

// Component to detect when usb devices are connected or disconnected

// using RegisterDeviceNotification

 

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.