VB6使用API实现串口通信.doc
.需要和客户的产品通讯，但波特率是非常规的，MScomm无法实现，原有的软件框架和条件又不能转用VC开发底层，于是用VB6调用API实现了这个通讯功能，虽然在VB6下这个程序还是单进程的，但实现了异步非阻塞的通信，性能相当稳定，下面是测试程序代码 Private Sub cmdSend_Click()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 IfEnd 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) ThenDebug.Print "已接收字节数：" & typCommStat.cbInQue判断接收缓冲区内的数据是否等于需要接收的字节数 If typCommStat.cbInQue >= 22 Then 跳出循环 Debug.Print "跳出循环" Exit Do End IfEnd 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 "关闭串口：" & closeFlagEnd Sub
