Работа с COM-портом в Excel

[Меджикивис]

Есть задача отправить/получить данные в Экселе по RS-232.
Я написал в макросе такой код:

filenum = FreeFile
Open "COM1" For Random As #filenum
Put #filenum, 1, "test string"
Get #filenum, 1, a$
Close #filenum

На операторе Get он почему-то виснет. Не показывает никаких ошибок, просто молча виснет макрос.

НО!
Если перед запуском Экселя запустить какую-нибудь стороннюю программу работающую с COM, (я использовал терминал), закрыть ее, а потом запустить Excel - то всё работает! Выше приведенный код исправно передает и принимает.
Можно закрывать Excel, запускать его вновь - всё продолжает работать; - до выключения компа.
Но после рестарта компа - опять висяк.

Очевидно, что после начальной загрузки Винды порт настроен как-то неправильно. Терминал его настраивает как надо, после чего порт нормально работоспособен.

Вопрос:
Как правильно настроить порт, не выходя из Excel?

ЗЫ:
После рестарта компа сразу открыл Менеджер Устройств, посмотрел Свойства COM1: 9600, 8N1, - стандартный режим. Ненормальностей не обнаружил. Никаких конфликтов, никаких ошибок.
Винда - XP. Порт - "железный", на материнке.

[Меджикивис]

Подключился на порт осциллографом. (На прием-то порт виснет, но передавать - передает.)
Так вот, передача идет не на 9600 как указано в свойствах порта, а на очень медленной скорости, 110 где-то.(((((((((

Почему так - совершенно непонятно, но абсолютно ясно, что порт требует инициализации.
Как сделать?

[MBo]

Open "COM1:9600,чего там еще нужно" работает?

Кстати, подсмотреть, что выполняется при работе другой программы, можно с помощью
PortMon или AccessPort

[Меджикивис]

Цитата MBo @ 05.04.20, 10:21

Open "COM1:9600,чего там еще нужно" работает?

Не работает.

Цитата MBo @ 05.04.20, 10:21

Кстати, подсмотреть, что выполняется при работе другой программы, можно с помощью PortMon или AccessPort

Дык я знаю, что она делает: инициализирует порт.
Вопрос - как это сделать в VBA.

[Меджикивис]

Ннн-дааааа... Пожалуй спецами много круче меня этот форум похвалиться не очень способен((((((
Решение я изобразил, но оно получилось настолько громоздким, что пришлось вынести его в отдельный модуль
Полный текст модуля привожу ниже.
Создаёте в вашей программе новый модуль, копипастите в него ниже следующее без изменений, и у вас доступна функция initCOM, инициализирующая указанный порт на заданные параметры, и одновременно проверяющая его доступность. Использовать ее достатачно однократно вначале программы.
Подробности поставил в комментах:

'            === ИНИЦИАЛИЗАЦИЯ ПОСЛЕДОВАТЕЛЬНОГО ПОРТА ===
'
'  Модуль для инициализации 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

Хотя вопрос темы этим по-существу решен, я тему не закрываю, в надежде, что может быть кто-нибудь напишет более изящное решение.

Сообщение отредактировано: Меджикивис - 11.04.20, 05:36