How to enumerate available COM ports on a computer? - vb6

Question

Other than looping from 1 to 32 and trying open each of them, is there a reliable way to get COM ports on the system?

Answer 1

I believe under modern windows environments you can find them in the registry under the following key HKEY_LOCAL_MACHINE\HARDWARE\DEVICEMAP\SERIALCOMM. I'm not sure of the correct way to specify registry keys. However I have only ever tested this on Windows XP.

Answer 2

Check out this article from Randy Birch's site: CreateFile: Determine Available COM Ports
There's also the approach of using an MSCOMM control: ConfigurePort: Determine Available COM Ports with the MSCOMM Control
The code's a bit too long for me to post here but the links have everything you need.

Answer 3

It's 1 to 255. Fastest you can do it is using QueryDosDevice like this
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
The snippet falls back to CreateFile on 9x. IsNT function is stubbed for brevity.

Answer 4

Using VB6 or VBScript to enumerate available COM ports can be as simple as using VB.NET, and this can be done by enumerating values from registry path HKEY_LOCAL_MACHINE\HARDWARE\DEVICEMAP\SERIALCOMM. It's better than calling QueryDosDevice() and doing string comparison to filter out devices which's name is leading by COM since you will get something like CompositeBattery (or other stuff which have full upper case name leading by COM) that isn't a COM port. Another benefit of doing this is that the registry values also containing USB to COM devices, which could not be detected by using the codes such as WMIService.ExecQuery("Select * from Win32_SerialPort"). If you try to plug the USB to COM devices in or out of the computer, you can see the registry values also appear or disappear immediately, since it's keeping updated.
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
The code above is using StdRegProv class to enumerate the values of a registry key. I've tested the code in XP, Windows 7, Windows 10, and it works without any complainant. The items which were added to the Listbox looks like below:
COM1 - \Device\Serial0
COM3 - \Device\ProlificSerial0
The downside of this code is that it could not detect which port is already opened by other programs since every port could only be opened once. The way to detect a COM port is opened by another program or not can be done by calling the API CreateFile. Here is an example.