vb用API对串口操作的类.doc

*模 块 名：SPort*by zdt 20081110*用API 对Com进行操作*Option ExplicitPrivate Type COMSTAT fCtsHold As Long fDsrHold As Long fRlsdHold As Long fXoffHold As Long fXoffSent As Long fEof As Long fTxim As Long fReserved As Long cbInQue As Long cbOutQue As LongEnd TypePrivate Type COMSTAT fBitFields As Long See Comment in Win32API.Txt COMSTAT cbInQue As Long cbOutQue As LongEnd TypePrivate Type COMMTIMEOUTS ReadIntervalTimeout As Long ReadTotalTimeoutMultiplier As Long ReadTotalTimeoutConstant As Long WriteTotalTimeoutMultiplier As Long WriteTotalTimeoutConstant As LongEnd TypePrivate 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 UseEnd TypePrivate Type OVERLAPPED Internal As Long InternalHigh As Long offset As Long OffsetHigh As Long hEvent As LongEnd TypePrivate Type SECURITY_ATTRIBUTES nLength As Long lpSecurityDescriptor As Long bInheritHandle As LongEnd TypePrivate Declare Function CloseHandle Lib kernel32 (ByVal hObject As Long) As LongPrivate Declare Function GetLastError Lib kernel32 () As LongPrivate Declare Function ReadFile Lib kernel32 (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As OVERLAPPED) As LongPrivate Declare Function WriteFile Lib kernel32 (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As OVERLAPPED) As Long OVERLAPPEDPrivate Declare Function SetCommTimeouts Lib kernel32 (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As LongPrivate Declare Function GetCommTimeouts Lib kernel32 (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As LongPrivate Declare Function GetOverlappedResult Lib kernel32 (ByVal hFile As Long, lpOverlapped As OVERLAPPED, lpNumberOfBytesTransferred As Long, ByVal bWait As Long) As LongPrivate Declare Function BuildCommDCB Lib kernel32 Alias BuildCommDCBA (ByVal lpDef As String, lpDCB As DCB) As LongPrivate Declare Function SetCommState Lib kernel32 (ByVal hCommDev As Long, lpDCB As DCB) As LongPrivate Declare Function GetCommState Lib kernel32 (ByVal nCid As Long, lpDCB As DCB) As LongPrivate 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 LongPrivate Declare Function FlushFileBuffers Lib kernel32 (ByVal hFile As Long) As LongPrivate Declare Function CreateEvent Lib kernel32 Alias CreateEventA (lpEventAttributes As SECURITY_ATTRIBUTES, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As String) As LongPrivate Declare Function SetCommMask Lib kernel32 (ByVal hFile As Long, ByVal dwEvtMask As Long) As LongPrivate Declare Function SetEvent Lib kernel32 (ByVal hEvent As Long) As LongPrivate Declare Function SetupComm Lib kernel32 (ByVal hFile As Long, ByVal dwInQueue As Long, ByVal dwOutQueue As Long) As LongPrivate Declare Function PurgeComm Lib kernel32 (ByVal hFile As Long, ByVal dwFlags As Long) As LongPrivate Declare Function ClearCommError Lib kernel32 (ByVal hFile As Long, lpErrors As Long, lpStat As COMSTAT) As LongPrivate Declare Function WaitCommEvent Lib kernel32 (ByVal hFile As Long, lpEvtMask As Long, lpOverlapped As OVERLAPPED) As LongPrivate Declare Function ResetEvent Lib kernel32 (ByVal hFile As Long) As LongPrivate Declare Function WaitForSingleObject Lib kernel32 (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As LongPrivate Declare Function GetTickCount Lib kernel32 () As LongPrivate Declare Sub Sleep Lib kernel32 (ByVal dwMilliseconds As Long)Private Const INVALID_HANDLE_VALUE = -1Private Const GENERIC_WRITE = &H40000000Private Const GENERIC_READ = &H80000000Private Const OPEN_EXISTING = 3Private Const FILE_ATTRIBUTE_NORMAL = &H80Private Const FILE_FLAG_OVERLAPPED = &H40000000Private Const DTR_CONTROL_DISABLE = &H0Private Const RTS_CONTROL_ENABLE = &H1Private Const PURGE_RXABORT = &H2Private Const PURGE_RXCLEAR = &H8Private Const PURGE_TXABORT = &H1Private Const PURGE_TXCLEAR = &H4Private Const ERROR_IO_PENDING = 997Private Const STATUS_WAIT_0 = &H0Private Const WAIT_OBJECT_0 = (STATUS_WAIT_0 + 0)Private Const WAIT_TIMEOUT = 258&Private Const EV_RXCHAR = &H1 Any Character receivedPrivate m_OverlappedRead As OVERLAPPEDPrivate m_OverlappedWrite As OVERLAPPEDPrivate com_Handle As LongPrivate com_RxBy As LongPrivate com_TxBy As LongPublic Property Get ReceivedByte() As Long ReceivedByte = com_RxByEnd PropertyPublic Property Get SendedByte() As Long SendedByte = com_TxByEnd PropertyPublic Property Let ReceivedByte(x As Long) com_RxBy = 0End PropertyPublic Property Let SendedByte(x As Long) com_TxBy = 0End PropertyPublic Property Get Handle() As Long Handle = com_HandleEnd PropertyPublic Property Let Handle(id As Long) com_Handle = idEnd Property*函 数 名：OpenPort*ComPort:形式如：COM1、COM2、LPT1等等*Comsettings：形式如：9600,n,8,1*lngInSize:写入缓冲区大小*lngOutSize:写出缓冲区大小*Public Function OpenPort(ComPort As String, Comsettings As String, Optional lngInSize As Long = 1024, Optional lngOutSize As Long = 1024) As Long On Error GoTo handelinitcom Dim RetVal As Long 定义标志值 Dim flag As Long 定义设备控制块 Dim typDCB As DCB Dim CtimeOut As COMMTIMEOUTS, dcbs As DCB Dim strCOM As String, strConfig As String strCOM = COM & Format(ComNumber, 0) strCOM = ComPort Com_Handle = CreateFile(strCOM, GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0, _ OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL Or FILE_FLAG_OVERLAPPED, 0) com_Handle = CreateFile(strCOM, _ GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0, _ OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL Or FILE_FLAG_OVERLAPPED, 0) If com_Handle = INVALID_HANDLE_VALUE Then OpenPort = -1 Exit Function End If *获取出错信息* Dim errNum As Long errNum = GetLastError() Debug.Print 出错信息： & errNum *获取设备控制块* flag = GetCommState(com_Handle, typDCB) Debug.Print 获取串口DCB： & flag Dim SetDb() As String SetDb = Split(Comsettings, ,) If UBound(SetDb) = 3 Then typDCB.BaudRate = CLng(SetDb(0) 定义波特率 If UCase(SetDb(1) = N Then NOPARITY typDCB.Parity = 0 NOPARITY 无校验位 Else typDCB.Parity = 1 End If typDCB.ByteSize = CByte(SetDb(2) 数据位 typDCB.StopBits = CByte(SetDb(3) 停止位 0/1/2 = 1/1.5/2 Else typDCB.BaudRate = 9600 定义波特率 typDCB.Parity = 0 NOPARITY 无校验位 typDCB.ByteSize = 8 数据位 typDCB.StopBits = 0 停止位 0/1/2 = 1/1.5/2 End If *设置串口参数* flag = SetCommState(com_Handle, typDCB) Debug.Print 设置串口参数： & flag *设置缓冲区大小* flag = SetupComm(com_Handle, lngInSize, lngOutSize) flag = SetupComm(com_Handle, 8192, 8192) CtimeOut.ReadIntervalTimeout = -1 0 CtimeOut.ReadTotalTimeoutConstant = 0 2500 CtimeOut.ReadTotalTimeoutMultiplier = 0 0 CtimeOut.WriteTotalTimeoutConstant = 0 20 2500 CtimeOut.WriteTotalTimeoutMultiplier = 0 200 0 *超时设置* flag = SetCommTimeouts(com_Handle, CtimeOut) flag = SetCommMask(com_Handle, EV_RXCHAR) 设置监视的事件为接收到字符 *清空读写缓冲区* Call PurgeComm(com_Handle, PURGE_RXABORT Or PURGE_RXCLEAR Or PURGE_TXABORT Or PURGE_TXCLEAR) 清除缓冲区 If flag = -1 Then RetVal = GetLastError() OpenPort = flag RetVal = CloseHandle(com_Handle) Exit Function End If 获取信号句柄 Dim lpEventAttributes1 As SECURITY_ATTRIBUTES Dim lpEventAttributes2 As SECURITY_ATTRIBUTES m_OverlappedRead.hEvent = CreateEvent(lpEventAttributes1, 1, 0, 0) m_OverlappedWrite.hEvent = CreateEvent(lpEventAttributes2, 1, 0, 0) 判断设置参数是否成功 设置输入和输出缓冲区是否成功 If m_OverlappedRead.hEvent = 0 Or m_OverlappedWrite.hEvent = 0 Then RetVal = GetLastError() OpenPort = RetVal If (m_OverlappedRead.hEvent 0) Then CloseHandle (m_OverlappedRead.hEvent) If (m_OverlappedWrite.hEvent 0) Then CloseHandle (m_OverlappedWrite.hEvent) Call CloseHandle(com_Handle) com_Handle = 0 Exit Function End If OpenPort = 0 Exit Functionhandelinitcom: Call CloseHandle(com_Handle) com_Handle = 0 OpenPort = -1 Exit FunctionEnd Function*函 数 名：ClosePort*Public Function ClosePort() As Long If com_Handle = INVALID_HANDLE_VALUE Then Exit Function End If Call SetCommMask(com_Handle, 0) Call SetEvent(m_OverlappedRead.hEvent) Call SetEvent(m_OverlappedWrite.hEvent) If (m_OverlappedRead.hEvent 0) Then CloseHandle (m_OverlappedRead.hEvent) If (m_OverlappedWrite.hEvent 0) Then CloseHandle (m_OverlappedWrite.hEvent) If CloseHandle(com_Handle) 0 Then ClosePort = 0 Else ClosePort = -1 End If com_Handle = INVALID_HANDLE_VALUEEnd Function*函 数 名：ClearInBuf*输 入：无*输 出：无*功能描述：清空输入缓冲区*Public Function ClearInBuf() As Long If (com_Handle = INVALID_HANDLE_VALUE) Then ClearInBuf = 1 Exit Function End If Call PurgeComm(com_Handle, PURGE_RXABORT Or PURGE_RXCLEAR) ClearInBuf = 0End Function*函 数 名：ClearOutBuf*输 入：无*输 出：(Long) -*功能描述：清空输出缓冲区*Public Function ClearOutBuf() As Long If (com_Handle = INVALID_HANDLE_VALUE) Then ClearOutBuf = 1 Exit Function End If Call PurgeComm(com_Handle, PURGE_TXABORT Or PURGE_TXCLEAR) ClearOutBuf = 0End Function*函 数 名：SendData*输 入：bytBuffer()(Byte) - 数据* ：lngSize(Long) - 数据长度*输 出：(Long) -*功能描述：发送数据*Public Function SendData(bytBuffer() As Byte, lngSize As Long) As Long On Error GoTo Routine_Exit 打开错误陷阱 Dim errNum As Long Dim flag As Long Dim i As Long If (com_Handle = 0) Then SendData = 1 Exit Function End If Dim dwBytesWritten As Long Dim bWriteStat As Long Dim ComStats As COMSTAT Dim dwErrorFlags As Long dwBytesWritten = lngSize Call ClearCommError(com_Handle, dwErrorFlags, ComStats) bWriteStat = WriteFile(com_Handle, bytBuffer(0), lngSize, dwBytesWritten, m_OverlappedWrite) 正常编译时候就这样就可以了 Call GetOverlappedResult(com_Handle, m_OverlappedWrite, dwBytesWritten, 1) 等待直到发送完毕 这样在调试状态下可以的或在编译为P代码的情况下是可以正常运行 If Not bWriteStat Then If GetLastError() = ERROR_IO_PENDING Then Call GetOverlappedResult(com_Handle, m_OverlappedWrite, dwBytesWritten, 1) 等待直到发送完毕 End If End If 这样在调试状态下可以的或在编译为P代码的情况下是可以正常运行 com_TxBy = com_TxBy + dwBytesWritten SendData = dwBytesWritten ClearOutBuf 清除缓冲区 发送数据 For i = 0 To UBound(bytBuffer) flag = WriteFile(Com_Handle, bytBuffer(i), 1, dwBytesWritten, m_OverlappedWrite) If Not flag Then 获取出错码 errNum = GetLastError() If (errNum = ERROR_IO_PENDING) Then flag = 0 flag = GetOverlappedResult(Com_Handle, m_OverlappedWrite, dwBytesWritten, 1) SendData = SendData + dwBytesWritten Debug.Print errNum = ERROR_IO_PENDING Else End If End If 间隔时间（用于需要设定每字节间间隔时间的发送协议） Sleep (intIntervalTime) Next Exit Function -Routine_Exit: SendData = -1End Function*函 数 名：ReadData*输 入：bytBuffer()(Byte) - 读取到的数据* ：Outtime(Long) - 等待时间ms*输 出：(Long) -读取的字节数量*功能描述：读取数据*Public Function ReadData(bytBuffer() As Byte, lngSize As Long, Optional Outtime As Long = 2000) As LongPublic Function ReadData(bytBuffer() As Byte, Optional lngSize As Long = 255, Optional Outtime As Long = 2000) As Long On Error GoTo Routine_Exit 打开错误陷阱 If (com_Handle = 0) Then ReadData = 0 Exit Function End If Dim lngBytesRead As Long Dim fReadStat As Long Dim dwRes As Long Dim lngErrorFlags As Long Dim lngStatus As Long Dim udtCommStat As COMSTA