送分100分：VB6MSCOMM控件，如何通过程序判断哪个串口可以用。

Question

送分100分：VB6MSCOMM控件，如何通过程序判断哪个串口可以用。

Answer 1

Option Explicit
    Dim a As Integer
    Dim blnAutoSendFlag As Boolean
    Dim openFlag As BooleanPrivate Sub Form_Load()
    MSComm1.Settings = "9600,n,8,1"
    MSComm1.InputMode = comInputModeBinary      '采用二进制传输
    MSComm1.InBufferCount = 0   '清空接受缓冲区
    MSComm1.OutBufferCount = 0  '清空传输缓冲区
    MSComm1.RThreshold = 1      '产生MSComm事件
    MSComm1.InBufferSize = 1024
    Shape1.FillStyle = 0
    OpenPortNum
End SubPrivate Sub OpenPortNum()
    On Error GoTo uerror
    For a = 1 To 16
        MSComm1.CommPort = a
        MSComm1.PortOpen = True
        If MSComm1.PortOpen = True Then
            Print "可用Com号= "; a
            MSComm1.PortOpen = False
        End If
    Next
    Exit Sub
uerror:
    Print "出错或占用Com号= "; a
    Resume Next
End Sub

Answer 2

Option Explicit
    Dim a As IntegerPrivate Sub Form_Load()
    MSComm1.Settings = "9600,n,8,1"
    MSComm1.InputMode = comInputModeBinary      '采用二进制传输
    MSComm1.InBufferCount = 0   '清空接受缓冲区
    MSComm1.OutBufferCount = 0  '清空传输缓冲区
    MSComm1.RThreshold = 1      '产生MSComm事件
    MSComm1.InBufferSize = 1024
    Shape1.FillStyle = 0
    OpenPortNum
End SubPrivate Sub OpenPortNum()
    On Error GoTo uerror
    For a = 1 To 16
        MSComm1.CommPort = a
        MSComm1.PortOpen = True
        If MSComm1.PortOpen = True Then
            Print "可用Com号= "; a
            MSComm1.PortOpen = False
        End If
    Next
    Exit Sub
uerror:
    Print "出错或占用Com号= "; a
    Resume Next
End Sub

Answer 3

首先需要枚举系统所拥有的串口，代码如下：
Option Explicit
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As String, lpcbData As Long) As LongPrivate Sub Command3_Click()
    Const ERROR_NO_MORE_ITEMS = 259&
    Const BUFFER_SIZE     As Long = 255
    Dim hKey     As Long, Cnt       As Long, sName       As String, sData       As String, Ret       As Long, RetData       As Long
    Ret = BUFFER_SIZE
    Cnt = 0
    List1.Clear
    If RegOpenKey(HKEY_LOCAL_MACHINE, "HardWare\DeviceMap\SerialComm", hKey) = 0 Then
            sName = Space(BUFFER_SIZE)
            sData = Space(BUFFER_SIZE)
            Ret = BUFFER_SIZE
            RetData = BUFFER_SIZE
            While RegEnumValue(hKey, Cnt, sName, Ret, 0, ByVal 0&, ByVal sData, RetData) <> ERROR_NO_MORE_ITEMS
                    If RetData > 0 Then
                            List1.AddItem Left$(sData, RetData - 1)
                    End If
                    Cnt = Cnt + 1
                    sName = Space(BUFFER_SIZE)
                    sData = Space(BUFFER_SIZE)
                    Ret = BUFFER_SIZE
                    RetData = BUFFER_SIZE
            Wend
            RegCloseKey hKey
    Else
            MsgBox "     错误"
    End If
End Sub对于如何判断串口是否打开，可以借鉴3楼的

Answer 4

 Dim i, j As Integer
    j = 0
    For i = 1 To 255
        MSComm1.CommPort = i
        On Error Resume Next
        MSComm1.PortOpen = True
        If Err.Number = 0 Then
            j = j + 1
            Combo1.AddItem "Com" & i
        Else
            MSComm1.PortOpen = False
        End If
    Next i
    If j < 0 Then
        Combo1.AddItem "Com1"
        StatusBar1.Panels(1).Text = "计算机上串口错误"
    Else
        StatusBar1.Panels(1).Text = "计算机上共有串口数：" & j
    End If
    Combo1.ListIndex = 0

Answer 5

串口硬件正常的情况下，以上代码不错。
另mscomm并不能检测到串口硬件是否正常，比如发送或接收的某一部分损坏，也一样可以正常打开此com口。