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