apexcommanalyse.frm

vb写的串口调试助手

         Height          =   255
         Left            =   3420
         TabIndex        =   34
         Top             =   1560
         Width           =   855
      End
      Begin VB.Label lblSendDataBytes 
         Caption         =   "0字节"
         ForeColor       =   &H00C00000&
         Height          =   255
         Left            =   1080
         TabIndex        =   33
         Top             =   1560
         Width           =   855
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         Caption         =   "帧间隔"
         Height          =   210
         Left            =   4440
         TabIndex        =   31
         Top             =   1560
         Width           =   630
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         Caption         =   "停止位"
         Height          =   210
         Left            =   7140
         TabIndex        =   30
         Top             =   480
         Width           =   630
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "校验位"
         Height          =   210
         Left            =   5220
         TabIndex        =   29
         Top             =   480
         Width           =   630
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "数据位"
         Height          =   210
         Left            =   3720
         TabIndex        =   28
         Top             =   480
         Width           =   630
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "串口"
         Height          =   210
         Left            =   240
         TabIndex        =   27
         Top             =   480
         Width           =   420
      End
   End
   Begin VB.Image Image1 
      Appearance      =   0  'Flat
      Height          =   435
      Left            =   120
      Picture         =   "ApexCommAnalyse.frx":101AC
      Stretch         =   -1  'True
      Top             =   8640
      Width           =   420
   End
End
Attribute VB_Name = "ApexCommAnalyse"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim RecvFileHandle As Integer
Dim RecvFileOpened As Boolean
Dim SendFileHandle As Integer
Dim SendFileOpened As Boolean
Dim TestFileHandle As Integer
Dim TestFileOpened As Boolean

Private Sub cmdClearRecvDispBufferAndCount_Click()
    txtRecvBuffer.Text = ""
End Sub

Private Sub cmdClearSendDispBufferAndCount_Click()
    txtSendBuffer.Text = ""
End Sub

Private Sub cmdOpenComm_Click()
    On Error GoTo lbComSetError
    
    If InStr(cmdOpenComm.Caption, "打开") > 0 Then
        If MSComm1.PortOpen = True Then MSComm1.PortOpen = False

        MSComm1.CommPort = Val(Mid(Trim(cmbComID.Text), 4, 3))
        MSComm1.Settings = cmbBaudrate.Text + "," + Mid(cmbParityBits.Text, 1, 1) + "," + cmbDataBits.Text + "," + cmbStopBits.Text
        MSComm1.InBufferCount = 0
        MSComm1.PortOpen = True
        
        cmbComID.Enabled = False
        cmbBaudrate.Enabled = False
        cmbDataBits.Enabled = False
        cmbParityBits.Enabled = False
        cmbStopBits.Enabled = False
        
        chkSaveSendInforToFile.Enabled = False
        chkSaveRecvInforToFile.Enabled = False
        chkSaveTestInforToFile.Enabled = False
        
        cmdSendOneFrame.Enabled = True
        cmdTest.Enabled = True
    
        cmdOpenComm.Caption = "关闭串口"
    Else
        ' 读取未处理的字节
        Dim buffer() As Byte, CharCount As Integer
        CharCount = MSComm1.InBufferCount
        If CharCount > 0 Then
            ReDim buffer(0 To CharCount - 1)
            MSComm1.InputLen = CharCount
            buffer = MSComm1.Input
        End If
    
        If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    
        If InStr(cmdTest.Caption, "停止") > 0 Then
            cmdTest_Click
        End If
    
        cmbComID.Enabled = True
        cmbBaudrate.Enabled = True
        cmbDataBits.Enabled = True
        cmbParityBits.Enabled = True
        cmbStopBits.Enabled = True

        chkSaveSendInforToFile.Enabled = True
        chkSaveRecvInforToFile.Enabled = True
        chkSaveTestInforToFile.Enabled = True
        
        cmdSendOneFrame.Enabled = False
        cmdTest.Enabled = False
    
        cmdOpenComm.Caption = "打开串口"
    End If

    Exit Sub

lbComSetError:
    MsgBox "串口不存在、被占用，或者参数设置错误", vbCritical + vbOKOnly
    Err.Clear
    
    On Error Resume Next
End Sub

Private Sub cmdRecvCmpDataBytes_Click()
    frmSendRecvData.Frame1.Caption = "接收比较帧数据（16进制、空格分隔、最多" & cnMaxFrameByteSize & " 字节）"
    frmSendRecvData.vDispSendRecvData ("接收")
    frmSendRecvData.Show vbModal
End Sub

Private Sub cmdSendData_Click()
    frmSendRecvData.Frame1.Caption = "发送帧数据（16进制、空格分隔、最多" & cnMaxFrameByteSize & "字节）"
    frmSendRecvData.vDispSendRecvData ("发送")
    frmSendRecvData.Show vbModal
End Sub

Sub vAddInforLine(strInfor As String)
    Dim strMessage As String
    strMessage = Format(Date, "MM-DD") + " " + Format(Time, "hh:mm:ss") + " " + strInfor + vbCrLf

    If TestFileOpened = True And chkSaveTestInforToFile.Value = vbChecked Then
        Print #TestFileHandle, strMessage;
    End If

    lstInfor.AddItem strMessage

    lblInforLineCount.Caption = lblInforLineCount.Caption + 1  ' 累计显示信息行
    If lstInfor.ListCount >= txtMaxLinesInfor.Text Then
        lstInfor.RemoveItem 0
    End If
    
    If chkLockInfor.Value <> vbChecked Then
        lstInfor.ListIndex = lstInfor.ListCount - 1
    End If
End Sub


Private Sub cmdSendOneFrame_Click()
    If iTotalSendBytes = 0 Then ' 发送缓冲有效字节数
        MsgBox "请先设置发送帧数据", vbInformation + vbOKOnly
        Exit Sub
    End If

    sglLastSendFrameTimer = Timer - 999

    If InStr(cmdTest.Caption, "开始") > 0 Then blTesting = True
    Timer1_Timer
    If InStr(cmdTest.Caption, "开始") > 0 Then blTesting = False
End Sub

Private Sub cmdTest_Click()
    If iTotalRecvCmpBytes > 0 And cmbBaudrate.Text > 0 Then
        sglSecondsPer3SendFrame = 30 * iTotalRecvCmpBytes / cmbBaudrate.Text ' 正常情况下接收3帧需要的时间（秒），用于计算超时
        sglSecondsPer10Bytes = 100 / cmbBaudrate.Text ' 正常情况下接收10字节需要的时间（秒），用于计算超时
    Else
        sglSecondsPer3SendFrame = 0 ' 正常情况下接收3帧需要的时间（秒），用于计算超时
        sglSecondsPer10Bytes = 0 ' 正常情况下接收10字节需要的时间（秒），用于计算超时
    End If
    
    If sglSecondsPer3SendFrame < 2# Then  ' 正常情况下接收3帧需要的时间（秒），用于计算超时
        sglSecondsPer3SendFrame = 2#  ' 最小1秒
    End If
    
    If sglSecondsPer10Bytes < 2# Then ' 正常情况下接收10字节需要的时间（秒），用于计算超时
        sglSecondsPer10Bytes = 2#  ' 最小1秒
    End If

    If iTotalSendBytes > 0 And cmbBaudrate.Text > 0 Then
        sglSecondsPerSendFrame = 12 * iTotalSendBytes / cmbBaudrate.Text ' 正常情况下发送1.1帧需要的时间（秒），用于计算基本时间，防止发送超速
    Else
        sglSecondsPerSendFrame = 0 ' 正常情况下接收3帧需要的时间（秒），用于计算超时
    End If

    If sglSecondsPerSendFrame < 0.1 Then    ' 正常情况下接收3帧需要的时间（秒），用于计算超时
        sglSecondsPerSendFrame = 0.1  ' 最小100ms
    End If

    If InStr(cmdTest.Caption, "开始") > 0 Then
        If iTotalSendBytes = 0 Then ' 发送缓冲有效字节数
            If MsgBox("还未设置发送帧数据，继续吗", vbYesNo + vbQuestion) = vbNo Then
                Exit Sub
            End If
        End If
        
        If iTotalRecvCmpBytes = 0 Then ' 接收比较缓冲有效字节数
            If MsgBox("还未设置接收比较帧数据，继续吗", vbYesNo + vbQuestion) = vbNo Then
                Exit Sub
            End If
        End If
        
        Close #RecvFileHandle
        RecvFileOpened = False ' 默认文件打开失败
    
        Close #SendFileHandle
        SendFileOpened = False ' 默认文件打开失败
    
        Close #TestFileHandle
        TestFileOpened = False ' 默认文件打开失败
        
        On Error GoTo lbFileError
        
        RecvFileHandle = FreeFile
        Open App.Path + "\RECV.TXT" For Append As #RecvFileHandle
        Print #RecvFileHandle, vbCrLf + Format(Date, "MM-DD") + " " + Format(Time, "hh:mm:ss") + "-->>>" + vbCrLf
        RecvFileOpened = True ' 文件打开成功
    
        SendFileHandle = FreeFile
        Open App.Path + "\SEND.TXT" For Append As #SendFileHandle
        Print #SendFileHandle, vbCrLf + Format(Date, "MM-DD") + " " + Format(Time, "hh:mm:ss") + "-->>>" + vbCrLf
        SendFileOpened = True ' 文件打开成功

        TestFileHandle = FreeFile
        Open App.Path + "\TEST.TXT" For Append As #TestFileHandle
        TestFileOpened = True ' 文件打开成功
        
        sglLastRecvBytesTimer = Timer '上次接收字节的时间
        sglLastRecvFrameTimer = Timer '上次接收帧的时间
        
        lblSendBytesCount.Caption = 0 ' 发送字节数
        lblRecvBytesCount.Caption = 0 ' 接收字节数

        lngRecvBytesOK = 0 ' 接收累计有效字节数
        iRecvFrameBytes = 0 ' 接收帧有效字节计数
        lngRecvBytesOK = 0 ' 接收累计有效字节数
        lngRecvFramesIntegrity = 0 ' 接收完整帧计数
        lngRecvFramesOk = 0 ' 正确接收帧计数
        lngRecvFrames = 0 ' 接收帧计数
        lngSendFrames = 0 ' 发送帧计数
        
        vAddInforLine "开始测试..."

        cmdTest.Caption = "停止"
        
        cmdSendData.Enabled = False
        cmdRecvCmpDataBytes.Enabled = False

        iBytesPerSend = cmbBaudrate.Text \ 300 + 1 ' 每次写入控件的字节数

        blTesting = True ' 是否处于测试中

        sglLastSendFrameTimer = Timer - 999 '上次发送帧的时间 ' 启动首次发送
        Timer1_Timer ' 启动首次发送
    Else
        blTesting = False ' 是否处于测试中

        cmdTest.Caption = "开始"

        vAddInforLine "测试结束..."

        vAddInforLine "------------------"
        vAddInforLine "发送帧: " & lngSendFrames
        vAddInforLine "接收帧: " & lngRecvFrames
        vAddInforLine "完整帧: " & lngRecvFramesIntegrity
        vAddInforLine "正确帧: " & lngRecvFramesOk
        If lngRecvFramesIntegrity > 0 Then
            vAddInforLine "正确率: " & Format(100# * lngRecvFramesOk / lngRecvFramesIntegrity, "0.00") & "%"  ' 正确接收帧计数 ' 接收完整帧计数
        End If
        
        vAddInforLine "------------------"
        vAddInforLine "发送字节: " & Val(lblSendBytesCount.Caption)
        vAddInforLine "接收字节: " & Val(lblRecvBytesCount.Caption)
        vAddInforLine "正确字节: " & lngRecvBytesOK

        If iTotalRecvCmpBytes > 0 And Val(lblRecvBytesCount.Caption) > 0 Then
            vAddInforLine "正 确 率: " & Format(100# * lngRecvBytesOK / Val(lblRecvBytesCount.Caption), "0.00") & "%"
        End If
        vAddInforLine "------------------"

        cmdSendData.Enabled = True
        cmdRecvCmpDataBytes.Enabled = True
    
        Close #RecvFileHandle
        RecvFileOpened = False ' 默认文件打开失败
    
        Close #SendFileHandle
        SendFileOpened = False ' 默认文件打开失败
    
        Close #TestFileHandle
        TestFileOpened = False ' 默认文件打开失败
    End If

    Exit Sub
    
lbFileError:
    
    Close #RecvFileHandle
    RecvFileOpened = False ' 默认文件打开失败

    Close #SendFileHandle
    SendFileOpened = False ' 默认文件打开失败

    Close #TestFileHandle
    TestFileOpened = False ' 默认文件打开失败

    On Error Resume Next
End Sub

Private Sub CmdClearInforLine_Click()
    lblInforLineCount.Caption = 0 ' 累计显示信息行
    lstInfor.Clear
    strLastInfor = "" ' 连续相同的信息仅显示一次
End Sub

Private Sub Form_Load()
    Dim i As Integer

    On Error Resume Next

    Close #RecvFileHandle
    RecvFileOpened = False ' 默认文件打开失败

    Close #SendFileHandle
    SendFileOpened = False ' 默认文件打开失败

    Close #TestFileHandle
    TestFileOpened = False ' 默认文件打开失败

    iBytesPerSend = 0 ' 每次写入控件的字节数
    
    blFrameBeginFlagReceived = False ' 收到了帧开始标识
    blFrameEndFlagReceived = False ' 收到了帧结束标识
    
    blTesting = False ' 是否处于测试中
    
    strSendBytesHexString = "" ' 发送内容的HEX显示内容
    iTotalSendBytes = 0 ' 发送缓冲有效字节数
    iTotalRecvCmpBytes = 0 ' 接收比较缓冲有效字节数

    sglSecondsPerSendFrame = 0 ' 正常情况下发送1帧需要的时间（秒），用于计算基本时间，防止发送超速
    sglLastSendFrameTimer = Timer '上次发送帧的时间

    sglSecondsPer3SendFrame = 0 ' 正常情况下接收3帧需要的时间（秒），用于计算超时
    sglLastRecvFrameTimer = Timer '上次接收帧的时间

    sglSecondsPer10Bytes = 0 ' 正常情况下接收10字节需要的时间（秒），用于计算超时
    sglLastRecvBytesTimer = Timer '上次接收字节的时间

    iRecvFrameBytes = 0 ' 接收帧有效字节计数

    lngSendFrames = 0 ' 发送帧计数
    lngRecvFramesOk = 0 ' 正确接收帧计数
    lngRecvFrames = 0 ' 接收帧计数

    strLastInfor = "" ' 连续相同的信息仅显示一次

    txtSendBuffer.Text = ""