Check how many com ports and loop through them 2

[WBH1138]

Hi

I need to write a routine see how many com ports a PC may have so I can loop through them. I'm using VB6.

Is there an API call or some other feature I can use?

Wayne

 

[avanderlaan]

If the account you are using has permission to read the registry you can enumerate the contents of HKLM\HARDWARE\DEVICEMAP\SERIALCOMM

 

[guitarzan]

Something like this may work... add a MSComm control to a form:

Option Explicit

Private Sub Form_Load()
   Dim x As Integer, strPorts As String
   strPorts = ""
   For x = 1 To 8
      If TestPort(x) = True Then
         strPorts = strPorts & "COM" & Str(x) & vbCrLf
      End If
   Next
   MsgBox "COM ports found: " & vbCrLf & strPorts
End Sub

Function TestPort(intPort As Integer) As Boolean
   Dim blnPortValid As Boolean
   
   blnPortValid = True
   
   If MSComm1.PortOpen = True Then
      MSComm1.PortOpen = False
   End If
   
   On Error GoTo errPortTest
   MSComm1.CommPort = intPort
   MSComm1.PortOpen = True
   
   If MSComm1.PortOpen = True Then
      MSComm1.PortOpen = False
   End If
   
   TestPort = blnPortValid
   
   Exit Function

errPortTest:
   blnPortValid = False
   Resume Next
End Function

 

[WBH1138]

Thanks for that.

I did wonder if there was somewhere holding the number of Com ports or if you just had to assume there may be a certain number.

I guess though if you cannot guarantee having access to the Registry it would be better to assume a number of com ports?

 

[TipGiver]

Although I am not sure, avanderlaan's solution may be better. The reason is that there are drivers that can convert a USB port into a SERIAL port (virtual COM). So if you loop under a certain number, you may miss that COM. I am not either sure on this, but i think that a pc can have up to 127 USB ports... so 127 possible virtual COMs. So guitarzan's code should work fine if the limit is increased.

 

[guitarzan]

TipGiver; Good point, that code was used on specific systems with a RocketPort card with 8 ports... The "8" should have been a variable or constant, and you have to make some assumption of the max com ports to check.

 

[Foada]

In case you are interested this will check the enumerate the registry for the ports.

Private Ports() As Variant
Private sSubKey As String
Private hnd As Long
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const SYNCHRONIZE = &H100000
Private Const READ_CONTROL = &H20000
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const REG_DWORD = 4
Private Const REG_SZ = 1
Private Const REG_BINARY = 3
Private Const lMainKey As Long = HKEY_LOCAL_MACHINE
Private Const KEY_READ = ((READ_CONTROL Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As _
    String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult 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 Any, _
lpcbData As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, Source As Any, ByVal numBytes As Long)
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Private Sub VerifyPorts()
    Dim sPort As String
    Dim iX As Long
    Dim iY As Long
    Dim lngType As Long
    Dim lngValue As Long
    Dim sName As String
    Dim sSwap As String
    ReDim varResult(0 To 1, 0 To 100) As Variant
    Const lNameLen As Long = 260
    Const lDataLen As Long = 4096

        sSubKey = "Hardware\Devicemap\SerialComm"
        If RegOpenKeyEx(lMainKey, sSubKey, 0, KEY_READ, hnd) Then Exit Sub
            For iX = 0 To 999999
                If iX > UBound(varResult, 2) Then
                    ReDim Preserve varResult(0 To 1, iX + 99)
                End If
                sName = Space$(lNameLen)
                ReDim binValue(0 To lDataLen - 1) As Byte
                If RegEnumValue(hnd, iX, sName, lNameLen, ByVal 0&, lngType, binValue(0), lDataLen) Then Exit For
                    varResult(0, iX) = Left$(sName, lNameLen)
                    
                    Select Case lngType
                        Case REG_DWORD
                            CopyMemory lngValue, binValue(0), 4
                            varResult(1, iX) = lngValue
                        Case REG_SZ
                            varResult(1, iX) = Left$(StrConv(binValue(), vbUnicode), lDataLen - 1)
                        Case Else
                            ReDim Preserve binValue(0 To lDataLen - 1) As Byte
                            varResult(1, iX) = binValue()
                    End Select
            Next
        If hnd Then RegCloseKey hnd                                             'Close The Registry Key
        ReDim Preserve varResult(0 To 1, iX - 1) As Variant
        ReDim Ports(iX - 1)
        For iX = 0 To UBound(varResult, 2)                                      'Trim 'Port' To Get Just The Number
            sPort = Mid$(varResult(1, iX), 4, 1)
            Ports(iX) = sPort
        Next

        iY = UBound(Ports)                                                       'Arrange The Ports Numbers Low To High
        For iX = 0 To (iY - 1)
            If Ports(iX + 1) < Ports(iX) Then
                sSwap = Ports(iX + 1)
                Ports(iX + 1) = Ports(iX)
                Ports(iX) = sSwap
                iX = -1
            End If
        Next

End Sub

Private Sub Command1_Click()
    Dim iX As Long

    VerifyPorts
    
    For iX = 0 To UBound(Ports)
        Debug.Print Ports(iX)
    Next
End Sub

If you choose to battle wits with the witless be prepared to lose.

 

[avanderlaan]

I use multiple USB <-> RS-232 Serial port "fans" that create 4, 8, 16 or 32 COMM "ports" on a PC to support manufacturing instrumentation. Occasionally the COMM ports are NOT numbered consecutively when there are multiple devices on one PC. Also COMM created over PnP devices can vanish at runtime if the device is disconnected. That is why I suggested an enumeration of the contents of HKLM\HARDWARE\DEVICEMAP\SERIALCOMM hive.