不用MSCOMM控件怎样进行串口收发数据

Private Sub cmdSend_Click()
'定义文件读写属性结构
Dim sa As SECURITY_ATTRIBUTES
'定义串口状态结构
Dim typCommStat As COMSTAT
'定义串口状态错误
Dim lngError As Long

'********打开串口********
Dim hCF As Long
hCF = CreateFile("COM4", _
GENERIC_READ Or GENERIC_WRITE, 0, sa, _
OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL Or FILE_FLAG_OVERLAPPED, 0)
Debug.Print "打开串口：" & hCF

'********获取出错信息********
Dim errNum As Long
errNum = GetLastError()
Debug.Print "出错信息：" & errNum

'定义标志值
Dim flag As Long

'定义设备控制块
Dim typDCB As DCB

'********获取设备控制块********
flag = GetCommState(hCF, typDCB)
Debug.Print "获取串口DCB：" & flag

typDCB.BaudRate = 2500 '定义波特率
typDCB.Parity = NOPARITY '无校验位
typDCB.ByteSize = 8 '数据位
typDCB.StopBits = 0 '停止位 0/1/2 = 1/1.5/2

'********设置串口参数********
flag = SetCommState(hCF, typDCB)
Debug.Print "设置串口参数：" & flag

'********设置缓冲区大小********
flag = SetupComm(hCF, 1024, 1024)
'Debug.Print "设置缓冲区：" & flag

'********清空读写缓冲区********
flag = PurgeComm(hCF, PURGE_RXABORT Or PURGE_RXCLEAR Or PURGE_TXABORT Or PURGE_TXCLEAR)
'Debug.Print "强制清空缓冲区：" & flag

'定义超时结构体
Dim typCommTimeouts As COMMTIMEOUTS
typCommTimeouts.ReadIntervalTimeout = 0 '相邻两字节读取最大时间间隔（为0表示不使用该超时间隔）
typCommTimeouts.ReadTotalTimeoutMultiplier = 0 '一个读操作的时间常数
typCommTimeouts.ReadTotalTimeoutConstant = 0 '读超时常数
typCommTimeouts.WriteTotalTimeoutMultiplier = 0 '一个写操作的时间常数（为0表示不使用该超时间隔）
typCommTimeouts.WriteTotalTimeoutConstant = 0 '写超时常数（为0表示不使用该超时间隔）

'********超时设置********
flag = SetCommTimeouts(hCF, typCommTimeouts)
'Debug.Print "超时设置：" & flag

'********发送数据********
'定义要发送字节数
Dim lngNumberofBytesToWrite As Long
'定义实际发送字节数
Dim lngNumberofBytesToWritten As Long
'定义重叠结构体
Dim typOverLapped As OVERLAPPED

'定义发送数据
Dim arrbytTest(0 To 23) As Byte
'载波收发器同步头
arrbytTest(0) = CByte(&H53)
arrbytTest(1) = CByte(&H4E)
arrbytTest(2) = CByte(&H44)
'后续数据包长度
arrbytTest(3) = CByte(&H14)
'载波表预同步头
arrbytTest(4) = CByte(&HFF)
arrbytTest(5) = CByte(&HFF)
arrbytTest(6) = CByte(&HFF)
arrbytTest(7) = CByte(&HFF)

arrbytTest(8) = CByte(&HFF)
arrbytTest(9) = CByte(&HFF)
'载波表帧同步头
arrbytTest(10) = CByte(&H9)
arrbytTest(11) = CByte(&HAF)
'载波表地址
arrbytTest(12) = CByte(&H59)
arrbytTest(13) = CByte(&H20)
arrbytTest(14) = CByte(&H0)
'控制码
arrbytTest(15) = CByte(&H1)
'数据长度
arrbytTest(16) = CByte(&H5)
'功能码
arrbytTest(17) = CByte(&H10)
arrbytTest(18) = CByte(&H90)
'集中器地址
arrbytTest(19) = CByte(&HBB)
arrbytTest(20) = CByte(&HBB)
arrbytTest(21) = CByte(&HBB)
'校验和
arrbytTest(22) = CByte(&H50)
arrbytTest(23) = CByte(&H3)


'获取要发送字节数
lngNumberofBytesToWrite = UBound(arrbytTest) + 1

'声明等待开始时间、结束时间值
Dim writeStarTime, writeEndTime As Long

writeStarTime = GetTickCount()
Debug.Print "发送开始时间：" & writeStarTime

'定义发送循环步长值
Dim i As Integer
'定义累计发送字节数
Dim intTotalNumberOfBytesToWritten As Integer
'定义发送间隔时间（毫秒）
Dim intIntervalTime As Integer
intIntervalTime = 0

'发送数据
For i = 0 To UBound(arrbytTest)
flag = WriteFile(hCF, arrbytTest(i), 1, lngNumberofBytesToWritten, typOverLapped)

'获取出错码
errNum = GetLastError()
'Debug.Print "发送操作出错码：" & errNum

'若返回值不是IO异步操作未决，则关闭串口
If (errNum <> ERROR_IO_PENDING) And (errNum <> 0) Then GoTo closeComm

'异步IO事件获取（返回值为 0 表示出错）
flag = WaitForSingleObject(typOverLapped.hEvent, 0)
'Debug.Print "异步IO事件获取：" & flag

'判断异步IO事件获取是否成功
If flag <> 0 Then
'异步IO操作结果获取(等待标记值，必须为true ，否则需要事件激活返回结果)
flag = GetOverlappedResult(hCF, typOverLapped, lngNumberofBytesToWritten, 1)
'Debug.Print "异步IO操作获取：" & flag

'判断异步IO操作结果获取是否成功
If flag <> 0 Then
intTotalNumberOfBytesToWritten = intTotalNumberOfBytesToWritten + _
lngNumberofBytesToWritten
End If

End If

'间隔时间（用于需要设定每字节间间隔时间的发送协议）
Sleep (intIntervalTime)
Next

writeEndTime = GetTickCount()
Debug.Print "发送结束时间：" & writeEndTime
Debug.Print "发送总时间：" & (writeEndTime - writeStarTime)
Debug.Print "串口发送操作：" & flag
Debug.Print "实际发送字节数：" & intTotalNumberOfBytesToWritten

'********清空缓冲区等待数据接收********
flag = FlushFileBuffers(hCF)

'Debug.Print "清空缓冲区：" & flag

'********设置串口事件********
'监听数据接收事件
' flag = SetCommMask(hCF, EV_ERR Or EV_RXCHAR)
' Debug.Print "监听事件设置：" & flag
flag = SetCommMask(hCF, 0)
Debug.Print "监听事件设置：" & flag

'********等待串口接收事件********
'声明等待开始时间、结束时间值
Dim sngStarTime, sngEndTime As Long
'事件掩码
Dim lngEventMask As Long

'定义接收字节数变量
Dim tempReceive As Long
tempReceive = 0

Debug.Print "监听开始"
'生成开始时间
sngStarTime = GetTickCount()
Debug.Print "开始监听时间：" & sngStarTime

'定义等待步骤参数
Dim n As Integer
n = 1

' '监听串口事件
' flag = WaitCommEvent(hCF, lngEventMask, typOverLapped)
' Debug.Print "监听操作：" & flag

' '获取出错码
' errNum = GetLastError()
' Debug.Print "监听操作出错码：" & errNum
'
' '若返回值不是IO异步操作未决，则关闭串口
' If (errNum <> ERROR_IO_PENDING) And (errNum <> 0) Then GoTo closeComm

'定义读取间隔时间(毫秒)
Dim intReadIntervalTime As Integer
intReadIntervalTime = 1

Do

' '异步IO事件获取（返回值为 0 表示出错）
' flag = WaitForSingleObject(typOverLapped.hEvent, 0)
' Debug.Print "异步IO事件获取：" & flag
' '获取出错码
' errNum = GetLastError()
' Debug.Print "IO事件获取出错码：" & errNum

'清除错误标志函数，获取串口设备状态
flag = ClearCommError(hCF, lngError, typCommStat)
Debug.Print "获取串口设备状态：" & flag

'若获取状态成功
If (flag <> 0) And (typCommStat.cbInQue > 0) Then

Debug.Print "已接收字节数：" & typCommStat.cbInQue

'判断接收缓冲区内的数据是否等于需要接收的字节数
If typCommStat.cbInQue >= 22 Then
'跳出循环
Debug.Print "跳出循环"
Exit Do
End If

End If

'生成结束时间
sngEndTime = GetTickCount()
Debug.Print "第" & n & "次监听事件时间：" & sngEndTime

n = n + 1

'读时间间隔
Sleep (intReadIntervalTime)

Loop Until (sngEndTime - sngStarTime) > 1000

'生成结束时间
sngEndTime = GetTickCount()
Debug.Print "结束监听时间：" & sngEndTime

Debug.Print "监听结束"
Debug.Print "总接收时间：" & (sngEndTime - sngStarTime)

'********接收数据********
'定义接收数组
Dim arrbytReceive(0 To 22) As Byte
'定义实际接收字节数
Dim lngNBR As Long
'重叠结构

置0
typOverLapped.hEvent = 0
typOverLapped.Internal = 0
typOverLapped.InternalHigh = 0
typOverLapped.offset = 0
typOverLapped.OffsetHigh = 0

'接收数据
flag = ReadFile(hCF, arrbytReceive(0), 23, lngNBR, typOverLapped)
Debug.Print "串口接收操作：" & flag
Debug.Print "实际接收字节数：" & lngNBR
Debug.Print arrbytReceive(0)
Debug.Print arrbytReceive(21)
Debug.Print arrbytReceive(22)

closeComm:
'********关闭所有串口事件********
flag = SetCommMask(hCF, 0)
'Debug.Print "关闭串口事件：" & flag

'********关闭串口********
Dim closeFlag As Long
closeFlag = CloseHandle(hCF)
Debug.Print "关闭串口：" & closeFlag

End Sub