Option ExplicitPrivate Const DIGCF_PRESENT = &H2
Private Const DIGCF_DEVICEINTERFACE = &H10
'Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const HidP_Input = 0
Private Const HidP_Output = 1
Private Const HidP_Feature = 2
Private Const OPEN_EXISTING = 3
Private Const INVALID_HANDLE_VALUE = -1
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type
Private Type HIDD_ATTRIBUTES
    Size As Long
    VendorID As Integer
    ProductID As Integer
    VersionNumber As Integer
End Type
Private Type SP_DEVINFO_DATA
    cbSize As Long
    ClassGuid As GUID
    DevInst As Long
    Reserved As Long
End Type
Private Type SP_DEVICE_INTERFACE_DATA
    cbSize As Long
    InterfaceClassGuid As GUID
    Flags As Long
    Reserved As Long
End Type
Private Type SP_DEVICE_INTERFACE_DETAIL_DATA
    cbSize As Long
    DevicePath As Byte
End TypePrivate Declare Sub InitCommonControls Lib "comctl32" ()
Private Declare Function HidD_GetHidGuid Lib "hid.dll" (ByRef HidGuid As GUID) As Long
Private Declare Function HidD_GetAttributes Lib "hid.dll" (ByVal HidDeviceObject As Long, ByRef Attributes As HIDD_ATTRIBUTES) As Long
Private Declare Function HidP_GetvalueCaps Lib "hid.dll" (ByVal ReportType As Integer, ByRef valueCaps As Byte, ByRef valueCapsLength As Integer, ByVal PreparsedData As Long) As Long
Private Declare Function HidD_GetPreparsedData Lib "hid.dll" (ByVal HidDeviceObject As Long, ByRef PreparsedData As Long) As Long
Private Declare Function HidD_FreePreparsedData Lib "hid.dll" (ByRef PreparsedData As Long) As Long
'Private Declare Function HidP_GetCaps Lib "hid.dll" (ByVal PreparsedData As Long, ByRef Capabilities As HIDP_CAPS) As Long
Private Declare Function SetupDiGetClassDevs Lib "setupapi.dll" Alias "SetupDiGetClassDevsA" (ByRef ClassGuid As GUID, ByVal Enumerator As String, ByVal hwndParent As Long, ByVal Flags As Long) As Long
Private Declare Function SetupDiEnumDeviceInterfaces Lib "setupapi.dll" (ByVal DeviceInfoSet As Long, ByVal DeviceInfoData As Long, ByRef InterfaceClassGuid As GUID, ByVal MenberIndex As Long, ByRef DeviceInterfaceData As SP_DEVICE_INTERFACE_DATA) As Long
Private Declare Function SetupDiGetDeviceInterfaceDetail Lib "setupapi.dll" Alias "SetupDiGetDeviceInterfaceDetailA" (ByVal DeviceInfoSet As Long, ByRef DeviceInterfaceData As SP_DEVICE_INTERFACE_DATA, ByVal DeviceInterfaceDetailData As Long, ByVal DeviceInterfaceDetailDataSize As Long, ByRef RequiredSize As Long, ByVal DeviceInfoData As Long) As Long
Private Declare Function SetupDiDestroyDeviceInfoList Lib "setupapi.dll" (ByVal DeviceInfoSet As Long) As Long
'Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As Variant, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByRef lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
'Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As LongPrivate Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, ByRef lpNumberOfBytesRead As Long, lpOverlapped As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, ByRef lpBuffer As Byte, ByVal nNumberOfBytesToWrite As Long, ByRef lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, source As Any, ByVal Length As Long)
Private Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End Type
'Private Const FILE_FLAG_DELETE_ON_CLOSE = &H4000000
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000'private Result1 as Long ,Result2 as Long
Private Const MVID = &HB04
Private Const MPID = &H8613Private Function GTS(Address As Long, Bytes As Long) As String
    Dim Offset As Integer
    Dim Result As String
    Dim ThisByte As Byte
    For Offset = 0 To Bytes - 1
        Call CopyMemory(ByVal VarPtr(ThisByte), ByVal Address + Offset, 1)
        If (ThisByte And &HF0) = 0 Then
            Result = Result & "0"
        End If
        Result = Result & Hex(ThisByte) & " "
    Next Offset
    
    GTS = Result
    
End Function
Private Sub Command1_Click()
    Dim cg As Integer
    Dim cs As String
    Dim hg As GUID
    Dim mb As Long
    Dim rr As Long
    Dim r2 As Long
    rr = HidD_GetHidGuid(hg)
    r2 = SetupDiGetClassDevs(hg, vbNullString, 0, DIGCF_PRESENT Or DIGCF_DEVICEINTERFACE)
    Dim dss As String
    dss = GTS(r2, 32)
    mb = 0
    Dim jk As SP_DEVICE_INTERFACE_DATA
    Dim ll As Boolean
    
    ll = False
    Dim Needed As Long
    Dim n2 As Long
    Dim dd() As Byte
    Dim aaa As SECURITY_ATTRIBUTES
    Dim jk2 As SP_DEVICE_INTERFACE_DETAIL_DATA
    Dim jk3 As SP_DEVINFO_DATA
    Dim Ded As Long
    Dim dp As String
    Dim dp2 As Variant
    Dim hiid As Long
    Dim jjj As HIDD_ATTRIBUTES
    mb = 0
    Dim hh As String
    Do
      
      jk.cbSize = LenB(jk)
      
      rr = SetupDiEnumDeviceInterfaces(r2, 0, hg, mb, jk)
      If rr = 0 Then ll = True
      If rr <> 0 Then
         jk3.cbSize = LenB(jk3)
         
         rr = SetupDiGetDeviceInterfaceDetail(r2, jk, 0, 0, Needed, 0)
         n2 = Needed
         jk2.cbSize = Len(jk2)
         ReDim dd(Needed) As Byte
         Call CopyMemory(dd(0), jk2, 4)
         rr = SetupDiGetDeviceInterfaceDetail(r2, jk, VarPtr(dd(0)), n2, Needed, 0)
         dp = CStr(dd)
         dp = StrConv(dp, vbUnicode)
         dp = Right$(dp, Len(dp) - 4)
         dp = Left(dp, Len(dp) - 2)'         dp2 = dp
         hiid = CreateFile(dp, GENERIC_READ Or GENERIC_WRITE, (FILE_SHARE_READ Or FILE_SHARE_WRITE), aaa, OPEN_EXISTING, 0, 0)
         hh = ges(-1)
         If hiid = -1 Then GoTo 10
         jjj.Size = LenB(jjj.Size)
         rr = HidD_GetAttributes(hiid, jjj)
         rr = CloseHandle(hiid)
      End If
10
      mb = mb + 1
    Loop Until mb = 1
End Sub