Выкладываю полный текст моего модуля для работы с COM-портом при помощи API:
Код |
' МОДУЛЬ ДЛЯ РАБОТЫ С COM-ПОРТОМ ' при помощи API. '-------------------------------------------------------- 'для использования в программе здесь четыре подпрограммы: 'OpenCOM -открытие порта. Имеет аргументом единственное число - номер указанного порта. 'SetCommParam -настройка порта. Имеет параметрами четыре числа. 'ReadCOM -функция получения данных с порта. Параметр - количество запрашиваемых символов. 'WriteCOM -отправка данных в порт. Параметр - отправляемая строка символов
'Перед завершением программы обязательно закрывайте открытый порт следующим образом: ' If ComNum > 0 Then fin_com = CloseHandle(ComNum)
Option Explicit
'глобальные переменные Global ComNum As Long 'хэндл открытого порта; >0, если порт открыт. Global BarDCB As DCB 'таблица параметров порта Global CtimeOut As COMMTIMEOUTS 'таймауты порта Global bRead(2047) As Byte 'буфер принятых символов
'Структуры для параметров настройки порта Type COMMTIMEOUTS ReadIntervalTimeout As Long ReadTotalTimeoutMultiplier As Long ReadTotalTimeoutConstant As Long WriteTotalTimeoutMultiplier As Long WriteTotalTimeoutConstant As Long End Type Type DCB DCBlength As Long BaudRate As Long fBitFields As Long wReserved As Integer XonLim As Integer XoffLim As Integer ByteSize As Byte parity As Byte StopBits As Byte XonChar As Byte XoffChar As Byte ErrorChar As Byte EofChar As Byte EvtChar As Byte wReserved1 As Integer End Type
'структура для операций файлового чтения-записи Type OVERLAPPED Internal As Long InternalHigh As Long offset As Long OffsetHigh As Long hEvent As Long End Type
'объявления функций API 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 Declare Function PurgeComm Lib "kernel32" (ByVal hFile As Long, ByVal dwFlags As Long) As Long Public Declare Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long Public Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long, lpDCB As DCB) As Long Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As OVERLAPPED) As Long Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As OVERLAPPED) As Long Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Public Declare Function GetLastError Lib "kernel32" () As Long
Public Sub OpenCOM(ByVal com As Integer) 'Открытие COM-порта Dim retval As Long
ComNum = CreateFile(("COM" + Trim(Str$(com))), &HC0000000, 0, 0&, &H3, 0, 0) If ComNum = -1 Then MsgBox "Ошибка открытия порта COM" + Trim(Str$(com)), vbCritical Else retval = PurgeComm(ComNum, 0) 'очистка порта, очередей End If ' Начальное заполнение таблицы параметров приемопередачи BarDCB.DCBlength = 28 'длина блока DCB BarDCB.BaudRate = 2400 'скорость приемопередачи в бодах BarDCB.fBitFields = &H83 'Битовое поле, биты которого означают следующее: '1 fBinary вкл двоичный режим. Всегда 1 (кроме Windows 3.x :)) '2 fParity 1 -проверять четность, возвращать код ошибки. '3 fOutxCtsFlow 1 -задействовать сигнал CTS: при сброшенном CTS приостанавливает передачу до появления CTS. '4 OutxDsrFlow 1 -точно так же задействовать сигнал DSR '5,6 fDtrControl режим управления DTR. Три значения, не выяснил, каких. '7 fDsrSensitivity чувствительность драйвера к DSR. При 1 драйвер устройства будет игнорировать данные, принятые без DSR. '8 fTXContinueOnXoff 0 - прием будет приостанавливаться принятым символом Xoff и возобновляться Xon. '9 fOutX 1 -передача будет приостанавливаться принятым символом Xoff и возобновляться Xon. '10 fInX 1 -драйвер будет передавать управляющие символы Xon\Xoff '11 fErrorChar 1 -при ошибке по четности заменить ошибочный символ на заданный в поле ErrorChar '12 fNull 1 -отбрасывать при передаче нулевые байты '13,14 fRtsControl 0 -выдавать сигнал RTS. Возможны три значения для выбора режима управления, какая кодировка - не выяснил. '15 fAbortOnError 1 -при возникновении ошибки драйвер остановится до вызова функции ClearCommError. '16 fDummy2 =0 зарезервировано, не используется. BarDCB.wReserved = 0 'не используется, должен быть 0 BarDCB.XonLim = 128 'Задает минимальное число символов в приемном буфере перед посылкой символа XON BarDCB.XoffLim = 64 'Определяет макс кол-во байт в приемном буфере перед посылкой символа XOFF. Оно вычисляется вычитанием данного значения из размера применого буфера (в байтах) BarDCB.ByteSize = 8 'разрядность данных (кол-во бит) BarDCB.parity = 0 '1-проверять нечетность, 2-проверять четность, 0-не проверять ничего BarDCB.StopBits = 0 'количество стоповых бит: 0 -один, 1 -полтора, 2 -два BarDCB.XonChar = 17 'символ, используемый в качестве Xon BarDCB.XoffChar = 19 'символ, используемый в качестве Xoff BarDCB.ErrorChar = 35 'символ, заменяющий принятый с ошибкой BarDCB.EofChar = 26 'символ "конец данных" BarDCB.EvtChar = 0 'символ для сигнализации о событии BarDCB.wReserved1 = 0 'зарезервировано. Не используется.
'Времена ожидания (Time Outs) в миллисекундах CtimeOut.ReadIntervalTimeout = 1 'максимальное время между двумя принимаемыми символами. CtimeOut.ReadTotalTimeoutConstant = 1 'постоянная часть таймаута на прием CtimeOut.ReadTotalTimeoutMultiplier = 1 'время на прием одного символа (для вычисления переменной части таймаута) CtimeOut.WriteTotalTimeoutConstant = 20 'постоянная часть таймаута на передачу CtimeOut.WriteTotalTimeoutMultiplier = 5 'время на передачу одного символа (для вычисления переменной части таймаута) 'нулевые времена означают, что таймауты не используются.
End Sub
Public Sub SetCommParam(baud As Long, parity As Byte, bits As Byte, stops As Byte) 'подпрограмма установки параметров порту 'все аргументы- числа: ' baud -скорость обмена в бодах, из принятой шкалы скоростей. ' parity -четность. 1=проверять нечетность, 2=проверять четность, 0=не проверять ничего ' bits -битность данных. Число: 5, 6, 7 или 8 бит. ' stops 0=один стоповый бит, 1=полтора стоповых бита, 2=два стоповых бита.
Dim retval As Long
'установка таймаутов ' CtimeOut.ReadIntervalTimeout = 1 + Int(12000 / baud) ' CtimeOut.ReadTotalTimeoutConstant = 1 ' CtimeOut.ReadTotalTimeoutMultiplier = 1 + Int(12000 / baud) CtimeOut.WriteTotalTimeoutMultiplier = 1 + Int(12000 / baud) retval = SetCommTimeouts(ComNum, CtimeOut) If retval = -1 Then retval = GetLastError() MsgBox "Ошибка при установке таймаутов, Error: " & retval End If BarDCB.BaudRate = baud 'скорость приемопередачи в бодах BarDCB.ByteSize = bits 'разрядность данных (кол-во бит) BarDCB.parity = parity '1-проверять нечетность, 2-проверять четность, 0-не проверять ничего BarDCB.StopBits = stops 'количество стоповых бит: 0 -один, 1 -полтора, 2 -два retval = SetCommState(ComNum, BarDCB) If retval = -1 Then retval = GetLastError() MsgBox "Не удается настроить порт на заданные параметры Error: " & retval End If End Sub
Public Function ReadCOM(ByVal numChar As Integer) As String 'функция приема через COM 'параметр - число принимаемых за раз символов, до 2047 '(при циклическом вызове его можно уменьшить для ускорения работы) Dim RetBytes As Long, i As Integer, ReadStr As String, retval As Long Dim lpOverlapped As OVERLAPPED
'чтение с порта retval = ReadFile(ComNum, bRead(0), numChar, RetBytes, lpOverlapped) If retval = 0 Then retval = GetLastError() MsgBox "Ошибка работы с портом Error: " & retval End If
ReadStr = "" If (RetBytes > 0) Then For i = 0 To RetBytes - 1 ReadStr = ReadStr + Chr(bRead(i)) Next i End If
ReadCOM = ReadStr
End Function
Public Sub WriteCOM(COMString As String) 'Подпрограмма передачи в порт. 'Параметр - передаваемая строка символов
Dim RetBytes As Long, LenVal As Long, retval As Long Dim lpOverlapped As OVERLAPPED
If COMString = "" Then Exit Sub
'Рекурсивный вызов: передача длинных строк 'частями по 2048 знаков (потому что буфер приемопередачи- 2048 знаков) If Len(COMString) > 2047 Then Call WriteCOM(Left$(COMString, 2047)) Call WriteCOM(Right$(COMString, Len(COMString) - 2047)) Exit Sub End If
'передача знаков в буфер For LenVal = 0 To Len(COMString) - 1 bRead(LenVal) = Asc(Mid$(COMString, LenVal + 1, 1)) Next LenVal
'передачa через COM retval = WriteFile(ComNum, bRead(0), Len(COMString), RetBytes, lpOverlapped) If retval = 0 Then retval = GetLastError() MsgBox "Ошибка передачи Error: " & retval & vbCrLf & "Передано " & RetBytes & " байт" End If End Sub
|
Как использовать. Создаете в своем проекте модуль и вписываете в него целиком этот код. В результате в вашей проге доступны три подпрограммы и две функции для работы с COMом.
Сначала открываете желаемый порт подпрограммой OpenCOM. Аргументом ее является только число, напр. 2 (а не COM2: ). Потом настраиваете желаемую скорость и прочее при помощи SetCommParam - у нее тоже все аргументы числовые. Вместо "9600,8,n,1" задаем 9600, 0, 8, 0 . Подробное описание поставил в комментах.
Всё! После этого можно посылать данные WriteCOM и принимать ReadCOM. ReadCOM имеет параметром количество читаемых знаков. Это сделано для того, чтобы при циклическом вызове можно было ускорить вращение цикла, убавив число принимаемых за раз символов (все равно вызовы идут друг за другом!). Можно сделать даже посимвольный прием, но тогда скорость опять падает за счет увеличения количества проходов цикла. Оптимум- 10 - 15 в цикле и 255 знаков при разовом приеме кнопкой.
Замеченные ошибки мной исправлены, формат DCB правильный. При желании можно писать "в ручную" прямо в поля переменной BarDCB, а потом вызвать SetCommParam, которая отправит настройки в порт. Про DCB я могу рассказать отдельно (если спросите), впрочем я постарался по возможности подробно ее откомментировать.
И одно важное предупреждение:
перед завершением программы следует порт закрыть ОБЯЗАТЕЛЬНО! Если Вы этого не сделаете - он останется открытым и недоступным для всех программ. Я не знаю другого способа вернуть такой порт в действие, кроме перезагрузки компа. API принадлежат собственно не Бейсику, а Виндам, и поэтому их действие сохраняется и после закрытия вашей программы. В данном случае - это единственный минус использования API.
Закрыть порт в нашей программе можно, использовав непосредственно функцию API, поставленную в событие Unload формы:
fin_com = CloseHandle(ComNum)
ComNum у нас хранит хэндл порта, полученный при открытии. Эту переменную можно использовать в программе для проверки, открыт ли порт. Если ComNum больше нуля - то открыт.
К этому сообщению я приаттачиваю полностью проект. Собственно, всё необходимое для работы с портом сосредоточено в модуле. А форма - это только пользовательский интерфейс, и все, что наворочено в ней - всего лишь связи элементов между собой. (Дело в том, что текстовые поля не отображают нулевой код, а мне хотелось, чтоб он отсылался/принимался тоже. Пришлось дублировать данные в переменных, и проч. мутату).
Проект был задуман как терминал для отладки микроконтроллеров, и поэтому внешне он реализует поход электронщика, а не программиста. Кнопки "Open" нет: порт открывается автоматически, когда начинается работа с ним, а закрывается при закрытии программы.
Форма About первоначально была предназначена для дополнительных параметров, типа размера буферов. Это делайте сами
Благодарности: Неизвестному автору примера, на котором я тренировался, и от которого остались имена и некоторые решения.
Олегу Титову, за замечательную
статью , которая мне всё разъяснила. Об этом я постараюсь рассказать в отдельной темке.
Всем удачи!
Автор: JusTalionis Источник: Vingrad