apexcommanalyse.frm

vb写的串口调试助手

    txtRecvBuffer.Text = ""

    cmbComID.Clear
    For i = 1 To 16
        cmbComID.AddItem "COM" & i
    Next i
    cmbComID.ListIndex = 0 ' COM1
    
    cmbBaudrate.Clear
    cmbBaudrate.AddItem "300"
    cmbBaudrate.AddItem "600"
    cmbBaudrate.AddItem "1200"
    cmbBaudrate.AddItem "2400"
    cmbBaudrate.AddItem "4800"
    cmbBaudrate.AddItem "9600"
    cmbBaudrate.AddItem "19200"
    cmbBaudrate.AddItem "38400"
    cmbBaudrate.AddItem "57600"
    cmbBaudrate.AddItem "115200"
    cmbBaudrate.ListIndex = 5 ' 9600bps

    cmbDataBits.Clear
    For i = 4 To 8
        cmbDataBits.AddItem i
    Next i
    cmbDataBits.ListIndex = 4 ' 8
    
    cmbParityBits.Clear
    cmbParityBits.AddItem "None"  ' N 无(None)
    cmbParityBits.AddItem "Even"  ' E 偶数(Even)
    cmbParityBits.AddItem "Odd"   ' O 奇数(Odd)
    cmbParityBits.AddItem "Mark"  ' M 标记(Mark)
    cmbParityBits.AddItem "Space" ' S 空格(Space)
    cmbParityBits.ListIndex = 0 ' N 无(None)
    
    cmbStopBits.Clear
    cmbStopBits.AddItem "1"
    cmbStopBits.AddItem "1.5"
    cmbStopBits.AddItem "2"
    cmbStopBits.ListIndex = 0 ' 1

    cmbSpeed.Clear
    For i = 0 To 99
        cmbSpeed.AddItem Trim(Str(i)) + "秒"
    Next i
    cmbSpeed.ListIndex = 1 ' 1秒
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If MSComm1.PortOpen = True Then
        MSComm1.PortOpen = False
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Close #RecvFileHandle
    Close #SendFileHandle
    Close #TestFileHandle
    End
End Sub

Private Sub Image1_Click()
  Dim strURL As String
  strURL = "http://www.apextech.com.cn"
  Call ShellExecute(Me.hwnd, "Open", strURL, "", "", SW_SHOWMAXIMIZED)
End Sub

Private Sub MSComm1_OnComm()
    On Error Resume Next

    If MSComm1.CommEvent <> comEvReceive Then Exit Sub ' 接收事件

    Static blIsOnComm As Boolean
    If blIsOnComm = True Then Exit Sub
    
    blIsOnComm = True ' 正在执行MSComm11_OnComm，防止重入

    Dim CharCount As Integer, i As Integer, j As Integer
    Dim buffer() As Byte, bByte As Byte

    CharCount = MSComm1.InBufferCount
    ReDim buffer(0 To CharCount - 1)

    MSComm1.InputLen = CharCount
    buffer = MSComm1.Input

    Dim strRecvInfor As String
    strRecvInfor = ""

    If CharCount > 0 Then
        sglLastRecvBytesTimer = Timer '上次接收字节的时间
    End If

    For i = 0 To CharCount - 1
        bByte = buffer(i)

        If chkRecvDispPause.Value <> vbChecked Then ' 暂停接收显示
            strRecvInfor = strRecvInfor + ConvertByteToHex(bByte) + " "
        End If

        lblRecvBytesCount.Caption = lblRecvBytesCount.Caption + 1

        If iTotalRecvCmpBytes > 0 Then ' 需要比较/统计接收正确性
            bRecvFrameBuffer(iRecvFrameBytes) = bByte ' 接收帧缓冲

            If blFrameBeginFlagReceived = False Then ' 收到了帧起始标识
                ' 连续接收的字节都非帧起始标志
                If iRecvFrameBytes >= 3 And iTotalRecvCmpBytes >= 3 Then  ' 3个及以上比较字节，以最前3个字节相同为标准
                    bRecvFrameBuffer(0) = bRecvFrameBuffer(1) ' 接收帧缓冲
                    bRecvFrameBuffer(1) = bRecvFrameBuffer(2)
                    bRecvFrameBuffer(2) = bRecvFrameBuffer(3)
                    iRecvFrameBytes = 2 ' 后面加1
                ElseIf iRecvFrameBytes = 2 And iTotalRecvCmpBytes = 2 Then  ' 2个比较字节，以最前2个字节相同为标准
                    bRecvFrameBuffer(0) = bRecvFrameBuffer(1) ' 接收帧缓冲
                    bRecvFrameBuffer(1) = bRecvFrameBuffer(2)
                    iRecvFrameBytes = 1 ' 后面加1
                ElseIf iRecvFrameBytes = 1 And iTotalRecvCmpBytes = 1 Then ' 1个比较字节
                    bRecvFrameBuffer(0) = bRecvFrameBuffer(1) ' 接收帧缓冲
                    iRecvFrameBytes = 0 ' 后面加1
                End If
            
                ' 找帧起始标志
                If iRecvFrameBytes >= 2 And iTotalRecvCmpBytes >= 3 Then  ' 3个及以上比较字节，以最前3个字节相同为标准
                    If bRecvFrameBuffer(2) = bRecvCmpBuffer(2) And _
                        bRecvFrameBuffer(1) = bRecvCmpBuffer(1) And _
                        bRecvFrameBuffer(0) = bRecvCmpBuffer(0) Then
                        blFrameBeginFlagReceived = True ' 收到了帧起始标识
                        blFrameEndFlagReceived = False ' 收到了帧结束标识
                    End If
                ElseIf iRecvFrameBytes >= 1 And iTotalRecvCmpBytes = 2 Then  ' 2个比较字节，以最前2个字节相同为标准
                    If bRecvFrameBuffer(1) = bRecvCmpBuffer(1) And _
                        bRecvFrameBuffer(0) = bRecvCmpBuffer(0) Then
                        blFrameBeginFlagReceived = True ' 收到了帧起始标识
                        blFrameEndFlagReceived = False ' 收到了帧结束标识
                    End If
                ElseIf iTotalRecvCmpBytes = 1 Then ' 1个比较字节
                    If bRecvFrameBuffer(0) = bRecvCmpBuffer(0) Then
                        blFrameBeginFlagReceived = True ' 收到了帧起始标识
                        blFrameEndFlagReceived = False ' 收到了帧结束标识
                    End If
                End If
            End If
            
            If blFrameEndFlagReceived = False Then ' 收到了帧结束标识
                ' 找帧结束标志
                If iRecvFrameBytes >= 2 And iTotalRecvCmpBytes >= 3 Then ' 3个及以上比较字节，以最后3个字节相同为标准
                    If bRecvFrameBuffer(iRecvFrameBytes - 2) = bRecvCmpBuffer(iTotalRecvCmpBytes - 3) And _
                        bRecvFrameBuffer(iRecvFrameBytes - 1) = bRecvCmpBuffer(iTotalRecvCmpBytes - 2) And _
                        bRecvFrameBuffer(iRecvFrameBytes) = bRecvCmpBuffer(iTotalRecvCmpBytes - 1) Then
                        blFrameEndFlagReceived = True ' 收到了帧结束标识
                        
                        If chkRecvDispPause.Value <> vbChecked Then ' 暂停接收显示
                            strRecvInfor = strRecvInfor + vbCrLf ' 帧结束换行
                        End If
        
                        sglLastRecvFrameTimer = Timer '上次接收帧的时间
                        lngRecvFrames = lngRecvFrames + 1 ' 接收帧计数
                    End If
                ElseIf iRecvFrameBytes >= 1 And iTotalRecvCmpBytes = 2 Then  ' 2个比较字节，以最后2个字节相同为标准
                    If bRecvFrameBuffer(iRecvFrameBytes - 1) = bRecvCmpBuffer(iTotalRecvCmpBytes - 2) And _
                        bRecvFrameBuffer(iRecvFrameBytes) = bRecvCmpBuffer(iTotalRecvCmpBytes - 1) Then
                        blFrameEndFlagReceived = True ' 收到了帧结束标识
                        
                        If chkRecvDispPause.Value <> vbChecked Then ' 暂停接收显示
                            strRecvInfor = strRecvInfor + vbCrLf ' 帧结束换行
                        End If
        
                        sglLastRecvFrameTimer = Timer '上次接收帧的时间
                        lngRecvFrames = lngRecvFrames + 1 ' 接收帧计数
                    End If
                ElseIf iTotalRecvCmpBytes = 1 Then ' 1个比较字节
                    If bRecvFrameBuffer(iRecvFrameBytes) = bRecvCmpBuffer(iTotalRecvCmpBytes - 1) Then
                        blFrameEndFlagReceived = True ' 收到了帧结束标识
                        
                        If chkRecvDispPause.Value <> vbChecked Then ' 暂停接收显示
                            strRecvInfor = strRecvInfor + vbCrLf ' 帧结束换行
                        End If
        
                        sglLastRecvFrameTimer = Timer '上次接收帧的时间
                        lngRecvFrames = lngRecvFrames + 1 ' 接收帧计数
                    End If
                End If
            End If

            ' 收到了帧起始标识
            If blFrameBeginFlagReceived = True Then
                ' 收齐一帧长度
                If iRecvFrameBytes >= iTotalRecvCmpBytes - 1 Then ' 接收比较缓冲有效字节数
                    j = 0 ' 用于当未收到帧结束标志时判断为“错误的数据帧”

                    If blFrameEndFlagReceived = True Then ' 收到了帧结束标识
                        lngRecvFramesIntegrity = lngRecvFramesIntegrity + 1 ' 接收完整帧计数
                    
                        ' 内容判断
                        For j = 0 To iTotalRecvCmpBytes - 1
                            If bRecvFrameBuffer(j) <> bRecvCmpBuffer(j) Then ' 对应字节的内容不同
                                Exit For
                            Else
                                lngRecvBytesOK = lngRecvBytesOK + 1 ' 接收累计有效字节数
                            End If
                        Next j
                    End If

                    If j <= iTotalRecvCmpBytes - 1 Then
                        vAddInforLine "错误的数据帧"
                    Else ' 完整的、正确的帧
                        lngRecvFramesOk = lngRecvFramesOk + 1 ' 正确接收帧计数
                    End If

                    iRecvFrameBytes = -1 ' 接收帧有效字节计数、准备接收下一帧

                    blFrameBeginFlagReceived = False ' 收到了帧开始标识
                    blFrameEndFlagReceived = False ' 收到了帧结束标识
                End If
            End If
            
            iRecvFrameBytes = iRecvFrameBytes + 1 ' 接收帧有效字节计数
        End If ' If iTotalRecvCmpBytes > 0 Then ' 需要比较/统计接收正确性
    Next i

    If RecvFileOpened = True And chkSaveRecvInforToFile.Value = vbChecked Then
        Print #RecvFileHandle, strRecvInfor; ' 保存接收信息
    End If

    If chkRecvDispPause.Value <> vbChecked Then ' 暂停接收显示
        txtRecvBuffer.Text = txtRecvBuffer.Text + strRecvInfor

        If Len(txtRecvBuffer.Text) > 3 * txtRecvDispBufferSize.Text Then ' 一字节显示占3个字符位置
            ' 删除前面的字符
            txtRecvBuffer.SelStart = 0
            txtRecvBuffer.SelLength = Len(txtRecvBuffer.Text) - 3 * txtRecvDispBufferSize.Text
            txtRecvBuffer.SelText = ""
        End If
    
        ' txtRecvBuffer.SetFocus ' 显示最新信息位置
        ' SendKeys "^{END}"
    End If

    blIsOnComm = False ' 正在执行MSComm11_OnComm，防止重入
End Sub

Private Sub Picture1_Click()
    Image1_Click
End Sub

Private Sub Timer1_Timer()
    On Error Resume Next

    If chkSendPause.Value = vbChecked Then ' 暂停发送
        Exit Sub
    End If

    Static blIsInTimer1 As Boolean
    If blIsInTimer1 = True Then Exit Sub
    
    blIsInTimer1 = True ' 正在执行Timer1_Timer，防止重入

    If iTotalSendBytes > 0 And blTesting = True And MSComm1.OutBufferCount = 0 And Abs(Timer - sglLastSendFrameTimer) > sglSecondsPerSendFrame Then ' 需要发送 ' 是否处于测试中 ' 上次发送完毕
        sglLastSendFrameTimer = Timer '上次发送帧的时间 ' 启动首次发送

        txtSendBuffer.Text = txtSendBuffer.Text + strSendBytesHexString ' 显示发送帧

        If SendFileOpened = True And chkSaveSendInforToFile.Value = vbChecked Then
            Print #SendFileHandle, strSendBytesHexString; ' 保存发送信息
        End If

        If Len(txtSendBuffer.Text) > 3 * txtSendDispBufferSize.Text Then ' 一字节显示占3个字符位置
            ' 删除前面的字符
            txtSendBuffer.SelLength = Len(txtSendBuffer.Text) - 3 * txtSendDispBufferSize.Text
            txtSendBuffer.SelStart = 0
            txtSendBuffer.SelText = ""
        End If

        ' txtSendBuffer.SetFocus ' 显示最新信息位置
        ' SendKeys "^{END}"

        lblSendBytesCount.Caption = lblSendBytesCount.Caption + iTotalSendBytes ' 发送缓冲有效字节数

        lngSendFrames = lngSendFrames + 1 ' 发送帧计数
    
        '''''''''''''''''''
        ' 方法一：每次一帧
        '''''''''''''''''''
        MSComm1.Output = bSendBuffer ' 输出数据
'
'        '''''''''''''''''''
'        ' 方法二：每帧多次
'        '''''''''''''''''''
'        Dim iTotalBytesCount As Integer, iBytesCountPerSend As Integer
'
'        ReDim byteArray(0 To iBytesPerSend - 1) As Byte
'
'        iBytesCountPerSend = 0
'        For iTotalBytesCount = 0 To iTotalSendBytes - 1
'            byteArray(iBytesCountPerSend) = bSendBuffer(iTotalBytesCount)
'
'            iBytesCountPerSend = iBytesCountPerSend + 1
'
'            ' 最后一次发送（本帧发完）   或者  达到每次发送的字节数
'            If iTotalBytesCount >= iTotalSendBytes - 1 Or iBytesCountPerSend >= iBytesPerSend Then  ' 每次写入控件的字节数
'                ReDim Preserve byteArray(0 To iBytesCountPerSend - 1)
'                MSComm1.Output = byteArray ' 输出数据
'
'                lblSendBytesCount.Caption = lblSendBytesCount.Caption + iBytesCountPerSend ' 发送字节累计
'
'                iBytesCountPerSend = 0 ' 准备下次发送
'
'                Do While MSComm1.OutBufferCount <> 0
'                    DoEvents
'                Loop
'            End If
'
'            If blTesting = False Then Exit For ' 用户中止了测试
'        Next iTotalBytesCount
    End If

    Timer1.Enabled = False
    Timer1.Interval = cmbSpeed.ListIndex * 1000 + 100 ' 至少100ms
    Timer1.Enabled = True

    blIsInTimer1 = False ' 正在执行Timer1_Timer，防止重入
End Sub

Private Sub Timer2_Timer()
    If iTotalSendBytes > 0 And blTesting = True Then ' 需要发送 ' 是否处于测试中
        If iRecvFrameBytes > 0 And iRecvFrameBytes < iTotalRecvCmpBytes - 1 Then ' 正在接收帧期间
            If Abs(Timer - sglLastRecvBytesTimer) > sglSecondsPer10Bytes Then '上次接收字节的时间
                sglLastRecvBytesTimer = Timer
                vAddInforLine "接收字节超时"
            End If
        End If

        If blFrameBeginFlagReceived = True Then ' 收到了帧开始标识
            If Abs(Timer - sglLastRecvFrameTimer) > sglSecondsPer3SendFrame + Val(cmbSpeed.Text) Then ' 更新时间差 > 正常情况下接收3帧需要的时间（秒），用于计算超时
                sglLastRecvFrameTimer = Timer
                vAddInforLine "接收帧超时"
                
                blFrameBeginFlagReceived = False ' 收到了帧开始标识
                blFrameEndFlagReceived = False ' 收到了帧结束标识
                iRecvFrameBytes = 0 ' 接收帧有效字节计数
            End If
        End If
    End If
End Sub

Private Sub txtMaxLinesInfor_KeyPress(KeyAscii As Integer)
    ' 只能输入16进制数, 空格, BACKSPACE
    If KeyAscii = 8 Or KeyAscii = 32 Or _
       (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) Then
    Else
        KeyAscii = 0
    End If
End Sub

Private Sub txtMaxLinesInfor_LostFocus()
    If txtMaxLinesInfor.Text < 20 Then
        txtMaxLinesInfor.Text = 20
    ElseIf txtMaxLinesInfor.Text > 999 Then
        txtMaxLinesInfor.Text = 999
    End If
End Sub

Private Sub txtRecvDispBufferSize_KeyPress(KeyAscii As Integer)
    ' 只能输入16进制数, 空格, BACKSPACE
    If KeyAscii = 8 Or KeyAscii = 32 Or _
       (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) Then
    Else
        KeyAscii = 0
    End If
End Sub

Private Sub txtRecvDispBufferSize_LostFocus()
    If txtRecvDispBufferSize.Text < 32 Then
        txtRecvDispBufferSize.Text = 32
    ElseIf txtRecvDispBufferSize.Text > 6400 Then
        txtRecvDispBufferSize.Text = 6400
    End If
End Sub

Private Sub txtSendDispBufferSize_KeyPress(KeyAscii As Integer)
    ' 只能输入16进制数, 空格, BACKSPACE
    If KeyAscii = 8 Or KeyAscii = 32 Or _
       (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) Then
    Else
        KeyAscii = 0
    End If
End Sub

Private Sub txtSendDispBufferSize_LostFocus()
    If txtSendDispBufferSize.Text < 32 Then
        txtSendDispBufferSize.Text = 32
    ElseIf txtSendDispBufferSize.Text > 6400 Then
        txtSendDispBufferSize.Text = 6400
    End If
End Sub