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 = Val(cls注冊表.GetKeyValue(HKEY_CURRENT_USER, "DS", "BaudRate"))
    串口控制結構字.StopBits = 0
    串口控制結構字.Parity = 0
    串口控制結構字.ByteSize = Val(cls注冊表.GetKeyValue(HKEY_CURRENT_USER, "DS", "ByteSize"))
    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