VB6使用API实现串口通信

《VB6使用API实现串口通信》由会员上传分享，免费在线阅读，更多相关内容在行业资料-天天文库。

需要和客户的产品通讯，但波特率是非常规的，MScomm无法实现，原有的软件框架和条件又不能转用VC开发底层，于是用VB6调用API实现了这个通讯功能，虽然在VB6下这个程序还是单进程的，但实现了异步非阻塞的通信，性能相当稳定，下面是测试程序代码PrivateSubcmdSend_Click()SubcmdSend_Click()   '定义文件读写属性结构   DimsaAsSECURITY_ATTRIBUTES   '定义串口状态结构   DimtypCommStatAsCOMSTAT   '定义串口状态错误   DimlngErrorAsLong      '********打开串口********   DimhCFAsLong   hCF=CreateFile("COM4",_                       GENERIC_READOrGENERIC_WRITE,0,sa,_                   OPEN_EXISTING,FILE_ATTRIBUTE_NORMALOrFILE_FLAG_OVERLAPPED,0)   Debug.Print"打开串口："&hCF      '********获取出错信息********   DimerrNumAsLong   errNum= GetLastError()   Debug.Print"出错信息："&errNum      '定义标志值   DimflagAsLong              '定义设备控制块   DimtypDCBAsDCB      '********获取设备控制块********   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_RXABORTOrPURGE_RXCLEAROrPURGE_TXABORTOrPURGE_TXCLEAR)   'Debug.Print"强制清空缓冲区："&flag      '定义超时结构体   DimtypCommTimeoutsAsCOMMTIMEOUTS   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          '********发送数据********   '定义要发送字节数   DimlngNumberofBytesToWriteAsLong   '定义实际发送字节数   DimlngNumberofBytesToWrittenAs Long   '定义重叠结构体   DimtypOverLappedAsOVERLAPPED      '定义发送数据   DimarrbytTest(0To23)AsByte   '载波收发器同步头   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      '声明等待开始时间、结束时间值   DimwriteStarTime,writeEndTimeAsLong      writeStarTime=GetTickCount()   Debug.Print"发送开始时间："&writeStarTime       '定义发送循环步长值   DimiAsInteger   '定义累计发送字节数   DimintTotalNumberOfBytesToWrittenAsInteger   '定义发送间隔时间（毫秒）   DimintIntervalTimeAsInteger   intIntervalTime=0      '发送数据   Fori=0ToUBound(arrbytTest)       flag=WriteFile(hCF,arrbytTest(i),1,lngNumberofBytesToWritten,typOverLapped)              '获取出错码       errNum=GetLastError()       'Debug.Print"发送操作出错码："&errNum'若返回值不是IO异步操作未决，则关闭串口       If(errNum<>ERROR_IO_PENDING)And(errNum<>0)ThenGoTocloseComm'异步IO事件获取（返回值为0表示出错）       flag=WaitForSingleObject(typOverLapped.hEvent,0)       'Debug.Print"异步IO事件获取："&flag'判断异步IO事件获取是否成功       Ifflag<>0 Then           '异步IO操作结果获取(等待标记值，必须为true，否则需要事件激活返回结果)           flag=GetOverlappedResult(hCF,typOverLapped,lngNumberofBytesToWritten,1)           'Debug.Print"异步IO操作获取："&flag'判断异步IO操作结果获取是否成功           Ifflag<>0Then               intTotalNumberOfBytesToWritten=intTotalNumberOfBytesToWritten+_                                                   lngNumberofBytesToWritten           EndIfEndIf              '间隔时间（用于需要设定每字节间间隔时间的发送协议）       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_ERROrEV_RXCHAR)'   Debug.Print"监听事件设置："&flag   flag=SetCommMask(hCF,0)   Debug.Print"监听事件设置："&flag      '********等待串口接收事件********   '声明等待开始时间、结束时间值   DimsngStarTime,sngEndTimeAsLong   '事件掩码   DimlngEventMaskAsLong      '定义接收字节数变量   DimtempReceiveAsLong   tempReceive=0          Debug.Print"监听开始"   '生成开始时间   sngStarTime=GetTickCount()   Debug.Print"开始监听时间："&sngStarTime      '定义等待步骤参数   DimnAs 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)ThenGoTocloseComm'定义读取间隔时间(毫秒)   DimintReadIntervalTimeAsInteger   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'判断接收缓冲区内的数据是否等于需要接收的字节数           IftypCommStat.cbInQue>=22Then               '跳出循环               Debug.Print"跳出循环"               ExitDo           EndIfEndIf'生成结束时间       sngEndTime=GetTickCount()       Debug.Print"第"&n&"次监听事件时间："&sngEndTime              n=n+1                      '读时间间隔       Sleep(intReadIntervalTime)           LoopUntil(sngEndTime-sngStarTime)>1000      '生成结束时间   sngEndTime=GetTickCount()   Debug.Print"结束监听时间："&sngEndTime      Debug.Print"监听结束"   Debug.Print"总接收时间："&(sngEndTime-sngStarTime)          '********接收数据********   '定义接收数组   DimarrbytReceive(0To22)AsByte   '定义实际接收字节数   DimlngNBRAsLong   '重叠结构置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.PrintarrbytReceive(0)   Debug.PrintarrbytReceive(21)   Debug.PrintarrbytReceive(22)closeComm:   '********关闭所有串口事件********   flag=SetCommMask(hCF,0)   'Debug.Print"关闭串口事件："&flag      '********关闭串口********   DimcloseFlagAsLong   closeFlag=CloseHandle(hCF)   Debug.Print"关闭串口："&closeFlagEndSub