📄 vbserial.frm
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Comm
Caption = "串行通信可靠性测试程序"
ClientHeight = 5940
ClientLeft = 60
ClientTop = 345
ClientWidth = 8100
LinkTopic = "Form1"
ScaleHeight = 5940
ScaleWidth = 8100
StartUpPosition = 3 '窗口缺省
Begin VB.TextBox BeginError
Height = 375
Left = 5040
TabIndex = 13
Text = "0"
Top = 3960
Width = 2775
End
Begin VB.TextBox HandshakeError
Height = 375
Left = 1200
TabIndex = 11
Text = "0"
Top = 3960
Width = 2295
End
Begin VB.TextBox BodeRate
Height = 375
Left = 1920
TabIndex = 9
Text = "1200"
Top = 4680
Width = 855
End
Begin MSCommLib.MSComm MSComm1
Left = 3600
Top = 5280
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = 0 'False
InputMode = 1
End
Begin VB.CommandButton CommEnd
Caption = "通信结束"
Height = 495
Left = 5520
TabIndex = 7
Top = 5280
Width = 1455
End
Begin VB.CommandButton CommBegin
Caption = "开始通信"
Height = 495
Left = 720
TabIndex = 6
Top = 5280
Width = 1455
End
Begin VB.TextBox CheckoutError
Height = 495
Left = 2280
TabIndex = 5
Text = "0"
Top = 3120
Width = 5295
End
Begin VB.TextBox CommCount
Height = 495
Left = 2280
TabIndex = 3
Text = "0"
Top = 2400
Width = 5295
End
Begin VB.TextBox Text1
Height = 1575
Left = 240
TabIndex = 0
Text = "Text1"
Top = 720
Width = 7335
End
Begin VB.Label Label6
Caption = "起始帧错误："
Height = 375
Left = 3600
TabIndex = 12
Top = 3960
Width = 1215
End
Begin VB.Label Label5
Caption = "握手错误："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 0
TabIndex = 10
Top = 3960
Width = 1095
End
Begin VB.Label Label4
Caption = "波特率："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 360
TabIndex = 8
Top = 4680
Width = 1095
End
Begin VB.Label Label3
Caption = "校验错误次数："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 360
TabIndex = 4
Top = 3240
Width = 1935
End
Begin VB.Label Label2
Caption = "通信总次数："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 360
TabIndex = 2
Top = 2520
Width = 1695
End
Begin VB.Label Label1
Caption = " 串行传输值："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 1
Top = 240
Width = 1695
End
End
Attribute VB_Name = "Comm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub CommBegin_Click()
Dim BodeR As String
Dim AckBuff(1) As Byte '注意是两个数
Dim n As Integer ' 数据长度
Dim i As Integer '计数变量
Dim DataBuff() As Byte
Dim pf As Byte '校验和
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
MSComm1.CommPort = 1
End If
BodeR = BodeRate.Text
' 设定波特，无奇偶校验，8 位数据，一个停止位。
MSComm1.Settings = BodeR & ",N,8,1" '注意&有空格，VB不会自动纠正
MSComm1.InputLen = 0
MSComm1.PortOpen = True
MSComm1.OutBufferCount = 0 '清空发送缓冲区
MSComm1.InBufferCount = 0 '清空接收缓冲区
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Select Case WaitRecieveByte()
Case &H54 '握手定义：收54H,回两次63H
AckBuff(0) = &H63
AckBuff(1) = &H63
Call SendBuff(AckBuff)
Case Else '握手信号错误，要求重发
AckBuff(0) = &HEE
AckBuff(1) = &HEE
Call SendBuff(AckBuff)
HandshakeError.Text = HandshakeError.Text + 1 '计算握手出错个数
End Select
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'开始数据帧的接收
Select Case WaitRecieveByte()
''''''''''''''''''''''''''''''''''''''''''''''
Case &H55 '55H是数据帧起始位
n = WaitRecieveByte()
ReDim DataBuff(n) '确定数组大小
For i = 0 To n - 1
DataBuff(i) = WaitRecieveByte()
pf = DataBuff(i) + pf
Next
If pf = WaitRecieveByte() Then '此处是比较校验数据
AckBuff(0) = &H63
AckBuff(1) = &H63
Call SendBuff(AckBuff) '校验正确发63H
CommCount.Text = CommCount.Text + 1
Else
AckBuff(0) = &HEE
AckBuff(1) = &HEE
Call SendBuff(AckBuff) '校验不正确发EEH
CheckoutError.Text = CheckoutError.Text + 1 '计算校验出错个数
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case Else
BeginError.Text = BeginError.Text + 1 '计算起始帧出错个数
'延时2S后回信息
AckBuff(0) = &HEE
AckBuff(1) = &HEE
Call SendBuff(AckBuff) '起始帧出错发EEH
End Select
End Sub
'等待并接收一个字节。
Function WaitRecieveByte() As Byte
'''''''''''''''''''''''''''''''''''''''
MSComm1.InputLen = 0 '接收二进制数据
MSComm1.InBufferCount = 0
MSComm1.InputMode = comInputModeBinary
''''''''''''''''''''''''''''''''''''''''''
Do While MSComm1.InBufferCount = 0
DoEvents
Loop
WaitRecieveByte = MSComm1.Input '接收字符数据
End Function
Private Sub SendBuff(buff() As Byte)
MSComm1.Output = buff
Do
DoEvents
Loop Until MSComm1.OutBufferCount = 0
End Sub
Private Sub Text4_Change()
End Sub
Private Sub CommEnd_Click()
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
End Sub
Private Sub Form_Load()
HandshakeError.Text = 0
BeginError.Text = 0
CheckoutError.Text = 0
CommCount.Text = 0
End Sub
Private Sub Text3_Change()
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -