VB6使用API實現(xiàn)串口通信

1、需要和客戶的產(chǎn)品通訊，但波特率是非常規(guī)的，MScomm無法實現(xiàn)，原有的軟件框架和條件又不能轉(zhuǎn)用VC開發(fā)底層，于是用VB6調(diào)用API實現(xiàn)了這個通訊功能，雖然在VB6下這個程序還是單進程的，但實現(xiàn)了異步非阻塞的通信，性能相當(dāng)穩(wěn)定，下面是測試程序代碼 Private Sub cmdSend_Click()Sub cmdSend_Click()    '定義文件讀寫屬性結(jié)構(gòu)    Dim sa As SECURITY_ATTRIBUTES    '定義串口狀態(tài)結(jié)構(gòu)   

2、; Dim typCommStat As COMSTAT    '定義串口狀態(tài)錯誤    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        '定義標(biāo)志值 

5、60;  Dim flag As Long                '定義設(shè)備控制塊    Dim typDCB As DCB        '*獲取設(shè)備控制塊*    flag = GetCommState(hCF, typDCB)    Debug.Print "

6、獲取串口DCB：" & flag        typDCB.BaudRate = 2500     '定義波特率    typDCB.Parity = NOPARITY   '無校驗位    typDCB.ByteSize = 8        '數(shù)據(jù)位    typDCB.

7、StopBits = 0        '停止位 0/1/2 = 1/1.5/2            '*設(shè)置串口參數(shù)*    flag = SetCommState(hCF, typDCB)    Debug.Print "設(shè)置串口參數(shù)：" & flag      

8、60; '*設(shè)置緩沖區(qū)大小*    flag = SetupComm(hCF, 1024, 1024)    'Debug.Print "設(shè)置緩沖區(qū)：" & flag        '*清空讀寫緩沖區(qū)*    flag = PurgeComm(hCF, PURGE_RXABORT Or PURGE_RXCLEAR Or PURGE_TXABORT Or PURGE_TXCLEAR) &

9、#160;  'Debug.Print "強制清空緩沖區(qū)：" & flag        '定義超時結(jié)構(gòu)體    Dim typCommTimeouts As COMMTIMEOUTS    typCommTimeouts.ReadIntervalTimeout = 0     '相鄰兩字節(jié)讀取最大時間間隔（為0表示不使用該超時間隔）    ty

10、pCommTimeouts.ReadTotalTimeoutMultiplier = 0      '一個讀操作的時間常數(shù)    typCommTimeouts.ReadTotalTimeoutConstant = 0        '讀超時常數(shù)    typCommTimeouts.WriteTotalTimeoutMultiplier = 0     

11、9;一個寫操作的時間常數(shù)（為0表示不使用該超時間隔）    typCommTimeouts.WriteTotalTimeoutConstant = 0       '寫超時常數(shù)（為0表示不使用該超時間隔）            '*超時設(shè)置*    flag = SetCommTimeouts(hCF, typCommTimeouts)  &

12、#160; 'Debug.Print "超時設(shè)置：" & flag            '*發(fā)送數(shù)據(jù)*    '定義要發(fā)送字節(jié)數(shù)    Dim lngNumberofBytesToWrite As Long    '定義實際發(fā)送字節(jié)數(shù)    Dim lngNumberofBytesToWritten As Long&

13、#160;   '定義重疊結(jié)構(gòu)體    Dim typOverLapped As OVERLAPPED        '定義發(fā)送數(shù)據(jù)    Dim arrbytTest(0 To 23) As Byte    '載波收發(fā)器同步頭    arrbytTest(0) = CByte(&H53)    arrbytTest(1) = CByt

14、e(&H4E)    arrbytTest(2) = CByte(&H44)    '后續(xù)數(shù)據(jù)包長度    arrbytTest(3) = CByte(&H14)    '載波表預(yù)同步頭    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)    '數(shù)據(jù)長度 

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)'獲取要發(fā)送字節(jié)數(shù)    lngNumberofBytesToWrite = UBound(arrbytTest) + 1        &#

19、39;聲明等待開始時間、結(jié)束時間值    Dim writeStarTime, writeEndTime As Long        writeStarTime = GetTickCount()    Debug.Print "發(fā)送開始時間：" & writeStarTime        '定義發(fā)送循環(huán)步長值    Dim i As Integer

20、    '定義累計發(fā)送字節(jié)數(shù)    Dim intTotalNumberOfBytesToWritten As Integer    '定義發(fā)送間隔時間（毫秒）    Dim intIntervalTime As Integer    intIntervalTime = 0        '發(fā)送數(shù)據(jù)    For i = 0 To U

21、Bound(arrbytTest)        flag = WriteFile(hCF, arrbytTest(i), 1, lngNumberofBytesToWritten, typOverLapped)                '獲取出錯碼        errNum = GetLastErro

22、r()        'Debug.Print "發(fā)送操作出錯碼：" & errNum'若返回值不是IO異步操作未決，則關(guān)閉串口        If (errNum <> ERROR_IO_PENDING) And (errNum <> 0) Then GoTo closeComm'異步IO事件獲?。ǚ祷刂禐?0 表示出錯）     

23、;   flag = WaitForSingleObject(typOverLapped.hEvent, 0)        'Debug.Print "異步IO事件獲?。?quot; & flag'判斷異步IO事件獲取是否成功        If flag <> 0 Then         

24、0;  '異步IO操作結(jié)果獲取(等待標(biāo)記值，必須為true ，否則需要事件激活返回結(jié)果)            flag = GetOverlappedResult(hCF, typOverLapped, lngNumberofBytesToWritten, 1)            'Debug.Print "異步IO操作獲取："

25、; & flag'判斷異步IO操作結(jié)果獲取是否成功            If flag <> 0 Then                intTotalNumberOfBytesToWritten = intTotalNumberOfBytesToWritten + _   &

26、#160;                                                lngNumberofB

27、ytesToWritten            End IfEnd If                '間隔時間（用于需要設(shè)定每字節(jié)間間隔時間的發(fā)送協(xié)議）        Sleep (intIntervalTime)    Next

28、60;       writeEndTime = GetTickCount()    Debug.Print "發(fā)送結(jié)束時間：" & writeEndTime    Debug.Print "發(fā)送總時間：" & (writeEndTime - writeStarTime)    Debug.Print "串口發(fā)送操作：" & flag    D

29、ebug.Print "實際發(fā)送字節(jié)數(shù)：" & intTotalNumberOfBytesToWritten            '*清空緩沖區(qū)等待數(shù)據(jù)接收*    flag = FlushFileBuffers(hCF)    'Debug.Print "清空緩沖區(qū)：" & flag        &#

30、39;*設(shè)置串口事件*    '監(jiān)聽數(shù)據(jù)接收事件'    flag = SetCommMask(hCF, EV_ERR Or EV_RXCHAR)'    Debug.Print "監(jiān)聽事件設(shè)置：" & flag    flag = SetCommMask(hCF, 0)    Debug.Print "監(jiān)聽事件設(shè)置：" & flag   

31、;     '*等待串口接收事件*    '聲明等待開始時間、結(jié)束時間值    Dim sngStarTime, sngEndTime As Long    '事件掩碼    Dim lngEventMask As Long        '定義接收字節(jié)數(shù)變量    Dim tempReceive As Long &

32、#160;  tempReceive = 0            Debug.Print "監(jiān)聽開始"    '生成開始時間    sngStarTime = GetTickCount()    Debug.Print "開始監(jiān)聽時間：" & sngStarTime       

33、'定義等待步驟參數(shù)    Dim n As Integer    n = 1    '    '監(jiān)聽串口事件'    flag = WaitCommEvent(hCF, lngEventMask, typOverLapped)'    Debug.Print "監(jiān)聽操作：" & flag'    '獲取出

34、錯碼'    errNum = GetLastError()'    Debug.Print "監(jiān)聽操作出錯碼：" & errNum''    '若返回值不是IO異步操作未決，則關(guān)閉串口'    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事件獲?。?quot; & flag'        '獲取出錯碼'        errNum = GetLastError()'     

37、;   Debug.Print "IO事件獲取出錯碼：" & errNum                              '清除錯誤標(biāo)志函數(shù)，獲取串口設(shè)備狀態(tài)        flag

38、 = ClearCommError(hCF, lngError, typCommStat)        Debug.Print "獲取串口設(shè)備狀態(tài)：" & flag'若獲取狀態(tài)成功        If (flag <> 0) And (typCommStat.cbInQue > 0) ThenDebug.Print "已接收字節(jié)數(shù)：" & typCommStat.cbInQ

39、ue'判斷接收緩沖區(qū)內(nèi)的數(shù)據(jù)是否等于需要接收的字節(jié)數(shù)            If typCommStat.cbInQue >= 22 Then                '跳出循環(huán)           &

40、#160;    Debug.Print "跳出循環(huán)"                Exit Do            End IfEnd If'生成結(jié)束時間        sngEndTime = GetT

41、ickCount()        Debug.Print "第" & n & "次監(jiān)聽事件時間：" & sngEndTime                n = n + 1            

42、60;           '讀時間間隔        Sleep (intReadIntervalTime)            Loop Until (sngEndTime - sngStarTime) > 1000        '生成結(jié)束時間    sngEndTime = GetTickCount()    Debug.Print "結(jié)束監(jiān)聽時間："