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

InputModeBinary

=

1

'通空升过

Input

属性以二进制方式检取回数据

写法有错，正确写法:

MSComm1.InputMode

=

comInputModeBinary

'以二进制带亏前方式蠢清接收

或:

MSComm1.InputMode

=

1

'以二进制方式接收

Private Sub Form_Load()

    MSComm1.CommPort = 1

    盯没MSComm1.Settings = " 9600,n,8,1"

    MSComm1.InputMode = comInputModeBinary

    MSComm1.InputLen = 0

    MSComm1.SThreshold = 1

  唯则兄  MSComm1.RThreshold = 1

    MSComm1.PortOpen = True

    Text5 = ""

End Sub

Private Sub MSComm1_OnComm()

    Dim buffer As Variant

    Dim arr() As Byte

    Dim i 指袭As Long

    Select Case MSComm1.CommEvent

        Case comEvReceive

            buffer = MSComm1.Input

            arr = buffer

            For i = 0 To UBound(arr)

                Text5.Text = Text5.Text + "||" + Right("0" & Hex(arr(i)), 2)

            Next i

            MSComm1.InBufferCount = 0

    End Select

End Sub

Option Explicit

Dim a As Integer

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 cmdClear_Click()

strData = ""

txtReceive = ""

End Sub

Private Sub cmdOpen_Click() '打开关闭端口

On Error GoTo Userr

If List1 <>"" And List2 <皮卖耐>"" And List3 <>"" And List3 <>"" And List3 <>"" Then

MSComm1.Settings = List2 &"," &List3 &"," &List5 &"," &List4

If openFlag Then

cmdOpen.Caption = "打开串口"

MSComm1.PortOpen = False '打开端口

Shape1.FillColor = vbRed

Else

MSComm1.CommPort = Val(List1)

MSComm1.PortOpen = True

cmdOpen.Caption = "关闭串口"

Shape1.FillColor = vbGreen

End If

End If

openFlag = Not openFlag

Exit Sub

Userr:

MsgBox ("Err号" &Err.Number &" 串口号错误或已打开!")

End Sub

Private Sub cmdSendASc_Click() '文本发送

Dim sj_Txt As String

sj_Txt = TxtSend

If MSComm1.PortOpen = True Then

MSComm1.Output = sj_Txt

End If

End Sub

Private Sub cmdSendHex_Click() '16进制发送

Dim sj() As Byte

Dim sj_Txt As String

Dim i As Integer

sj_Txt = TxtSend

If Len(TxtSend) Mod 2 = 0 And Len(TxtSend) <>0 Then '检验16进制字符串长

ReDim sj(Len(sj_Txt) / 2 - 1)

For i = 0 To Len(sj_Txt) - 1 Step 2

sj(i / 2) = Val("&H" &Mid(sj_Txt, i + 1, 2))

Next

If MSComm1.PortOpen = True Then

MSComm1.Output = sj

Else

MSComm1.PortOpen = True

Shape1.FillColor = vbGreen

MSComm1.Output = sj

End If

Else

MsgBox ("配让格式不对!")

End If

End Sub

'字符串表示的十六进制数据转化为相应的字节串,返回转化后的字节数

Private Sub Form_Load()

MSComm1.InputMode = comInputModeBinary '采用二进制传输

MSComm1.InBufferCount = 0 '清空接受缓冲区

MSComm1.OutBufferCount = 0 '清空传输缓冲区

MSComm1.RThreshold = 1 '产生MSComm事件

MSComm1.InBufferSize = 1024

TxtSend = ""

TxtSend = "" '800A00113135323634389794"

txtReceive = ""

Text2 = ""

End Sub

Private Sub List1_Click()

On Error GoTo useErr

If List1 <>"" And List2 <>"" And List3 <>"" And List3 <>""燃春 And List3 <>"" Then

MSComm1.CommPort = Val(List1)

End If

useErr:

End Sub

Private Sub List2_Click()

If List1 <>"" And List2 <>"" And List3 <>"" And List3 <>"" And List3 <>"" Then

MSComm1.Settings = List2 &"," &List3 &"," &List5 &"," &List4

cmdOpen.Enabled = True

End If

End Sub

Private Sub List3_Click()

If List1 <>"" And List2 <>"" And List3 <>"" And List3 <>"" And List3 <>"" Then

MSComm1.Settings = List2 &"," &List3 &"," &List5 &"," &List4

cmdOpen.Enabled = True

End If

End Sub

Private Sub List4_Click()

If List1 <>"" And List2 <>"" And List3 <>"" And List3 <>"" And List3 <>"" Then

MSComm1.Settings = List2 &"," &List3 &"," &List5 &"," &List4

cmdOpen.Enabled = True

End If

End Sub

Private Sub List5_Click()

If List1 <>"" And List2 <>"" And List3 <>"" And List3 <>"" And List3 <>"" Then

MSComm1.Settings = List2 &"," &List3 &"," &List5 &"," &List4

cmdOpen.Enabled = True

End If

End Sub

Private Sub MSComm1_OnComm() '接收数据

Dim strBuff As String

Select Case MSComm1.CommEvent

Case 2

MSComm1.InputLen = 0

strBuff = MSComm1.Input

BytReceived() = strBuff

jieshou

lenInput = Len(strData)

Text2 = lenInput \ 2

'数据处理代码

End Select

End Sub

Public Function jieshou() '接收数据处理为16进制

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

txtReceive = strData

End Function

---