module1.bas

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

Attribute VB_Name = "Module1"
Option Explicit
Public RegKey As String                             ' name of registry key
Public ZerodBm As Single                            ' calibration level of 0dBm for current range
Public ZerodBmHF As Single                          ' calibration level of 0dBm for HF
Public ZerodBmVHF As Single                         ' calibration level of 0dBm for VHF
Public ZerodBmUHF As Single                         ' calibration level of 0dBm for UHF
Public Minus40dBm As Single                         ' calibration level of -40dBm for current range
Public Minus40dBmHF As Single                       ' calibration level of -40dBm for HF
Public Minus40dBmVHF As Single                      ' calibration level of -40dBm for VHF
Public Minus40dBmUHF As Single                      ' calibration level of -40dBm for UHF
Public Slope As Single                              ' number of reading units per dBm
Public Const Green = &HFF00&
Public Const Red = &HFF&
Public Const White = &HFFFFFF
Public Const Yellow = &HFFFF&
Public Const ButtonFace = &H8000000F
Public NumberOfReadings                             ' number of readings taken when continuous
Public StopReading As Boolean                       ' true = stop continuous readings
Public OurDevice As String                          ' the name of our DLP2232 device
Public Reading As Single                            ' actual value of reading from ADC
Public Saved_Port_Value As Byte                     ' the setting of the first 8 data lines
Public OutIndex As Long                             ' position within the output buffer
Public PortAIsOpen As Boolean                       ' true = the DLP2232M chan A is open

'==============================
'CLASSIC INTERFACE DECLARATIONS
'==============================
Public Declare Function FT_ListDevices Lib "FTD2XX.DLL" ( _
                                    ByVal arg1 As Long, _
                                    ByVal arg2 As String, _
                                    ByVal dwFlags As Long) As Long
                                    
Public Declare Function FT_GetNumDevices Lib "FTD2XX.DLL" Alias "FT_ListDevices" ( _
                                    ByRef arg1 As Long, _
                                    ByVal arg2 As String, _
                                    ByVal dwFlags As Long) As Long
                                    
Public Declare Function FT_Open Lib "FTD2XX.DLL" ( _
                                    ByVal intDeviceNumber As Integer, _
                                    ByRef lngHandle As Long) As Long
                                    
Public Declare Function FT_OpenEx Lib "FTD2XX.DLL" ( _
                                    ByVal arg1 As String, _
                                    ByVal arg2 As Long, _
                                    ByRef lngHandle As Long) As Long
                                    
Public Declare Function FT_Close Lib "FTD2XX.DLL" ( _
                                    ByVal lngHandle As Long) As Long
                                    
Public Declare Function FT_Read Lib "FTD2XX.DLL" ( _
                                    ByVal lngHandle As Long, _
                                    ByVal lpszBuffer As String, _
                                    ByVal lngBufferSize As Long, _
                                    ByRef lngBytesReturned As Long) As Long
                                    
Public Declare Function FT_Write Lib "FTD2XX.DLL" ( _
                                    ByVal lngHandle As Long, _
                                    ByVal lpszBuffer As String, _
                                    ByVal lngBufferSize As Long, _
                                    ByRef lngBytesWritten As Long) As Long
                                    
Public Declare Function FT_WriteByte Lib "FTD2XX.DLL" Alias "FT_Write" ( _
                                    ByVal lngHandle As Long, _
                                    ByRef lpszBuffer As Any, _
                                    ByVal lngBufferSize As Long, _
                                    ByRef lngBytesWritten As Long) As Long
                                    
Public Declare Function FT_SetBaudRate Lib "FTD2XX.DLL" ( _
                                    ByVal lngHandle As Long, _
                                    ByVal lngBaudRate As Long) As Long
                                    
Public Declare Function FT_SetDataCharacteristics Lib "FTD2XX.DLL" ( _
                                    ByVal lngHandle As Long, _
                                    ByVal byWordLength As Byte, _
                                    ByVal byStopBits As Byte, _
                                    ByVal byParity As Byte) As Long
                                    
Public Declare Function FT_SetFlowControl Lib "FTD2XX.DLL" ( _
                                    ByVal lngHandle As Long, _
                                    ByVal intFlowControl As Integer, _
                                    ByVal byXonChar As Byte, _
                                    ByVal byXoffChar As Byte) As Long
                                    
Public Declare Function FT_SetDtr Lib "FTD2XX.DLL" ( _
                                    ByVal lngHandle As Long) As Long
                                    
Public Declare Function FT_ClrDtr Lib "FTD2XX.DLL" ( _
                                    ByVal lngHandle As Long) As Long
                                    
Public Declare Function FT_SetRts Lib "FTD2XX.DLL" ( _
                                    ByVal lngHandle As Long) As Long
                                    
Public Declare Function FT_ClrRts Lib "FTD2XX.DLL" ( _
                                    ByVal lngHandle As Long) As Long
                                    
Public Declare Function FT_GetModemStatus Lib "FTD2XX.DLL" ( _
                                    ByVal lngHandle As Long, _
                                    ByRef lngModemStatus As Long) As Long
                                    
Public Declare Function FT_SetChars Lib "FTD2XX.DLL" ( _
                                    ByVal lngHandle As Long, _
                                    ByVal byEventChar As Byte, _
                                    ByVal byEventCharEnabled As Byte, _
                                    ByVal byErrorChar As Byte, _
                                    ByVal byErrorCharEnabled As Byte) As Long
                                    
Public Declare Function FT_Purge Lib "FTD2XX.DLL" ( _
                                    ByVal lngHandle As Long, _
                                    ByVal lngMask As Long) As Long
                                    
Public Declare Function FT_SetTimeouts Lib "FTD2XX.DLL" ( _
                                    ByVal lngHandle As Long, _
                                    ByVal lngReadTimeout As Long, _
                                    ByVal lngWriteTimeout As Long) As Long
                                    
Public Declare Function FT_GetQueueStatus Lib "FTD2XX.DLL" ( _
                                    ByVal lngHandle As Long, _
                                    ByRef lngRxBytes As Long) As Long
                                    
Public Declare Function FT_SetBreakOn Lib "FTD2XX.DLL" ( _
                                    ByVal lngHandle As Long) As Long
                                    
Public Declare Function FT_SetBreakOff Lib "FTD2XX.DLL" ( _
                                    ByVal lngHandle As Long) As Long
                                    
Public Declare Function FT_GetStatus Lib "FTD2XX.DLL" ( _
                                    ByVal lngHandle As Long, _
                                    ByRef lngRxBytes As Long, _
                                    ByRef lngTxBytes As Long, _
                                    ByRef lngEventsDWord As Long) As Long
                                    
Public Declare Function FT_SetEventNotification Lib "FTD2XX.DLL" ( _
                                    ByVal lngHandle As Long, _
                                    ByVal dwEventMask As Long, _
                                    ByVal pVoid As Long) As Long
                                    
Public Declare Function FT_ResetDevice Lib "FTD2XX.DLL" ( _
                                    ByVal lngHandle As Long) As Long
                                    
Public Declare Function FT_GetBitMode Lib "FTD2XX.DLL" ( _
                                    ByVal lngHandle As Long, _
                                    ByRef intData As Any) As Long
                                    
Public Declare Function FT_SetBitMode Lib "FTD2XX.DLL" ( _
                                    ByVal lngHandle As Long, _
                                    ByVal intMask As Byte, _
                                    ByVal intMode As Byte) As Long
                                    
Public Declare Function FT_SetLatencyTimer Lib "FTD2XX.DLL" ( _
                                    ByVal Handle As Long, _
                                    ByVal pucTimer As Byte) As Long
                                    
Public Declare Function FT_GetLatencyTimer Lib "FTD2XX.DLL" ( _
                                    ByVal Handle As Long, _
                                    ByRef ucTimer As Long) As Long
                                    
' Return codes
Public Const FT_OK = 0
Public Const FT_INVALID_HANDLE = 1
Public Const FT_DEVICE_NOT_FOUND = 2
Public Const FT_DEVICE_NOT_OPENED = 3
Public Const FT_IO_ERROR = 4
Public Const FT_INSUFFICIENT_RESOURCES = 5
Public Const FT_INVALID_PARAMETER = 6
Public Const FT_INVALID_BAUD_RATE = 7
Public Const FT_DEVICE_NOT_OPENED_FOR_ERASE = 8
Public Const FT_DEVICE_NOT_OPENED_FOR_WRITE = 9
Public Const FT_FAILED_TO_WRITE_DEVICE = 10
Public Const FT_EEPROM_READ_FAILED = 11
Public Const FT_EEPROM_WRITE_FAILED = 12
Public Const FT_EEPROM_ERASE_FAILED = 13
Public Const FT_EEPROM_NOT_PRESENT = 14
Public Const FT_EEPROM_NOT_PROGRAMMED = 15
Public Const FT_INVALID_ARGS = 16
Public Const FT_NOT_SUPPORTED = 17
Public Const FT_OTHER_ERROR = 18

' Flags for FT_OpenEx
Public Const FT_OPEN_BY_SERIAL_NUMBER = 1
Public Const FT_OPEN_BY_DESCRIPTION = 2

' Flags for FT_ListDevices
Public Const FT_LIST_NUMBER_ONLY = &H80000000
Public Const FT_LIST_BY_INDEX = &H40000000
Public Const FT_LIST_ALL = &H20000000

' IO buffer sizes
Public Const FT_In_Buffer_Size = 1024
Public Const FT_Out_Buffer_Size = 1024

Public FT_In_Buffer As String * FT_In_Buffer_Size
Public FT_Out_Buffer As String * FT_Out_Buffer_Size
Public FT_IO_Status As Long
Public FT_Result As Long
Public FT_Device_Count As Long
Public FT_Device_String_Buffer As String * 50
Public FT_Device_String As String

Global lngHandle As Long

Public FT_HANDLE As Long
Public FT_STATUS As Long
Public PV_Device As Integer
Public FT_Q_Bytes As Long

Public Sub AddToBuffer(I As Long)
' add a character to the output buffer
    
    Mid(FT_Out_Buffer, OutIndex + 1, 1) = Chr(I)
    OutIndex = OutIndex + 1
    
End Sub

Public Function Close_USB_Device() As Long
' close the module

    FT_Result = FT_Close(FT_HANDLE)
    If FT_Result <> FT_OK Then
        FT_Error_Report "FT_Close", FT_Result
    End If
    Close_USB_Device = FT_Result
    
End Function

Public Sub FormatReading(Reading As Single)
' format a Reading in dBm
Dim Difference As Single
Dim dB As Single

    If Reading = 0 Then Exit Sub                    ' if 0 then exit
    
    Difference = Abs(ZerodBm - Reading)             ' calc reading difference to 0dBm
    dB = Difference / Slope                         ' calc how many dBm
    If Reading < ZerodBm Then
        Form1.lblDBM.Caption = Format(dB, "-#0.0dBm") ' format with a -
    Else
        Form1.lblDBM.Caption = Format(dB, "#0.0dBm") ' format without a -
    End If

End Sub

Public Sub FT_Error_Report(ErrStr As String, PortStatus As Long)
' show an error message
Dim Str As String

    Select Case PortStatus
        Case FT_INVALID_HANDLE
            Str = ErrStr & " - Invalid Handle"
        Case FT_DEVICE_NOT_FOUND
            Str = ErrStr & " - Device Not Found"
        Case FT_DEVICE_NOT_OPENED
            Str = ErrStr & " - Device Not Opened"
        Case FT_IO_ERROR
            Str = ErrStr & " - General IO Error"
        Case FT_INSUFFICIENT_RESOURCES
            Str = ErrStr & " - Insufficient Resources"
        Case FT_INVALID_PARAMETER