frmmain.frm

usb communciation with Visual Basic

'the structure's size in bytes. The size is 28 bytes.
    MyDeviceInterfaceData.cbSize = LenB(MyDeviceInterfaceData)
    Result = SetupDiEnumDeviceInterfaces _
        (DeviceInfoSet, _
        0, _
        HidGuid, _
        MemberIndex, _
        MyDeviceInterfaceData)
    If Result = 0 Then LastDevice = True
'If a device exists, get more information, check for our VID/PID
    If Result <> 0 Then
        
        '******************************************************************************
        '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
            
'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)
        DevicePathName = CStr(DetailDataBuffer())   'Convert the byte array to a string.
        DevicePathName = StrConv(DevicePathName, vbUnicode) 'Convert to Unicode.
'Strip cbSize (4 bytes) from the beginning.
        DevicePathName = Right$(DevicePathName, Len(DevicePathName) - 4)
        '******************************************************************************
        'CreateFile
        'Returns: a handle that enables reading and writing to the device.
        'Requires:
        'The DevicePathName returned by SetupDiGetDeviceInterfaceDetail.
        '******************************************************************************
        HidDevice = CreateFile _
            (DevicePathName, _
            GENERIC_READ Or GENERIC_WRITE, _
            (FILE_SHARE_READ Or FILE_SHARE_WRITE), _
            0, _
            OPEN_EXISTING, _
            0, _
            0)
        
'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 _
            (HidDevice, _
            DeviceAttributes)
            
'Find out if the device matches the one we're looking for.
        If (DeviceAttributes.VendorID = MyVendorID) And _
            (DeviceAttributes.ProductID = MyProductID) Then
                MyDeviceDetected = True
        Else
                MyDeviceDetected = False
                'If it's not the one we want, close its handle.
                Result = CloseHandle _
                    (HidDevice)
        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)

If MyDeviceDetected = True Then
    FindTheHid = True
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 cmdDPBUT_Click()    ' update the decimal point display
If dp = 0 Then
    dp = 255
    shDP.FillColor = vbBlack
Else
    dp = 0
    shDP.FillColor = vbRed
End If
End Sub
'_____________________________________________________________
Private Sub Form_Load()
frmMain.Show
tmrDelay.Enabled = False
Call Startup
End Sub
'_____________________________________________________________
Private Sub Form_Unload(Cancel As Integer)
Call Shutdown
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 _
    (HidDevice, _
    PreparsedData)
'Copy the data at PreparsedData into a byte array.

Result = RtlMoveMemory _
    (ppData(0), _
    PreparsedData, _
    30)

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)

'******************************************************************************
'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)
End Sub
'_____________________________________________________________
Private Sub ReadReport()    'Read data from the device.
Dim NumberOfBytesRead As Long
Dim ReadBuffer() As Byte 'Allocate a buffer for the report.Byte 0 is the report ID.

'******************************************************************************
'ReadFile (a blocking call, hangs if no IN data)
'Returns: the report in ReadBuffer.
'Requires: a device handle returned by CreateFile,
'the Input report length in bytes returned by HidP_GetCaps.
'******************************************************************************
Dim readval As Byte
'The ReadBuffer array begins at 0, so subtract 1 from the number of bytes.
ReDim ReadBuffer(Capabilities.InputReportByteLength - 1)
    
'Pass the address of the first byte of the read buffer.
Result = ReadFile _
    (HidDevice, _
    ReadBuffer(0), _
    CLng(Capabilities.InputReportByteLength), _
    NumberOfBytesRead, _
    0)

tb7SEG = Hex$(ReadBuffer(1))        ' put first byte value into text box (7-seg value)
readval = ReadBuffer(2)             ' get button states
If (readval And 1) Then
    but(0).FillColor = vbGreen
    If hsRate.Value > 1 Then hsRate.Value = hsRate.Value - 1
    Else: but(0).FillColor = vbBlack
End If
If (readval And 2) Then
    but(1).FillColor = vbGreen
    dp = 0
    shDP.FillColor = vbRed
    Else: but(1).FillColor = vbBlack
End If
If (readval And 4) Then
    but(2).FillColor = vbGreen
    dp = 255
    shDP.FillColor = vbBlack
    Else: but(2).FillColor = vbBlack
End If
If (readval And 8) Then
    but(3).FillColor = vbGreen
    If hsRate.Value < 30 Then hsRate.Value = hsRate.Value + 1
Else: but(3).FillColor = vbBlack
End If
End Sub
'_____________________________________________________________
Private Sub Shutdown()
'stop acquiring data
Do While busy = 1       ' don't shut down during a HID request
Loop
tmrRWData.Enabled = False    ' disable timer
'Close the open handle to the device.
Result = CloseHandle(HidDevice)
'Free memory used by SetupDiGetClassDevs
'Nonzero = success
Result = SetupDiDestroyDeviceInfoList(DeviceInfoSet)
Result = HidD_FreePreparsedData(PreparsedData)
End Sub

'_____________________________________________________________
Private Sub tmrRWData_Timer()
Call ReadAndWriteToDevice
End Sub
'_____________________________________________________________
Private Sub WriteReport()   'Send data to the device.
Dim NumberOfBytesWritten As Long
Dim SendBuffer() As Byte

'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
'******************************************************************************
SendBuffer(0) = 0                   'The first byte is the Report ID
SendBuffer(1) = 31 - hsRate.Value   ' next 2 bytes are data--rate
SendBuffer(2) = dp                  ' decimal point

NumberOfBytesWritten = 0

Result = WriteFile _
    (HidDevice, _
    SendBuffer(0), _
    CLng(Capabilities.OutputReportByteLength), _
    NumberOfBytesWritten, _
    0)
End Sub