VB6使用API实现串口通信

1、需要和客户的产品通讯，但波特率是非常规的，MScomm无法实现，原有的软件框架和条件又不能转用VC开发底层，于是用VB6调用API实现了这个通讯功能，虽然在VB6下这个程序还是单进程的，但实现了异步非阻塞的通信，性能相当稳定，下面是测试程序代码 Private Sub cmdSend_Click()Sub cmdSend_Click()    '定义文件读写属性结构    Dim sa As SECURITY_ATTRIBUTES    '定义串口状态结构   

2、; Dim typCommStat As COMSTAT    '定义串口状态错误    Dim lngError As Long        '*打开串口*    Dim hCF As Long    hCF = CreateFile("COM4", _          

3、60;             GENERIC_READ Or GENERIC_WRITE, 0, sa, _                    OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL Or FILE_FLAG_OVERLAPPED, 0) 

4、   Debug.Print "打开串口：" & hCF        '*获取出错信息*    Dim errNum As Long    errNum = GetLastError()    Debug.Print "出错信息：" & errNum        '定义标志值 

5、60;  Dim flag As Long                '定义设备控制块    Dim typDCB As DCB        '*获取设备控制块*    flag = GetCommState(hCF, typDCB)    Debug.Print "

6、获取串口DCB：" & flag        typDCB.BaudRate = 2500     '定义波特率    typDCB.Parity = NOPARITY   '无校验位    typDCB.ByteSize = 8        '数据位    typDCB.

7、StopBits = 0        '停止位 0/1/2 = 1/1.5/2            '*设置串口参数*    flag = SetCommState(hCF, typDCB)    Debug.Print "设置串口参数：" & flag      

8、60; '*设置缓冲区大小*    flag = SetupComm(hCF, 1024, 1024)    'Debug.Print "设置缓冲区：" & flag        '*清空读写缓冲区*    flag = PurgeComm(hCF, PURGE_RXABORT Or PURGE_RXCLEAR Or PURGE_TXABORT Or PURGE_TXCLEAR) &

9、#160;  'Debug.Print "强制清空缓冲区：" & flag        '定义超时结构体    Dim typCommTimeouts As COMMTIMEOUTS    typCommTimeouts.ReadIntervalTimeout = 0     '相邻两字节读取最大时间间隔（为0表示不使用该超时间隔）    ty

10、pCommTimeouts.ReadTotalTimeoutMultiplier = 0      '一个读操作的时间常数    typCommTimeouts.ReadTotalTimeoutConstant = 0        '读超时常数    typCommTimeouts.WriteTotalTimeoutMultiplier = 0     

11、9;一个写操作的时间常数（为0表示不使用该超时间隔）    typCommTimeouts.WriteTotalTimeoutConstant = 0       '写超时常数（为0表示不使用该超时间隔）            '*超时设置*    flag = SetCommTimeouts(hCF, typCommTimeouts)  &

12、#160; 'Debug.Print "超时设置：" & flag            '*发送数据*    '定义要发送字节数    Dim lngNumberofBytesToWrite As Long    '定义实际发送字节数    Dim lngNumberofBytesToWritten As Long&

13、#160;   '定义重叠结构体    Dim typOverLapped As OVERLAPPED        '定义发送数据    Dim arrbytTest(0 To 23) As Byte    '载波收发器同步头    arrbytTest(0) = CByte(&H53)    arrbytTest(1) = CByt

14、e(&H4E)    arrbytTest(2) = CByte(&H44)    '后续数据包长度    arrbytTest(3) = CByte(&H14)    '载波表预同步头    arrbytTest(4) = CByte(&HFF)    arrbytTest(5) = CByte(&HFF)    arrbytTe

15、st(6) = CByte(&HFF)    arrbytTest(7) = CByte(&HFF)    arrbytTest(8) = CByte(&HFF)    arrbytTest(9) = CByte(&HFF)    '载波表帧同步头    arrbytTest(10) = CByte(&H9)    arrbytTest(11) = CByte(&

16、;HAF)    '载波表地址    arrbytTest(12) = CByte(&H59)    arrbytTest(13) = CByte(&H20)    arrbytTest(14) = CByte(&H0)    '控制码    arrbytTest(15) = CByte(&H1)    '数据长度 

17、60;  arrbytTest(16) = CByte(&H5)    '功能码    arrbytTest(17) = CByte(&H10)    arrbytTest(18) = CByte(&H90)    '集中器地址    arrbytTest(19) = CByte(&HBB)    arrbytTest(20) = CByte(&HBB

18、)    arrbytTest(21) = CByte(&HBB)    '校验和    arrbytTest(22) = CByte(&H50)    arrbytTest(23) = CByte(&H3)'获取要发送字节数    lngNumberofBytesToWrite = UBound(arrbytTest) + 1        &#

19、39;声明等待开始时间、结束时间值    Dim writeStarTime, writeEndTime As Long        writeStarTime = GetTickCount()    Debug.Print "发送开始时间：" & writeStarTime        '定义发送循环步长值    Dim i As Integer

20、    '定义累计发送字节数    Dim intTotalNumberOfBytesToWritten As Integer    '定义发送间隔时间（毫秒）    Dim intIntervalTime As Integer    intIntervalTime = 0        '发送数据    For i = 0 To U

21、Bound(arrbytTest)        flag = WriteFile(hCF, arrbytTest(i), 1, lngNumberofBytesToWritten, typOverLapped)                '获取出错码        errNum = GetLastErro

22、r()        'Debug.Print "发送操作出错码：" & errNum'若返回值不是IO异步操作未决，则关闭串口        If (errNum <> ERROR_IO_PENDING) And (errNum <> 0) Then GoTo closeComm'异步IO事件获取（返回值为 0 表示出错）     

23、;   flag = WaitForSingleObject(typOverLapped.hEvent, 0)        'Debug.Print "异步IO事件获取：" & flag'判断异步IO事件获取是否成功        If flag <> 0 Then         

24、0;  '异步IO操作结果获取(等待标记值，必须为true ，否则需要事件激活返回结果)            flag = GetOverlappedResult(hCF, typOverLapped, lngNumberofBytesToWritten, 1)            'Debug.Print "异步IO操作获取："

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

26、#160;                                                lngNumberofB

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

28、60;       writeEndTime = GetTickCount()    Debug.Print "发送结束时间：" & writeEndTime    Debug.Print "发送总时间：" & (writeEndTime - writeStarTime)    Debug.Print "串口发送操作：" & flag    D

29、ebug.Print "实际发送字节数：" & intTotalNumberOfBytesToWritten            '*清空缓冲区等待数据接收*    flag = FlushFileBuffers(hCF)    'Debug.Print "清空缓冲区：" & flag        &#

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

31、;     '*等待串口接收事件*    '声明等待开始时间、结束时间值    Dim sngStarTime, sngEndTime As Long    '事件掩码    Dim lngEventMask As Long        '定义接收字节数变量    Dim tempReceive As Long &

32、#160;  tempReceive = 0            Debug.Print "监听开始"    '生成开始时间    sngStarTime = GetTickCount()    Debug.Print "开始监听时间：" & sngStarTime       

33、'定义等待步骤参数    Dim n As Integer    n = 1    '    '监听串口事件'    flag = WaitCommEvent(hCF, lngEventMask, typOverLapped)'    Debug.Print "监听操作：" & flag'    '获取出

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

35、   Dim intReadIntervalTime As Integer    intReadIntervalTime = 1        Do        '        '异步IO事件获取（返回值为 0 表示出错）'        flag =

36、 WaitForSingleObject(typOverLapped.hEvent, 0)'        Debug.Print "异步IO事件获取：" & flag'        '获取出错码'        errNum = GetLastError()'     

37、;   Debug.Print "IO事件获取出错码：" & errNum                              '清除错误标志函数，获取串口设备状态        flag

38、 = ClearCommError(hCF, lngError, typCommStat)        Debug.Print "获取串口设备状态：" & flag'若获取状态成功        If (flag <> 0) And (typCommStat.cbInQue > 0) ThenDebug.Print "已接收字节数：" & typCommStat.cbInQ

39、ue'判断接收缓冲区内的数据是否等于需要接收的字节数            If typCommStat.cbInQue >= 22 Then                '跳出循环           &

40、#160;    Debug.Print "跳出循环"                Exit Do            End IfEnd If'生成结束时间        sngEndTime = GetT

41、ickCount()        Debug.Print "第" & n & "次监听事件时间：" & sngEndTime                n = n + 1            

42、60;           '读时间间隔        Sleep (intReadIntervalTime)            Loop Until (sngEndTime - sngStarTime) > 1000        '生成结束时间    sngEndTime = GetTickCount()    Debug.Print "结束监听时间："