VB裡使用API对串口進行操作

4,198次阅读

引用前言：

為什麼要用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(#換成@)

正文完