Как получить список HID устройств и возможность откл./вкл. событий этих устройств?

infopol · #1 07.09.2023, 07:36

Приветствую! Очень нужно. JEDI установить не удалось.
Задача - определения HID устройства - клавиатура, и функция отключения и включения событий.

lmikle · #2 08.09.2023, 09:27

Глянь тут: https://stackoverflow.com/questions/...us%3B%20end%3B

infopol · #3 09.09.2023, 07:25

Ознакомлюсь.надеюсь получиться сделать функцию DLL

Код:

procedure EnumDevices( List:TStrings);
var
  DevInfo:HDEVINFO;
  InfoData:SP_DEVINFO_DATA;
  I,A,Size,DType:DWORD;
  Buffer,PC:PChar;
  GUID:TGUID;
begin
  I:=0;
  while True do begin
    if CM_Enumerate_Classes(I,GUID,0)=CR_NO_SUCH_VALUE then Break;
    DevInfo:=SetupDiGetClassDevs(@GUID,nil,0,DIGCF_PRESENT);
    if DevInfo<>HDEVINFO(INVALID_HANDLE_VALUE) then try
      InfoData.cbSize:=SizeOf(InfoData);
      A:=0;
      Buffer:=nil;
      try
        while SetupDiEnumDeviceInfo(DevInfo,A,InfoData) do begin
          Size:=0;
          while not SetupDiGetDeviceRegistryProperty(DevInfo,InfoData,SPDRP_HARDWAREID,DType,Pointer(Buffer),Size,Size) do
            if GetLastError=ERROR_INSUFFICIENT_BUFFER then
              ReallocMem(Buffer,Size)
            else
              Exit;
          PC:=Buffer;
          while PC^<>#0 do begin
            List.Add(PC);
            PC:=StrEnd(PC)+1;
          end;
          Inc(A);
        end;
      finally
        FreeMem(Buffer);
      end;
    finally
      SetupDiDestroyDeviceInfoList(DevInfo);
    end;
    Inc(I);
  end;
end;

в строке if CM_Enumerate_Classes(I,GUID,0)=CR_NO_SUCH_VALUE then Break; выдается ошибка undeclare identifier

infopol · #4 09.09.2023, 12:22

Код:

Type
  THIDUSBDeviceInfo = Record   { contains interface level information of each device}
    SymLink            : String;
    BufferSize         : Word;
    Handle             : THandle;
    VID                : DWord;
    PID                : DWord;
    VersionNumber      : Word;
    ManufacturerString : String;
    ProductString      : String;
    SerialNumberString : String;
  end;
  THIDDeviceList = Array of THIDUSBDeviceInfo;

Const
  HIDUSB_COUNTOFINTERRUPTBUFFERS = 64;   // Count of buffers for interrupt data


procedure EnumDevices( List:TStrings);
var
  DevInfo:HDEVINFO;
  InfoData:SP_DEVINFO_DATA;
  I,A,Size,DType:DWORD;
  Buffer,PC:PChar;
  GUID:TGUID;
begin
  I:=0;
  while True do begin
    if CM_Enumerate_Classes(I,GUID,0)=CR_NO_SUCH_VALUE then Break;
    DevInfo:=SetupDiGetClassDevs(@GUID,nil,0,DIGCF_PRESENT);
    if DevInfo<>HDEVINFO(INVALID_HANDLE_VALUE) then try
      InfoData.cbSize:=SizeOf(InfoData);
      A:=0;
      Buffer:=nil;
      try
        while SetupDiEnumDeviceInfo(DevInfo,A,InfoData) do begin
          Size:=0;
          while not SetupDiGetDeviceRegistryProperty(DevInfo,InfoData,SPDRP_HARDWAREID,DType,Pointer(Buffer),Size,Size) do
            if GetLastError=ERROR_INSUFFICIENT_BUFFER then
              ReallocMem(Buffer,Size)
            else
              Exit;
          PC:=Buffer;
          while PC^<>#0 do begin
            List.Add(PC);
            PC:=StrEnd(PC)+1;
          end;
          Inc(A);
        end;
      finally
        FreeMem(Buffer);
      end;
    finally
      SetupDiDestroyDeviceInfoList(DevInfo);
    end;
    Inc(I);
  end;
end;

if CM_Enumerate_Classes(I,GUID,0)=CR_NO_SUCH_VALUE then Break;
undeclare identifier

infopol · #5 09.09.2023, 16:29

Код:

uses 
 CfgMgr32;// Добавил 
procedure ScanForHIDdevices( Var DeviceList : THIDDeviceList;
    TargetVID, TargetPID  : DWord);
Var
  HID_GUIid     : TGUID;
  spdid        : TSPDeviceInterfaceData;
  pSpDidd      : PSPDEVICEINTERFACEDETAILDATAA;
  spddd        : TSPDevInfoData;
  HIDinfo       : HDEVINFO;
  CurIdx       : Integer;
  dwSize       : DWord;
pdwSize       : DWord;// добавил, почему то в примере PDWORD;

  SymbolicLink : String;
  DevHandle    : THandle;
  HidAttrs     : THIDDAttributes;
  FoundIdx     : Integer;
  Info         : THIDUSBDeviceInfo;

  Function GetHidDeviceInfo( Symlink : PChar) : THIDUSBDeviceInfo;
  Var
    pstr          : pWideChar;
    preparsedData : PHIDPPreparsedData;
    hidCaps       : THIDPCaps;
  Begin

    FillChar(Result, SizeOf( Result), 0);
    Result.SymLink := SymLink+ #0;
    GetMem( pstr, 512);
    DevHandle := CreateFile( Symlink,
                             GENERIC_READ or GENERIC_WRITE,
                             FILE_SHARE_READ or FILE_SHARE_WRITE,
                             nil,
                             OPEN_EXISTING,
                             0,
                             0);


    If DevHandle <> INVALID_HANDLE_VALUE then
    begin
      If HidD_GetAttributes( DevHandle,
                             HidAttrs) then
      begin
        result.VID           := HidAttrs.VendorID;
        result.PID           := HidAttrs.ProductID;
        result.VersionNumber := HidAttrs.VersionNumber;
      end;

      If HidD_GetManufacturerString( DevHandle, pstr, 512) then
        Result.ManufacturerString := pStr;

      If HidD_GetProductString( DevHandle, pstr, 512) then
        Result.ProductString := pStr;

      If HidD_GetSerialNumberString( DevHandle, pstr, 512) then
        Result.SerialNumberString := pStr;

      { Set Input buffer size }
      HidD_SetNumInputBuffers( DevHandle,
                               HIDUSB_COUNTOFINTERRUPTBUFFERS);

      { Get capabilities }
      HidD_GetPreparsedData( DevHandle, preparsedData);

      if HidD_GetPreparsedData( DevHandle, preparsedData)


       then
      begin
        HidP_GetCaps( preparsedData, hidCaps);
        Result.BufferSize := hidCaps.OutputReportByteLength;
      end
      else
       Result.BufferSize := 11;

      closeHandle( DevHandle);
    end;
    FreeMem( pStr);
  End;

Begin
  FoundIdx   := 0;
  DeviceList := Nil;
  { Get GUID of hid class }
//ShowMessage(GUIDToString( HID_GUIid));
//  abort;
  HidD_GetHidGuid( HID_GUIid);
ShowMessage(GUIDToString( HID_GUIid));

 abort;
  { Get a list of devices belonging to HID class }
  HIDinfo := SetupDiGetClassDevs( @HID_GUIid,
                                  nil,
                                  GetDesktopWindow(),
                                  DIGCF_DEVICEINTERFACE or DIGCF_PRESENT);
  { Go through list of devices }
//  abort;

  If thandle(HIDinfo) <> INVALID_HANDLE_VALUE then
  begin
    CurIdx := 0;
    spdid.cbSize := SizeOf(spdid);
    While SetupDiEnumDeviceInterfaces( HIDinfo,
                                       nil,
                                       HID_GUIid,
                                       curIdx,
                                        spdid) do
    begin
      dwSize := 0;
      { Get device path for Createfile calls }


      SetupDiGetDeviceInterfaceDetail( HIDinfo,
                                       @spdid,
                                       nil,
                                       dwSize,
                                       pdwSize,
                                       nil);

      If dwSize > 0 then
      begin
        GetMem(pSpDidd, pdwSize);
        pSpDidd^.cbSize := SizeOf( TSPDEVICEINTERFACEDETAILDATAA);
        spddd.cbSize    := SizeOf(spddd);
        If SetupDiGetDeviceInterfaceDetail( HIDinfo,
                                            @spdid,
                                            pSpDidd,
                                            dwSize,
                                            pdwSize,
                                            @spddd) then
        begin
          SymbolicLink := PChar( @(pSpDidd^.DevicePath));

          { Get information about the device (Vendor and
            Product IDs, Strings, ...) }
          FillChar(info, SizeOf(Info), 0);
          Info        := GetHidDeviceInfo( @(pSpDidd^.DevicePath));
          Info.Handle := INVALID_HANDLE_VALUE;

          { check if VID/PID match targets }
          If (Info.VID = TargetVID) AND
             (Info.PID = TargetPID) then
          begin
            { Add Devices to result list }
            SetLength(DeviceList, FoundIdx + 1);
            DeviceList[foundIdx] := Info;
            Inc(FoundIdx);
          end
          else  // list all HID devices if no target is specified
            If (TargetVID = 0) AND (TargetPID = 0) then
            begin
              { Add Devices to result list }
              SetLength( DeviceList, FoundIdx + 1);
              DeviceList[FoundIdx] := Info;

              Inc(FoundIdx);
            end;
        end;

        FreeMem( pSpDidd);
      end;
      inc(CurIdx);
    end;
    SetupDiDestroyDeviceInfoList( HIDinfo);
  end;
End;

Запускаю кнопкой выполнение Access violation at address 0000000

lmikle · #6 10.09.2023, 02:21

скорее всего либо какой-то объект не создан, либо возвращается 0, а ты это не проверяешь. На какой строке вываливается дебаггер?

infopol · #7 10.09.2023, 06:54

Я так понял это функция из HID.pas .
Вот есть такая процедура,она тоже вызывает аналогичную ошибку

Код:

procedure EnumDevices( List:TStrings);
var
  DevInfo:HDEVINFO;
  InfoData:SP_DEVINFO_DATA;
  I,A,Size,DType:DWORD;
  Buffer,PC:PChar;
  GUID:TGUID;
begin
  I:=0;
  while True do begin

    if CM_Enumerate_Classes(I,GUID,0)=CR_NO_SUCH_VALUE then Break;
    DevInfo:=SetupDiGetClassDevs(@GUID,nil,0,DIGCF_PRESENT);
    if DevInfo<>HDEVINFO(INVALID_HANDLE_VALUE) then try
      InfoData.cbSize:=SizeOf(InfoData);
      A:=0;
      Buffer:=nil;
      try
        while SetupDiEnumDeviceInfo(DevInfo,A,InfoData) do begin
          Size:=0;
          while not SetupDiGetDeviceRegistryProperty(DevInfo,InfoData,SPDRP_HARDWAREID,DType,Pointer(Buffer),Size,Size) do
            if GetLastError=ERROR_INSUFFICIENT_BUFFER then
              ReallocMem(Buffer,Size)
            else
              Exit;
          PC:=Buffer;
          while PC^<>#0 do begin
            List.Add(PC);
            PC:=StrEnd(PC)+1;
          end;
          Inc(A);
        end;
      finally
        FreeMem(Buffer);
      end;
    finally
      SetupDiDestroyDeviceInfoList(DevInfo);
    end;
    Inc(I);
  end;
end;

При вызове CM_Enumerate_Classes(I,GUID,0) появляется ошибка

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	RSS лента	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Новости сайта Новости форума	Ссылки и Баннеры Donate О сайте Реклама Контакты

Этот пользователь сказал Спасибо lmikle за это полезное сообщение:
infopol (09.09.2023)