如何枚举计算机上可用的COM端口?

时间:2011-03-12 04:10:42

标签: vb6 serial-port

除了从1到32的循环并尝试打开它们之外,是否有可靠的方法来获取系统上的COM端口?

4 个答案:

答案 0 :(得分:3)

我相信在现代Windows环境下,您可以在注册表中的以下键HKEY_LOCAL_MACHINE\HARDWARE\DEVICEMAP\SERIALCOMM下找到它们。我不确定指定注册表项的正确方法。但是我只在Windows XP上测试过它。

答案 1 :(得分:3)

查看Randy Birch网站上的这篇文章:CreateFile: Determine Available COM Ports

还有使用MSCOMM控件的方法:ConfigurePort: Determine Available COM Ports with the MSCOMM Control

这段代码对我来说有点太长了,但是链接里面有你需要的一切。

答案 2 :(得分:2)

它是1到255.你能做的最快就是使用这样的QueryDosDevice

Option Explicit

'--- for CreateFile
Private Const GENERIC_READ                  As Long = &H80000000
Private Const GENERIC_WRITE                 As Long = &H40000000
Private Const OPEN_EXISTING                 As Long = 3
Private Const INVALID_HANDLE_VALUE          As Long = -1
'--- error codes
Private Const ERROR_ACCESS_DENIED           As Long = 5&
Private Const ERROR_GEN_FAILURE             As Long = 31&
Private Const ERROR_SHARING_VIOLATION       As Long = 32&
Private Const ERROR_SEM_TIMEOUT             As Long = 121&

Private Declare Function QueryDosDevice Lib "kernel32" Alias "QueryDosDeviceA" (ByVal lpDeviceName As Long, ByVal lpTargetPath As String, ByVal ucchMax As Long) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Function PrintError(sFunc As String)
    Debug.Print sFunc; ": "; Error
End Function

Public Function IsNT() As Boolean
    IsNT = True
End Function

Public Function EnumSerialPorts() As Variant
    Const FUNC_NAME     As String = "EnumSerialPorts"
    Dim sBuffer         As String
    Dim lIdx            As Long
    Dim hFile           As Long
    Dim vRet            As Variant
    Dim lCount          As Long

    On Error GoTo EH
    ReDim vRet(0 To 255) As Variant
    If IsNT Then
        sBuffer = String$(100000, 1)
        Call QueryDosDevice(0, sBuffer, Len(sBuffer))
        sBuffer = Chr$(0) & sBuffer
        For lIdx = 1 To 255
            If InStr(1, sBuffer, Chr$(0) & "COM" & lIdx & Chr$(0), vbTextCompare) > 0 Then
                vRet(lCount) = "COM" & lIdx
                lCount = lCount + 1
            End If
        Next
    Else
        For lIdx = 1 To 255
            hFile = CreateFile("COM" & lIdx, GENERIC_READ Or GENERIC_WRITE, 0, 0, OPEN_EXISTING, 0, 0)
            If hFile = INVALID_HANDLE_VALUE Then
                Select Case Err.LastDllError
                Case ERROR_ACCESS_DENIED, ERROR_GEN_FAILURE, ERROR_SHARING_VIOLATION, ERROR_SEM_TIMEOUT
                    hFile = 0
                End Select
            Else
                Call CloseHandle(hFile)
                hFile = 0
            End If
            If hFile = 0 Then
                vRet(lCount) = "COM" & lIdx
                lCount = lCount + 1
            End If
        Next
    End If
    If lCount = 0 Then
        EnumSerialPorts = Split(vbNullString)
    Else
        ReDim Preserve vRet(0 To lCount - 1) As Variant
        EnumSerialPorts = vRet
    End If
    Exit Function
EH:
    PrintError FUNC_NAME
    Resume Next
End Function

该代码段在9x时回落到CreateFile。为简洁起见,IsNT函数存在缺陷。

答案 3 :(得分:1)

使用VB6或VBScript枚举可用的COM端口可以像使用VB.NET一样简单,这可以通过枚举注册表路径HKEY_LOCAL_MACHINE\HARDWARE\DEVICEMAP\SERIALCOMM中的值来完成。这比调用QueryDosDevice()并进行字符串比较来过滤掉以COM开头的设备更好,因为您会得到CompositeBattery之类的东西(或其他带有全大写字母名字的东西COM)不是COM端口。这样做的另一个好处是注册表值还包含 USB到COM设备,而使用WMIService.ExecQuery("Select * from Win32_SerialPort")这样的代码则无法检测到。如果您尝试将USB插入COM设备的计算机中或从计算机中拔出,则可以看到注册表值也立即出现或消失,因为它会不断更新。

Option Explicit

Sub ListComPorts()
List1.Clear

Dim Registry As Object, Names As Variant, Types As Variant
Set Registry = GetObject("winmgmts:\\.\root\default:StdRegProv")
If Registry.EnumValues(&H80000002, "HARDWARE\DEVICEMAP\SERIALCOMM", Names, Types) <> 0 Then Exit Sub

Dim I As Long
If IsArray(Names) Then
    For I = 0 To UBound(Names)
        Dim PortName As Variant
        Registry.GetStringValue &H80000002, "HARDWARE\DEVICEMAP\SERIALCOMM", Names(I), PortName
        List1.AddItem PortName & " - " & Names(I)
    Next
End If

End Sub

Private Sub Form_Load()
ListComPorts
End Sub

上面的代码使用StdRegProv class来枚举注册表项的值。我已经在XP,Windows 7,Windows 10中测试了该代码,并且可以正常工作。添加到列表框中的项目如下所示:

COM1 - \Device\Serial0
COM3 - \Device\ProlificSerial0

此代码的缺点是,由于每个端口只能打开一次,因此它无法检测到其他程序已打开了哪个端口。可以通过调用API CreateFile来完成检测COM端口是否由其他程序打开的方法。 Here is an example.