class_串口异步读写.cls

日本富士仪表PXR的MODBUS通信测试

    m_OverlappedRead.hEvent = CreateEvent(lpEventAttributes1, 1, 0, 0)
    m_OverlappedWrite.hEvent = CreateEvent(lpEventAttributes2, 1, 0, 0)

    '判断设置参数是否成功   设置输入和输出缓冲区是否成功
    If SetCommState(m_Handle, dcbs) = -1 Or SetupComm(m_Handle, lngInSize, lngOutSize) = -1 Or 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(m_Handle)
        m_Handle = 0
        Exit Function
    End If

    OpenPort = 0
    Exit Function
handelinitcom:
    Call CloseHandle(m_Handle)
    m_Handle = 0
    OpenPort = -2
    Exit Function
End Function

'*************************************************************************
'**函 数 名：ClosePort
'**输    入：无
'**输    出：(Long) - 0 成功 -1 失败
'**功能描述：关闭串口
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2006-08-17 14:56:13
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Public Function ClosePort() As Long
    If (m_Handle = 0) Then
        ClosePort = 1
        Exit Function
    End If

    Call SetCommMask(m_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(m_Handle) <> 0 Then
        ClosePort = 0
    Else
        ClosePort = -1
    End If

    m_Handle = 0
End Function

'*************************************************************************
'**函 数 名：ClearInBuf
'**输    入：无
'**输    出：无
'**功能描述：清空输入缓冲区
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2006-08-17 14:57:26
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Public Function ClearInBuf() As Long
    If (m_Handle = 0) Then
        ClearInBuf = 1
        Exit Function
    End If
    Call PurgeComm(m_Handle, PURGE_RXABORT Or PURGE_RXCLEAR)
    ClearInBuf = 0
End Function

'*************************************************************************
'**函 数 名：ClearOutBuf
'**输    入：无
'**输    出：(Long) -
'**功能描述：清空输出缓冲区
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2006-08-17 15:40:38
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Public Function ClearOutBuf() As Long
    If (m_Handle = 0) Then
        ClearOutBuf = 1
        Exit Function
    End If
    Call PurgeComm(m_Handle, PURGE_TXABORT Or PURGE_TXCLEAR)
    ClearOutBuf = 0
End Function

'*************************************************************************
'**函 数 名：SendData
'**输    入：bytBuffer()(Byte) - 数据
'**        ：lngSize(Long)     - 数据长度
'**输    出：(Long) -
'**功能描述：SendData
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2006-08-17 15:43:42
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Public Function SendData(bytBuffer() As Byte, lngSize As Long) As Long
    On Error GoTo ToExit '打开错误陷阱
    '------------------------------------------------
    If (m_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(m_Handle, dwErrorFlags, ComStats)
    bWriteStat = WriteFile(m_Handle, bytBuffer(0), lngSize, dwBytesWritten, m_OverlappedWrite)

    If bWriteStat = 0 Then
        If GetLastError() = ERROR_IO_PENDING Then
            Call GetOverlappedResult(m_Handle, m_OverlappedWrite, dwBytesWritten, 1)                   '等待直到发送完毕
        End If
    Else
        dwBytesWritten = 0
    End If

    SendData = dwBytesWritten
    '------------------------------------------------
    Exit Function
    '----------------
ToExit:
    SendData = -1
End Function

'*************************************************************************
'**函 数 名：ReadData
'**输    入：bytBuffer()(Byte) - 数据
'**        ：lngSize(Long)     - 数据长度
'**输    出：(Long) -
'**功能描述：读取数据
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2006-08-17 16:04:38
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Public Function ReadData(bytBuffer() As Byte, lngSize As Long, Optional Overtime As Long = 3000) As Long
    On Error GoTo ToExit '打开错误陷阱
    '------------------------------------------------
    If (m_Handle = 0) Then
        ReadData = 1
        Exit Function
    End If

    Dim lngBytesRead As Long
    Dim fReadStat As Long
    Dim dwRes  As Long

    lngBytesRead = lngSize

    '读数据
    fReadStat = ReadFile(m_Handle, bytBuffer(0), lngSize, lngBytesRead, m_OverlappedRead)
    If fReadStat = 0 Then
        If GetLastError() = ERROR_IO_PENDING Then                           '重叠 I/O 操作在进行中
            dwRes = WaitForSingleObject(m_OverlappedRead.hEvent, Overtime)  '等待，直到超时
            Select Case dwRes
            Case WAIT_OBJECT_0:   '读完成
                If GetOverlappedResult(m_Handle, m_OverlappedRead, lngBytesRead, 0) = 0 Then
                    '错误
                    ReadData = -2
                    Exit Function
                End If
            Case WAIT_TIMEOUT:    '超时
                ReadData = -1
                Exit Function
            Case Else:                  'WaitForSingleObject 错误
            End Select
        End If
    End If
    ReadData = lngBytesRead
    '------------------------------------------------
    Exit Function
    '----------------
ToExit:
    ReadData = -1
End Function

'*************************************************************************
'**函 数 名：Class_Terminate
'**输    入：无
'**输    出：无
'**功能描述：
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2006-08-17 16:36:21
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Private Sub Class_Terminate()
    Call ClosePort
End Sub