Класс для COM-порта с поддержкой событий - VB

Формулировка задачи:

Доброго. Мне нужен класс для работы с COM-портом с поддержкой событий. У меня есть вариант: Serial Port Communication in Excel (VBA). Я его использую в Excel. Проблема в том, что нужно ручками регулировать время между командой и ответом, чтобы гарантировано принять данные во входной буфер. Хотелось бы иметь событие OnReceive(), которое основано на WaitCommEvent(). Без событийного решения трудно реализовать оптимальный по скорости алгоритм работы с устройствами. Мне нужно с определённой частотой читать данные и желательно получать их по мере заполнения входного буфера нужной посылкой. Можно ли что-то такое сделать на vb6? Мне не нужны сторонние решения в готовом виде (ActiveX, dll и т.п.). Нужно всё реализовать на макросах в таблице.

Решение задачи: «Класс для COM-порта с поддержкой событий»

textual
                            Листинг программы 
                        

                            Public Function CommRead(intPortID As Integer, strData As String, _
    lngSize As Long) As Long
 
    Dim lngStatus As Long
    Dim lngRdSize As Long, lngBytesRead As Long
    Dim lngRdStatus As Long, strRdBuffer As String * 1024
    Dim lngErrorFlags As Long, udtCommStat As COMSTAT
    
    Dim osReader As OVERLAPPED
    
    osReader.hEvent = 0
    osReader.Internal = 0
    osReader.InternalHigh = 0
    osReader.offset = 0
    osReader.OffsetHigh = 0
    
    On Error GoTo Routine_Error
 
    strData = ""
    lngBytesRead = 0
    
'    ' Clear any previous errors and get current status.
'    lngStatus = ClearCommError(udtPorts(intPortID).lngHandle, lngErrorFlags, _
'        udtCommStat)
'
'    If lngStatus = 0 Then
'
'        lngBytesRead = -1
'        lngStatus = SetCommError("CommRead (ClearCommError)")
'        GoTo Routine_Exit
'
'    End If
        
'    If udtCommStat.cbInQue > 0 Then
'
'        If udtCommStat.cbInQue > lngSize Then
'
'            lngRdSize = udtCommStat.cbInQue
'
'        Else
'
'            lngRdSize = lngSize
'
'        End If
'
'    Else
'
'        lngRdSize = 0
'
'    End If
    
    lngRdSize = lngSize
    
    If lngRdSize Then
        
        osReader.hEvent = CreateEvent(0, True, False, 0)
    
        If osReader.hEvent = 0 Then
        
            lngBytesRead = -1
            lngStatus = SetCommErrorEx("CommRead (CreateEvent)", _
                udtPorts(intPortID).lngHandle)
                
            GoTo Routine_Exit
 
        End If
                
        lngRdStatus = ReadFile(udtPorts(intPortID).lngHandle, strRdBuffer, _
            lngRdSize, 0, osReader)
            
        If lngRdStatus = 0 Then
                    
            Dim dwRes As Long
        
            ' Wait for read to complete.
            dwRes = WaitForSingleObject(osReader.hEvent, READ_TIMEOUT)
            
            Select Case dwRes
            
                ' Read completed.
                Case WAIT_OBJECT_0
            
                    If GetOverlappedResult(udtPorts(intPortID).lngHandle, _
                        osReader, lngBytesRead, False) = 0 Then
                        
                        ' Error in communications; report it.
                        lngBytesRead = -1
                        lngStatus = SetCommErrorEx("CommRead (GetOverlappedResult)", _
                            udtPorts(intPortID).lngHandle)
                            
                        GoTo Routine_Exit
                
                    Else
                    
                        ' Read completed successfully.
                    
                    End If
                    
          
                Case WAIT_TIMEOUT
 
                    lngBytesRead = -1
                    lngStatus = SetCommErrorEx("CommRead (WaitForSingleObject)", _
                        udtPorts(intPortID).lngHandle)
                        
                    GoTo Routine_Exit
                
                Case Else
 
                    lngBytesRead = -1
                    lngStatus = SetCommErrorEx("CommRead (WaitForSingleObject)", _
                        udtPorts(intPortID).lngHandle)
                    GoTo Routine_Exit
                        
            End Select
            
        End If
    
        strData = Left$(strRdBuffer, lngBytesRead)
        
    End If
 
Routine_Exit:
    
    If Not osReader.hEvent = 0 Then CloseHandle osReader.hEvent
 
    CommRead = lngBytesRead
    Exit Function
 
Routine_Error:
    lngBytesRead = -1
    lngStatus = Err.Number
    
    With udtCommError
    
        .lngErrorCode = lngStatus
        .strFunction = "CommRead"
        .strErrorMessage = Err.Description
        
    End With
    
    Resume Routine_Exit
    
End Function
                        