Question

利用VB实现接收单片机数据

利用VB实现接收单片机数据（1字节2进制数据）
Private Sub Form_Load()
MSComm1.CommPort = 1 '通道1
MSComm1.Settings = "9600,N,8,1" '"9600,N,8,1"
MSComm1.PortOpen = True '打开串口
MSComm1.RThreshold = 1 '接收缓冲区收到每一个字符都会使 MSComm 控件产生 OnComm 事件
'InputModeBinary = 1
End Sub

Private Sub MSComm1_OnComm()
Dim a As Byte
Text1.Text = a
MSComm1.InBufferCount = 0
End Sub
这样对吗？
InputModeBinary=1是什么？
我是接收20个左右的数据``而每个数据都是二进制的只占1字节的数
Private Sub Form_Load()
MSComm1.CommPort = 1 '通道1
MSComm1.Settings = "9600,N,8,1" '"9600,N,8,1"
MSComm1.RThreshold = 1 '接收缓冲区收到每一个字符都会使 MSComm 控件产生 OnComm 事件
MSComm1.PortOpen = True '打开串口
MSComm1.InputMode = comInputModeBinary '以二进制方式接收
End Sub

Private Sub MSComm1_OnComm()
On Error Resume Next
Text1 = ""
Dim a() As Byte
Dim strBuff As String
Dim strData As String
Dim i As Integer
Dim x As Integer
Select Case MSComm1.CommEvent
Case 2
MSComm1.InputLen = 0
strBuff = MSComm1.Input
a() = strBuff
For i = 0 To UBound(a)
If Len(Hex(a(i))) = 1 Then
strData = strData & "0" & Hex(a(i))
Else
strData = strData & Hex(a(i))
End If
Next
Text1 = Text1 + strData
End Select
End Sub
我试了你发的这个，单片机一次只发7字节数字``接收正常
但是接收9个字节或以上的时候text1却只显示62
那是为什么啊？我是初学者`呵呵

Answer 1

代码有错，修改如下，以二进制方式接收，转为16进制字符形式显示：
Private Sub Form_Load()
MSComm1.CommPort = 1 '通道1
MSComm1.Settings = "9600,N,8,1" '"9600,N,8,1"
MSComm1.RThreshold = 1 '接收缓冲区收到每一个字符都会使 MSComm 控件产生 OnComm 事件
MSComm1.PortOpen = True '打开串口
MSComm1.InputMode = comInputModeBinary '以二进制方式接收
End Sub

Private Sub MSComm1_OnComm()
On Error Resume Next
Text1 = ""
Dim a() As Byte
Dim strBuff As String
Dim strData As String
Dim i As Integer
Dim x As Integer
Select Case MSComm1.CommEvent
Case 2
MSComm1.InputLen = 0
strBuff = MSComm1.Input
a() = strBuff
For i = 0 To UBound(a)
If Len(Hex(a(i))) = 1 Then
strData = strData & "0" & Hex(a(i))
Else
strData = strData & Hex(a(i))
End If
Next
Text1 = Text1 + strData
End Select
End Sub

你提问是仅接收1字节2进制数据，我认为，VB经RS232口接收单片机的数据字节数是依据通信协议而定，上述代码是MSCOMM控件接收数据的通用代码，可根据需要进行修改，见如下代码中的数据判别：
Private Sub MSComm1_OnComm()
On Error Resume Next
Dim BytReceived() As Byte
Dim strBuff As String
Dim strData As String
Dim i As Integer
Dim x As Integer
Select Case MSComm1.CommEvent
Case 2
MSComm1.InputLen = 0
strBuff = MSComm1.Input
BytReceived() = strBuff
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
Text3 = Text3 + strData
If Left(strData, 2) = "7D" And Len(strData) = 2 Then '接收1字节数据
Text1(0).Text = Left(strData, 8)
Call DataClear
ElseIf Left(strData, 2) = "7F" And Len(strData) = 10 Then '接收5字节数据
Text1(1).Text = Left(strData, 10)
Call DataClear
End If
End Select
End Sub

Public Sub DataClear()
MSComm1.OutBufferCount = 0 '清空发送缓冲区
MSComm1.InBufferCount = 0
Text3 = ""
End Sub

下面补充用VB调试精灵的源代码改的16进制收发代码：
Option Explicit
Dim intTime As Integer
Private strSendText As String '发送文本数据
Private bytSendByte() As Byte '发送二进制数据
Private blnReceiveFlag As Boolean
Private blnAutoSendFlag As Boolean
Private intPort As Integer
Private strSet As String
Private intReceiveLen As Integer
Private bytReceiveByte() As Byte
Private strAscii As String '设置初值
Private strHex As String
Private intHexWidth As Integer
Private intLine As Integer
Private m As Integer
Private strAddress As String
'字符表示的十六进制数转化为相应的整数,错误则返回 -1
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

'字符串表示的十六进制数据转化为相应的字节串,返回转化后的字节数
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 cmdManualSend_Click()
If Not Me.MSComm.PortOpen Then
Me.MSComm.CommPort = intPort
Me.MSComm.Settings = strSet
Me.MSComm.PortOpen = True
End If
Call ctrTimer_Timer
If Not blnAutoSendFlag Then
Me.MSComm.PortOpen = False
End If
End Sub
Private Sub cmdAutoSend_Click()
If blnAutoSendFlag Then
Me.ctrTimer.Enabled = False
If Not blnReceiveFlag Then
Me.MSComm.PortOpen = False
End If
Me.cmdAutoSend.Caption = "自动发送"
Else
If Not Me.MSComm.PortOpen Then
Me.MSComm.CommPort = intPort
Me.MSComm.Settings = strSet
Me.MSComm.PortOpen = True
End If
Me.ctrTimer.Interval = intTime
Me.ctrTimer.Enabled = True
Me.cmdAutoSend.Caption = "停止发送"
End If
blnAutoSendFlag = Not blnAutoSendFlag
End Sub

Private Sub ctrTimer_Timer()
Dim longth As Integer
strSendText = Me.txtSend.Text
longth = strHexToByteArray(strSendText, bytSendByte())
If longth > 0 Then
Me.MSComm.Output = bytSendByte
End If
End Sub
'输入处理,处理接收到的字节流,并保存在全局变量
Private Sub InputManage(bytInput() As Byte, intInputLenth As Integer)
Dim n As Integer '定义变量及初始化
ReDim Preserve bytReceiveByte(intReceiveLen + intInputLenth)
For n = 1 To intInputLenth Step 1
bytReceiveByte(intReceiveLen + n - 1) = bytInput(n - 1)
Next n
intReceiveLen = intReceiveLen + intInputLenth
End Sub

'为输出准备文本,保存在全局变量
'总行数保存在intLine
Public Sub GetDisplayText()
Dim n As Integer
Dim intValue As Integer
Dim intHighHex As Integer
Dim intLowHex As Integer
Dim strSingleChr As String * 1
Dim intAddress As Integer
Dim intAddressArray(8) As Integer
Dim intHighAddress As Integer
strAscii = "" '设置初值
strHex = ""
strAddress = ""
'获得16进制码和ASCII码的字符串
For n = 1 To intReceiveLen
intValue = bytReceiveByte(n - 1)
If intValue < 32 Or intValue > 128 Then '处理非法字符
strSingleChr = Chr(46) '对于不能显示的ASCII码,
Else '用"."表示
strSingleChr = Chr(intValue)
End If
strAscii = strAscii + strSingleChr
intHighHex = intValue \ 16
intLowHex = intValue - intHighHex * 16
If intHighHex < 10 Then
intHighHex = intHighHex + 48
Else
intHighHex = intHighHex + 55
End If
If intLowHex < 10 Then
intLowHex = intLowHex + 48
Else
intLowHex = intLowHex + 55
End If
strHex = strHex + Chr$(intHighHex) + Chr$(intLowHex) + " "
If (n Mod intHexWidth) = 0 Then
strAscii = strAscii + Chr$(13) + Chr$(10)
strHex = strHex + Chr$(13) + Chr$(10)
Else
End If
Next n
txtAsc = strAscii 'Ascii
txtHex = strHex '16进制
'获得地址字符串
intLine = intReceiveLen \ intHexWidth
If (intReceiveLen - intHexWidth * intLine) > 0 Then
intLine = intLine + 1
End If
'设置换行
For n = 1 To intLine
intAddress = (n - 1) * intHexWidth
intHighAddress = 8
intAddressArray(0) = intAddress
For m = 1 To intHighAddress
intAddressArray(m) = intAddressArray(m - 1) \ 16
Next m
For m = 1 To intHighAddress
intAddressArray(m - 1) = intAddressArray(m - 1) - intAddressArray(m) * 16
Next m
For m = 1 To intHighAddress
If intAddressArray(intHighAddress - m) < 10 Then
intAddressArray(intHighAddress - m) = intAddressArray(intHighAddress - m) + Asc("0")
Else
intAddressArray(intHighAddress - m) = intAddressArray(intHighAddress - m) + Asc("A") - 10
End If
strAddress = strAddress + Chr$(intAddressArray(intHighAddress - m))
Next m
strAddress = strAddress + Chr$(13) + Chr$(10)
Next n
txtAdd = strAddress '地址
End Sub
Private Sub cmdReceive_Click()
If blnReceiveFlag Then
If Not blnReceiveFlag Then
Me.MSComm.PortOpen = False
End If
Me.cmdReceive.Caption = "开始接收"
Else
If Not Me.MSComm.PortOpen Then
Me.MSComm.CommPort = intPort
Me.MSComm.Settings = strSet
Me.MSComm.PortOpen = True
End If
Me.MSComm.InputLen = 0
Me.MSComm.InputMode = 0
Me.MSComm.InBufferCount = 0
Me.MSComm.RThreshold = 1
Me.cmdReceive.Caption = "停止接收"
End If
blnReceiveFlag = Not blnReceiveFlag
End Sub

Private Sub Form_Load()
intHexWidth = 8
txtAdd = ""
txtHex = ""
txtAsc = ""
txtSend = "11"
txtAdd.Width = 1335
txtHex.Width = 2535
txtAsc.Width = 1215
'设置默认发送接收关闭状态
blnAutoSendFlag = False
blnReceiveFlag = False
'接收初始化
intReceiveLen = 0
'默认发送方式为16进制
'intOutMode = 1
'初始化串行口
intPort = 1
intTime = 1000
strSet = "9600,n,8,1"
Me.MSComm.InBufferSize = 1024
Me.MSComm.OutBufferSize = 512
If Not Me.MSComm.PortOpen Then
Me.MSComm.CommPort = intPort
Me.MSComm.Settings = strSet
Me.MSComm.PortOpen = True
End If
Me.MSComm.PortOpen = False
End Sub

Private Sub cmdClear_Click()
Dim bytTemp(0) As Byte
ReDim bytReceiveByte(0)
intReceiveLen = 0
Call InputManage(bytTemp, 0)
Call GetDisplayText
Call disPlay
End Sub

Private Sub MsComm_OnComm()
Dim bytInput() As Byte
Dim intInputLen As Integer
Select Case Me.MSComm.CommEvent
Case comEvReceive
If blnReceiveFlag Then
If Not Me.MSComm.PortOpen Then
Me.MSComm.CommPort = intPort
Me.MSComm.Settings = strSet
Me.MSComm.PortOpen = True
End If
'此处添加处理接收的代码
Me.MSComm.InputMode = comInputModeBinary '二进制接收
intInputLen = Me.MSComm.InBufferCount
ReDim bytInput(intInputLen)
bytInput = Me.MSComm.Input
Call InputManage(bytInput, intInputLen)
Call GetDisplayText
'Call disPlay
If Not blnReceiveFlag Then
Me.MSComm.PortOpen = False
End If
End If
End Select
End Sub

Private Sub disPlay()
txtHex = ""
txtAsc = ""
txtAdd = ""
End Sub