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

hu柏拉图的永恒

VB串口自动检测为什么总是无效的端口号8002 [复制链接]

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

dcexpert

不如直接检查注册表，windows中的串口可以在注册表中找到的。

HKEY_LOCAL_MACHINE\HARDWARE\DEVICEMAP\SERIALCOMM