[Delphi (Object Pascal)] Delphi监控USB端口 →→→→→进入此内容的聊天室

来自 , 2020-11-21, 写在 Delphi (Object Pascal), 查看 154 次.
URL http://www.code666.cn/view/38faae06
  1. Unit USBUnit;
  2. Interface
  3. Uses
  4. Windows, SysUtils, Classes, Messages, Forms;
  5. Type
  6. PDevBroadcastHdr = ^DEV_BROADCAST_HDR;
  7. DEV_BROADCAST_HDR = Packed Record
  8.     dbch_size: DWORD;
  9.     dbch_devicetype: DWORD;
  10.     dbch_reserved: DWORD;
  11. End;
  12. PDevBroadcastDeviceInterface = ^DEV_BROADCAST_DEVICEINTERFACE;
  13. DEV_BROADCAST_DEVICEINTERFACE = Record
  14.     dbcc_size: DWORD;
  15.     dbcc_devicetype: DWORD;
  16.     dbcc_reserved: DWORD;
  17.     dbcc_classguid: TGUID;
  18.     dbcc_name: short;
  19. End;
  20. TUSB = Class(TObject)
  21. private
  22.     FWindowHandle: HWND;
  23.     FOnUSBArrival: TNotifyEvent;
  24.     FOnUSBRemove: TNotifyEvent;
  25.     Procedure WndProc(Var Msg: TMessage);
  26.     Function USBRegister: Boolean;
  27. protected
  28.     Procedure WMDeviceChange(Var Msg: TMessage); dynamic;
  29. public
  30.     Constructor Create;
  31.     Destructor Destroy; override;
  32.     Property OnUSBArrival: TNotifyEvent read FOnUSBArrival write FOnUSBArrival;
  33.     Property OnUSBRemove: TNotifyEvent read FOnUSBRemove write FOnUSBRemove;
  34. End;
  35. Const
  36. GUID_DEVINTERFACE_USB_DEVICE: TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';
  37. DBT_DEVICEARRIVAL = $8000; // system detected a new device
  38. DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone
  39. DBT_DEVTYP_DEVICEINTERFACE = $00000005; // device interface class
  40. Var
  41. USB: TUSB;
  42. Implementation
  43. { TUSB }
  44. Constructor TUSB.Create;
  45. Begin
  46. FWindowHandle := AllocateHWnd(WndProc);
  47. USBRegister;
  48. End;
  49. Destructor TUSB.Destroy;
  50. Begin
  51. DeallocateHWnd(FWindowHandle);
  52. Inherited Destroy;
  53. End;
  54. Function TUSB.USBRegister: Boolean;
  55. Var
  56. dbi: DEV_BROADCAST_DEVICEINTERFACE;
  57. Size: Integer;
  58. r: Pointer;
  59. Begin
  60. Result := False;
  61. Size := Sizeof(DEV_BROADCAST_DEVICEINTERFACE);
  62. ZeroMemory(@dbi, Size);
  63. dbi.dbcc_size := Size;
  64. dbi.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE;
  65. dbi.dbcc_reserved := 0;
  66. dbi.dbcc_classguid := GUID_DEVINTERFACE_USB_DEVICE;
  67. dbi.dbcc_name := 0;
  68. r := RegisterDeviceNotification(FWindowHandle, @dbi, DEVICE_NOTIFY_WINDOW_HANDLE);
  69. If Assigned(r) Then
  70.     Result := True;
  71. End;
  72. Procedure TUSB.WMDeviceChange(Var Msg: TMessage);
  73. Var
  74. devType: Integer;
  75. Datos: PDevBroadcastHdr;
  76. Begin
  77. If (Msg.wParam = DBT_DEVICEARRIVAL) or (Msg.wParam = DBT_DEVICEREMOVECOMPLETE) Then Begin
  78.     Datos := PDevBroadcastHdr(Msg.lParam);
  79.     devType := Datos^.dbch_devicetype;
  80.     If devType = DBT_DEVTYP_DEVICEINTERFACE Then Begin // USB Device
  81.       If Msg.wParam = DBT_DEVICEARRIVAL Then Begin
  82.         If Assigned(FOnUSBArrival) Then
  83.           FOnUSBArrival(Self);
  84.       End
  85.       Else Begin
  86.         If Assigned(FOnUSBRemove) Then
  87.           FOnUSBRemove(Self);
  88.       End;
  89.     End;
  90. End;
  91. End;
  92. Procedure TUSB.WndProc(Var Msg: TMessage);
  93. Begin
  94. If (Msg.Msg = WM_DEVICECHANGE) Then Begin
  95.     Try
  96.       WMDeviceChange(Msg);
  97.     Except
  98.       Application.HandleException(Self);
  99.     End;
  100. End
  101. Else
  102.     Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
  103. End;
  104. Initialization
  105. If Not Assigned(USB) Then
  106.     USB := TUSB.Create;
  107. Finalization
  108. FreeAndNil(USB);
  109. End.
  110.  
  111.  
  112.  
  113. //delphi/5102

回复 "Delphi监控USB端口"

这儿你可以回复上面这条便签

captcha