vb commication.txt

这是利用VB编写的一个通信协议程序

Option Explicit
Dim rev_str As String
Dim right_count As Variant
Dim wrong_count As Variant
Dim rev_arr() As Byte
Dim auto_clear As Variant
Dim temp As Boolean
Dim counte As Long
Dim fso As New FileSystemObject
Dim fil As TextStream
Dim send_str As String
Dim rev_fail As Long

Public Sub printout(str As String)
txt_par.Text = txt_par.Text + str + Chr(13) + Chr(10)
End Sub

Private Sub Check1_Click()
If Check1.Value = 1 Then
Timer2.Enabled = True
Else
Timer2.Enabled = False
End If
End Sub


Private Sub Com_port_click()
On Error Resume Next
MSComm1.PortOpen = False
MSComm1.CommPort = Com_port.Text
MSComm1.Settings = Com_baud.Text + ",n,8,1"
MSComm1.RThreshold = 1
MSComm1.InputMode = comInputModeBinary
MSComm1.PortOpen = True
End Sub

Private Sub Command1_Click()
txt_par.Text = ""
End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Command3_Click()
Dim senddat As String
MSComm1.RThreshold = 1
If Text1.Text = "" Then
MsgBox "您还没有输入要发送的数据!", vbInformation, "提示"
senddat = InputBox("请输入要发送的数据", , "提示")
senddat = "&H" + senddat
Else
senddat = "&H" + Text1.Text
End If
MSComm1.Output = Chr(senddat)
printout (" ")
printout ("******************************************************")
printout (Now)
printout ("发送数据为:" + senddat)
Timer2.Enabled = True
Timer3.Enabled = True
End Sub

Private Sub Command4_Click()
Open App.Path & "\测试数据\" & CStr(Label2.Caption) & "测试数据.txt" For Append As #1
Print #1, Now
Print #1, "井下单元发送的数据为：" & "  " & send_str
Print #1, "接收到的数据总数为：" & "    " & txt_rev.Text
Print #1, "接收到的错误数据总数为：" & txt_wro.Text
Print #1, "本次传输数据误码率为：" & "  " & txt_rat.Text & "%"
Print #1, ""
Close #1
End Sub

Private Sub Command5_Click()
txt_rev.Text = "0"
txt_wro.Text = "0"
txt_rat.Text = "0"
right_count = 0
wrong_count = 0
End Sub

Private Sub Command6_Click()
Text1.Locked = False
Command3.Enabled = True
txt_par.Text = ""
MSComm1.RThreshold = 0
txt_rev.Text = "0"
txt_wro.Text = "0"
txt_rat.Text = "0"
right_count = 0
wrong_count = 0
counte = 0
End Sub

Private Sub Command7_Click()
MSComm1.RThreshold = 0
Command7.Visible = False
Command8.Visible = True
Timer2.Enabled = False
End Sub

Private Sub Command8_Click()
MSComm1.RThreshold = 1
Command8.Visible = False
Command7.Visible = True
Timer2.Enabled = True
End Sub

Private Sub Form_Load()
'fso.CreateFolder ("测试数据")
Label2.Caption = Format(Date, "yyyy年mm月dd日") + " " + Format(Time, "hh时mm分ss秒")
Com_port.Text = Com_port.List(0)
Com_baud.Text = Com_baud.List(0)
MSComm1.CommPort = Com_port.Text
MSComm1.Settings = Com_baud.Text + ",n,8,1"
MSComm1.InputLen = 0
MSComm1.RThreshold = 1
MSComm1.InputMode = comInputModeBinary
MSComm1.PortOpen = True
End Sub

Private Sub MSComm1_OnComm()
On Error Resume Next
Dim inbyte As Byte
Dim i As Integer
If MSComm1.CommEvent <> comEvReceive Then
Exit Sub
Else
Text1.Locked = True
Command3.Enabled = False
Timer3.Enabled = False
End If

counte = MSComm1.InBufferCount
rev_arr = MSComm1.Input
For i = 1 To counte
inbyte = inbyte & rev_arr(i)
rev_str = CStr(Hex(inbyte))
send_str = rev_str
If rev_str = "11" Then
right_count = right_count + 1
txt_rev.Text = right_count
Else
wrong_count = wrong_count + 1
txt_wro.Text = wrong_count
End If
txt_par.Text = txt_par.Text & rev_str & " "
rev_str = ""
Next i

txt_rat.Text = Format((wrong_count / right_count) * 100, "0.000000")

End Sub

Private Sub Timer1_Timer()
Label2.Caption = Format(Date, "yyyy年mm月dd日") + " " + Format(Time, "hh时mm分ss秒")
End Sub


Private Sub Timer2_Timer()
auto_clear = auto_clear + 1
If auto_clear = 60 Then
auto_clear = 0
txt_par.Text = ""
End If
End Sub

Private Sub Timer3_Timer()
rev_fail = rev_fail + 1
If rev_fail = 10 Then
rev_fail = 0
MsgBox "接收超时，请重新发送", vbInformation, "提示"
End If
End Sub