VB裡使用API对串口進行操作
引用前言:
為什麼要用API來操作串口?VB不是有很方便的MSCOMM控件來操作的嗎?
因為有些特殊設置用API操作起來比較方便,就如我現在所需要用到的特殊第9位格式、多變的串口設置……導致我試過如果用MSCOMM控件的話,會出現接收到錯誤字節、校驗不對等異常情況出現。
基本上API來操作串口還是比較方便快捷的,相比MSCOMM的一個缺點就是沒有接收中斷,需要查詢接收狀態。(這個也僅是我現在學習的成果,不代表真的沒有哦)。
之前只是找到別人一個例子,不是一個完整的類,剛好前幾天找到一個更全的例子,作為類進行添加,裡面註釋也比較完整,希望對於需要學習的同學有所幫助吧:
文章原址:http://blog.csdn.net/dt168/archive/2008/11/11/3278871.aspx
恩,漏了一點進行補充的,就是串口號的設置方法,常規的直接使用COM1~COM9就應該沒事了,如果要調用COM10及以上,則需要加上“\\.\ ”,整個端口號就變為"\\.\COM10",而且這種方法同樣適用於COM9及之前的,所以統一加上"\\.\"會更加好。
網上流行的一篇文章上面說的是變為 "\\\\.\\COM10", 我試驗過是不行的,為了避免大家走同樣的彎路,所以在這裡特意指明一下吧。以下為源代碼了:
'************************************************************************* '**模 块 名:SPort '**by zdt 20081110 '**用API 对Com进行操作 '************************************************************************* Option Explicit 'Private 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 Long 'End Type Private Type COMSTAT fBitFields As Long ' See Comment in Win32API.Txt COMSTAT cbInQue As Long cbOutQue As Long End Type Private Type COMMTIMEOUTS ReadIntervalTimeout As Long ReadTotalTimeoutMultiplier As Long ReadTotalTimeoutConstant As Long WriteTotalTimeoutMultiplier As Long WriteTotalTimeoutConstant As Long End Type 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 OVERLAPPED Internal As Long InternalHigh As Long offset As Long OffsetHigh As Long hEvent As Long End Type Private Type SECURITY_ATTRIBUTES nLength As Long lpSecurityDescriptor As Long bInheritHandle As Long End Type Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function GetLastError Lib "kernel32" () As Long Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As OVERLAPPED) As Long Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As OVERLAPPED) As Long 'OVERLAPPED Private Declare Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long Private Declare Function GetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long Private Declare Function GetOverlappedResult Lib "kernel32" (ByVal hFile As Long, lpOverlapped As OVERLAPPED, lpNumberOfBytesTransferred As Long, ByVal bWait As Long) As Long Private Declare Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" (ByVal lpDef As String, lpDCB As DCB) As Long Private Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long, lpDCB As DCB) As Long Private Declare Function GetCommState Lib "kernel32" (ByVal nCid As Long, lpDCB As DCB) As Long 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 FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long Private Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (lpEventAttributes As SECURITY_ATTRIBUTES, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As String) As Long Private Declare Function SetCommMask Lib "kernel32" (ByVal hFile As Long, ByVal dwEvtMask As Long) As Long Private Declare Function SetEvent Lib "kernel32" (ByVal hEvent As Long) 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 Declare Function ClearCommError Lib "kernel32" (ByVal hFile As Long, lpErrors As Long, lpStat As COMSTAT) As Long Private Declare Function WaitCommEvent Lib "kernel32 " (ByVal hFile As Long, lpEvtMask As Long, lpOverlapped As OVERLAPPED) As Long Private Declare Function ResetEvent Lib "kernel32 " (ByVal hFile As Long) As Long Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long Private Declare Function GetTickCount Lib "kernel32" () As Long Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Private Const INVALID_HANDLE_VALUE = -1 Private Const GENERIC_WRITE = &H40000000 Private Const GENERIC_READ = &H80000000 Private Const OPEN_EXISTING = 3 Private Const FILE_ATTRIBUTE_NORMAL = &H80 Private Const FILE_FLAG_OVERLAPPED = &H40000000 Private Const DTR_CONTROL_DISABLE = &H0 Private Const RTS_CONTROL_ENABLE = &H1 Private Const PURGE_RXABORT = &H2 Private Const PURGE_RXCLEAR = &H8 Private Const PURGE_TXABORT = &H1 Private Const PURGE_TXCLEAR = &H4 Private Const ERROR_IO_PENDING = 997 Private Const STATUS_WAIT_0 = &H0 Private Const WAIT_OBJECT_0 = (STATUS_WAIT_0 + 0) Private Const WAIT_TIMEOUT = 258& Private Const EV_RXCHAR = &H1 ' Any Character received Private m_OverlappedRead As OVERLAPPED Private m_OverlappedWrite As OVERLAPPED Private com_Handle As Long Private com_RxBy As Long Private com_TxBy As Long Public Property Get ReceivedByte() As Long ReceivedByte = com_RxBy End Property Public Property Get SendedByte() As Long SendedByte = com_TxBy End Property Public Property Let ReceivedByte(x As Long) com_RxBy = 0 End Property Public Property Let SendedByte(x As Long) com_TxBy = 0 End Property Public Property Get Handle() As Long Handle = com_Handle End Property 'Public Property Let Handle(id As Long) ' com_Handle = id 'End 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 Function handelinitcom: Call CloseHandle(com_Handle) com_Handle = 0 OpenPort = -1 Exit Function End 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_VALUE End 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 = 0 End 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 = 0 End 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 = -1 End Function '************************************************************************* '**函 数 名:ReadData '**输 入:bytBuffer()(Byte) - 读取到的数据 '** :Outtime(Long) - 等待时间ms '**输 出:(Long) -读取的字节数量 '**功能描述:读取数据 '************************************************************************* 'Public Function ReadData(bytBuffer() As Byte, lngSize As Long, Optional Outtime As Long = 2000) As Long Public 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 COMSTAT Dim evtMask As Long Dim ret As Long ' lngBytesRead = lngSize '清除之前的一切错误与获取当前的状态 lngStatus = ClearCommError(com_Handle, lngErrorFlags, _ udtCommStat) ' Debug.Print "udtCommStat.cbInQue " & udtCommStat.cbInQue '读数据 If lngStatus <> 0 And udtCommStat.cbInQue > 0 And lngSize > 0 Then If lngSize = 255 And udtCommStat.cbInQue > 255 Then lngSize = udtCommStat.cbInQue End If ReDim bytBuffer(lngSize) As Byte fReadStat = ReadFile(com_Handle, bytBuffer(0), lngSize, lngBytesRead, m_OverlappedRead) com_RxBy = com_RxBy + lngBytesRead If fReadStat = 0 Then Call PurgeComm(com_Handle, PURGE_RXABORT Or PURGE_RXCLEAR Or PURGE_TXABORT Or PURGE_TXCLEAR) '清除缓冲区 ' lngStatus = GetLastError ' If lngStatus = ERROR_IO_PENDING Then ' Call PurgeComm(Com_Handle, PURGE_RXABORT Or PURGE_RXCLEAR Or PURGE_TXABORT Or PURGE_TXCLEAR) '清除缓冲区 ' Else ' ' Some other error occurred. ' lngBytesRead = -1 ' ' lngStatus = SetCommErrorEx("CommRead (ReadFile)", _ ' ' Com_Handle) ' GoTo Routine_Exit ' ' End If End If ClearInBuf '清除缓冲区 End If ReadData = lngBytesRead Exit Function Routine_Exit: ReadData = 0 End Function '************************************************************************* '**函 数 名:Class_Initialize '************************************************************************* Private Sub Class_Initialize() com_Handle = INVALID_HANDLE_VALUE com_RxBy = 0 com_TxBy = 0 End Sub '************************************************************************* '**函 数 名:Class_Terminate '************************************************************************* Private Sub Class_Terminate() Call ClosePort End Sub
需要進一步交流的朋友,也可以email與我聯繫,occ#occool.com(#換成@)
发表评论