Attribute VB_Name = "GeneralSerialPortRoutines"
Option Explicit
'General routines used by applications that access the serial port.
'Some routines access forms and variables in template.vbp.

'The following constants are from win32api.txt:
'Constants used in DCB access
'Parity
Global Const NOPARITY = 0
Global Const ODDPARITY = 1
Global Const EVENPARITY = 2
Global Const MARKPARITY = 3
Global Const SPACEPARITY = 4
'Stop bits
Global Const ONESTOPBIT = 0
Global Const ONE5STOPBITS = 1
Global Const TWOSTOPBITS = 2

'Errors
Global Const CE_RXOVER = &H1
Global Const CE_OVERRUN = &H2
Global Const CE_RXPARITY = &H4
Global Const CE_FRAME = &H8
Global Const CE_BREAK = &H10
Global Const CE_CTSTO = &H20
Global Const CE_DSRTO = &H40
Global Const CE_RLSDTO = &H80
Global Const CE_TXFULL = &H100
Global Const CE_PTO = &H200
Global Const CE_IOE = &H400
Global Const CE_DNS = &H800
Global Const CE_OOP = &H1000
Global Const CE_MODE = &H8000

Global Const IE_BADID = (-1)
Global Const IE_OPEN = (-2)
Global Const IE_NOPEN = (-3)
Global Const IE_MEMORY = (-4)
Global Const IE_DEFAULT = (-5)
Global Const IE_HARDWARE = (-10)
Global Const IE_BYTESIZE = (-11)
Global Const IE_BAUDRATE = (-12)

'CommEventMask bits
Global Const EV_RXCHAR = &H1
Global Const EV_RXFLAG = &H2
Global Const EV_TXEMPTY = &H4
Global Const EV_CTS = &H8
Global Const EV_DSR = &H10
Global Const EV_RLSD = &H20
Global Const EV_BREAK = &H40
Global Const EV_ERR = &H80
Global Const EV_RING = &H100
Global Const EV_PERR = &H200
Global Const EV_CTSS = &H400
Global Const EV_DSRS = &H800
Global Const EV_RLSDS = &H1000

'EscapeCommFunction values
Global Const SETXOFF = 1
Global Const SETXON = 2
Global Const SETRTS = 3
Global Const CLRRTS = 4
Global Const SETDTR = 5
Global Const CLRDTR = 6
Global Const RESETDEV = 7
Global Const GETMAXLPT = 8
Global Const GETMAXCOM = 9
Global Const GETBASEIRQ = 10

'Bit rates
Global Const CBR_110 = &HFF10
Global Const CBR_300 = &HFF11
Global Const CBR_600 = &HFF12
Global Const CBR_1200 = &HFF13
Global Const CBR_2400 = &HFF14
Global Const CBR_4800 = &HFF15
Global Const CBR_9600 = &HFF16
Global Const CBR_14400 = &HFF17
Global Const CBR_19200 = &HFF18
Global Const CBR_38400 = &HFF1B
Global Const CBR_56000 = &HFF1F
Global Const CBR_128000 = &HFF23
Global Const CBR_256000 = &HFF27

Global Const CN_RECEIVE = &H1
Global Const CN_TRANSMIT = &H2
Global Const CN_EVENT = &H4
Global Const CSTF_CTSHOLD = &H1
Global Const CSTF_DSRHOLD = &H2
Global Const CSTF_RLSDHOLD = &H4
Global Const CSTF_XOFFHOLD = &H8
Global Const CSTF_XOFFSENT = &H10
Global Const CSTF_EOF = &H20
Global Const CSTF_TXIM = &H40
Global Const LPTx = &H80

Public Const OPEN_EXISTING = 3

'  DTR Control Flow Values.
Public Const DTR_CONTROL_DISABLE = &H0
Public Const DTR_CONTROL_ENABLE = &H1
Public Const DTR_CONTROL_HANDSHAKE = &H2

'  RTS Control Flow Values
Public Const RTS_CONTROL_DISABLE = &H0
Public Const RTS_CONTROL_ENABLE = &H1
Public Const RTS_CONTROL_HANDSHAKE = &H2
Public Const RTS_CONTROL_TOGGLE = &H3

Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000

'DCB Bits values:
Public Const FLAG_fBinary& = &H1
Public Const FLAG_fParity& = &H2
Public Const FLAG_fOutxCtsFlow = &H4
Public Const FLAG_fOutxDsrFlow = &H8
Public Const FLAG_fDtrControl = &H30
Public Const FLAG_fDsrSensitivity = &H40
Public Const FLAG_fTXContinueOnXoff = &H80
Public Const FLAG_fOutX = &H100
Public Const FLAG_fInX = &H200
Public Const FLAG_fErrorChar = &H400
Public Const FLAG_fNull = &H800
Public Const FLAG_fRtsControl = &H3000
Public Const FLAG_fAbortOnError = &H4000

'End of win32api.txt constants.

Public Type COMMTIMEOUTS
     ReadIntervalTimeout As Long
    ReadTotalTimoutMultiplier As Long
    ReadTotalTimeoutConstant As Long
    WriteTotalTimeoutMultiplier As Long
    WriteTotalTimeoutConstant As Long
End Type

Public Type dcbType
        DCBlength As Long
        BaudRate As Long
        Bits1 As Long
        wReserved As Integer
        XonLim As Integer
        XoffLim As Integer
        ByteSize As Byte
        Parity As Byte
        StopBits As Byte
        XonChar As Byte
        XoffChar As Byte
        ErrorChar As Byte
        EofChar As Byte
        EvtChar As Byte
        wReserved2 As Integer
End Type

'Global variables & constants used by the application:

Public Const ProjectName = "SerialPortComplete"

Public BitRate As Long
Public Buffer As Variant
Public CommDCB As dcbType
Public CommPorts() As String
Public OneByteDelay As Single
Public PortExists As Boolean
Public PortInUse As Boolean
Public PortNumber As Integer
Public PortOpen As Boolean
Public SaveDataInFile As Boolean
Public TimedOut As Boolean
Public ValidPort As Boolean

'API declares:
Public Declare Function apiGetCommState _
    Lib "kernel32" _
    Alias "GetCommState" _
    (ByVal nCid As Long, _
    lpDCB As dcbType) _
    As Long
Public Declare Function apiSetCommState _
    Lib "kernel32" _
    Alias "SetCommState" _
    (ByVal hCommDev As Long, _
    lpDCB As dcbType) _
    As Long
Public Declare Function EscapeCommFunction _
    Lib "kernel32" _
    (ByVal nCid As Long, _
    ByVal nFunc As Long) _
    As Long
Public Declare Function GetCommTimeouts _
    Lib "kernel32" _
    (ByVal hFile As Long, _
    lpCommTimeouts As COMMTIMEOUTS) _
    As Long
Public Declare Function SetCommTimeouts _
    Lib "kernel32" _
    (ByVal hFile As Long, _
    lpCommTimeouts As COMMTIMEOUTS) _
    As Long
Public Declare Function timeGetTime _
    Lib "winmm.dll" () _
    As Long
Public Declare Function TransmitCommChar _
    Lib "kernel32" _
    (ByVal nCid As Long, _
    ByVal cChar As Byte) _
    As Long

Public Function fncAddChecksumToAsciiHexString _
    (UserString As String) _
    As String
'Calculates a checksum for a string containing
'a series bytes in Ascii Hex format.
'Places the checksum in Ascii Hex format
'at the end of the string.
Dim Count As Integer
Dim Sum As Long
Dim Checksum As Byte
Dim ChecksumAsAsciiHex As String
'Add the values of each Ascii Hex pair:
For Count = 1 To Len(UserString) - 1 Step 2
    Sum = Sum + Val("&h" & Mid(UserString, Count, 2))
Next Count
'The checksum is the low byte of the sum.
Checksum = Sum - (CInt(Sum / 256)) * 256
ChecksumAsAsciiHex = fncByteToAsciiHex(Checksum)
'Add the checksum to the end of the string.
fncAddChecksumToAsciiHexString = UserString & ChecksumAsAsciiHex
End Function

Public Function fncByteToAsciiHex _
    (ByteToConvert As Byte) _
    As String
'Converts a byte to a 2-character ASCII Hex string
Dim AsciiHex As String
AsciiHex = Hex$(ByteToConvert)
If Len(AsciiHex) = 1 Then
    AsciiHex = "0" & AsciiHex
End If
fncByteToAsciiHex = AsciiHex
End Function

Public Function fncDisplayDateAndTime() As String
'Date and time formatting.
fncDisplayDateAndTime = _
    CStr(Format(Date, "General Date")) & ", " & _
    (Format(Time, "Long Time"))
End Function

Public Function fncGetHighestComPortNumber() As Integer
'Returns the number of the system's highest Com port.
'Also shows how to use the EscapeCommFunction API call.
Dim ClosePortOnExit As Boolean
Dim PortCount As Long