Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > ОС и железо
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 07.09.2023, 07:36
infopol infopol вне форума
Прохожий
 
Регистрация: 03.06.2021
Сообщения: 35
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Как получить список HID устройств и возможность откл./вкл. событий этих устройств?

Приветствую! Очень нужно. JEDI установить не удалось.
Задача - определения HID устройства - клавиатура, и функция отключения и включения событий.
Ответить с цитированием
  #2  
Старый 08.09.2023, 09:27
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,051
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Глянь тут: https://stackoverflow.com/questions/...us%3B%20end%3B
Ответить с цитированием
Этот пользователь сказал Спасибо lmikle за это полезное сообщение:
infopol (09.09.2023)
  #3  
Старый 09.09.2023, 07:25
infopol infopol вне форума
Прохожий
 
Регистрация: 03.06.2021
Сообщения: 35
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Спасибо.Попробую

Ознакомлюсь.надеюсь получиться сделать функцию 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, 09.09.2023 в 12:20.
Ответить с цитированием
  #4  
Старый 09.09.2023, 12:22
infopol infopol вне форума
Прохожий
 
Регистрация: 03.06.2021
Сообщения: 35
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию В процедуре ошибка

Код:
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
Ответить с цитированием
  #5  
Старый 09.09.2023, 16:29
infopol infopol вне форума
Прохожий
 
Регистрация: 03.06.2021
Сообщения: 35
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Немного переделал процедуру,но ошибка

Код:
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
Ответить с цитированием
  #6  
Старый 10.09.2023, 02:21
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,051
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

скорее всего либо какой-то объект не создан, либо возвращается 0, а ты это не проверяешь. На какой строке вываливается дебаггер?
Ответить с цитированием
  #7  
Старый 10.09.2023, 06:54
infopol infopol вне форума
Прохожий
 
Регистрация: 03.06.2021
Сообщения: 35
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Ошибка при вызове HidD_GetHidGuid( HID_GUIid);

Я так понял это функция из 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) появляется ошибка

Последний раз редактировалось infopol, 10.09.2023 в 06:57.
Ответить с цитированием
  #8  
Старый 10.09.2023, 23:09
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,051
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Ну не знаю. У меня работает - возвращает список гуидов.
Возможно, ты что-то с импортом функции напутал.
Код:
const
  CR_SUCCESS       = $00000000;
  CR_NO_SUCH_VALUE = $00000025;

function CM_Enumerate_Classes(ulClassIndex : Cardinal; var ClassGuid : TGUID; ulFlags : Cardinal) : DWORD; stdcall; external 'Cfgmgr32.dll';

procedure TForm1.Button1Click(Sender: TObject);
var
  Idx : Integer;
  DevGUID : TGUID;
  iRet : DWORD;
begin
  Idx := 0;
  iRet := CM_Enumerate_Classes(Idx,DevGUID,0);
  While iRet = CR_SUCCESS Do
    Begin
      Memo1.Lines.Add(GUIDToString(DevGUID));
      Inc(Idx);
      iRet := CM_Enumerate_Classes(Idx,DevGUID,0);
    End;
  ShowMessage(Format('Last function return is %s',[IntToHex(iRet,2)]));
end;
Ответить с цитированием
Этот пользователь сказал Спасибо lmikle за это полезное сообщение:
infopol (11.09.2023)
  #9  
Старый 11.09.2023, 07:23
infopol infopol вне форума
Прохожий
 
Регистрация: 03.06.2021
Сообщения: 35
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Это у меня тоже работает.

А вот тут затык
{ Get a list of devices belonging to HID class }
Код:
 
HidD_GetHidGuid( HID_GUIid); // Вызов этой процедуры дает ошибку
 
 HIDinfo := SetupDiGetClassDevs( @HID_GUIid,
                                  nil,
                                  GetDesktopWindow(),
                                  DIGCF_DEVICEINTERFACE or DIGCF_PRESENT);
Это можно пропустить, но как получить информация об устройствах?
нашел функцию
Код:
Function GetHidDeviceInfo( Symlink : PChar) : THIDUSBDeviceInfo;
  Var
    pstr          : pWideChar;
    preparsedData : PHIDPPreparsedData;
    hidCaps       : THIDPCaps;
  Begin
 //  abort;
    FillChar(Result, SizeOf( Result), 0);
    Result.SymLink := SymLink+ #0;
    GetMem( pstr, 512);
 //   abort;
    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;


;
Чтобы это работало нужно как то запустить LoadHid();
Не найдена точка входа в процедуру advapi32.EventSetInformation в DLL api-ms-win-eventing-provider-l1-1-0.dll

Последний раз редактировалось infopol, 11.09.2023 в 16:40. Причина: Изменение
Ответить с цитированием
  #10  
Старый 11.09.2023, 20:33
infopol infopol вне форума
Прохожий
 
Регистрация: 03.06.2021
Сообщения: 35
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Загрузил 64 разрядную HID.DLL

Код:
procedure TForm1.Button2Click(Sender: TObject);
Var
  List:TStrings;
  DeviceList : THIDDeviceList;
  I          : Integer;
  HID_GUIid :TGUID;
  begin
 LoadHid();
LoadSetupApi();
  // Abort;
//EnumDevices(list);
 //  HidD_GetHidGuid
 //HidD_GetHidGuid( HID_GUIid);
//Abort;
  ScanForHIDdevices( DeviceList, 0, 0);

  Memo1.Lines.Clear;
  Memo1.Lines.Add(IntToStr(Length(DeviceList)) + ' device(s) found');
  If Length(DeviceList) > 0 then
    For I := 0 to Length(DeviceList)-1 do
      With DeviceList[i] do
      begin
        Memo1.Lines.Add('Device Number : '   + IntToStr(I));
        Memo1.Lines.Add('Symbolic link : '   + SymLink);
        Memo1.Lines.Add('Handle        : 0x' + IntToHex(Handle, 1));
        Memo1.Lines.Add('Buffer size   : '   + IntToStr(BufferSize));
        Memo1.Lines.Add('VID           : 0x' + IntToHex(VID, 4));
        Memo1.Lines.Add('PID           : 0x' + IntToHex(PID, 4));
        Memo1.Lines.Add('Version       : '   + IntToStr(VersionNumber));
        Memo1.Lines.Add('Manufacturer  : '   + ManufacturerString);
        Memo1.Lines.Add('Product name  : '   + ProductString);
        Memo1.Lines.Add('Serial number : '   + SerialNumberString);
        Memo1.Lines.Add(' ');
      end;
  Memo1.SetFocus;



unLoadHid();
unLoadSetupApi();
 end;
0 device(s) found
Ответить с цитированием
  #11  
Старый 12.09.2023, 07:31
infopol infopol вне форума
Прохожий
 
Регистрация: 03.06.2021
Сообщения: 35
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Сделал такой unit

EnumDevices( List) дает ошибку
ScanForHIDdevices( DeviceList, 0, 0) вообще ничего не дает
Вложения
Тип файла: pas HIDCOM.pas (15.5 Кбайт, 1 просмотров)
Тип файла: pas Hid.pas (116.7 Кбайт, 1 просмотров)
Ответить с цитированием
  #12  
Старый 12.09.2023, 09:14
infopol infopol вне форума
Прохожий
 
Регистрация: 03.06.2021
Сообщения: 35
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию c procedure EnumDevices(var List:TStrings) разобрался

Код:
procedure EnumDevices(var List:TStrings);
var
  InfoData:SP_DEVINFO_DATA;
  I,A,Size,DType:DWORD;
  Buffer,PC:PChar;
  GUID:TGUID;
begin
 LoadSetupApi();
      List:=TStringList.Create;
 LoadHid();
  I:=0;
//  CM_Enumerate_Classes(I,GUID,0);
 // abort;
  while True do begin

    if CM_Enumerate_Classes(I,GUID,0)=CR_NO_SUCH_VALUE then Break;
    DevInfo:=SetupDiGetClassDevs(@GUID,nil,0,DIGCF_PRESENT);
// abort;
    if DevInfo<>HDEVINFO(INVALID_HANDLE_VALUE) then
    try
    //  exit;
      InfoData.cbSize:=SizeOf(InfoData);
      A:=0;
      Buffer:=nil;
      //Exit;
      try
        while SetupDiEnumDeviceInfo(DevInfo,A,InfoData) do begin
          Size:=0;

          while not SetupDiGetDeviceRegistryProperty(DevInfo,InfoData,SPDRP_HARDWAREID,DType,Pointer(Buffer),Size,Size)
           do
          begin

         // Exit;
            if GetLastError=ERROR_INSUFFICIENT_BUFFER then
              ReallocMem(Buffer,Size)
            else
              Exit;
            end;
          PC:=Buffer;
        // exit;
          while PC^<>#0 do begin

            List.Add(String(PC));
          PC:=StrEnd(PC)+1;
          end;

      //    Exit;
          Inc(A);
        end;
      finally

//            break;
          // Exit;
          FreeMem(Buffer);
    end;
 //   Exit;
    finally
  //  Exit;
                     SetupDiDestroyDeviceInfoList(@DevInfo);
      //       SetupDiDestroyDeviceInfoList(DevInfo);
    end;
    Inc(I);
  end;
  UnLoadSetupApi();
  UnLoadHid();
end;
а вот procedure ScanForHIDdevices( Var DeviceList : THIDDeviceList;
TargetVID, TargetPID : DWord); ничего не выдает


Код:
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;

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

  Function GetHidDeviceInfo( Symlink : PChar) : THIDUSBDeviceInfo;
  Var
    pstr          : pWideChar;
    preparsedData : PHIDPPreparsedData;
    hidCaps       : THIDPCaps;
  Begin
 //  abort;
 LoadHid();
    FillChar(Result, SizeOf( Result), 0);
    Result.SymLink := SymLink+ #0;
    GetMem( pstr, 512);
 //   abort;
    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
 LoadHid();

    LoadSetupApi();

  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 }


  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 pdwSize > 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;
Ответить с цитированием
  #13  
Старый 20.09.2023, 21:53
infopol infopol вне форума
Прохожий
 
Регистрация: 03.06.2021
Сообщения: 35
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Функция нужна чтобы отключить события HID клавиатуры при использовании сканера штри

При установке сканера в режиме HIDUSB нужно отключить события HID клавиатры,которая устанавливается при загрузке драйвера
HID\VID_25A7&PID_0701&REV_1001 {4D36E96B-E325-11CE-BFC1-08002BE10318} > 4588
HID\VID_25A7&PID_0701 {4D36E96B-E325-11CE-BFC1-08002BE10318} > 4588
HID_DEVICE_SYSTEM_KEYBOARD {4D36E96B-E325-11CE-BFC1-08002BE10318} > 4588
HID_DEVICE_UP:0001_U:0006 {4D36E96B-E325-11CE-BFC1-08002BE10318} > 4588
HID_DEVICE {4D36E96B-E325-11CE-BFC1-08002BE10318} > 4588

Последний раз редактировалось infopol, 20.09.2023 в 22:12.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 18:42.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter