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;

function IsWinePresent(): boolean;
var
  fHandle: HMODULE;
begin
  Result := False;
  fHandle := GetModuleHandle('ntdll.dll');
  if fHandle = 0 then Exit;
  Result :=  Assigned(GetProcAddress(fHandle, 'wine_get_version'));
end;

Function IsItWine ; Если Wine, то возвращает в $0 не 0, иначе - 0.
  System::Call "kernel32::GetModuleHandle(t 'ntdll.dll') i .s"
  System::Call "kernel32::GetProcAddress(i s, t 'wine_get_version') i .r0"
FunctionEnd

OutFile "tst01.exe"
 
Section

  Push $0

  Call IsItWine 
    IntCmp $0 0 notWine
      MessageBox MB_OK "Wine"
      Goto next 
    notWine:
      MessageBox MB_OK "Not Wine"
    next:
  Pop $0
  
SectionEnd

Function IsItWine ; Если Wine, то возвращает в $0 не 0, иначе - 0.
  System::Call "kernel32::GetModuleHandle(t 'ntdll.dll') i .s"
  System::Call "kernel32::GetProcAddress(i s, t 'wine_get_version') i .r0"
FunctionEnd