Фиксация изменения состава USB устройств.
unit grdKeyDetector;
interface
uses
Messages, Windows;
const
GUID_CLASS_USBHUB: TGUID = '{f18a0e88-c30c-11d0-8815-00a0c906bed8}';
GUID_CLASS_USB_DEVICE: TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';
GUID_CLASS_USB_HOST_CONTROLLER: TGUID = '{3ABF6F2D-71C4-462a-8A92-1E6861E6AF27}';
DBT_DEVTYP_DEVICEINTERFACE = $00000005; // device interface class
DBT_DEVICEARRIVAL = $8000; // system detected a new device
DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone
type
_DEV_BROADCAST_DEVICEINTERFACE_A = record
dbcc_size: DWORD;
dbcc_devicetype: DWORD;
dbcc_reserved: DWORD;
dbcc_classguid: TGUID;
dbcc_name: array [0..0] of AnsiChar;
end;
TDevBroadcastDeviceInterface = _DEV_BROADCAST_DEVICEINTERFACE_A;
PDevBroadcastDeviceInterface = ^_DEV_BROADCAST_DEVICEINTERFACE_A;
TDeviceOperation = (doInsert, doRemove);
TDeviceChangeEvent = procedure(Sender: TObject; VID, PID: Word; const Serial, GUID:
string; Operation: TDeviceOperation) of object;
TgrdKeyDetector = class(TObject)
private
FWndHandle: HWND;
FClassGUID: TGUID;
FNotifyHandle: Pointer;
FOnChange: TDeviceChangeEvent;
procedure SetClassGUID(const Value: TGUID);
procedure Close;
procedure Open;
procedure WndProc(var aMsg: TMessage);
function ParseDeviceName(Mask, Text: string; Params: array of Pointer): Boolean;
protected
procedure DoDeviceChange(Event: Integer; Device: PDevBroadcastDeviceInterface);
public
constructor Create;
destructor Destroy; override;
property ClassGUID: TGUID read FClassGUID write SetClassGUID;
property OnChange: TDeviceChangeEvent read FOnChange write FOnChange;
end;
implementation
uses
Forms, SysUtils, Classes;
constructor TgrdKeyDetector.Create;
begin
inherited;
FWndHandle := AllocateHWnd(WndProc);
FClassGUID := GUID_CLASS_USB_DEVICE;
Open;
end;
destructor TgrdKeyDetector.Destroy;
begin
Close;
DeallocateHWnd(FWndHandle);
end;
procedure TgrdKeyDetector.DoDeviceChange(Event: Integer;
Device: PDevBroadcastDeviceInterface);
var
VID, PID: Word;
Serial, GUID: string;
const
USBDeviceNameMask = '\\?\USB#Vid_%x&Pid_%x#%s#%s';
begin
if (Device.dbcc_devicetype = DBT_DEVTYP_DEVICEINTERFACE) and Assigned(FOnChange)
and ParseDeviceName(USBDeviceNameMask, PChar(@Device.dbcc_name), [@VID, @PID,
@Serial, @GUID]) then
case Event of
DBT_DEVICEARRIVAL: FOnChange(Self, VID, PID, Serial, GUID, doInsert);
DBT_DEVICEREMOVECOMPLETE: FOnChange(Self, VID, PID, Serial, GUID, doRemove);
end;
end;
procedure TgrdKeyDetector.Close;
begin
if FNotifyHandle <> nil then
UnregisterDeviceNotification(FNotifyHandle);
end;
procedure TgrdKeyDetector.Open;
var
Info: TDevBroadcastDeviceInterface;
begin
Info.dbcc_size := SizeOf(TDevBroadcastDeviceInterface);
Info.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE;
Info.dbcc_classguid := FClassGUID;
FNotifyHandle := RegisterDeviceNotification(FWndHandle, @Info,
DEVICE_NOTIFY_WINDOW_HANDLE); end;
function TgrdKeyDetector.ParseDeviceName(Mask, Text: string;
Params: array of Pointer): Boolean;
var
PText, PMask, First: PChar;
V, Index: Integer;
Token: Boolean;
Ch: Char;
begin
Result := False;
Text := Trim(Text);
if (Text = '') or (Mask = '') then Exit;
PText := PChar(Text);
PMask := PChar(Mask);
Token := False;
Index := 0;
while PMask^ <> #0 do begin
if Token then begin
Token := False;
case UpCase(PMask^) of
'X': begin
if not (PText^ in ['0'..'9', 'a'..'f', 'A'..'F']) then Exit;
V := 0;
repeat
case PText^ of
'0'..'9': V := V * 16 + Ord(PText^) - Ord('0');
'a'..'f': V := V * 16 + Ord(PText^) - Ord('a') + 10;
'A'..'F': V := V * 16 + Ord(PText^) - Ord('A') + 10;
else
Break;
end;
if V > MaxWord then Exit;
Inc(PText);
until False;
if Index > High(Params) then Exit;
PWord(Params[Index])^ := V;
Inc(Index);
end;
'S': begin
First := PText;
Ch := UpCase(PMask[1]);
while (PText^ <> #0) and (UpCase(PText^) <> Ch) do
Inc(PText);
if Index > High(Params) then Exit;
SetString(PString(Params[Index])^, First, PText - First);
Inc(Index);
end;
'%': begin
if PText^ <> '%' then Exit;
Inc(PText);
end;
else
Exit;
end
end
else
if PMask^ = '%' then
Token := True
else
if UpCase(PMask^) <> UpCase(PText^) then
Exit
else
Inc(PText);
Inc(PMask)
end;
Result := True;
end;
procedure TgrdKeyDetector.SetClassGUID(const Value: TGUID);
begin
if not IsEqualGUID(FClassGUID, Value) then begin
FClassGUID := Value;
Close;
Open;
end;
end;
procedure TgrdKeyDetector.WndProc(var aMsg: TMessage);
begin
with aMsg do
if (Msg = WM_DEVICECHANGE)
and ((wParam = DBT_DEVICEARRIVAL) or (wParam = DBT_DEVICEREMOVECOMPLETE)) then try
DoDeviceChange(wParam, PDevBroadcastDeviceInterface(lParam));
except
if Assigned(ApplicationHandleException) then
ApplicationHandleException(Self)
else
raise;
end
else
DefWindowProc(FWndHandle, Msg, wParam, lParam);
end;
end.
Как использовать:
uses
...grdKeyDetector;
...
TfrmMain = class(TForm)
private
fKD: TgrdKeyDetector;
procedure KOnChanged(Sender: TObject; VID, PID: Word;
const Serial, GUID: string; Operation: TDeviceOperation);
public
procedure Start();
procedure Stop();
public
{ Public declarations }
end;
...
procedure TfrmMain.Start();
begin
if not Assigned(fKD) then begin
fKD := TgrdKeyDetector.Create;
fKD.OnChange := KOnChanged;
end;
end;
procedure TfrmMain.Stop();
begin
if Assigned(fKD) then
FreeAndNil(fKD);
end;
procedure TfrmMain.KOnChanged(Sender: TObject; VID, PID: Word; const Serial,
GUID: string; Operation: TDeviceOperation);
var
fStr: string;
begin
case Operation of
doInsert: fStr := ' Inserted!';
doRemove: fStr := 'Removed!';
end;
ShowMessage(fStr);
end;
