在VB中利用API進行串列埠通訊

    一般來說，在VB中編寫串列埠通訊程式，首先考慮到是使用MSComm控制元件，可是該控制元件不能設定超時，而且對許多內部的引數進行了隱藏，從而不能滿足有些具體的工作。而使用API進行串列埠通訊，大多是使用VC，很少見到完整的VB程式碼，為此，我編寫了這個模組。

    同時，由於串列埠通訊是基於位元組流的，為方便程式設計，我還編寫了三個簡單的輔助函式，並寫了一個詳細的測試程式碼。

    如果讀者有好的建議，歡迎留言告知。具體程式碼如下：

 '* ******************************************************* * '* 程式名稱：basComm.bas '* 程式功能：在VB中利用API進行串列埠通訊 '* 作者：lyserver '* 聯絡方式：http://blog.csdn.net/lyserver '* ******************************************************* * Option Explicit Option Base 0 Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Const GENERIC_READ = &H80000000 Private Const GENERIC_WRITE = &H40000000 Private Const OPEN_EXISTING = 3 Private Const INVALID_HANDLE_VALUE = -1 Private Declare Function GetCommState Lib "kernel32" (ByVal nCid As Long, lpDCB As DCB) As Long Private Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long, lpDCB As DCB) As Long Private Declare Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long Private Declare Function SetupComm Lib "kernel32" (ByVal hFile As Long, ByVal dwInQueue As Long, ByVal dwOutQueue As Long) As Long Private Declare Function PurgeComm Lib "kernel32" (ByVal hFile As Long, ByVal dwFlags As Long) As Long Private Const PURGE_TXABORT = &H1 ' Kill the pending/current writes to the comm port. Private Const PURGE_RXABORT = &H2 ' Kill the pending/current reads to the comm port. Private Const PURGE_TXCLEAR = &H4 ' Kill the transmit queue if there. Private Const PURGE_RXCLEAR = &H8 ' Kill the typeahead buffer if there. Private Type DCB DCBlength As Long BaudRate As Long fBitFields As Long 'See Comments in Win32API.Txt wReserved As Integer XonLim As Integer XoffLim As Integer ByteSize As Byte Parity As Byte StopBits As Byte XonChar As Byte XoffChar As Byte ErrorChar As Byte EOFChar As Byte EvtChar As Byte wReserved1 As Integer 'Reserved; Do Not Use End Type Private Type COMMTIMEOUTS ReadIntervalTimeout As Long ReadTotalTimeoutMultiplier As Long ReadTotalTimeoutConstant As Long WriteTotalTimeoutMultiplier As Long WriteTotalTimeoutConstant As Long End Type Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" (ByRef saArray() As Any) As Long '串列埠操作演示 Sub Main() Dim hComm As Long Dim szTest As String '開啟串列埠1 hComm = OpenComm(1) If hComm <> 0 Then '設定串列埠通訊引數 SetCommParam hComm '設定串列埠超時 SetCommTimeOut hComm, 2, 3 '向串列埠寫入字串123 szTest = "123" WriteComm hComm, StringToBytes(szTest) '讀串列埠 szTest = BytesToString(ReadComm(hComm)) Debug.Print szTest '關閉串列埠 CloseComm hComm End If End Sub '開啟串列埠 Function OpenComm(ByVal lComPort As Long) As Long Dim hComm As Long hComm = CreateFile("COM" & lComPort, GENERIC_READ Or GENERIC_WRITE, 0, 0, OPEN_EXISTING, 0, 0) If hComm = INVALID_HANDLE_VALUE Then OpenComm = 0 Else OpenComm = hComm End If End Function '關閉串列埠 Sub CloseComm(hComm As Long) CloseHandle hComm hComm = 0 End Sub '讀串列埠 Function ReadComm(ByVal hComm As Long) As Byte() Dim dwBytesRead As Long Dim BytesBuffer() As Byte ReDim BytesBuffer(4095) ReadFile hComm, BytesBuffer(0), UBound(BytesBuffer) + 1, dwBytesRead, 0 If dwBytesRead > 0 Then ReDim Preserve BytesBuffer(dwBytesRead) ReadComm = BytesBuffer End If End Function '寫串列埠 Function WriteComm(ByVal hComm As Long, BytesBuffer() As Byte) As Long Dim dwBytesWrite If SafeArrayGetDim(BytesBuffer) = 0 Then Exit Function WriteFile hComm, BytesBuffer(0), UBound(BytesBuffer) + 1, dwBytesWrite, 0 WriteComm = dwBytesWrite End Function '設定串列埠通訊引數 Function SetCommParam(ByVal hComm As Long, Optional ByVal lBaudRate As Long = 9600, _ Optional ByVal cByteSize As Byte = 8, Optional ByVal cStopBits As Byte = 0, _ Optional ByVal cParity As Byte = 0, Optional ByVal cEOFChar As Long = 26) As Boolean Dim dc As DCB If hComm = 0 Then Exit Function If GetCommState(hComm, dc) Then dc.BaudRate = lBaudRate dc.ByteSize = cByteSize dc.StopBits = cStopBits dc.Parity = cParity dc.EOFChar = cEOFChar SetCommParam = CBool(SetCommState(hComm, dc)) End If End Function '設定串列埠超時 Function SetCommTimeOut(ByVal hComm As Long, Optional ByVal dwReadTimeOut As Long = 2, _ Optional ByVal dwWriteTimeOut As Long = 3) As Boolean Dim ct As COMMTIMEOUTS If hComm = 0 Then Exit Function ct.ReadIntervalTimeout = dwReadTimeOut '讀操作時，字元間超時 ct.ReadTotalTimeoutMultiplier = dwReadTimeOut '讀操作時，每位元組超時 ct.ReadTotalTimeoutConstant = dwReadTimeOut '讀操作時，固定超時（總超時=每位元組超時*位元組數+固定超時） ct.WriteTotalTimeoutMultiplier = dwWriteTimeOut '寫操作時，每位元組超時 ct.WriteTotalTimeoutConstant = dwWriteTimeOut '寫操作時，固定超時（總超時=每位元組超時*位元組數+固定超時） SetCommTimeOut = CBool(SetCommTimeouts(hComm, ct)) End Function '設定串列埠讀寫緩衝區大小 Function SetCommBuffer(ByVal hComm As Long, Optional ByVal dwBytesRead As Long = 1024, _ Optional ByVal dwBytesWrite As Long = 512) As Boolean If hComm = 0 Then Exit Function SetCommBuffer = CBool(SetupComm(hComm, dwBytesRead, dwBytesWrite)) End Function '清空串列埠緩衝區 Sub ClearComm(ByVal hComm As Long, Optional ByVal InBuffer As Boolean = True, Optional ByVal OutBuffer As Boolean = True) If hComm = 0 Then Exit Sub If InBuffer And OutBuffer Then '清空輸入輸出緩衝區 PurgeComm hComm, PURGE_TXABORT Or PURGE_RXABORT Or PURGE_TXCLEAR Or PURGE_RXCLEAR ElseIf InBuffer Then '清空輸入緩衝區 PurgeComm hComm, PURGE_RXABORT Or PURGE_RXCLEAR ElseIf OutBuffer Then '清空輸出緩衝區 PurgeComm hComm, PURGE_TXABORT Or PURGE_TXCLEAR End If End Sub '輔助函式：BSTR字串轉換為CHAR字串 Function StringToBytes(ByVal szText As String) As Byte() If Len(szText) > 0 Then StringToBytes = StrConv(szText, vbFromUnicode) End If End Function '輔助函式：CHAR字串轉換為BSTR字串 Function BytesToString(bytesText() As Byte) As String If SafeArrayGetDim(bytesText) <> 0 Then BytesToString = StrConv(bytesText, vbUnicode) End If End Function '輔助函式：獲得CHAR字串長度 Function Byteslen(bytesText() As Byte) As Long If SafeArrayGetDim(bytesText) <> 0 Then Byteslen = UBound(bytesText) + 1 End If End Function