Detecting Available Comm Port Weirdness

[freefly21]

I'm baffled....maybe you can help enlighten me...

Com2 is installed and working, as listed in the device manager and tested with other applications.

My app runs the following code to verify which Com ports are available for use. If a com port is available a corrosponding option button is enabled -

Dim i as Long
On Error Resume Next

For i = 1 To 8
MSComm1.CommPort = i
MSComm1.PortOpen = True
If MSComm1.PortOpen Then 'port was opened.
MSComm1.PortOpen = False
Option1(i).Enabled = True
MsgBox i & " is a valid port."
Else
Debug.Print "Error " & Err & ", Port " & i & "."
End If
Next

Every CommPort value returns an error. The error codes returned are 8002 (not found) and for Com2 the error code is 8015 (could not set com state.)

Like I said Com2 is a valid com port, and I have used it with other applications.

So what does err 8015 mean is going on? I've tried droping in a new MSComm ctrl and using its default settings just to see if it was a programming error. However that didn't change anything.

As another option I have considered changing the above If statement to work off of the returned error code. I just hate to program it to 'ignore' certain errors when I'm not certain of what they represent.


TIA for your help!

[MrShickadance]

Error 8002 is "Invalid Port number" which is normal if the port Does Not Exist... so you have to trap out those errors, and deal with them... like so:

vbCOMS.Settings = "9600,N,8,1"
vbCOMS.CommPort = 1
vbCOMR.Settings = "9600,N,8,1"
vbCOMR.CommPort = 2
    
With vbCOMS
    '' test what COM ports we have
     On Error GoTo P
    
    '' maximum of 16 COM ports
    For cnt = 1 To 16 Step 1
        .CommPort = cnt
        .PortOpen = True
        If (vbCOMS.PortOpen) Then
            Call Me.cboPortSend.AddItem(cnt)
            Call cboPortRec.AddItem(cnt)
        End If
        .PortOpen = False
        DoEvents
    Next cnt
End With

Exit Sub

P:
    Debug.Print "On COM:" & vbCOMS.CommPort & " error: " & Err.Number & " : " & Err.Description
    If (vbCOMS.PortOpen) Then vbCOMS.PortOpen = False
    Resume Next

[freefly21]

Shickadance,

Thanks for your reply. I think though I wasn't clear about my exact problem.

I'm getting an error 8015 on Com2 when I try to open it, even though it is a good port... The invalid ports error out as expected (8002.)

Since my original post I recoded the If statement to be based on the Err code returned. However to get it to work I've got to say 'If Err = 0 Or Err = 8015 Then..." for valid ports.

So I guess I'm trying to figure out why I'm getting THIS error on Com2, when it appears to be a valid port. I cringe at having to essentially ignore an error to get this to work...

Thanks again!

[MrShickadance]

hmm... 8015 is "Could not set comm state" Does the COM port work properly? I assume this implys that it could not open/close the COM port.. is something using the COM port?

[Chris]

You can get the Serial Comm Port in your PC through the following registry path HKEY_LOCAL_MACHINE\HARDWARE\DEVICEMAP\SERIALCOMM

'//Put this code under a Form
Option Explicit

Private Sub Form_Load()
On Error GoTo Err
    Dim COMMPORT
    Dim i As Long
    
    Me.MousePointer = vbHourglass
    
    COMMPORT = ENUM_REG_STRING_VALUE(HKEY_LOCAL_MACHINE, "HARDWARE\DEVICEMAP\SERIALCOMM")
    For i = 0 To UBound(COMMPORT)
        'Query the string value
        List1.AddItem GET_STRING_VALUE(HKEY_LOCAL_MACHINE, "HARDWARE\DEVICEMAP\SERIALCOMM", COMMPORT(i), REG_SZ)
        DoEvents
    Next
    
    Me.MousePointer = vbDefault
    Exit Sub
Err:
    Me.MousePointer = vbDefault
End Sub

'//Put this code under a Basic Module file
Option Explicit
'WIN32API Costant
Public Const REG_SZ = 1
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const ERROR_SUCCESS = 0&
Public Const ERROR_NO_MORE_ITEMS = 259&

'WIN32 API declaration
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long         ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public 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 Byte, lpcbData As Long) As Long

Private hCurKey As Long

Public Function GET_STRING_VALUE(ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpString As String, ByVal dwType As Long) As Variant
On Error GoTo ErrHandle
    'Data validation
    If hKey = 0 Or lpSubKey = "" Or lpString = "" Then GoTo ErrHandle
    
    'Open the given hkey + subkey
    If RegOpenKey(hKey, lpSubKey, hCurKey) = ERROR_SUCCESS Then
        'Retrieve the given string value
        Dim strBuff As String
        strBuff = String(255, Chr(0))
        
        If RegQueryValueEx(hCurKey, lpString, 0, dwType, ByVal strBuff, Len(strBuff)) = ERROR_SUCCESS Then
            GET_STRING_VALUE = Left(strBuff, InStr(1, strBuff, Chr(0), vbTextCompare))
        Else
            GET_STRING_VALUE = ""
        End If
    Else
        GET_STRING_VALUE = ""
    End If
    RegCloseKey hCurKey
    
    Exit Function
ErrHandle:
    GET_STRING_VALUE = ""
End Function

Public Function ENUM_REG_STRING_VALUE(ByVal hKey As Long, ByVal lpSubKey As String) As Variant
    Dim Cnt As Long
    Dim Buff As String
    Dim History() As String
    
    RegOpenKey hKey, lpSubKey, hCurKey
    Cnt = 0
    Do
        Buff = String(255, 0)
        'Enum the given registry key
        If RegEnumValue(hCurKey, Cnt, Buff, 255, 0, ByVal 0&, ByVal 0&, ByVal 0&) = ERROR_NO_MORE_ITEMS Then Exit Do
        'Save the string into array
        ReDim Preserve History(Cnt)
        History(Cnt) = Left(Buff, InStr(1, Buff, Chr(0), vbTextCompare) - 1)
        'Increase the counter
        Cnt = Cnt + 1
        DoEvents
    Loop
    RegCloseKey hKey
    ENUM_REG_STRING_VALUE = History
End Function

Or see the attached sample code

[freefly21]

Thanks for everyone's help!

I think I may have figured out what was going on too. On Com2 I have a label printer installed. I restarted the computer with my other serial device plugged into this port and it worked fine. However, like I told you guys, I was getting that darn error.... I decided to uninstall the print driver and the error no longer occurs. So, with the driver installed I get an error, and either way, the port works properly AFAIK.