VB串口自动检测为什么总是无效的端口号8002

2019-03-24 17:56发布

QQ图片20150717155805.png


Private Sub command2_Click()



If MSComm1.PortOpen = True Then MSComm.PortOpen = False                          ' 先判断串口是否打开,如果打开则先关闭



With MSComm1



  .Settings = "9600,N,8,1"   '设置通信口参数

  .InputMode = comInputModeBinary '设置接收数据模式为二进制形式

  .InputLen = 1                  '设置input一次从接收缓冲区读取字节数为1

  .InBufferCount = 0              '清除接收缓冲区,等待计算机接收的字符数为0

  .RThreshold = 1               '设置接收一个字节产生oncomm事件,打开接收

  .SThreshold = 0

.PortOpen = True         ‘如果这句去掉就好了但是去掉这句文本框里就收不到1 2 3了

End With



End Sub



Private Sub Form_Load()

  Text1.Text = ""



On Error GoTo errline                           '如果出错,进入错误处理程序

    Dim i As Integer                                '定义可访问的串口总数

    Dim Counter As Integer                          '用于记录经检查可以使用的串口号

    '=======================初始化串口列表====================

    Counter = 0                                     '计数器清零

    For i = 1 To 16                                 '循环检查可能存在的16个串口

        MSComm1.CommPort = i                        '依次打开每个串口

        MSComm1.PortOpen = True                     '打开串口

        If MSComm1.PortOpen = True Then             '如果打开成功,说明该串口可用

            MSComm1.PortOpen = False                '检查完毕,关闭串口

            Combo1.AddItem "COM" + CStr(i), Counter '将可用串口增加到组合框

            Counter = Counter + 1                   '计数器加1

        End If

    Next i

    Combo1.ListIndex = 0                            '将第一个可用串口设为默认值



    Exit Sub

errline:

    If Err.Number = 8005 Then                       '若有的串口已被其他程序打开,也应该将其加入组合框内

        Combo1.AddItem "COM" + CStr(i), Counter  '将可用串口增加到组合框内

        Counter = Counter + 1                       '计数器加1

    End If

    Resume Next                                     '回到出错入口处,继续执行巡检串口程序



End Sub



Private Sub MSComm1_OnComm()



Dim buffer As Variant

Dim arr() As Byte

Select Case MSComm1.CommEvent

  Case comEvReceive

  buffer = MSComm1.Input

  arr = buffer        '返回一组二进制数据

  'Text1.Text = Text1.Text + " " + Hex(arr(0))

   Text1.Text = Hex(arr(0))

If Trim(Text1.Text) = "1" Then

SendKeys "a"



ElseIf Trim(Text1.Text) = "2" Then

SendKeys "b"



ElseIf Trim(Text1.Text) = "3" Then

SendKeys "c"

End If

End Select

End Sub



此帖出自小平头技术问答
友情提示: 此问题已得到解决,问题已经关闭,关闭后问题禁止继续编辑,回答。
该问题目前已经被作者或者管理员关闭, 无法添加新回复
1条回答
dcexpert
1楼-- · 2019-03-25 00:33
 精彩回答 2  元偷偷看……

一周热门 更多>