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

除了从1循环到32并尝试打开每个端口之外，还有可靠的方法在系统上获取COM端口吗？

我相信在现代windows环境下，您可以在注册表中的以下项下找到它们

HKEY\U LOCAL\U MACHINE\HARDWARE\DEVICEMAP\SERIALCOMM

。我不确定指定注册表项的正确方法。但是，我只在Windows XP上测试过这一点。

请从Randy Birch的网站上查看这篇文章：

还有一种使用MSCOMM控件的方法：

---

代码有点太长，我在这里发布，但链接有你需要的一切

是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函数为简洁起见被截短。

使用VB6或VBScript枚举可用COM端口可以像使用VB.NET一样简单，这可以通过从注册表路径枚举值来完成。

HKEY_LOCAL_MACHINE\HARDWARE\DEVICEMAP\SERIALCOMM

。这比调用

QueryDosDevice（）

并进行字符串比较以筛选出名称以

COM

开头的设备要好，因为您将获得类似于

CompositeBattery

（或其他以

COM

开头的大写全名的设备）的非COM端口。这样做的另一个好处是注册表值也包含USB到COM设备，使用诸如

WMIService.ExecQuery（“从Win32\u SerialPort选择*）

之类的代码无法检测到这些设备。如果您尝试将USB-to-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

---

此代码的缺点是它无法检测其他程序已打开的端口，因为每个端口只能打开一次。通过调用API

CreateFile

，可以检测COM端口是否被其他程序打开

在.NET中非常简单，您使用VB6有什么原因吗？如何获取COM的名称？您的is脚本只列出了可用的COM端口，没有名称。这不是脚本。OP没有请求COM端口“名称”。如果您需要更多关于该主题的指导，请单独提问。我仅使用

com0com

进行了测试。YMMV

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