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 "結束監聽時間："