[RESOLVED] Need help with API Communication Port State reading

[beic]

Hi there,

Is there a way to check the State/Status of the port, port presence, removed device from com port while the application is running with mentioned functions below?

I'm using these API functions:

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Long) As Long
Private Declare Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
Private Declare Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" (ByVal lpDef As String, lpDCB As DCB) As Long
Private Declare Function SetCommState Lib "kernel32" (ByVal hFile As Long, lpDCB As DCB) 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 FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long

Any help would be appreciated,

Kind regards,
Viktor

[dz32]

You can enum the current devices using wmi and compare the list with a previous copy to detect removals

Class supports state information as well:
https://docs.microsoft.com/en-us/win...n32-serialport

There is probably a notification message you can register to receive from windows somehow too. drive notification change
or something. I know DefineDosDevice can generate this message if you want to hunt down the details.

Private Sub LoadPorts()
    Dim strComputer As String
    Dim objWMIService As Object
    Dim colItems As Object
    Dim objItem As Object
    
    On Error Resume Next
    
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
    Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_SerialPort", , 48)
    
    For Each objItem In colItems
        CboPort.AddItem objItem.DeviceID & " " & objItem.Description
    Next
       
    Set objItem = Nothing
    Set colItems = Nothing
    Set objWMIService = Nothing
    
    CboPort.ListIndex = 0
    
End Sub

[wqweto]

Here is a fast EnumSerialPorts implementation:

Option Explicit
 
Private Declare Function QueryDosDevice Lib "kernel32" Alias "QueryDosDeviceA" (ByVal lpDeviceName As Long, ByVal lpTargetPath As String, ByVal ucchMax As Long) As Long
 
Public Function EnumSerialPorts() As Variant
    Dim sBuffer         As String
    Dim lIdx            As Long
    Dim vRetVal         As Variant
    Dim lCount          As Long
    
    ReDim vRetVal(0 To 255) As Variant
    sBuffer = String$(100000, 1)
    Call QueryDosDevice(0, sBuffer, Len(sBuffer))
    sBuffer = vbNullChar & sBuffer
    For lIdx = 1 To 255
        If InStr(1, sBuffer, vbNullChar & "COM" & lIdx & vbNullChar, vbTextCompare) > 0 Then
            vRetVal(lCount) = "COM" & lIdx
            lCount = lCount + 1
        End If
    Next
    If lCount = 0 Then
        vRetVal = Array()
    Else
        ReDim Preserve vRetVal(0 To lCount - 1) As Variant
    End If
    EnumSerialPorts = vRetVal
End Function
 
Private Sub Form_Load()
    Dim vElem           As Variant
    
    For Each vElem In EnumSerialPorts
        Debug.Print vElem
    Next
End Sub

For new USB serial ports arrival you can use RegisterDeviceNotification to get WM_DEVICECHANGE message like this:

Option Explicit
 
'--- Windows Messages
Private Const WM_DEVICECHANGE               As Long = &H219
'--- for RegisterDeviceNotification
Private Const DEVICE_NOTIFY_WINDOW_HANDLE   As Long = &H0
Private Const DBT_DEVTYP_DEVICEINTERFACE    As Long = &H5
Private Const DBT_DEVICEARRIVAL             As Long = &H8000&
Private Const DBT_DEVICEREMOVECOMPLETE      As Long = &H8004&
Private Const GUID_DEVINTERFACE_USB_DEVICE  As String = "{A5DCBF10-6530-11D2-901F-00C04FB951ED}"
 
Private Declare Function RegisterDeviceNotification Lib "user32" Alias "RegisterDeviceNotificationA" (ByVal hRecipient As Long, ByRef NotificationFilter As Any, ByVal Flags As Long) As Long
Private Declare Function UnregisterDeviceNotification Lib "user32" (ByVal Handle As Long) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Long, pclsid As Any) As Long
 
Private Type DEV_BROADCAST_DEVICEINTERFACE
    dbcc_size           As Long
    dbcc_devicetype     As Long
    dbcc_reserved       As Long
    dbcc_classguid(0 To 3) As Long
    dbcc_name           As Long
End Type
 
Private m_hDevNotify                As Long
Private m_pSubclass                 As IUnknown
 
Private Property Get pvAddressOfSubclassProc() As Form1
    Set pvAddressOfSubclassProc = InitAddressOfMethod(Me, 5)
End Property
 
Private Sub Form_Load()
    Dim uFilter         As DEV_BROADCAST_DEVICEINTERFACE
 
    '--- on device insert/eject notify w/ WM_DEVICECHANGE
    uFilter.dbcc_size = Len(uFilter)
    uFilter.dbcc_devicetype = DBT_DEVTYP_DEVICEINTERFACE
    Call CLSIDFromString(StrPtr(GUID_DEVINTERFACE_USB_DEVICE), uFilter.dbcc_classguid(0))
    m_hDevNotify = RegisterDeviceNotification(hWnd, uFilter, DEVICE_NOTIFY_WINDOW_HANDLE)
    Set m_pSubclass = InitSubclassingThunk(hWnd, Me, pvAddressOfSubclassProc.SubclassProc(0, 0, 0, 0, 0))
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    If m_hDevNotify <> 0 Then
        Call UnregisterDeviceNotification(m_hDevNotify)
        m_hDevNotify = 0
    End If
End Sub
 
Public Function SubclassProc(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long, Handled As Boolean) As Long
    Select Case wMsg
    Case WM_DEVICECHANGE
        Select Case wParam
        Case DBT_DEVICEARRIVAL, DBT_DEVICEREMOVECOMPLETE
            Debug.Print "wParam=&H" & Hex(wParam), Timer
        End Select
        Handled = True
    End Select
End Function

This uses the Modern Subclassing Thunk for the IDE-safe subclassing.

For serial ports overlapped I/O you can check out this cSerialPortConnector class test project.

cheers,
</wqw>

[beic]

Thank you all for the propositions and examples,

I went with WMI implementation, because RegisterDeviceNotification on USB are detecting 4-6 times in a row after insertion because it's a virtual USB COM port device or the device driver is poorly written.

Thank you again for your time!

[wqweto]

Thank you all for the propositions and examples,

I went with WMI implementation

Which WMI implementation?

Note that WMI is a feature for admin scripts that might be uninstalled on client machines for security reasons.

cheers,
</wqw>

[beic]

Which WMI implementation?
Note that WMI is a feature for admin scripts that might be uninstalled on client machines for security reasons.

Similar like mentioned in the second post above, I tried QueryDosDevice but it's slow as hell!

Kind regards,
Viktor

[wqweto]

How many serial ports are you enumerating? I have 10 ports and it’s instant here. It returns a simple cached string so I cannot see where the overhead would come from.

[beic]

How many serial ports are you enumerating? I have 10 ports and it’s instant here. It returns a simple cached string so I cannot see where the overhead would come from.

I have only one USB to SERIAL adapter, so, only 1 port!