'            === ИНИЦИАЛИЗАЦИЯ ПОСЛЕДОВАТЕЛЬНОГО ПОРТА ===

'

'  Модуль для инициализации COM-порта.

' Содержит функцию initCOM, которая имеет пять параметров в следующем порядке:

'    COMn -имя порта, строка вида например COM1

' остальные параметры - целый числовой тип (Integer):

'    baud -скорость приемопередачи, число из ряда стандартных скоростей

'    bits -количество битов в посылке

'    parity: 0-без четности(N), 1-нечетность, 2-четность

'    stops -количество стоповых бит (1 или 2)

'  Стандартный режим для COM1 9600 8N1 будет выглядеть как initCOM("COM1", 9600, 8, 0, 1)

'  Функция возвращает пустую строку в случае успешной инициализации порта,

'  либо строку с сообщением об ошибке на русском языке.

'  После этого порт готов к открытию стандартным оператором OPEN, например так:

'        filenum = FreeFile

'        Open COMport$ For Random As #filenum Len = 256

'        Put #filenum, 1, "test"      'передача строки

'        Get #filenum, 1, comstring$  'прием строки

'        Close #filenum

'   где COMport$ содержит то же самое имя порта.

'=====================================================================

'

Private BarDCB As DCB   'таблица параметров порта

Private CtimeOut As COMMTIMEOUTS  'таймауты порта

'Структуры для параметров настройки порта

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

Declare Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long

Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long, lpDCB As DCB) As Long

Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Declare Function GetLastError Lib "kernel32" () As Long

 

Public Function initCOM(ByVal COMn As String, ByVal baud As Integer, ByVal bits As Integer, ByVal parity As Integer, ByVal stops As Integer) As String

'Инициализация COM-порта

'в случае ошибки выдает строку сообщения об ошибке,

'в противном случае - пустую строку.

    Dim retval As Long

 

    initCOM = ""

    ComNum = CreateFile(COMn, &HC0000000, 0, 0&, &H3, 0, 0)

    If ComNum = -1 Then

        initCOM = "Ошибка инициализации порта"

        Exit Function

      Else

         retval = PurgeComm(ComNum, 0) 'очистка порта, очередей

    End If

 

    ' Начальное заполнение таблицы параметров приемопередачи

    BarDCB.DCBlength = 28  'длина блока DCB

    BarDCB.BaudRate = baud 'скорость приемопередачи в бодах

    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 = bits  'разрядность данных (кол-во бит)

    BarDCB.parity = parity  '1-проверять нечетность, 2-проверять четность, 0-не проверять ничего

'    BarDCB.StopBits = 0     'количество стоповых бит: 0 -один, 1 -полтора, 2 -два

    If stops >= 2 Then BarDCB.StopBits = 2 Else BarDCB.StopBits = 0

    BarDCB.XonChar = 17 'символ, используемый в качестве Xon

    BarDCB.XoffChar = 19 'символ, используемый в качестве Xoff

    BarDCB.ErrorChar = 35 'символ, заменяющий принятый с ошибкой

    BarDCB.EofChar = 26 'символ "конец данных"

    BarDCB.EvtChar = 0  'символ для сигнализации о событии

    BarDCB.wReserved1 = 0 'зарезервировано. Не используется.

    retval = SetCommState(ComNum, BarDCB)

    If retval = -1 Then

        retval = GetLastError()

        initCOM = "Не удается настроить порт Error: " + retval

        retval = CloseHandle(ComNum)

        Exit Function

    End If

    'Времена ожидания (Time Outs) в миллисекундах

    'нулевые времена означают, что таймауты не используются.

    CtimeOut.ReadIntervalTimeout = 1 'максимальное время между двумя принимаемыми символами.

    CtimeOut.ReadTotalTimeoutConstant = 1 'постоянная часть таймаута на прием

    CtimeOut.ReadTotalTimeoutMultiplier = 1 'время на прием одного символа (для вычисления переменной части таймаута)

    CtimeOut.WriteTotalTimeoutConstant = 20 'постоянная часть таймаута на передачу

    CtimeOut.WriteTotalTimeoutMultiplier = 5 'время на передачу одного символа (для вычисления переменной части таймаута)

    retval = SetCommTimeouts(ComNum, CtimeOut)

    If retval = -1 Then

        retval = GetLastError()

        initCOM = "Ошибка при установке таймаутов, Error: " & retval

    End If

    retval = CloseHandle(ComNum)

End Function