clscomobject.cls

FLA-502控制、标定、分析用

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsComObject"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'*************************
'串口
'*************************
Dim gn串口字节() As Byte
Dim 串口控制结构字 As dcb
Dim 串口延时结构字 As COMMTIMEOUTS

Public Function 串口初始化(str串口号 As String) As Long
    Dim n串口句柄 As Long
    Dim n返回值 As Long
    n串口句柄 = CreateFile(str串口号, GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0, OPEN_EXISTING, 0, ByVal 0)
    If n串口句柄 = -1 Then
        串口初始化 = vb串口返回失败
        Exit Function
    End If
    n返回值 = GetCommState(n串口句柄, 串口控制结构字)
    串口控制结构字.BaudRate = 9600
    串口控制结构字.StopBits = 0
    串口控制结构字.Parity = 0
    串口控制结构字.ByteSize = 8
    n返回值 = SetCommState(n串口句柄, 串口控制结构字)
    If n返回值 = 0 Then
        串口初始化 = vb串口返回失败
        Exit Function
    End If
    n返回值 = GetCommTimeouts(n串口句柄, 串口延时结构字)
    If n返回值 <> 0 Then
        串口延时结构字.ReadIntervalTimeout = &HFFFFFFFF
        串口延时结构字.ReadTotalTimeoutMultiplier = 0
        串口延时结构字.ReadTotalTimeoutConstant = 0
        n返回值 = SetCommTimeouts(n串口句柄, 串口延时结构字)
    End If
    串口初始化 = n串口句柄
End Function

Public Function 发串口命令(n串口句柄 As Long, nCmd As Byte) As Long
    Dim lp串口错 As Long
    Dim lp串口状态 As COMSTAT
    Dim n返回值 As Long
    Dim n发送字节数 As Long
    Dim n接收字节缓冲区(1 To 1) As Byte
    Call PurgeComm(n串口句柄, PURGE_TXCLEAR Or PURGE_RXCLEAR)
    n接收字节缓冲区(1) = nCmd
    n返回值 = WriteFile(n串口句柄, n接收字节缓冲区(1), 1, n发送字节数, ByVal 0)
    If (n返回值 <> 0) And (n发送字节数 = 1) Then
        FlushFileBuffers (n串口句柄)
        发串口命令 = vb串口返回成功
    Else
        发串口命令 = vb串口返回失败
    End If
    Call ClearCommError(n串口句柄, lp串口错, lp串口状态)
End Function

Public Function 发串口命令组(n串口句柄 As Long, nCmd() As Byte, nBytesToBeSent As Byte) As Long
    Dim lp串口错 As Long
    Dim lp串口状态 As COMSTAT
    Dim n发送字节数 As Long
    Dim n接收字节缓冲区() As Byte
    Dim i As Integer
    Dim n返回值 As Long
    Call PurgeComm(n串口句柄, PURGE_TXCLEAR Or PURGE_RXCLEAR)
    ReDim n接收字节缓冲区(1 To nBytesToBeSent) As Byte
    For i = 1 To nBytesToBeSent
        n接收字节缓冲区(i) = nCmd(i)
    Next
    n返回值 = WriteFile(n串口句柄, n接收字节缓冲区(1), nBytesToBeSent, n发送字节数, ByVal 0)
    If (n返回值 <> 0) And (n发送字节数 = nBytesToBeSent) Then
        FlushFileBuffers (n串口句柄)
        发串口命令组 = vb串口返回成功
    Else
        发串口命令组 = vb串口返回失败
    End If
    Call ClearCommError(n串口句柄, lp串口错, lp串口状态)
End Function

'取串口数据组
Public Function 取串口数据组(n串口句柄 As Long, n需要接收字节数 As Byte) As Long
    Dim lp串口错 As Long
    Dim lp串口状态 As COMSTAT
    Dim n返回值 As Long
    Dim n已接收字节数 As Long
    Dim n接收字节缓冲区() As Byte
    Dim n接收字节缓冲区字节长度 As Byte
    Dim i As Long
    n接收字节缓冲区字节长度 = n需要接收字节数
    ReDim n接收字节缓冲区(1 To n接收字节缓冲区字节长度) As Byte
    n返回值 = ReadFile(n串口句柄, n接收字节缓冲区(1), n接收字节缓冲区字节长度, n已接收字节数, ByVal 0)
    If (n返回值 <> 0) Then
        If n已接收字节数 > 0 And n已接收字节数 = n需要接收字节数 Then
            ReDim gn串口字节(1 To n已接收字节数)
            For i = 1 To n已接收字节数
                gn串口字节(i) = n接收字节缓冲区(i)
            Next i
            取串口数据组 = vb串口返回成功
        Else
            取串口数据组 = vb串口返回失败
        End If
    Else
        取串口数据组 = vb串口返回失败
    End If
    Call ClearCommError(n串口句柄, lp串口错, lp串口状态)
End Function

Public Sub 清除串口缓冲区(n串口句柄 As Long)
    Dim n返回值 As Long
    n返回值 = PurgeComm(n串口句柄, PURGE_TXCLEAR Or PURGE_TXABORT Or PURGE_RXCLEAR Or PURGE_RXABORT)
End Sub

Public Function GetTrueValue(n高字节 As Byte, n低字节 As Byte) As Long
    Dim str高字节 As String
    Dim str低字节 As String
    str高字节 = Hex(n高字节)
    If Len(str高字节) = 1 Then
        str高字节 = "0" & str高字节
    End If
    str低字节 = Hex(n低字节)
    If Len(str低字节) = 1 Then
        str低字节 = "0" & str低字节
    End If
    GetTrueValue = CInt("&H" & str高字节 & str低字节)
End Function

Public Function FormatHexNumber(ByVal n字节 As Byte) As String
    Dim strTemp As String
    strTemp = CStr(Hex(n字节))
    If Len(strTemp) = 1 Then
        strTemp = "0" + strTemp
    End If
    FormatHexNumber = strTemp
End Function