delphi 监控 USB 端口(附源码下载)

 前段时间，有朋友问我，可以不可以写个程序监控USB端口，效果要求如下：

1. 插入USB 端口的时候，系统将自动打开一个网页，这个网页地址，当然是可以配置在配置文件中的。还可以定义提示消息。

2.当拔出USB的同时，也必须给出提示，或者记录日志，或在数据库中记录。

这应该是个功能很简单，不难的小程序，于是我就答应了他，先做一个简单的POC，验证是否可行。

我用的开发工具是 delphi7, 后来测试了在 delphi 2010 ,delphi xe 下都可以正常运行。当然我的系统是32位操作系统。下面我就将主要用到的东西记录下来，以供参考。

先看运行后界面如下：

到此演示，从效果上来说，确实满足了要求，当然有很多细节需要去完善。但只要很小的工作量就可以实现了。

重点在什么地方呢，重点是操作USB 的单元, 代码如下：

Unit USBUnit;
Interface
Uses
Windows, SysUtils, Classes, Messages, 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;
TUSB = Class(TObject)
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;
    Destructor Destroy; override;
    Property OnUSBArrival: TNotifyEvent read FOnUSBArrival write FOnUSBArrival;
    Property OnUSBRemove: TNotifyEvent read FOnUSBRemove write FOnUSBRemove;
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
Var
USB: TUSB;
Implementation
{ TUSB }
Constructor TUSB.Create;
Begin
FWindowHandle := AllocateHWnd(WndProc);
USBRegister;
End;
Destructor TUSB.Destroy;
Begin
DeallocateHWnd(FWindowHandle);
Inherited Destroy;
End;
Function TUSB.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;
Procedure TUSB.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;
Procedure TUSB.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;
Initialization
If Not Assigned(USB) Then
    USB := TUSB.Create;
Finalization
FreeAndNil(USB);
End.
[/code]
在主窗口界面直接调用就好了：
[code]
procedure TForm1.OnmyUSBArrival(Sender:   TObject);
begin
    ShowMessage('USB插入,打开网页:http://www.yihaomen.com');
    ShellExeCute(Handle,nil,'http://www.yihaomen.com',nil,nil,SW_Normal);
end;
procedure TForm1.OnmyUSBRemove(Sender:   TObject);
begin
    ShowMessage( '拔出了！！！ ');
end;
procedure TForm1.FormCreate(Sender: TObject);
var
MYUSB:TUSB;
begin
  MYUSB:=TUSB.Create;
  MYUSB.OnUSBRemove:=OnmyUSBRemove;
  MYUSB.OnUSBArrival:=OnmyUSBArrival;
end;

整个程序附源代码下载:点击下载此文件

From：一号门