串口通讯

Private Sub cmdSend_Click() MSComm1.Output = Textsend.Text End Sub

Private Sub MSComm1_OnComm() Dim intInputLen As Integer

Select Case Me.MSComm1.CommEvent Case comEvReceive

TextReceive.Text = TextReceive.Text + MSComm1.Input End Select End Sub

Private Sub Cmdauto_Click() Timer1.Enabled = True End Sub

Private Sub Timer1_Timer() MSComm1.Output = Textsend.Text

TextReceive.Text = TextReceive.Text + MSComm1.Input End Sub

Private Sub Cmdstop_Click() Timer1.Enabled = False End Sub

Private Sub Cmdquit_Click() MSComm1.PortOpen = False End End Sub

Private Sub CmdReceivecl_Click() TextReceive.Text = \"\" End Sub

Private Sub Cmdsendcl_Click() Textsend.Text = \"\" End Sub

实现16进制接收实质就是按2进制接收

设置MSComm控件的属性InputMode = comInputModeBinary '二进制接收 接收后由HEX函数转为16进制字符串形式显示 Option Explicit

Dim strData As String Dim bytInput() As Byte

Private Sub MsComm1_OnComm() Dim intInputLen As Integer

Select Case Me.MSComm2.CommEvent Case comEvReceive '此处添加处理接收的代码

MSComm1.InputMode = comInputModeBinary '二进制接收 intInputLen = MSComm1.InBufferCount ReDim bytInput(intInputLen) bytInput = MSComm1.Input jieshou End Select End Sub

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

For i = 0 To UBound(bytInput) If Len(Hex(bytInput(i))) = 1 Then

strData = strData & \"0\" & Hex(bytInput(i)) Else

strData = strData & Hex(bytInput(i)) End If Next

Text1 = strData End Function

Private Sub Form_Load() MSComm1.CommPort = 1 MSComm1.InBufferSize = 1024 MSComm1.OutBufferSize = 512 MSComm1.Settings = \"9600,n,8,1\" MSComm1.PortOpen = True Text1 = \"\" End Sub

3回答

代码如下：

Private Sub Form_Load()

If MSComm1.PortOpen = True Then MSComm1.PortOpen = False Else End If

Combo1.AddItem \"COM1\" Combo1.AddItem \"COM2\" Combo1.AddItem \"COM3\" Combo1.AddItem \"COM4\" Combo1.AddItem \"COM5\" Combo1.AddItem \"COM6\" Combo1.AddItem \"COM7\" Combo1.AddItem \"COM8\" Combo1.AddItem \"COM9\" Combo1.AddItem \"COM10\" Combo1.AddItem \"COM11\" Combo1.AddItem \"COM12\" Combo1.AddItem \"COM13\"

Combo1.AddItem \"COM14\" Combo1.AddItem \"COM15\" Combo1.AddItem \"COM16\" Combo1.ListIndex = 2 Combo2.AddItem \"256000\" Combo2.AddItem \"128000\" Combo2.AddItem \"115200\" Combo2.AddItem \"57600\" Combo2.AddItem \"38400\" Combo2.AddItem \"28800\" Combo2.AddItem \"19200\" Combo2.AddItem \"14400\" Combo2.AddItem \"12800\" Combo2.AddItem \"11520\" Combo2.AddItem \"9600\" Combo2.AddItem \"4800\" Combo2.AddItem \"2400\" Combo2.AddItem \"1200\" Combo2.AddItem \"600\" Combo3.AddItem \"无None\" Combo3.AddItem \"奇Odd\" Combo3.AddItem \"偶Even\" Combo4.AddItem \"4\" Combo4.AddItem \"5\" Combo4.AddItem \"6\" Combo4.AddItem \"7\" Combo4.AddItem \"8\" Combo5.AddItem \"1\" Combo5.AddItem \"2\"

MSComm1.CommPort = Combo1.ListIndex + 1 MSComm1.Settings = \"9600,n,8,1\" ComOpen.Caption = \"打开串口\" Shape1.FillColor = &HFFFFC0 End Sub

Private Sub ComOpen_Click()

On Error GoTo uerror '发现错误跳转到错误处理

If ComOpen.Caption = \"关闭串口\" Then MSComm1.PortOpen = False

ComOpen.Caption = \"打开串口\" '按钮文字改变 Shape1.FillColor = &HFFFFC0 '灯颜色改变 Else

MSComm1.PortOpen = True ComOpen.Caption = \"关闭串口\" Shape1.FillColor = &HFF End If Exit Sub uerror:

msg$ = \"无效端口号\" '错误显示 Title$ = \"串口调试助手\"

X = MsgBox(msg$, 48, Title$) '48标示显示警告图标 End Sub

Private Sub MSComm1_OnComm() Dim BytReceived() As Byte Dim strBuff As String Dim i As Integer

Select Case MSComm1.CommEvent '事件发生 Case 2 Cls

MSComm1.InputLen = 0 '读入缓冲区全部内容 strBuff = MSComm1.Input '读入到缓冲区

Label10.Caption = Label10.Caption + Len(strBuff) '接收计数 If MSComm1.InputMode = comInputModeBinary Then

BytReceived() = strBuff '如果是二进制接收模式则进行数据处理，否则直接显示字符串

For i = 0 To UBound(BytReceived) If Len(Hex(BytReceived(i))) = 1 Then

strData = strData & \"0\" & Hex(BytReceived(i)) & \" \" '如果只有一个字符，则前补0，如F显示0F，最后补空格

Else '方便显示观察如： 00 0F FE strData = strData & Hex(BytReceived(i)) & \" \"

End If Next

TextReceive = TextReceive & strData strData = \"\" Else

TextReceive = TextReceive & strBuff End If End Select End Sub

Private Sub ComSend1_Click() '手动发送 Dim Temp(0) As Byte Dim strBuff As String

If Option1.Value = True Then '如果显示16进制发送则进行16进制处理 ，这里只发送一个

Temp(0) = \"&H\" & TextSend

MSComm1.Output = Temp '发送一个16进制 Else

strBuff = TextSend End If

If MSComm1.PortOpen = False Then MsgBox \"请打开串口\" End If

On Error GoTo uerror MSComm1.Output = strBuff

Label11.Caption = Label11.Caption + Len(strBuff) '发送计数 uerror: End Sub

Private Sub ComSend2_Click()

If ComSend2.Caption = \"自动发送\" Then ComSend2.Caption = \"关闭自动发送\" Timer1.Interval = TextTime.Text Timer1.Enabled = True Else

ComSend2.Caption = \"自动发送\" Timer1.Enabled = False End If

End Sub

Private Sub ComClean1_Click()

TextSend.Text = \"\" '清空发送窗口 End Sub

Private Sub Option3_Click()

MSComm1.InputMode = comInputModeBinary '选择接收方式 End Sub

Private Sub Option4_Click()

MSComm1.InputMode = comInputModeText '选择接收方式 End Sub

Private Sub Timer1_Timer()

Call ComSend1_Click '定时调用手动发送 End Sub

Private Sub Timer2_Timer() If Combo3 = \"无None\" Then

MSComm1.Settings = Str(Combo2) + \"N\" + Str(Combo4) + Str(Combo5) ElseIf Combo3 = \"奇Odd\" Then

MSComm1.Settings = Str(Combo2) + \"O\" + Str(Combo4) + Str(Combo5) ElseIf Combo3 = \"偶Even\" Then

MSComm1.Settings = Str(Combo2) + \"E\" + Str(Combo4) + Str(Combo5) End If End Sub

Private Sub Combo1_Click()

If MSComm1.PortOpen = True Then '如果串口打开先关闭后再进行其他操作 MSComm1.PortOpen = False End If

MSComm1.CommPort = Combo1.ListIndex + 1 '读取com口号 End Sub

Private Sub ComClean3_Click() Label10.Caption = 0 Label11.Caption = 0 End Sub

Private Sub ComClean2_Click() TextReceive.Text = \"\" '接收窗口 End Sub

功能上：实现了字符串的发送和接收，8位数据的十六进制发送和接收，有端口，波特率等设置。 缺点：

1：只可以发送两位十六进制数。

2：接收和发送的显示数据上有点不同步，十六进制的没有算进去。 3：没有TXT的文件发送和接收的功能。

如需要源程序的，可下载本文的图片，下载后把图片的.jpg格式改为.rar格式就可以解压出来了。

附：MSComm控件的属性 属性 (Name) (自定义) CommPort MSComm控件的名称 打开属性页 获得或设置通讯端口号 决定在通讯过程中是否使数据终端机状态线有效。取值为： DTREnable True False 获得或设置是否搜索EOF字符。取值为： EOFEnable True False 获得或设置软件的握手协议。取值为： 0 comNone Handshaking 1 comXOnXoff 2 comRTS 3 comRTSXOnXOff InBufferSize Index InputLen 获得或设置接收缓冲区的大小，以字节数为单位。 在对象数组中的编号 获得或设置输入属性从接收缓冲区读出的字符数。 获得或设置输入属性检索的数据类型。取值为： InputMode 0 comInputModeText 1 comInputModeBinary Left NullDiscard 距离容器左边框的距离 决定是否将空字符串从端口传送到接收缓冲区。取值为： True 说明 False OutBufferSize ParityReplace RThreshold 获得或设置传输缓冲区中的字符数 获得或设置当出现奇偶校验错误时，用来替换数据流中无效字符的字符。 获得或设置要接受的字符数。 决定能否使行有效。取值为： RTSEnable True False Settings SThreshold Tag Top 获得或设置波特率、奇偶校验、数据位和停止位参数。 获得或设置传输中所能允许的最小字符数 存储程序所需的附加数据 距容器顶部边界的距离 。

通讯突然停住的有几个原因：

1 串口设置了接收长度产生中断，但长时间内接收缓冲区没达到产生中断的数据； 2 文本框字符串的总长度超过了k，文本框不再更新； 3 串口参数配置不正确。

试试我下面的程序看还会不会停住吧，我的程序是不间断接收数据的，不会有停住的可能。 Private Sub Command1_Click() Timer1.Enabled = True

Command1.BackColor = vbGreen End Sub

Private Sub Command2_Click() Text1.Text = \"\" End Sub

Private Sub Form_Load() '通讯口初始化：

With MSComm1

.Settings = \"9600,n,8,2\" .CommPort = 3

.InputMode = comInputModeBinary .InBufferCount = 0 .OutBufferCount = 0 .RThreshold = 0

.SThreshold = 0 .PortOpen = True End With Text1.Text = \"\" End Sub

Private Sub Text1_Change()

If Len(Text1.Text) > 10000 Then Text1.Text = \"\" End Sub

Private Sub Timer1_Timer() '采用轮循法采集数据 Dim inx() As Byte Dim strTemp As String Dim strTemp1 As String Dim ReceivedLen As Integer

Timer1.Enabled = False '关闭定时器

If MSComm1.InBufferCount > 0 Then ReceivedLen = MSComm1.InBufferCount inx = MSComm1.Input For i = 0 To UBound(inx) strTemp1 = Hex(inx(i)) If Len(strTemp1) > 1 Then

strTemp = strTemp & strTemp1 & \" \" Else

strTemp = strTemp & \"0\" & strTemp1 & \" \" End If Next i

Text1.Text = Text1.Text & Format(Second(Now), \"00\") & Right(Format(Str(Timer), \"0.00\"), 3) & \" \" & strTemp & vbCrLf Text1.SelStart = Len(Text1.Text) End If

Timer1.Enabled = True '打开定时器 Label1.Caption = Now()

End Sub