Attribute VB_Name = "HIDmodule"
'Based upon software by Jan Axelson
'http://www.lvr.com/hidpage.htm

Option Explicit

Dim bAlertable As Long
Dim Capabilities As HIDP_CAPS
Dim DataString As String
Dim DetailData As Long
Dim DetailDataBuffer() As Byte
Dim DeviceAttributes As HIDD_ATTRIBUTES
Dim DevicePathName As String
Dim DeviceInfoSet As Long
Dim ErrorString As String
Dim EventObject As Long
Public HIDHandle As Long
Dim HIDOverlapped As OVERLAPPED
Dim LastDevice As Boolean
Public MyDeviceDetected As Boolean
Dim MyDeviceInfoData As SP_DEVINFO_DATA
Dim MyDeviceInterfaceDetailData As SP_DEVICE_INTERFACE_DETAIL_DATA
Dim MyDeviceInterfaceData As SP_DEVICE_INTERFACE_DATA
Dim Needed As Long
Dim PreparsedData As Long
Public ReadHandle As Long
Dim Result As Long
Dim Security As SECURITY_ATTRIBUTES
Public Timeout As Boolean

'Set these to match the values in the device's firmware and INF file.
'0925h is Lakeview Research's vendor ID.

Const MyVendorID = &H461
Const MyProductID = &H20

Public ReadBuffer() As Byte
Public OutputReportData(31) As Byte

Function FindTheHid() As Boolean
    'Makes a series of API calls to locate the desired HID-class device.
    'Returns True if the device is detected, False if not detected.
    
    Dim Count As Integer
    Dim GUIDString As String
    Dim HidGuid As GUID
    Dim MemberIndex As Long
    
    LastDevice = False
    MyDeviceDetected = False
    
    'Values for SECURITY_ATTRIBUTES structure:
    
    Security.lpSecurityDescriptor = 0
    Security.bInheritHandle = True
    Security.nLength = Len(Security)
    
    '******************************************************************************
    'HidD_GetHidGuid
    'Get the GUID for all system HIDs.
    'Returns: the GUID in HidGuid.
    'The routine doesn't return a value in Result
    'but the routine is declared as a function for consistency with the other API calls.
    '******************************************************************************
    
    Result = HidD_GetHidGuid(HidGuid)
    Call DisplayResultOfAPICall("GetHidGuid")
    
    'Display the GUID.
    
    GUIDString = _
        Hex$(HidGuid.Data1) & "-" & _
        Hex$(HidGuid.Data2) & "-" & _
        Hex$(HidGuid.Data3) & "-"
    
    For Count = 0 To 7
    
        'Ensure that each of the 8 bytes in the GUID displays two characters.
        
        If HidGuid.Data4(Count) >= &H10 Then
            GUIDString = GUIDString & Hex$(HidGuid.Data4(Count)) & " "
        Else
            GUIDString = GUIDString & "0" & Hex$(HidGuid.Data4(Count)) & " "
        End If
    Next Count
    
    'GUID for system HIDs = GUIDString
    
    '******************************************************************************
    'SetupDiGetClassDevs
    'Returns: a handle to a device information set for all installed devices.
    'Requires: the HidGuid returned in GetHidGuid.
    '******************************************************************************
    
    DeviceInfoSet = SetupDiGetClassDevs _
        (HidGuid, _
        vbNullString, _
        0, _
        (DIGCF_PRESENT Or DIGCF_DEVICEINTERFACE))
        
    Call DisplayResultOfAPICall("SetupDiClassDevs")
    DataString = GetDataString(DeviceInfoSet, 32)
    
    '******************************************************************************
    'SetupDiEnumDeviceInterfaces
    'On return, MyDeviceInterfaceData contains the handle to a
    'SP_DEVICE_INTERFACE_DATA structure for a detected device.
    'Requires:
    'the DeviceInfoSet returned in SetupDiGetClassDevs.
    'the HidGuid returned in GetHidGuid.
    'An index to specify a device.
    '******************************************************************************
    
    'Begin with 0 and increment until no more devices are detected.
    
    MemberIndex = 0
    
    Do
        'The cbSize element of the MyDeviceInterfaceData structure must be set to
        'the structure's size in bytes. The size is 28 bytes.
        
        MyDeviceInterfaceData.cbSize = LenB(MyDeviceInterfaceData)
        Result = SetupDiEnumDeviceInterfaces _
            (DeviceInfoSet, _
            0, _
            HidGuid, _
            MemberIndex, _
            MyDeviceInterfaceData)
        
        Call DisplayResultOfAPICall("SetupDiEnumDeviceInterfaces")
        If Result = 0 Then LastDevice = True
        
        'If a device exists, display the information returned.
        
        If Result <> 0 Then
            '"  DeviceInfoSet for device #" & CStr(MemberIndex) & ": "
            '"  cbSize = " & CStr(MyDeviceInterfaceData.cbSize)
            '"  InterfaceClassGuid.Data1 = " & Hex$(MyDeviceInterfaceData.InterfaceClassGuid.Data1)
            '"  InterfaceClassGuid.Data2 = " & Hex$(MyDeviceInterfaceData.InterfaceClassGuid.Data2)
            '"  InterfaceClassGuid.Data3 = " & Hex$(MyDeviceInterfaceData.InterfaceClassGuid.Data3)
            '"  Flags = " & Hex$(MyDeviceInterfaceData.Flags)
            
            '******************************************************************************
            'SetupDiGetDeviceInterfaceDetail
            'Returns: an SP_DEVICE_INTERFACE_DETAIL_DATA structure
            'containing information about a device.
            'To retrieve the information, call this function twice.
            'The first time returns the size of the structure in Needed.
            'The second time returns a pointer to the data in DeviceInfoSet.
            'Requires:
            'A DeviceInfoSet returned by SetupDiGetClassDevs and
            'an SP_DEVICE_INTERFACE_DATA structure returned by SetupDiEnumDeviceInterfaces.
            '*******************************************************************************
            
            MyDeviceInfoData.cbSize = Len(MyDeviceInfoData)
            Result = SetupDiGetDeviceInterfaceDetail _
               (DeviceInfoSet, _
               MyDeviceInterfaceData, _
               0, _
               0, _
               Needed, _
               0)
            
            DetailData = Needed
                
            Call DisplayResultOfAPICall("SetupDiGetDeviceInterfaceDetail")
            '(OK to say too small)
            'Required buffer size for the data = Needed
            
            'Store the structure's size.
            
            MyDeviceInterfaceDetailData.cbSize = _
                Len(MyDeviceInterfaceDetailData)
            
            'Use a byte array to allocate memory for
            'the MyDeviceInterfaceDetailData structure
            
            ReDim DetailDataBuffer(Needed)
            
            'Store cbSize in the first four bytes of the array.
            
            Call RtlMoveMemory _
                (DetailDataBuffer(0), _
                MyDeviceInterfaceDetailData, _
                4)
            
            'Call SetupDiGetDeviceInterfaceDetail again.
            'This time, pass the address of the first element of DetailDataBuffer
            'and the returned required buffer size in DetailData.
            
            Result = SetupDiGetDeviceInterfaceDetail _
               (DeviceInfoSet, _
               MyDeviceInterfaceData, _
               VarPtr(DetailDataBuffer(0)), _
               DetailData, _
               Needed, _
               0)
            
            Call DisplayResultOfAPICall(" Result of second call: ")
            'MyDeviceInterfaceDetailData.cbSize = CStr(MyDeviceInterfaceDetailData.cbSize)
            
            'Convert the byte array to a string.
            
            DevicePathName = CStr(DetailDataBuffer())
            
            'Convert to Unicode.
            
            DevicePathName = StrConv(DevicePathName, vbUnicode)
            
            'Strip cbSize (4 bytes) from the beginning.
            
            DevicePathName = Right$(DevicePathName, Len(DevicePathName) - 4)
            'Device pathname = DevicePathName
                    
            '******************************************************************************
            'CreateFile
            'Returns: a handle that enables reading and writing to the device.
            'Requires:
            'The DevicePathName returned by SetupDiGetDeviceInterfaceDetail.
            '******************************************************************************
        
            HIDHandle = CreateFile _
                (DevicePathName, _
                GENERIC_READ Or GENERIC_WRITE, _
                (FILE_SHARE_READ Or FILE_SHARE_WRITE), _
                Security, _
                OPEN_EXISTING, _
                0&, _
                0)
                
            Call DisplayResultOfAPICall("CreateFile")
            'Returned handle = HIDHandle
            
            'Now we can find out if it's the device we're looking for.
            
            '******************************************************************************
            'HidD_GetAttributes
            'Requests information from the device.
            'Requires: The handle returned by CreateFile.
            'Returns: an HIDD_ATTRIBUTES structure containing
            'the Vendor ID, Product ID, and Product Version Number.
            'Use this information to determine if the detected device
            'is the one we're looking for.
            '******************************************************************************
            
            'Set the Size property to the number of bytes in the structure.
            
            DeviceAttributes.Size = LenB(DeviceAttributes)
            Result = HidD_GetAttributes _
                (HIDHandle, _
                DeviceAttributes)
                
            Call DisplayResultOfAPICall("HidD_GetAttributes")
            If Result <> 0 Then
                'HIDD_ATTRIBUTES structure filled without error.
            Else
                'Error in filling HIDD_ATTRIBUTES structure.
            End If
        
            'Structure size = DeviceAttributes.Size
            'Vendor ID = Hex$(DeviceAttributes.VendorID)
            'Product ID = Hex$(DeviceAttributes.ProductID)
            'Version Number = Hex$(DeviceAttributes.VersionNumber)
            
            'Find out if the device matches the one we're looking for.
            
            If (DeviceAttributes.VendorID = MyVendorID) And _
                (DeviceAttributes.ProductID = MyProductID) Then
                    
                    'It's the desired device.
                    
                    'My device detected
                    MyDeviceDetected = True
            Else
                    MyDeviceDetected = False
                    
                    'If it's not the one we want, close its handle.
                    Result = CloseHandle _
                        (HIDHandle)
                    DisplayResultOfAPICall ("CloseHandle")
            End If
    End If
        
        'Keep looking until we find the device or there are no more left to examine.
        
        MemberIndex = MemberIndex + 1
    Loop Until (LastDevice = True) Or (MyDeviceDetected = True)
    
    'Free the memory reserved for the DeviceInfoSet returned by SetupDiGetClassDevs.
    
    Result = SetupDiDestroyDeviceInfoList _
        (DeviceInfoSet)
    Call DisplayResultOfAPICall("DestroyDeviceInfoList")
    
    If MyDeviceDetected = True Then
        FindTheHid = True
        
        'Learn the capabilities of the device
         
         Call GetDeviceCapabilities
        
        'Get another handle for the overlapped ReadFiles.
        
        ReadHandle = CreateFile _
                (DevicePathName, _
                (GENERIC_READ Or GENERIC_WRITE), _
                (FILE_SHARE_READ Or FILE_SHARE_WRITE), _
                Security, _
                OPEN_EXISTING, _
                FILE_FLAG_OVERLAPPED, _
                0)
     
        Call DisplayResultOfAPICall("CreateFile, ReadHandle")
        'Returned handle = ReadHandle
        Call PrepareForOverlappedTransfer
    Else
        'Device not found
    End If
End Function

Private Function GetDataString _
    (Address As Long, _
    Bytes As Long) _
As String
    'Retrieves a string of length Bytes from memory, beginning at Address.
    'Adapted from Dan Appleman's "Win32 API Puzzle Book"
    
    Dim Offset As Integer
    Dim Result$
    Dim ThisByte As Byte
    
    For Offset = 0 To Bytes - 1
        Call RtlMoveMemory(ByVal VarPtr(ThisByte), ByVal Address + Offset, 1)