usb_to_serial.frm

usb serial converter

      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      Height          =   255
      Index           =   5
      Left            =   8520
      TabIndex        =   25
      Top             =   2280
      Width           =   735
   End
   Begin VB.Label lblswitch 
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      Height          =   255
      Index           =   4
      Left            =   8520
      TabIndex        =   24
      Top             =   2040
      Width           =   735
   End
   Begin VB.Label lblswitch 
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      Height          =   255
      Index           =   3
      Left            =   8520
      TabIndex        =   23
      Top             =   1800
      Width           =   735
   End
   Begin VB.Label lblswitch 
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      Height          =   255
      Index           =   2
      Left            =   8520
      TabIndex        =   22
      Top             =   1560
      Width           =   735
   End
   Begin VB.Label lblswitch 
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      Height          =   255
      Index           =   1
      Left            =   8520
      TabIndex        =   21
      Top             =   1320
      Width           =   735
   End
   Begin VB.Label lblswitch 
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      Height          =   255
      Index           =   0
      Left            =   8520
      TabIndex        =   20
      Top             =   1080
      Width           =   735
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'Project: USB_to_Serial.vbp
'Version: 1.0
'Date: 08/21/01

'This code is a modified version of Jan Axelson's Project: usbhidio.vbp
'To view a copy of the original usbhidio.vbp progject visit www.lvr.com

'This code builds upon the basic three functions from usbhidio.vbp: findtheHID, ReadFile, and WriteFile

'''''''''''''''''''''''''''''''
'Major functional Differences:'
'''''''''''''''''''''''''''''''
'Set_Feature_Report added to send configuration data such as baud rate, parity, etc. to USB to Serial.
'Broke the read and write dependency.  Read and Write can now be done seperately.

'''''''''''''''''''''''''''''''
'Purpose:                     '
'''''''''''''''''''''''''''''''
'To be used as a basic learning tool for HID communication to USB to Serial.
'Demonstrates proper API calls to locate, connect, and communicate to a HID device.

'''''''''''''''''''''''''''''''
'Precautions                  '
'''''''''''''''''''''''''''''''
'As with Jan Axelson's code, when this code calls the ReadFile it will hang until data is valid and
'   ready to by read.
'In the Form_Load function there is a build option for which microcontroller is being used in USB to Serial.
'The code will need to be recompiled for each microcontroller, CY7C64013 and CY7C63743.


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 HidDevice As Long
Dim LastDevice As Boolean
Dim 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 OutputReportData(7) As Byte
Dim PreparsedData As Long
Dim Result As Long
Dim Timeout As Boolean
Dim Show_hid_only As Boolean
Dim Connected As Boolean
Dim DeviceDetected As Boolean
Dim ReadValueTemp As Byte
Dim LEDResetFlag As Boolean
Dim LEDClickWrite   As Byte

Dim CY7C63743 As Boolean
Dim CY7C64013 As Boolean

'Set these to match the values in the device's firmware and INF file.
Dim MyVendorID As String
Dim MyProductID As String

Private Sub Cmd_showHIDs_Click()
Text2.Text = ""
Show_hid_only = True
DeviceDetected = FindTheHid
End Sub

Private Sub cmdExit_Click()

Result = CloseHandle(HidDevice)

Result = SetupDiDestroyDeviceInfoList(DeviceInfoSet)

Result = HidD_FreePreparsedData(PreparsedData)
End
End Sub

Private Sub Command_Connect_Click()
'This routine calls FindTheHid and attempts to connect to the device.

If txtVID.Text = "" Or txtPID.Text = "" Then
    Text1.Text = "Please Connect"
    txtVID.BackColor = &HFF&
    txtPID.BackColor = &HFF&
    Text1.BackColor = &H80FFFF
Else
    Result = CloseHandle(HidDevice)
    MyVendorID = txtVID.Text
    MyProductID = txtPID.Text
    txtVID.BackColor = &H80000005
    txtPID.BackColor = &H80000005
    Text1.BackColor = &H80000005

    DeviceDetected = FindTheHid
    Call initGraphics(1)
    Call Set_Feature_Report
    txtConfig.Text = "Configured: Baud Rate = 9600, Mode = 8-N-1"
    
End If

End Sub

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
Dim TempVID As String
Dim TempPID As String

LastDevice = False
MyDeviceDetected = False

'******************************************************************************
'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)


'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


'******************************************************************************
'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))
    
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)
    'If No device Detected then skip to end of FindHid function
    If Result = 0 Then LastDevice = True
    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)
        
        
        '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)
                
        '******************************************************************************
        '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)
            
        
        '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 _
            (HidDevice, _
            DeviceAttributes)
            
        Dim VID As String
        Dim PID As String
        VID = Hex$(DeviceAttributes.VendorID)
        PID = Hex$(DeviceAttributes.ProductID)
        'Find out if the device matches the one we're looking for.
        If (VID = MyVendorID) And _
            (PID = MyProductID) And (Show_hid_only = False) Then
                MyDeviceDetected = True
        Else
                MyDeviceDetected = False
                'If it's not the one we want, close its handle.
                Result = CloseHandle _
                    (HidDevice)
                If (Show_hid_only = True And (TempVID <> VID Or TempPID <> PID)) Then
                    Text2.Text = Text2.Text _
                    + "VID " + VID + Chr(13) + Chr(10) + "PID " + PID _
                    + Chr(13) + Chr(10) + Chr(13) + Chr(10)
                TempVID = VID
                TempPID = PID
                End If
        End If

    MemberIndex = MemberIndex + 1
    
End If
Loop Until (LastDevice = True) Or (MyDeviceDetected = True)

If MyDeviceDetected = True Then

    Call GetDeviceCapabilities

    Text1.BackColor = &H80000005
    FindTheHid = True
    Text1.Text = "Device Found and Connected"
    Connected = True
    Call Set_Feature_Report
    txtConfig.Text = "Configured: Baud Rate = 9600, Mode = 8-N-1"
    
Else
    Text1.BackColor = &H80FFFF
    If Show_hid_only = True Then
        Text1.Text = "Please Reconnect"
        txtConfig.Text = ""
    Else
        Text1.Text = "Device Not Found"
    End If
End If


Show_hid_only = False

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) _