module1.bas

FTDI设备测试和校准源程序。FT232R为例

    Saved_Port_Value = &H8                      ' set the initial state of the first 8 lines
    ' set the low byte
    AddToBuffer &H80                            ' Set data bits low byte command
    AddToBuffer &H8                             ' set CS=high, DI=low, DO=low, SK=low
    AddToBuffer &HB                             ' CS=output, DI=input, DO=output, SK=output
    ' set the clock divisor
    AddToBuffer &H86                            ' set clock divisor command to 1MHz
    AddToBuffer &H5                             ' low byte
    AddToBuffer &H0                             ' high byte
    AddToBuffer &H85                            ' turn off loopback
    SendBytes OutIndex                          ' send to command processor
    
    ' check for a bad command being echoed back
    Res = Get_USB_Device_QueueStatus
    If FT_Q_Bytes > 0 Or Res <> 0 Then
        Form1.shpOK.BackColor = Yellow
        Form1.lblStatus.Caption = "Possible bad command detected in procedure OpenDevice."
        Exit Sub
    End If
    
    Form1.shpOK.BackColor = Green               ' set status to green
    Form1.lblStatus.Caption = "OK"              ' set OK
    
End Sub

Public Function OpenPort(PortName As String) As Boolean
' to open the port named PortName
Dim Res As Long
Dim NoOfDevs As Long
Dim I As Long
Dim Name As String
Dim DualName As String

    PortAIsOpen = False                         ' init to port not open
    OpenPort = False                            ' init to failure to open port
    Name = ""                                   ' set name to null
    DualName = PortName                         ' set which port we want to open
    NoOfDevs = GetFTDeviceCount                 ' get the number of devices
    If FT_Result <> FT_OK Then Exit Function    ' exit if failure
    
    ' try to find the requested port
    For I = 0 To NoOfDevs - 1
       Name = GetFTDeviceDescription(I)         ' get the device desctiption
       If Name = DualName Then Exit For         ' exit if this is the one
    Next
    
    If Name <> DualName Then Exit Function      ' exit if not found
    
    Res = Open_USB_Device_By_Description(DualName) ' open the device by its description
    If FT_Result <> FT_OK Then Exit Function    ' exit if failure
    
    Res = Get_USB_Device_QueueStatus            ' perform a test function on the port
    If FT_Result <> FT_OK Then Exit Function    ' exit if failure
    PortAIsOpen = True                          ' flag port as open
    OpenPort = True                             ' return open OK

End Function

Public Function Read_USB_Device_Buffer(Read_Count As Long) As Long
' Reads Read_Count bytes or less from the USB device to the FT_In_Buffer
' The function returns the number of bytes actually received which may range from zero
' to the actual number of bytes requested, depending on how many have been received
' at the time of the request + the read timeout value.
Dim Read_Result As Long

    If Read_Count = 1 Then Read_Result = Read_Count
    
    FT_IO_Status = FT_Read(FT_HANDLE, FT_In_Buffer, Read_Count, Read_Result)
    If FT_IO_Status <> FT_OK Then
        FT_Error_Report "FT_Read", FT_IO_Status
    End If
    Read_USB_Device_Buffer = Read_Result
    
End Function

Public Sub SendBytes(NumberOfBytes As Long)
Dim I As Long

    I = Write_USB_Device_Buffer(NumberOfBytes)
    OutIndex = OutIndex - I
    
End Sub

Public Function Set_USB_Device_BitMode(ucMask As Byte, ucEnable As Byte) As Long

    Set_USB_Device_BitMode = FT_SetBitMode(FT_HANDLE, ucMask, ucEnable)
    
End Function

Public Function Set_USB_Device_LatencyTimer(ucLatency As Byte) As Long

    Set_USB_Device_LatencyTimer = FT_SetLatencyTimer(FT_HANDLE, ucLatency)
    
End Function

Public Sub SetDeviceString(S As String)
' set the device name

    FT_Device_String_Buffer = S & Chr(0)
    
End Sub

Public Function Sync_To_MPSSE() As Boolean
' uses &HAA and &HAB commands which are invalid so that the MPSSE processor should
' echo these back to use preceded with &HFA
Dim Res As Long
Dim I As Long
Dim J As Long

    Sync_To_MPSSE = False
    
    ' clear anything in the input buffer
    Res = Get_USB_Device_QueueStatus
    If Res <> FT_OK Then Exit Function
    If FT_Q_Bytes > 0 Then
        ' read chunks of 'input buffer size'
        Do While FT_Q_Bytes > FT_In_Buffer_Size
            I = Read_USB_Device_Buffer(FT_In_Buffer_Size) ' read a chunk
            FT_Q_Bytes = FT_Q_Bytes - FT_In_Buffer_Size ' calculate bytes left
        Loop
        I = Read_USB_Device_Buffer(FT_Q_Bytes) ' read the final bytes
    End If
    
    ' put a bad command to the command processor
    OutIndex = 0 ' point to start of buffer
    AddToBuffer &HAA ' add a bad command
    SendBytes OutIndex  ' send to command processor
    ' wait for a response
    Do
        Res = Get_USB_Device_QueueStatus
    Loop Until (FT_Q_Bytes > 0) Or (Res <> FT_OK)
    If Res <> FT_OK Then Exit Function
    
    ' read the input queue
    I = Read_USB_Device_Buffer(FT_Q_Bytes) ' read the bytes
    For J = 1 To I
        If Mid(FT_In_Buffer, J, 1) = Chr(&HAA) Then
            Sync_To_MPSSE = True
            Exit Function
        End If
    Next
        
End Function

Public Sub TakeReading()
' take a single read of the ADC
Dim BitTest As Byte
Dim Res As Long
Dim Byte0 As Byte
Dim Byte1 As Byte
Dim I As Long
Dim Reading0 As Integer
Dim Reading1 As Integer
Dim LoopLimit As Integer

    ' set CS low to initiate a conversion in the MAX187 ADC
    Saved_Port_Value = Saved_Port_Value And &HF7    ' set CS=low
    AddToBuffer &H80                                ' Set data bits low byte command
    AddToBuffer CLng(Saved_Port_Value)
    AddToBuffer &HB                                 ' CS=output, DI=input, DO=output, SK=output
    SendBytes OutIndex                              ' send to command processor
    
    ' check for bad command
    Res = Get_USB_Device_QueueStatus
    If FT_Q_Bytes > 0 Or Res <> 0 Then
        Form1.shpOK.BackColor = Yellow
        Form1.lblStatus.Caption = "Possible bad command detected in procedure TakeReading when initiating an ADC conversion."
    End If
    
    ' wait for DI to go high - raised by DO on the MAX187 to signal conversion complete
    LoopLimit = 0                                   ' clear the limit counter
    Do
        AddToBuffer &H81                            ' read data bits low byte
        AddToBuffer &H87                            ' send back results immediately
        SendBytes OutIndex                          ' send to command processor
        LoopLimit = LoopLimit + 1
        Do
            Res = Get_USB_Device_QueueStatus '
        Loop Until (FT_Q_Bytes > 0) Or (Res <> FT_OK) ' wait for answer to be available
        If Res <> FT_OK Then
            Form1.shpOK.BackColor = Red
            StopReading = True
            Form1.lblStatus.Caption = "Get USB device queue status failed in procedureTakeReading."
            Exit Sub
        End If
        ' read the input queue
        I = Read_USB_Device_Buffer(FT_Q_Bytes)      ' read the byte
        BitTest = CByte(Asc(Mid(FT_In_Buffer, 1, 1))) And &H4 ' check if conversion complete
    Loop Until BitTest <> &H0 Or LoopLimit > 100
    
    If LoopLimit > 100 Then
        Form1.shpOK.BackColor = Yellow
        StopReading = True
        Form1.lblStatus.Caption = "No reading received - please check the ADC power is turned on."
    Else
        Form1.shpOK.BackColor = Green
        Form1.lblStatus.Caption = "OK"
    End If
    
    ' Clock data in. 2 bytes on -ve clock MSB first, no write
    AddToBuffer &H24                                ' read bytes on -ve clock MSB
    AddToBuffer &H1                                 ' LSB value 2
    AddToBuffer &H0                                 ' MSB value 0
    AddToBuffer &H87                                ' do it now
    SendBytes OutIndex
    ' wait for data to become available
    Do
        Res = Get_USB_Device_QueueStatus '
    Loop Until (FT_Q_Bytes > 0) Or (Res <> FT_OK)   ' wait for answer to be available
    If Res <> FT_OK Then
        Form1.shpOK.BackColor = Red
        StopReading = True
        Form1.lblStatus.Caption = "Get USB device queue status failed while waiting to read an ADC conversion."
        Exit Sub
    End If
    ' read the input queue
    I = Read_USB_Device_Buffer(FT_Q_Bytes)          ' read the bytes
    ' the MAX187 sends 1 start bit followed by 7 data bits in the first byte, then the
    ' remaining 5 data bits in the second byte. We must join the 2 together...
    Byte0 = CByte(Asc(Mid(FT_In_Buffer, 1, 1)))     ' convert to byte format
    Byte1 = CByte(Asc(Mid(FT_In_Buffer, 2, 1)))     ' convert to byte format
    Byte0 = Byte0 And &H7F                          ' drop the start bit put there by the MAX187
    Reading0 = Reading0 Or Byte0                    ' convert the MSB to integer
    Reading0 = Reading0 * 32                        ' shift left 5 bits
    Reading1 = Reading1 Or Byte1                    ' convert the LSB to integer
    Reading1 = Reading1 \ 8                         ' shift right 3 bits
    Reading = Reading0 + Reading1                   ' add both together
    
    ' turn CS high
    Saved_Port_Value = Saved_Port_Value Or &H8      ' set CS=high
    AddToBuffer &H80                                ' Set data bits low byte command
    AddToBuffer CLng(Saved_Port_Value)
    AddToBuffer &HB                                 ' CS=output, DI=input, DO=output, SK=output
    SendBytes OutIndex                              ' send to command processor
    
    ' check got a reading
    If Reading = 0 Then
        Form1.shpOK.BackColor = Yellow
        StopReading = True
        Form1.lblStatus.Caption = "No reading received - please check the ADC power is turned on."
        Exit Sub
    Else
        Form1.shpOK.BackColor = Green
        Form1.lblStatus.Caption = "OK"
    End If

End Sub

Public Function Write_USB_Device_Buffer(Write_Count As Long) As Long
Dim Write_Result As Long

    FT_IO_Status = FT_Write(FT_HANDLE, FT_Out_Buffer, Write_Count, Write_Result)
    If FT_IO_Status <> FT_OK Then FT_Error_Report "FT-Write", FT_IO_Status
    Write_USB_Device_Buffer = Write_Result
    
End Function