' Language: vb
' Module: modSerialCOM5
#If VBA7 Then
Private Declare PtrSafe Function CreateFile Lib "kernel32" Alias "CreateFileA" ( _
ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As LongPtr, ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As LongPtr) As LongPtr
Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As LongPtr) As Long
Private Declare PtrSafe Function ReadFile Lib "kernel32" ( _
ByVal hFile As LongPtr, ByVal lpBuffer As String, ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As LongPtr, ByVal lpOverlapped As LongPtr) As Long
Private Declare PtrSafe Function WriteFile Lib "kernel32" ( _
ByVal hFile As LongPtr, ByVal lpBuffer As String, ByVal nNumberOfBytesToWrite As Long, _
lpNumberOfBytesWritten As LongPtr, ByVal lpOverlapped As LongPtr) As Long
Private Declare PtrSafe Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" ( _
ByVal lpDef As String, lpDCB As Any) As Long
Private Declare PtrSafe Function SetCommState Lib "kernel32" (ByVal hCommDev As LongPtr, lpDCB As Any) As Long
Private Declare PtrSafe Function SetCommTimeouts Lib "kernel32" (ByVal hFile As LongPtr, lpCommTimeouts As Any) As Long
Private Declare PtrSafe Function SetupComm Lib "kernel32" (ByVal hFile As LongPtr, ByVal dwInQueue As Long, ByVal dwOutQueue As Long) As Long
Private Declare PtrSafe Function PurgeComm Lib "kernel32" (ByVal hFile As LongPtr, ByVal dwFlags As Long) As Long
#Else
Private 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
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ReadFile Lib "kernel32" ( _
ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function WriteFile Lib "kernel32" ( _
ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToWrite As Long, _
lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" ( _
ByVal lpDef As String, lpDCB As Any) As Long
Private Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long, lpDCB As Any) As Long
Private Declare Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As Any) As Long
Private Declare Function SetupComm Lib "kernel32" (ByVal hFile As Long, ByVal dwInQueue As Long, ByVal dwOutQueue As Long) As Long
Private Declare Function PurgeComm Lib "kernel32" (ByVal hFile As Long, ByVal dwFlags As Long) As Long
#End If
Private Const GENERIC_READ As Long = &H80000000
Private Const GENERIC_WRITE As Long = &H40000000
Private Const OPEN_EXISTING As Long = 3
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
#If VBA7 Then
Private Const INVALID_HANDLE_VALUE As LongPtr = -1
#Else
Private Const INVALID_HANDLE_VALUE As Long = -1
#End If
Private Type COMMTIMEOUTS
ReadIntervalTimeout As Long
ReadTotalTimeoutMultiplier As Long
ReadTotalTimeoutConstant As Long
WriteTotalTimeoutMultiplier As Long
WriteTotalTimeoutConstant As Long
End Type
Public Sub COM5_WriteThenReadToA1()
Dim hCom As LongPtr
Dim comPort As String
comPort = "\\.\COM5" ' Используйте "\\.\COM5" — надёжно для COM>=10 и в целом
hCom = CreateFile(comPort, GENERIC_READ Or GENERIC_WRITE, 0, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
If hCom = INVALID_HANDLE_VALUE Then
MsgBox "Не удалось открыть " & comPort, vbExclamation
Exit Sub
End If
' Настройка DCB: baud/parity/data/stop
Dim dcbBuff As String * 256
Dim baudSettings As String
baudSettings = "baud=9600 parity=N data=8 stop=1"
If BuildCommDCB(baudSettings, dcbBuff) = 0 Then
CloseHandle hCom
MsgBox "BuildCommDCB failed"
Exit Sub
End If
If SetCommState(hCom, dcbBuff) = 0 Then
CloseHandle hCom
MsgBox "SetCommState failed"
Exit Sub
End If
' Таймауты: блокирующий режим с терпимыми таймаутами
Dim tmo As COMMTIMEOUTS
tmo.ReadIntervalTimeout = 50
tmo.ReadTotalTimeoutMultiplier = 10
tmo.ReadTotalTimeoutConstant = 500
tmo.WriteTotalTimeoutMultiplier = 10
tmo.WriteTotalTimeoutConstant = 500
Call SetCommTimeouts(hCom, tmo)
' Очистить и настроить буферы
Call SetupComm(hCom, 1024, 1024)
Call PurgeComm(hCom, &H1 Or &H2 Or &H4 Or &H8) ' PURGE flags
' Записать строку (Arduino может ожидать CR/LF — добавьте vbCrLf при необходимости)
Dim toSend As String
toSend = "AadasdsadasdastA0"
Dim bytesWritten As LongPtr
If WriteFile(hCom, toSend, LenB(toSend), bytesWritten, 0) = 0 Then
CloseHandle hCom
MsgBox "WriteFile failed", vbExclamation
Exit Sub
End If
' Прочитать ответ (до 1024 байт)
Dim readBuf As String * 1024
Dim bytesRead As LongPtr
Dim rv As Long
rv = ReadFile(hCom, readBuf, Len(readBuf), bytesRead, 0)
' ReadFile возвращает ненулевое значение при успешном чтении
If rv <> 0 Then
Dim result As String
result = Left$(readBuf, bytesRead)
ThisWorkbook.Worksheets(1).Range("A1").Value = result
Else
' При rv = 0 — ошибка или timeout; оставляем ячейку пустой
ThisWorkbook.Worksheets(1).Range("A1").Value = ""
End If
CloseHandle hCom
End Sub |
