除了从1到32的循环并尝试打开它们之外,是否有可靠的方法来获取系统上的COM端口?
答案 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.