Option Compare Database
Option Explicit
 
Dim mComm As MSComm
Dim m_PortOpen As Boolean
Dim m_Settings As String
Dim m_CommPort As Integer
Dim m_DTREnable As Boolean
Dim m_Handshaking As FlowControl
Dim m_InBufferSize As Integer
Dim m_InputLen As Integer
Dim m_InputMode As Mode
Dim m_OutBufferSize As Integer
Dim m_RTSEnable As Boolean
Dim m_CommEvent As Integer
 

    Const None = 0
    Const XonXoff = 1
    Const CTSRTS = 2
    Const XonXoffCTSRTS = 3

 

   Const Text = 0
   Const Binary = 1

 
Public Sub Output(Dat As Variant)
  mComm.Output = Dat
End Sub
 
Public Property Get InBufferCount() As Integer
  InBufferCount = mComm.InBufferCount
End Property
 
Public Property Get InputData() As Variant
  InputData = mComm.Input
End Property
 
Public Property Get OutBufferCount() As Integer
    OutBufferCount = mComm.OutBufferCount
End Property
 
Public Property Let PortOpen(ByVal NewValue As Boolean)
    If m_PortOpen = False And NewValue = True Then
        With mComm
            .ParityReplace = ""
            .Settings = m_Settings
            .CommPort = m_CommPort
            .DTREnable = m_DTREnable
            .Handshaking = m_Handshaking
            .InBufferSize = m_InBufferSize
            .InputLen = m_InputLen
            .InputMode = m_InputMode
            .OutBufferSize = m_OutBufferSize
            .RTSEnable = m_RTSEnable
            .PortOpen = True
        End With
        m_PortOpen = True
    ElseIf NewValue = False Then
        mComm.PortOpen = False
        m_PortOpen = False
    End If
End Property
 
Public Property Get PortOpen() As Boolean
    PortOpen = m_PortOpen
End Property
 
Private Sub Class_Initialize()
    m_Settings = "9600, N, 8, 1"
    m_CommPort = 1
    m_InBufferSize = 1024
    m_OutBufferSize = 1024
    Set mComm = CreateObject("MSCOMMLIB.MSCOMM")
End Sub
 
Public Property Get CommPort() As Integer
    CommPort = m_CommPort
End Property
 
Public Property Let CommPort(ByVal NewValue As Integer)
    m_CommPort = NewValue
    If m_PortOpen = True Then mComm.CommPort = NewValue
End Property
 
Public Property Get DTREnable() As Boolean
    DTREnable = m_DTREnable
End Property
 
Public Property Let DTREnable(ByVal NewValue As Boolean)
    m_DTREnable = NewValue
    If m_PortOpen = True Then mComm.DTREnable = NewValue
End Property
 
Public Property Get Handshaking() As FlowControl
    Handshaking = m_Handshaking
End Property
 
Public Property Let Handshaking(ByVal NewValue As FlowControl)
    m_Handshaking = NewValue
    If m_PortOpen = True Then mComm.Handshaking = NewValue
End Property
 
Public Property Get InBufferSize() As Integer
    InBufferSize = m_InBufferSize
End Property
 
Public Property Let InBufferSize(ByVal NewValue As Integer)
    m_InBufferSize = NewValue
    If m_PortOpen = True Then mComm.InBufferSize = NewValue
End Property
 
Public Property Get InputLen() As Integer
    InputLen = m_InputLen
End Property
 
Public Property Let InputLen(ByVal NewValue As Integer)
    m_InputLen = NewValue
    If m_PortOpen = True Then mComm.InputLen = NewValue
End Property
 
Public Property Get InputMode() As Mode
    InputMode = m_InputMode
End Property
 
Public Property Let InputMode(ByVal NewValue As Mode)
    m_InputMode = NewValue
    If m_PortOpen = True Then mComm.InputMode = NewValue
End Property
 
Public Property Get OutBufferSize() As Integer
    OutBufferSize = m_OutBufferSize
End Property
 
Public Property Let OutBufferSize(ByVal NewValue As Integer)
    m_OutBufferSize = NewValue
    If m_PortOpen = True Then mComm.OutBufferSize = NewValue
End Property
 
Public Property Get RTSEnable() As Boolean
    RTSEnable = m_RTSEnable
End Property
 
Public Property Let RTSEnable(ByVal NewValue As Boolean)
    m_RTSEnable = NewValue
    If m_PortOpen = True Then mComm.RTSEnable = NewValue
End Property
 
Public Property Get CDHolding() As Boolean
    If m_PortOpen = True Then CDHolding = mComm.CDHolding
End Property
 
Public Property Get CTSHolding() As Boolean
    If m_PortOpen = True Then CTSHolding = mComm.CTSHolding
End Property
 
Public Property Get DSRHolding() As Boolean
    If m_PortOpen = True Then DSRHolding = mComm.DSRHolding
End Property
 
Private Sub Class_Terminate()
    Set mComm = Nothing
End Sub
 
Public Property Get CommEvent() As Integer
    CommEvent = m_CommEvent
End Property
 
Private Sub mComm_OnComm()
    m_CommEvent = mComm.CommEvent
    m_CommEvent = 0
End Sub
 
Public Property Get RThreshold() As Integer
    RThreshold = mComm.RThreshold
End Property
 
Public Property Let RThreshold(ByVal NewValue As Integer)
    mComm.RThreshold = NewValue
End Property