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

Узнай цену своей работы

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

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

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

textual
Листинг программы 
  1. Public Function CommRead(intPortID As Integer, strData As String, _
  2.     lngSize As Long) As Long
  3.  
  4.     Dim lngStatus As Long
  5.     Dim lngRdSize As Long, lngBytesRead As Long
  6.     Dim lngRdStatus As Long, strRdBuffer As String * 1024
  7.     Dim lngErrorFlags As Long, udtCommStat As COMSTAT
  8.     
  9.     Dim osReader As OVERLAPPED
  10.     
  11.     osReader.hEvent = 0
  12.     osReader.Internal = 0
  13.     osReader.InternalHigh = 0
  14.     osReader.offset = 0
  15.     osReader.OffsetHigh = 0
  16.     
  17.     On Error GoTo Routine_Error
  18.  
  19.     strData = ""
  20.     lngBytesRead = 0
  21.     
  22. '    ' Clear any previous errors and get current status.
  23. '    lngStatus = ClearCommError(udtPorts(intPortID).lngHandle, lngErrorFlags, _
  24. '        udtCommStat)
  25. '
  26. '    If lngStatus = 0 Then
  27. '
  28. '        lngBytesRead = -1
  29. '        lngStatus = SetCommError("CommRead (ClearCommError)")
  30. '        GoTo Routine_Exit
  31. '
  32. '    End If
  33.         
  34. '    If udtCommStat.cbInQue > 0 Then
  35. '
  36. '        If udtCommStat.cbInQue > lngSize Then
  37. '
  38. '            lngRdSize = udtCommStat.cbInQue
  39. '
  40. '        Else
  41. '
  42. '            lngRdSize = lngSize
  43. '
  44. '        End If
  45. '
  46. '    Else
  47. '
  48. '        lngRdSize = 0
  49. '
  50. '    End If
  51.     
  52.     lngRdSize = lngSize
  53.     
  54.     If lngRdSize Then
  55.         
  56.         osReader.hEvent = CreateEvent(0, True, False, 0)
  57.     
  58.         If osReader.hEvent = 0 Then
  59.         
  60.             lngBytesRead = -1
  61.             lngStatus = SetCommErrorEx("CommRead (CreateEvent)", _
  62.                 udtPorts(intPortID).lngHandle)
  63.                 
  64.             GoTo Routine_Exit
  65.  
  66.         End If
  67.                 
  68.         lngRdStatus = ReadFile(udtPorts(intPortID).lngHandle, strRdBuffer, _
  69.             lngRdSize, 0, osReader)
  70.             
  71.         If lngRdStatus = 0 Then
  72.                     
  73.             Dim dwRes As Long
  74.         
  75.             ' Wait for read to complete.
  76.             dwRes = WaitForSingleObject(osReader.hEvent, READ_TIMEOUT)
  77.             
  78.             Select Case dwRes
  79.             
  80.                 ' Read completed.
  81.                 Case WAIT_OBJECT_0
  82.             
  83.                     If GetOverlappedResult(udtPorts(intPortID).lngHandle, _
  84.                         osReader, lngBytesRead, False) = 0 Then
  85.                         
  86.                         ' Error in communications; report it.
  87.                         lngBytesRead = -1
  88.                         lngStatus = SetCommErrorEx("CommRead (GetOverlappedResult)", _
  89.                             udtPorts(intPortID).lngHandle)
  90.                             
  91.                         GoTo Routine_Exit
  92.                 
  93.                     Else
  94.                     
  95.                         ' Read completed successfully.
  96.                     
  97.                     End If
  98.                     
  99.           
  100.                 Case WAIT_TIMEOUT
  101.  
  102.                     lngBytesRead = -1
  103.                     lngStatus = SetCommErrorEx("CommRead (WaitForSingleObject)", _
  104.                         udtPorts(intPortID).lngHandle)
  105.                         
  106.                     GoTo Routine_Exit
  107.                 
  108.                 Case Else
  109.  
  110.                     lngBytesRead = -1
  111.                     lngStatus = SetCommErrorEx("CommRead (WaitForSingleObject)", _
  112.                         udtPorts(intPortID).lngHandle)
  113.                     GoTo Routine_Exit
  114.                         
  115.             End Select
  116.             
  117.         End If
  118.     
  119.         strData = Left$(strRdBuffer, lngBytesRead)
  120.         
  121.     End If
  122.  
  123. Routine_Exit:
  124.     
  125.     If Not osReader.hEvent = 0 Then CloseHandle osReader.hEvent
  126.  
  127.     CommRead = lngBytesRead
  128.     Exit Function
  129.  
  130. Routine_Error:
  131.     lngBytesRead = -1
  132.     lngStatus = Err.Number
  133.     
  134.     With udtCommError
  135.     
  136.         .lngErrorCode = lngStatus
  137.         .strFunction = "CommRead"
  138.         .strErrorMessage = Err.Description
  139.         
  140.     End With
  141.     
  142.     Resume Routine_Exit
  143.     
  144. End Function

ИИ поможет Вам:

  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

15   голосов , оценка 4.133 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы