vb串口通信接收的问题

2025-03-05 03:11:02
推荐回答(2个)
回答1:

Option Explicit
Dim BytReceived() As Byte
Dim strData As String
Dim lenInput As Integer
Dim bytSendByte() As Byte '发送二进制数据
Dim strSendText As String '发送文本数据
Dim blnAutoSendFlag As Boolean
Dim openFlag As Boolean

Private Sub cmdOpen_Click()
On Error GoTo erruser
If openFlag Then
cmdOpen.Caption = "打开串口"
MSComm1.PortOpen = False '打开端口
Timer2.Enabled = False
Shape1.FillColor = vbRed
Label5 = "关闭"
Else
cmdOpen.Caption = "关闭串口"
Shape1.FillColor = vbGreen
Label5 = "打开"
MSComm1.PortOpen = True '打开端口
If blnAutoSendFlag = True Then
Timer2.Enabled = True
End If
End If
openFlag = Not openFlag
erruser:
End Sub

Private Sub cmdSend_Click()
Dim longth As Integer
strSendText = Me.TxtSend.Text
longth = strHexToByteArray(strSendText, bytSendByte())
If longth > 0 Then
If MSComm1.PortOpen = True Then
Me.MSComm1.Output = bytSendByte
End If
End If
End Sub
'字符串表示的十六进制数据转化为相应的字节串,返回转化后的字节数
Function strHexToByteArray(strText As String, bytByte() As Byte) As Integer
Dim HexData As Integer '十六进制(二进制)数据字节对应值
Dim hstr As String * 1 '高位字符
Dim lstr As String * 1 '低位字符
Dim HighHexData As Integer '高位数值
Dim LowHexData As Integer '低位数值
Dim HexDataLen As Integer '字节数
Dim StringLen As Integer '字符串长度
Dim Account As Integer
Dim n As Integer
'计数
'txtSend = "" '设初值
HexDataLen = 0
strHexToByteArray = 0
StringLen = Len(strText)
Account = StringLen \ 2
ReDim bytByte(Account)
For n = 1 To StringLen
Do '清除空格
hstr = Mid(strText, n, 1)
n = n + 1
If (n - 1) > StringLen Then
HexDataLen = HexDataLen - 1
Exit For
End If
Loop While hstr = " "
Do
lstr = Mid(strText, n, 1)
n = n + 1
If (n - 1) > StringLen Then
HexDataLen = HexDataLen - 1
Exit For
End If
Loop While lstr = " "
n = n - 1
If n > StringLen Then
HexDataLen = HexDataLen - 1
Exit For
End If
HighHexData = ConvertHexChr(hstr)
LowHexData = ConvertHexChr(lstr)

If HighHexData = -1 Or LowHexData = -1 Then '遇到非法字符中断转化
HexDataLen = HexDataLen - 1
Exit For
Else
HexData = HighHexData * 16 + LowHexData
bytByte(HexDataLen) = HexData
HexDataLen = HexDataLen + 1
End If
Next n
If HexDataLen > 0 Then '修正最后一次循环改变的数值
HexDataLen = HexDataLen - 1
ReDim Preserve bytByte(HexDataLen)
Else
ReDim Preserve bytByte(0)
End If
If StringLen = 0 Then '如果是空串,则不会进入循环体
strHexToByteArray = 0
Else
strHexToByteArray = HexDataLen + 1
End If
End Function

Private Sub cmdAutoSend_Click()
If blnAutoSendFlag Then
Me.Timer2.Enabled = False
Me.cmdAutoSend.Caption = "自动发送"
Else
Me.Timer2.Enabled = True
Me.cmdAutoSend.Caption = "停止发送"

End If
blnAutoSendFlag = Not blnAutoSendFlag
End Sub

Private Sub MSComm1_OnComm()
On Error Resume Next
Dim strBuff As String
Text1 = ""
Select Case MSComm1.CommEvent
Case 2
MSComm1.InputLen = 0
strBuff = MSComm1.Input
BytReceived() = strBuff
jieshou
LblJieshou = Text1
lenInput = Len(LblJieshou)
Text3 = lenInput \ 2
'Text2 = Mid(LblJieshou, 1, 2)
'数据处理代码
If Mid(LblJieshou, 3, 4) = "F111" And Len(LblJieshou) = 112 Then
'将接收数据在此处赋值给所需变量
Text4 = LblJieshou
ElseIf Mid(LblJieshou, 3, 4) = "F111" And Len(LblJieshou) = 14 Then
Text5 = LblJieshou
End If
End Select
End Sub
Private Sub Form_Load()
Dim port As Integer
port = 1
MSComm1.CommPort = port 'COM端口
MSComm1.Settings = "9600,n,8,1"
MSComm1.InputMode = comInputModeBinary '采用二进制传输
MSComm1.InBufferCount = 0 '清空接受缓冲区
MSComm1.OutBufferCount = 0 '清空传输缓冲区
MSComm1.RThreshold = 1 '产生MSComm事件
MSComm1.InBufferSize = 1024
Text1 = ""
Text3 = ""
LblJieshou = ""
Text4 = ""
Timer1.Interval = 200
Label4 = "端口:COM" & port
Label5 = "关闭"
TxtSend = "AA82020000002E55"
End Sub

Private Sub Timer1_Timer()
strData = ""
End Sub
Function ConvertHexChr(str As String) As Integer
Dim test As Integer
test = Asc(str)
If test >= Asc("0") And test <= Asc("9") Then
test = test - Asc("0")
ElseIf test >= Asc("a") And test <= Asc("f") Then
test = test - Asc("a") + 10
ElseIf test >= Asc("A") And test <= Asc("F") Then
test = test - Asc("A") + 10
Else
test = -1 '出错信息
End If
ConvertHexChr = test
End Function

Public Sub jieshou()
Dim i As Integer
For i = 0 To UBound(BytReceived)
If Len(Hex(BytReceived(i))) = 1 Then
strData = strData & "0" & Hex(BytReceived(i))
Else
strData = strData & Hex(BytReceived(i))
End If
Next
Text1 = strData
Text2 = Len(strData)
End Sub

Private Sub Timer2_Timer()
cmdSend_Click
End Sub

回答2:

设置InputLen=0,一次接收全部缓冲区的数据,缓冲区长度应该是1024字节,注意不要超出范围。
然后在产生oncomm事件后,给予适当的延时,一般100~200毫秒就差不多了,如果还是无法接收完,则可以再延长一些。
例如:
在GetData = MSCOMM_Rs232.Input 之前加入delay(200),delay()是自定义函数,200是延时的毫秒数。
以下延时函数我以前用的(因目前工作与VB无关,好久没用了,也没有VB的调试环境);你可以参考,自行调试。
Private Declare Function GetTickCount Lib "kernel32" () As Long
'API函数,获得计算机启动以来消逝的毫秒数
'
sub Delay(DTime as long)
dim Tmp as long
'
tmp=gettickcount
'
do
doevents '释放系统控制权,避免系统反应迟缓
loop while gettickcount-tmp<=dtime
'
end sub

'如通过其它方式处理好了,请不要忘了告诉我哦,也好让我长长见识,呵呵!