module1.bas

Visual basic in embeddd systems to inhance th gui

    (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), _
            0&, _
            OPEN_EXISTING, _
            FILE_FLAG_OVERLAPPED, _
            0)

    Call DisplayResultOfAPICall("CreateFile, ReadHandle")
    Call PrepareForOverlappedTransfer
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)
    If (ThisByte And &HF0) = 0 Then
        Result$ = Result$ & "0"
    End If
    Result$ = Result$ & Hex$(ThisByte) & " "
Next Offset

GetDataString = Result$
End Function

Private Function GetErrorString _
    (ByVal LastError As Long) _
As String

'Returns the error message for the last error.
'Adapted from Dan Appleman's "Win32 API Puzzle Book"

Dim Bytes As Long
Dim ErrorString As String
ErrorString = String$(129, 0)
Bytes = FormatMessage _
    (FORMAT_MESSAGE_FROM_SYSTEM, _
    0&, _
    LastError, _
    0, _
    ErrorString$, _
    128, _
    0)
    
'Subtract two characters from the message to strip the CR and LF.
If Bytes > 2 Then
    GetErrorString = Left$(ErrorString, Bytes - 2)
End If

End Function

Private Sub DisplayResultOfAPICall(FunctionName As String)

'Display the results of an API call.

Dim ErrorString As String

'lstResults.AddItem ""
ErrorString = GetErrorString(Err.LastDllError)
'lstResults.AddItem FunctionName
'lstResults.AddItem "  Result = " & ErrorString

'Scroll to the bottom of the list box.
'lstResults.ListIndex = lstResults.ListCount - 1

End Sub


Private Sub GetDeviceCapabilities()

'******************************************************************************
'HidD_GetPreparsedData
'Returns: a pointer to a buffer containing information about the device's capabilities.
'Requires: A handle returned by CreateFile.
'There's no need to access the buffer directly,
'but HidP_GetCaps and other API functions require a pointer to the buffer.
'******************************************************************************

Dim ppData(29) As Byte
Dim ppDataString As Variant

'Preparsed Data is a pointer to a routine-allocated buffer.
Result = HidD_GetPreparsedData _
    (HIDHandle, _
    PreparsedData)
Call DisplayResultOfAPICall("HidD_GetPreparsedData")

'Copy the data at PreparsedData into a byte array.

Result = RtlMoveMemory _
    (ppData(0), _
    PreparsedData, _
    30)
Call DisplayResultOfAPICall("RtlMoveMemory")

ppDataString = ppData()
'Convert the data to Unicode.
ppDataString = StrConv(ppDataString, vbUnicode)

'******************************************************************************
'HidP_GetCaps
'Find out the device's capabilities.
'For standard devices such as joysticks, you can find out the specific
'capabilities of the device.
'For a custom device, the software will probably know what the device is capable of,
'so this call only verifies the information.
'Requires: The pointer to a buffer containing the information.
'The pointer is returned by HidD_GetPreparsedData.
'Returns: a Capabilites structure containing the information.
'******************************************************************************
Result = HidP_GetCaps _
    (PreparsedData, _
    Capabilities)

Call DisplayResultOfAPICall("HidP_GetCaps")
'lstResults.AddItem "  Last error: " & ErrorString
'lstResults.AddItem "  Usage: " & Hex$(Capabilities.Usage)
'lstResults.AddItem "  Usage Page: " & Hex$(Capabilities.UsagePage)
'lstResults.AddItem "  Input Report Byte Length: " & Capabilities.InputReportByteLength
'lstResults.AddItem "  Output Report Byte Length: " & Capabilities.OutputReportByteLength
'lstResults.AddItem "  Feature Report Byte Length: " & Capabilities.FeatureReportByteLength
'lstResults.AddItem "  Number of Link Collection Nodes: " & Capabilities.NumberLinkCollectionNodes
'lstResults.AddItem "  Number of Input Button Caps: " & Capabilities.NumberInputButtonCaps
'lstResults.AddItem "  Number of Input Value Caps: " & Capabilities.NumberInputValueCaps
'lstResults.AddItem "  Number of Input Data Indices: " & Capabilities.NumberInputDataIndices
'lstResults.AddItem "  Number of Output Button Caps: " & Capabilities.NumberOutputButtonCaps
'lstResults.AddItem "  Number of Output Value Caps: " & Capabilities.NumberOutputValueCaps
'lstResults.AddItem "  Number of Output Data Indices: " & Capabilities.NumberOutputDataIndices
'lstResults.AddItem "  Number of Feature Button Caps: " & Capabilities.NumberFeatureButtonCaps
'lstResults.AddItem "  Number of Feature Value Caps: " & Capabilities.NumberFeatureValueCaps
'lstResults.AddItem "  Number of Feature Data Indices: " & Capabilities.NumberFeatureDataIndices

'******************************************************************************
'HidP_GetValueCaps
'Returns a buffer containing an array of HidP_ValueCaps structures.
'Each structure defines the capabilities of one value.
'This application doesn't use this data.
'******************************************************************************

'This is a guess. The byte array holds the structures.
Dim ValueCaps(1023) As Byte

Result = HidP_GetValueCaps _
    (HidP_Input, _
    ValueCaps(0), _
    Capabilities.NumberInputValueCaps, _
    PreparsedData)
   
Call DisplayResultOfAPICall("HidP_GetValueCaps")

'lstResults.AddItem "ValueCaps= " & GetDataString((VarPtr(ValueCaps(0))), 180)
'To use this data, copy the byte array into an array of structures.

'Free the buffer reserved by HidD_GetPreparsedData
Result = HidD_FreePreparsedData _
    (PreparsedData)
Call DisplayResultOfAPICall("HidD_FreePreparsedData")

End Sub


Private Sub PrepareForOverlappedTransfer()

'******************************************************************************
'CreateEvent
'Creates an event object for the overlapped structure used with ReadFile.
'Requires a security attributes structure or null,
'Manual Reset = True (ResetEvent resets the manual reset object to nonsignaled),
'Initial state = True (signaled),
'and event object name (optional)
'Returns a handle to the event object.
'******************************************************************************

If EventObject = 0 Then
    EventObject = CreateEvent _
        (0&, _
        True, _
        True, _
        "")
End If
    
Call DisplayResultOfAPICall("CreateEvent")
    
'Set the members of the overlapped structure.
HIDOverlapped.Offset = 0
HIDOverlapped.OffsetHigh = 0
HIDOverlapped.hEvent = EventObject
End Sub


Public Sub WriteToDevice(b1 As Byte, b2 As Byte, b3 As Byte, b4 As Byte, b5 As Byte, b6 As Byte, b7 As Byte, b8 As Byte)
Dim Count As Integer
Dim NumberOfBytesRead As Long
Dim NumberOfBytesToSend As Long
Dim NumberOfBytesWritten As Long
Dim SendBuffer() As Byte


'If the device hasn't been detected or it timed out on a previous attempt
'to access it, look for the device.
If MyDeviceDetected = False Then
    MyDeviceDetected = FindTheHid
End If

If MyDeviceDetected = True Then

'The SendBuffer array begins at 0, so subtract 1 from the number of bytes.
    ReDim SendBuffer(Capabilities.OutputReportByteLength - 1)

'******************************************************************************
'WriteFile
'Sends a report to the device.
'Returns: success or failure.
'Requires: the handle returned by CreateFile and
'The output report byte length returned by HidP_GetCaps
'******************************************************************************

    'The first byte is the Report ID
    SendBuffer(0) = 0
    SendBuffer(1) = b1
    SendBuffer(2) = b2
    SendBuffer(3) = b3
    SendBuffer(4) = b4
    SendBuffer(5) = b5
    SendBuffer(6) = b6
    SendBuffer(7) = b7
    SendBuffer(8) = b8


    NumberOfBytesWritten = 0

    Result = WriteFile _
        (HIDHandle, _
        SendBuffer(0), _
         CLng(Capabilities.OutputReportByteLength), _
        NumberOfBytesWritten, _
        0)

    Call DisplayResultOfAPICall("WriteFile")

    ' Read a report from the device.
    ' Call ReadReport
Else
End If

End Sub

Public Function ReadReport() As Long

'Read data from the device.

Dim Count
Dim NumberOfBytesRead As Long
'Allocate a buffer for the report.
'Byte 0 is the report ID.
Dim UBoundReadBuffer As Integer

'******************************************************************************
'ReadFile
'Returns: the report in ReadBuffer.
'Requires: a device handle returned by CreateFile
'(for overlapped I/O, CreateFile must be called with FILE_FLAG_OVERLAPPED),
'the Input report length in bytes returned by HidP_GetCaps,
'and an overlapped structure whose hEvent member is set to an event object.
'******************************************************************************

Dim ReadResult As Long

Dim ByteValue As String
'The ReadBuffer array begins at 0, so subtract 1 from the number of bytes.
'ReDim ReadBuffer(Capabilities.InputReportByteLength - 1)
ReDim ReadBuffer(8)
'Scroll to the bottom of the list box.
'lstResults.ListIndex = lstResults.ListCount - 1

'Do an overlapped ReadFile.
'The function returns immediately, even if the data hasn't been received yet.
Result = ReadFile _
    (ReadHandle, _
    ReadBuffer(0), _