Delphi检测GUID确定的设备是否在线

  //检测GUID任何设备插入拔出

unit DeviceDetect; 

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;

  TDeviceDetect = class(TComponent)
  private
    FWindowHandle: HWND;
    FOnUSBArrival: TNotifyEvent;
    FOnUSBRemove: TNotifyEvent;
    FUsbGuid: String;//the Usb Device's GUID String.
    procedure WndProc(var Msg: TMessage);
    function USBRegister: Boolean;

  protected
    procedure WMDeviceChange(var Msg: TMessage); dynamic;

  public
    constructor Create();
    destructor Destroy; override;

  published
  { Published declarations }
    property UsbGuid: String read FUsbGuid write FUsbGuid; // UsbGuid String you can replace it;
    property OnUSBArrival: TNotifyEvent read FOnUSBArrival write FOnUSBArrival;
    property OnUSBRemove: TNotifyEvent read FOnUSBRemove write FOnUSBRemove;
  end;

const
  GUID_DEVINTERFACE_USB_DEVICE: TGUID = '{7cbbad7c-3873-476b-a122-1e8e1a7ec66a}';  //32位GUID
  DBT_DEVICEARRIVAL = $8000; // system detected a new device
  DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone
  DBT_DEVTYP_DEVICEINTERFACE = $0005; // device interface class

var
  USB: TDeviceDetect;
 

procedure Register;    //for register in the system toolbar


implementation

{ TDeviceDetect }

constructor TDeviceDetect.Create;
begin
 
   FWindowHandle := AllocateHWnd(WndProc);
   if UsbGuid ='' then
       UsbGuid:='{7cbbad7c-3873-476b-a122-1e8e1a7ec66a}';
   FUsbGuid := UsbGuid  ;
   USBRegister;
end;

destructor TDeviceDetect.Destroy;
begin
  DeallocateHWnd(FWindowHandle);
  inherited Destroy;
end;

function TDeviceDetect.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;  //GUID is a DWORD
  dbi.dbcc_reserved := 0;
  dbi.dbcc_classguid  := StringToGuid(FUsbGuid);//GUID_DEVINTERFACE_USB_DEVICE;
  dbi.dbcc_name := 0;
  //注册消息
  r := RegisterDeviceNotification(FWindowHandle, @dbi, DEVICE_NOTIFY_WINDOW_HANDLE);
  if Assigned(r) then
    Result := True;
end;

procedure TDeviceDetect.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 TDeviceDetect.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;

//  Register
procedure Register;
begin
     RegisterComponents('System', [TDeviceDetect])     //regedit the Component in System Toolbar
end;


initialization
//  initialization always run first;
  if not Assigned(USB) then
    USB := TDeviceDetect.Create;

finalization
  FreeAndNil(USB);

end.

————————————————————————————————————————

提供了一个UsbGuid属性,可以在Object Inspector中填写类似于:

{7cbbad7c-3873-476b-a122-1e8e1a7ec66a}'

你可能感兴趣的:(Delphi检测GUID确定的设备是否在线)