module1.bas

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

            Str = ErrStr & " - Invalid Parameter"
        Case FT_INVALID_BAUD_RATE
            Str = ErrStr & " - Invalid Baud Rate"
        Case FT_DEVICE_NOT_OPENED_FOR_ERASE
            Str = ErrStr & " - Device not opened for Erase"
        Case FT_DEVICE_NOT_OPENED_FOR_WRITE
            Str = ErrStr & " - Device not opened for Write"
        Case FT_FAILED_TO_WRITE_DEVICE
            Str = ErrStr & " - Failed to write Device"
        Case FT_EEPROM_READ_FAILED
            Str = ErrStr & " - EEPROM read failed"
        Case FT_EEPROM_WRITE_FAILED
            Str = ErrStr & " - EEPROM write failed"
        Case FT_EEPROM_ERASE_FAILED
            Str = ErrStr & " - EEPROM erase failed"
        Case FT_EEPROM_NOT_PRESENT
            Str = ErrStr & " - EEPROM not present"
        Case FT_EEPROM_NOT_PROGRAMMED
            Str = ErrStr & " - EEPROM not programmed"
        Case FT_INVALID_ARGS
            Str = ErrStr & " - Invalid Arguments"
        Case FT_NOT_SUPPORTED
            Str = ErrStr & " - not supported"
        Case FT_OTHER_ERROR
            Str = ErrStr & " - other error"
    End Select
    
    Form1.shpOK.BackColor = Red                     ' turn status indicator red
    StopReading = True                              ' turn off continuous readings
    Form1.lblStatus.Caption = Str                   ' show the message in the status area
    MsgBox Str                                      ' display the message
    
End Sub

Public Function Get_USB_Device_QueueStatus() As Long
' return the number of bytes waiting to be read

    FT_Result = FT_GetQueueStatus(FT_HANDLE, FT_Q_Bytes)
    If FT_Result <> FT_OK Then
        FT_Error_Report "FT_GetQueueStatus", FT_Result
    End If
    Get_USB_Device_QueueStatus = FT_Result

End Function

Public Function GetDeviceString() As String
' get the device name

    GetDeviceString = Left(FT_Device_String_Buffer, InStr(FT_Device_String_Buffer, Chr(0)) - 1)
    
End Function

Public Function GetFTDeviceCount() As Long
' get the number of connected devices
    
    FT_Result = FT_GetNumDevices(FT_Device_Count, 0, FT_LIST_NUMBER_ONLY)
    If FT_Result = FT_OK Then
        GetFTDeviceCount = FT_Device_Count          ' return the number of devices
    Else
        FT_Error_Report "GetFTDeviceCount", FT_Result ' show error message
        GetFTDeviceCount = 0                        ' return 0 devices
    End If
    
End Function

Public Function GetFTDeviceDescription(DeviceIndex As Long) As String
' get the device description of a specific device
    
    FT_Result = FT_ListDevices(DeviceIndex, FT_Device_String_Buffer, (FT_OPEN_BY_DESCRIPTION Or FT_LIST_BY_INDEX))
    If FT_Result = FT_OK Then
        FT_Device_String = GetDeviceString          ' strip off trailing nulls
        GetFTDeviceDescription = FT_Device_String   ' return the character part
    Else
        FT_Error_Report "GetFTDeviceDescription", FT_Result
        GetFTDeviceDescription = ""                 ' init to null
    End If
    
End Function

Public Function GetFTDeviceSerialNo(DeviceIndex As Long) As String
' get the serial number of a specific device
    
    FT_Result = FT_ListDevices(DeviceIndex, FT_Device_String_Buffer, (FT_OPEN_BY_SERIAL_NUMBER Or FT_LIST_BY_INDEX))
    If FT_Result = FT_OK Then
        FT_Device_String = GetDeviceString          ' strip off trailing nulls
        GetFTDeviceSerialNo = FT_Device_String      ' return the character part
    Else
        FT_Error_Report "GetFTDeviceSerialNo", FT_Result
        GetFTDeviceSerialNo = ""                    ' init to null
    End If
    
End Function

Public Function Init_Controller(DName As String) As Boolean
' initialise the controller on port DName

    Init_Controller = OpenPort(DName)               ' open the port

End Function

Public Sub InitialiseVariables()
' initialise variables

    RegKey = "FTBMeter"
    OurDevice = "DLP2232M A"                        ' set the name of our DLP2232M
    ZerodBmHF = GetSetting(RegKey, "Settings", "ZerodBmHF", 2556)
    ZerodBmVHF = GetSetting(RegKey, "Settings", "ZerodBmVHF", 2519)
    ZerodBmUHF = GetSetting(RegKey, "Settings", "ZerodBmUHF", 2501)
    Minus40dBmHF = GetSetting(RegKey, "Settings", "Minus40dBmHF", 915)
    Minus40dBmVHF = GetSetting(RegKey, "Settings", "Minus40dBmVHF", 913)
    Minus40dBmUHF = GetSetting(RegKey, "Settings", "Minus40dBmUHF", 872)
    ZerodBm = ZerodBmVHF
    Minus40dBm = Minus40dBmVHF
    Slope = (ZerodBm - Minus40dBm) / 40
    Form1.cmdHF.BackColor = ButtonFace
    Form1.cmdVHF.BackColor = Green
    Form1.cmdUHF.BackColor = ButtonFace

End Sub

Public Function Open_USB_Device_By_Description(Device_Description As String) As Long

    SetDeviceString Device_Description
    FT_Result = FT_OpenEx(FT_Device_String_Buffer, FT_OPEN_BY_DESCRIPTION, FT_HANDLE)
    If FT_Result <> FT_OK Then
        FT_Error_Report "Open_USB_Device_By_Description", FT_Result
    End If
    
End Function

Public Sub OpenDevice()
' open the DLP2232M module by name. The A port is the only one that can be used for MPSSE SPI
' communications.
Dim I As Long
Dim X As Long
Dim DeviceDescription As String
Dim FoundDevice As Boolean
Dim Res As Long

    'FT_OK
    FT_STATUS = FT_Open(0, FT_HANDLE)
    If (FT_STATUS = FT_OK) Then
    FT_STATUS = FT_SetBitMode(FT_HANDLE, &HFF, &H20)
    FT_STATUS = FT_SetBitMode(FT_HANDLE, &HF0, &H20)
    FT_STATUS = FT_SetBitMode(FT_HANDLE, &HFF, &H20)
    'FT_STATUS = FT_SetBitMode(FT_HANDLE, &HF, &H20)
    'FT_STATUS = FT_SetBitMode(FT_HANDLE, &HF0, &H20)
    
    'CBUS0 OUTPUT 1 CBUS1 OUTPUT 1

    'CBUS0 OUTPUT 0 CBUS1 OUTPUT 0
    Else
    FT_STATUS = 1
    Form1.lblStatus.Caption = "Attempt to open FT232RL FAILURE."

    Exit Sub
    End If
    FT_Close (FT_HANDLE)
    
    
    ' if the port is already open then close it
    If PortAIsOpen Then
        Res = Close_USB_Device
        If FT_Result <> FT_OK Then
            PortAIsOpen = False
            Form1.shpOK.BackColor = Red
            Form1.lblStatus.Caption = "Attempt to close DLP2232M failed."
            StopReading = True
            Exit Sub
        End If
    End If

     
    ' set port A not open
    PortAIsOpen = False
    
    ' see if anything connected
    X = GetFTDeviceCount
    If X = 0 Then
        Form1.shpOK.BackColor = Yellow
        Form1.lblStatus.Caption = "No FTDI devices found. Please connect the meter and re-try"
        Exit Sub
    End If
    
    ' get the descriptions and look for DLP module channel A
    For I = 0 To FT_Device_Count - 1
        DeviceDescription = GetFTDeviceDescription(I)
        If FT_Result = FT_OK Then
            If DeviceDescription = OurDevice Then
                FoundDevice = True
                Exit For
            End If
        End If
    Next

    ' check we have a DLP A module found
    If Not (FoundDevice) Then
        Form1.shpOK.BackColor = Yellow
        Form1.lblStatus.Caption = "No DLP2232M A device found. Please re-connect the meter and re-try"
        Exit Sub
    End If
    
    ' open by the device description
    Open_USB_Device_By_Description DeviceDescription
    If FT_Result <> FT_OK Then
        Form1.shpOK.BackColor = Red
        StopReading = True
        Form1.lblStatus.Caption = "The open for the meter did not complete successfully."
        Exit Sub
    End If
    
    ' try a command
    Res = Get_USB_Device_QueueStatus
    If FT_Result <> FT_OK Then
        Form1.shpOK.BackColor = Red
        StopReading = True
        Form1.lblStatus.Caption = "Get USB Device QueuStatus command failed in procedure OpenDevice"
        Exit Sub
    End If
    PortAIsOpen = True
    
    ' set the latency
    FT_Result = Set_USB_Device_LatencyTimer(16)
    If FT_Result <> FT_OK Then
        Form1.shpOK.BackColor = Red
        StopReading = True
        Form1.lblStatus.Caption = "Set USB Device Latency Timer failed"
        Exit Sub
    End If
    
    ' reset the controller
    FT_Result = Set_USB_Device_BitMode(&H0, &H0) ' reset the controller
    If FT_Result <> FT_OK Then
        Form1.shpOK.BackColor = Red
        StopReading = True
        Form1.lblStatus.Caption = "Device reset failed in procedure OpenDevice."
        Exit Sub
    End If
    
    ' set the module to MPSSE mode
    FT_Result = Set_USB_Device_BitMode(&H0, &H2) ' set to MPSSE mode
    If FT_Result <> FT_OK Then
        Form1.shpOK.BackColor = Red
        StopReading = True
        Form1.lblStatus.Caption = "Set to MPSSE mode failed in procedure OpenDevice."
        Exit Sub
    End If
    
    ' sync MPSSE mode
    If Not (Sync_To_MPSSE) Then
        Form1.shpOK.BackColor = Red
        StopReading = True
        Form1.lblStatus.Caption = "Unable to synchronise the MPSSE write/read cycle in procedure OpenDevice."
        Exit Sub
    End If
    
    ' initialise the port
    OutIndex = 0                                ' point to the start of output buffer