mscommprocess.bas

这是一本学习串口编程喝计算机监控的好书里面是用VB开发的源代码

Attribute VB_Name = "MsCommProcess"
Option Explicit
'depend on MSComm, General.bas, Parity.bas

Public Type COMMTIMEOUTS
  ReadIntervalTimeout As Long
  ReadTotalTimeoutMultiplier As Long
  ReadTotalTimeoutConstant As Long
  WriteTotalTimeoutMultiplier As Long
  WriteTotalTimeoutConstant As Long
End Type
    
Declare Function SetCommTimeouts Lib "kernel32" _
     (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
Declare Function GetCommTimeouts Lib "kernel32" _
    (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
Public timeouts As COMMTIMEOUTS

Public Sub OpenAndAdjustPort(comMS As MSComm)
    'Check Err after it.
    Dim lRet As Long
    On Error Resume Next
      
    With comMS
        CloseMsComm comMS, 50
        
        lRet = GetCommTimeouts(.CommID, timeouts)
        timeouts.ReadIntervalTimeout = 1000 * 15 \ Val(.Settings) + 100
        timeouts.ReadTotalTimeoutMultiplier = 1000 * 15 \ Val(.Settings) + 100
        timeouts.ReadTotalTimeoutConstant = 1000
        timeouts.WriteTotalTimeoutMultiplier = 1000 * 15 \ Val(.Settings) + 100
        timeouts.WriteTotalTimeoutConstant = 1000
        lRet = SetCommTimeouts(.CommID, timeouts)
        
        OpenMsComm comMS, 50
    End With
End Sub

Public Function GetComStatus(comMS As MSComm) As String
    Dim strTmp As String
      
    With comMS
        strTmp = "COM" + Trim(Str(.CommPort)) + "; "
        strTmp = strTmp + .Settings + "; "
          
        If .DTREnable = True Then
            strTmp = strTmp + "DTR=Enable; "
        Else
            strTmp = strTmp + "DTR=Disable; "
        End If
          
        If .RTSEnable = True Then
            strTmp = strTmp + "RTS=Enable; "
        Else
            strTmp = strTmp + "RTS=Disable; "
        End If
          
        If .PortOpen = True Then
            strTmp = strTmp + "Open"
        Else
            strTmp = strTmp + "Close"
        End If
    End With
      
    GetComStatus = strTmp
End Function

Public Sub OpenMsComm(comMS As MSComm, nDelay As Integer)
    'Check Err after it.
    On Error Resume Next
      
    With comMS
        If .PortOpen = False Then
            .PortOpen = True
            If nDelay > 0 Then DelayTime nDelay 'Very important!
        End If
    End With
End Sub

Public Sub CloseMsComm(comMS As MSComm, nDelay As Integer)
    With comMS
        If .PortOpen = True Then
            comMS.PortOpen = False
            If nDelay > 0 Then DelayTime nDelay
        End If
    End With
End Sub

Public Function SendData(comMS As MSComm, ByVal strHexData As String, nParity As Integer, nEnd As Integer) As String
    Dim strTmp As String
    On Error Resume Next
    
    With comMS
        If .PortOpen = False Then
            MsgBox "The port is close!", vbCritical + vbOKOnly
            Exit Function
        End If
        
        strTmp = GetFullPackage(strHexData, nParity, nEnd)
        .Output = HexCharsToVariant(strTmp)
    End With
    
    SendData = strTmp
End Function