Attribute VB_Name = "Math"
Option Explicit
Public Declare Function GetTickCount Lib "kernel32" () As Long

Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function ResetEvent Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function GetLastError Lib "kernel32" () As Long
Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Long) As Long
Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Long) As Long
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
Declare Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" (ByVal lpDef As String, lpDCB As DCB) As Long
Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long, lpDCB As DCB) As Long
Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
Declare Function GetCommModemStatus Lib "kernel32" (ByVal hComm As Long, dwModemStatus As Long) As Long

'API calls
Declare Function EnumPorts Lib "winspool.drv" Alias "EnumPortsA" (ByVal pName As String, ByVal Level As Long, ByVal lpbPorts As Long, ByVal cbBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
Declare Function lstrlenW Lib "kernel32.dll" (ByVal lpString As Long) As Long
Declare Sub CopyMem Lib "kernel32.dll" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
Declare Function HeapAlloc Lib "kernel32.dll" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Declare Function GetProcessHeap Lib "kernel32.dll" () As Long
Declare Function HeapFree Lib "kernel32.dll" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long

Public iCharTime, iCharDelay As Integer
Public lChecksum As Long
Public iPollingCounter As Integer
Public Data(256) As Single
Public bFlag, bConnected, bDebugPoll, bWaitforIncoming, bDisconnect, bMBActive As Boolean
Public LoginSucceeded, bSingleUpdate, bExitProgram, bCRCFlag As Boolean
Public bConnectRequest, bDisconnectRequest, bPrepare2WriteSP As Boolean
Public bUpdateOverview, bUpdate3PRelays, bUpdate1PRelays, bUpdateATSTimers As Boolean
Public bWrite3PRelays, bWrite1PRelays, bWriteATSTimers, bWriteConfig As Boolean
Public Data_Recv(255) As Long
Public bSystemInitialized As Boolean
Public sGPCOn(25), sGPCOff(25), sLastTab, sCurrentTab As String
Public iOKState(25) As Integer
Public iConnected, bNewStart, bSPWritten As Boolean
Public fMainForm As frmMain
Public sContinue As String
Public UtilityVolt, UtilityAmps, UtilityWatts As Long
Public UtilityHz As Single
Public MaxSpan As Single
Public HzBias, VBias As Single
Public bUtilVRead, bUtilIRead, bUtilHzRead, bUtilWattsRead
Public bGenVRead, bGenIRead, bGenHzRead, bGenWattsRead, bHzBiasRead, bVBiasRead
Public bDigInputRead, bDigOut18Read, bDigOut916Read
Public iError, iWriteFail As Integer
Public bSendGPCSetpoints, bGetGPCSetpoints As Boolean
Public sSPNames(200), D(200) As String
Global ComNum As Long
Global bRead(255) As Byte
Global bForceTest As Boolean

Type COMSTAT
        fCtsHold As Long
        fDsrHold As Long
        fRlsdHold As Long
        fXoffHold As Long
        fXoffSent As Long
        fEof As Long
        fTxim As Long
        fReserved As Long
        cbInQue As Long
        cbOutQue As Long
End Type

Type COMMTIMEOUTS
        ReadIntervalTimeout As Long
        ReadTotalTimeoutMultiplier As Long
        ReadTotalTimeoutConstant As Long
        WriteTotalTimeoutMultiplier As Long
        WriteTotalTimeoutConstant As Long
End Type

Type DCB
        DCBlength As Long
        BaudRate As Long
        fBinary As Long
        fParity As Long
        fOutxCtsFlow As Long
        fOutxDsrFlow As Long
        fDtrControl As Long
        fDsrSensitivity As Long
        fTXContinueOnXoff As Long
        fOutX As Long
        fInX As Long
        fErrorChar As Long
        fNull As Long
        fRtsControl As Long
        fAbortOnError As Long
        fDummy2 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
End Type

Type OVERLAPPED
        Internal As Long
        InternalHigh As Long
        offset As Long
        OffsetHigh As Long
        hEvent As Long
End Type
Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End Type

'API Structures
Private Type PORT_INFO_2
    pPortName As String
    pMonitorName As String
    pDescription As String
    fPortType As Long
    Reserved As Long
End Type

Private Type API_PORT_INFO_2
    pPortName As Long
    pMonitorName As Long
    pDescription As Long
    fPortType As Long
    Reserved As Long
End Type


'Public Data Structure - up to 100 Ports Information
Public Ports(0 To 100) As PORT_INFO_2
Public Sub IntializeStrings()

    sSPNames(0) = "3P 27/59 HiHi Setting:"
    sSPNames(1) = "3P 27/59 Hi Setting:"
    sSPNames(2) = "3P 27/59 Lo Setting:"
    sSPNames(3) = "3P 27/59 LoLo Setting:"
    sSPNames(4) = "3P 27/59 Hi Set Time:"
    sSPNames(5) = "3P 27/59 HiHi Set Time:"
    sSPNames(6) = "3P 27/59 Hi Clear Time:"
    sSPNames(7) = "3P 27/59 HiHi Clear Time:"
    sSPNames(8) = "3P 27/59 HiHi Hysterisis:"
    sSPNames(9) = "3P 27/59 Hi Hysterisis:"
    sSPNames(10) = "3P 27/59 Lo Hysterisis:"
    sSPNames(11) = "3P 27/59 LoLo Hysterisis:"
    sSPNames(12) = "3P 81 HiHi Setting:"
    sSPNames(13) = "3P 81 Hi Setting:"
    sSPNames(14) = "3P 81 Lo Setting:"
    sSPNames(15) = "3P 81 LoLo Setting:"
    sSPNames(16) = "3P 81 Hi Set Time:"
    sSPNames(17) = "3P 81 HiHi Set Time:"
    sSPNames(18) = "3P 81 Hi Clear Time:"
    sSPNames(19) = "3P 81 HiHi Clear Time:"
    sSPNames(20) = "3P 81 HiHi Hysterisis:"
    sSPNames(21) = "3P 81 Hi Hysterisis:"
    sSPNames(22) = "3P 81 Lo Hysterisis:"
    sSPNames(23) = "3P 81 LoLo Hysterisis:"
    sSPNames(24) = "32-1 HiHi Setting:"
    sSPNames(25) = "32-1 Hi Setting:"
    sSPNames(26) = "32-1 Lo Setting:"
    sSPNames(27) = "32-1 LoLo Setting:"
    sSPNames(28) = "32-1 Hi Set Time:"
    sSPNames(29) = "32-1 HiHi Set Time:"
    sSPNames(30) = "32-1 Hi Clear Time:"
    sSPNames(31) = "32-1 HiHi Clear Time:"
    sSPNames(32) = "32-1 HiHi Hysterisis:"
    sSPNames(33) = "32-1 Hi Hysterisis:"
    sSPNames(34) = "32-1 Lo Hysterisis:"
    sSPNames(35) = "32-1 LoLo Hysterisis:"
    sSPNames(36) = "46 HiHi Setting:"
    sSPNames(37) = "46 Hi Setting:"
    sSPNames(38) = "46 Hi Set Time:"
    sSPNames(39) = "46 HiHi Set Time:"
    sSPNames(40) = "46 Hi Clear Time:"
    sSPNames(41) = "46 HiHi Clear Time:"
    sSPNames(42) = "46 HiHi Hysterisis:"
    sSPNames(43) = "46 Hi Hysterisis:"
    sSPNames(44) = "47 HiHi Setting:"
    sSPNames(45) = "47 Hi Setting:"
    sSPNames(46) = "47 Hi Set Time:"
    sSPNames(47) = "47 HiHi Set Time:"
    sSPNames(48) = "47 Hi Clear Time:"
    sSPNames(49) = "47 HiHi Clear Time:"
    sSPNames(50) = "47 HiHi Hysterisis:"
    sSPNames(51) = "47 Hi Hysterisis:"
    sSPNames(52) = "1P 27/59 HiHi Setting:"
    sSPNames(53) = "1P 27/59 Hi Setting:"
    sSPNames(54) = "1P 27/59 Lo Setting:"
    sSPNames(55) = "1P 27/59 LoLo Setting:"
    sSPNames(56) = "1P 27/59 Hi Set Time:"
    sSPNames(57) = "1P 27/59 HiHi Set Time:"
    sSPNames(58) = "1P 27/59 Hi Clear Time:"
    sSPNames(59) = "1P 27/59 HiHi Clear Time:"
    sSPNames(60) = "1P 27/59 HiHi Hysterisis:"
    sSPNames(61) = "1P 27/59 Hi Hysterisis:"
    sSPNames(62) = "1P 27/59 Lo Hysterisis:"
    sSPNames(63) = "1P 27/59 LoLo Hysterisis:"
    sSPNames(64) = "1P 81 HiHi Setting:"
    sSPNames(65) = "1P 81 Hi Setting:"
    sSPNames(66) = "1P 81 Lo Setting:"
    sSPNames(67) = "1P 81 LoLo Setting:"
    sSPNames(68) = "1P 81 Hi Set Time:"
    sSPNames(69) = "1P 81 HiHi Set Time:"
    sSPNames(70) = "1P 81 Hi Clear Time:"
    sSPNames(71) = "1P 81 HiHi Clear Time:"
    sSPNames(72) = "1P 81 HiHi Hysterisis:"
    sSPNames(73) = "1P 81 Hi Hysterisis:"
    sSPNames(74) = "1P 81 Lo Hysterisis:"
    sSPNames(75) = "1P 81 LoLo Hysterisis:"
    sSPNames(76) = "32-1 HiHi Setting:"
    sSPNames(77) = "32-1 Hi Setting:"
    sSPNames(78) = "32-1 Lo Setting:"
    sSPNames(79) = "32-1 LoLo Setting:"
    sSPNames(80) = "32-1 Hi Set Time:"
    sSPNames(81) = "32-1 HiHi Set Time:"
    sSPNames(82) = "32-1 Hi Clear Time:"
    sSPNames(83) = "32-1 HiHi Clear Time:"
    sSPNames(84) = "32-1 HiHi Hysterisis:"
    sSPNames(85) = "32-1 Hi Hysterisis:"
    sSPNames(86) = "32-1 Lo Hysterisis:"
    sSPNames(87) = "32-1 LoLo Hysterisis:"
    sSPNames(88) = "51V Voltage Limit:"
    sSPNames(89) = "51V Current Limit:"
    sSPNames(90) = "51V Set Time:"
    sSPNames(91) = "51V Clear Time:"
    sSPNames(92) = "ATS TDES:"
    sSPNames(93) = "ATS TDCL:"
    sSPNames(94) = "ATS TDNE:"
    sSPNames(95) = "ATS TDN:"
    sSPNames(96) = "ATS TDEN:"
    sSPNames(97) = "ATS TDEC:"
    sSPNames(98) = "3P PT ratio:"
    sSPNames(99) = "3P CT ratio:"
    sSPNames(100) = "1P PT ratio:"
    sSPNames(101) = "1P CT ratio:"
    sSPNames(102) = "3P Delta:"
    sSPNames(103) = "1P Delta:"
    sSPNames(104) = "CBA rotation:"
    sSPNames(105) = "Frequency Gain:"
    sSPNames(106) = "Frequency Offset:"
    sSPNames(107) = "Voltage Gain:"
    sSPNames(108) = "Voltage Offset:"

    
    
End Sub
Public Sub D2FinalString()
    frmSiteStatus.txt27HiHi(0).Text = D(0)
    frmSiteStatus.txt27Hi(0).Text = D(1)
    frmSiteStatus.txt27Lo(0).Text = D(2)
    frmSiteStatus.txt27LoLo(0).Text = D(3)
    frmSiteStatus.txt27HiSetTime(0).Text = D(4)
    frmSiteStatus.txt27HiHiSetTime(0).Text = D(5)
    frmSiteStatus.txt27HiClearTime(0).Text = D(6)
    frmSiteStatus.txt27HiHiClearTime(0).Text = D(7)
    frmSiteStatus.txt27HiHiHyster(0).Text = D(8)
    frmSiteStatus.txt27HiHyster(0).Text = D(9)
    frmSiteStatus.txt27LoHyster(0).Text = D(10)
    frmSiteStatus.txt27LoLoHyster(0).Text = D(11)
    frmSiteStatus.txt81HiHi(0).Text = D(12)
    frmSiteStatus.txt81Hi(0).Text = D(13)
    frmSiteStatus.txt81Lo(0).Text = D(14)
    frmSiteStatus.txt81LoLo(0).Text = D(15)
    frmSiteStatus.txt81HiSetTime(0).Text = D(16)
    frmSiteStatus.txt81HiHiSetTime(0).Text = D(17)
    frmSiteStatus.txt81HiClearTime(0).Text = D(18)
    frmSiteStatus.txt81HiHiClearTime(0).Text = D(19)
    frmSiteStatus.txt81HiHiHyster(0).Text = D(20)
    frmSiteStatus.txt81HiHyster(0).Text = D(21)
    frmSiteStatus.txt81LoHyster(0).Text = D(22)
    frmSiteStatus.txt81LoLoHyster(0).Text = D(23)
    frmSiteStatus.txt32HiHi(0).Text = D(24)
    frmSiteStatus.txt32Hi(0).Text = D(25)
    frmSiteStatus.txt32Lo(0).Text = D(26)
    frmSiteStatus.txt32LoLo(0).Text = D(27)
    frmSiteStatus.txt32HiSetTime(0).Text = D(28)
    frmSiteStatus.txt32HiHiSetTime(0).Text = D(29)
    frmSiteStatus.txt32HiClearTime(0).Text = D(30)
    frmSiteStatus.txt32HiHiClearTime(0).Text = D(31)
    frmSiteStatus.txt32HiHiHyster(0).Text = D(32)
    frmSiteStatus.txt32HiHyster(0).Text = D(33)
    frmSiteStatus.txt32LoHyster(0).Text = D(34)
    frmSiteStatus.txt32LoLoHyster(0).Text = D(35)
    frmSiteStatus.txt46HiHi(0).Text = D(36)
    frmSiteStatus.txt46Hi(0).Text = D(37)
    frmSiteStatus.txt46HiSetTime(0).Text = D(38)
    frmSiteStatus.txt46HiHiSetTime(0).Text = D(39)
    frmSiteStatus.txt46HiClearTime(0).Text = D(40)
    frmSiteStatus.txt46HiHiClearTime(0).Text = D(41)
    frmSiteStatus.txt46HiHiHyster(0).Text = D(42)
    frmSiteStatus.txt46HiHyster(0).Text = D(43)
    frmSiteStatus.txt47HiHi.Text = D(44)
    frmSiteStatus.txt47Hi.Text = D(45)
    frmSiteStatus.txt47HiSetTime.Text = D(46)
    frmSiteStatus.txt47HiHiSetTime.Text = D(47)
    frmSiteStatus.txt47HiClearTime.Text = D(48)
    frmSiteStatus.txt47HiHiClearTime.Text = D(49)
    frmSiteStatus.txt47HiHiHyster.Text = D(50)
    frmSiteStatus.txt47HiHyster.Text = D(51)
    frmSiteStatus.txt27HiHi(1).Text = D(52)
    frmSiteStatus.txt27Hi(1).Text = D(53)
    frmSiteStatus.txt27Lo(1).Text = D(54)
    frmSiteStatus.txt27LoLo(1).Text = D(55)
    frmSiteStatus.txt27HiSetTime(1).Text = D(56)
    frmSiteStatus.txt27HiHiSetTime(1).Text = D(57)
    frmSiteStatus.txt27HiClearTime(1).Text = D(58)
    frmSiteStatus.txt27HiHiClearTime(1).Text = D(59)
    frmSiteStatus.txt27HiHiHyster(1).Text = D(60)
    frmSiteStatus.txt27HiHyster(1).Text = D(61)
    frmSiteStatus.txt27LoHyster(1).Text = D(62)
    frmSiteStatus.txt27LoLoHyster(1).Text = D(63)
    frmSiteStatus.txt81HiHi(1).Text = D(64)
    frmSiteStatus.txt81Hi(1).Text = D(65)
    frmSiteStatus.txt81Lo(1).Text = D(66)
    frmSiteStatus.txt81LoLo(1).Text = D(67)
    frmSiteStatus.txt81HiSetTime(1).Text = D(68)
    frmSiteStatus.txt81HiHiSetTime(1).Text = D(69)
    frmSiteStatus.txt81HiClearTime(1).Text = D(70)
    frmSiteStatus.txt81HiHiClearTime(1).Text = D(71)
    frmSiteStatus.txt81HiHiHyster(1).Text = D(72)
    frmSiteStatus.txt81HiHyster(1).Text = D(73)
    frmSiteStatus.txt81LoHyster(1).Text = D(74)
    frmSiteStatus.txt81LoLoHyster(1).Text = D(75)
    frmSiteStatus.txt32HiHi(1).Text = D(76)
    frmSiteStatus.txt32Hi(1).Text = D(77)
    frmSiteStatus.txt32Lo(1).Text = D(78)
    frmSiteStatus.txt32LoLo(1).Text = D(79)
    frmSiteStatus.txt32HiSetTime(1).Text = D(80)
    frmSiteStatus.txt32HiHiSetTime(1).Text = D(81)
    frmSiteStatus.txt32HiClearTime(1).Text = D(82)
    frmSiteStatus.txt32HiHiClearTime(1).Text = D(83)
    frmSiteStatus.txt32HiHiHyster(1).Text = D(84)
    frmSiteStatus.txt32HiHyster(1).Text = D(85)
    frmSiteStatus.txt32LoHyster(1).Text = D(86)
    frmSiteStatus.txt32LoLoHyster(1).Text = D(87)
    frmSiteStatus.txt46HiHi(1).Text = D(88)
    frmSiteStatus.txt46Hi(1).Text = D(89)
    frmSiteStatus.txt46HiSetTime(1).Text = D(90)
    frmSiteStatus.txt46HiClearTime(1).Text = D(91)
    frmSiteStatus.txtATSTimer(2).Text = D(92)
    frmSiteStatus.txtATSTimer(4).Text = D(93)
    frmSiteStatus.txtATSTimer(5).Text = D(94)
    frmSiteStatus.txtATSTimer(0).Text = D(95)
    frmSiteStatus.txtATSTimer(1).Text = D(96)
    frmSiteStatus.txtATSTimer(3).Text = D(97)
    frmSiteStatus.txtATSTimer(7).Text = D(98)
    frmSiteStatus.txtATSTimer(6).Text = D(99)
    frmSiteStatus.txtATSTimer(8).Text = D(100)
    frmSiteStatus.txtATSTimer(9).Text = D(101)
    'the check boxes must be converted to integers.
    If D(102) > 1 Then D(102) = 1: If D(102) < 0 Then D(102) = 0
    frmSiteStatus.Check1(2).Value = D(102)
    If D(103) > 1 Then D(103) = 1: If D(103) < 0 Then D(103) = 0
    frmSiteStatus.Check1(3).Value = D(103)
    If D(104) > 1 Then D(104) = 1: If D(104) < 0 Then D(104) = 0
    frmSiteStatus.Check1(0).Value = D(104)
    
    frmSiteStatus.txtATSTimer(10).Text = D(105)
    frmSiteStatus.txtATSTimer(11).Text = D(106)
    frmSiteStatus.txtATSTimer(16).Text = D(107)
    frmSiteStatus.txtATSTimer(15).Text = D(108)

End Sub

Sub Pause(lMilliseconds As Long)
    Dim Start
    Start = GetTickCount
    While Start + lMilliseconds > GetTickCount
        DoEvents
    Wend
End Sub
Public Function mb_Rcv(ByVal Node As Integer, ByVal FNC As Integer, ByVal ST_ADD As Integer, ByVal Num As Integer) As Integer
    Dim Data(7) As Byte, lTemp As Long, iWaits, iTemp, iTemp2 As Integer
    Dim iCharReceived, iAttempt, Response As Integer
    Dim bTimeout, bAllReceived As Boolean
    Dim Style, Ctxt As Integer
    Dim Title, Help, Msg, sTemp As String
    
    iError = 0  'initialize when entering (since iError is a global variable)
    
    If Math.bExitProgram = True Then
        Exit Function
    End If
    Do While frmSiteStatus.MSComm1.InBufferCount <> 0
        sTemp = frmSiteStatus.MSComm1.Input 'clear receive buffer
    Loop

    On Error GoTo mb_Rcv_Error
'    Debug.Print "S:"; Time$
    If Math.bConnected = True Then
        bMBActive = True    'we have entered the communication routine
        frmSiteStatus.MSComm1.InBufferCount = 0 ' clears out any contents of the Input buffer
        ST_ADD = ST_ADD - 1     'ask for offset = 1, translates to offset 0 in the table
        Data(0) = Node
        Data(1) = FNC
        Data(2) = ST_ADD \ 256
        Data(3) = ST_ADD - ((ST_ADD \ 256) * 256)
        Data(4) = Num \ 256
        Data(5) = Num - ((Num \ 256) * 256)

        ' set which algorithm to use
        frmMain.CrcCtrl1.CRCType = Modbus

        ' do the calculation
        frmMain.CrcCtrl1.DoCRCByteArray Data, 6, True, 65535
        lTemp = (frmMain.CrcCtrl1.GetCRCDecStr) \ 256
        Data(6) = lTemp
        lTemp = (frmMain.CrcCtrl1.GetCRCDecStr) - ((frmMain.CrcCtrl1.GetCRCDecStr \ 256) * 256)
        Data(7) = lTemp

        frmSiteStatus.MSComm1.InBufferCount = 0 ' clears out any contents of the Input buffer
        frmSiteStatus.MSComm1.OutBufferCount = 0 ' clears out any contents of the output buffer
        If frmSiteStatus.MSComm1.PortOpen = False Then
            frmSiteStatus.MSComm1.CommPort = frmConfig.Port.Text
            frmSiteStatus.MSComm1.settings = frmConfig.settings.Caption
            frmSiteStatus.MSComm1.PortOpen = True
        End If

        frmSiteStatus.MSComm1.OutBufferCount = 0 ' clears out any contents of the output buffer
        frmMain.shpTX.BackColor = vbGreen
        frmSiteStatus.MSComm1.Output = Data
        frmMain.shpTX.BackColor = vbBlack

        'now wait for the response
        iWaits = frmConfig.txtTimeout.Text   'timeout
        iTemp = iWaits                    'save this

        Pause (frmConfig.txtWait(0))              'wait 4 character times (at 9600 bps)

        'any new characters?
        Do While (frmSiteStatus.MSComm1.InBufferCount = 0) And bTimeout = False
            If Math.bExitProgram = True Then
                Exit Function
            End If
            bTimeout = False            'clear this
            If frmSiteStatus.MSComm1.InBufferCount <> 0 Then
                frmMain.shpRX.BackColor = vbGreen
                Exit Do         'got something, exit
            Else
                iTemp = iTemp - 1
                If iTemp <= 0 Then
                    bTimeout = True
                    iError = 80
                    mb_Rcv = iError
                    frmSiteStatus.MSComm1.PortOpen = False
                    Pause (10)
                    frmSiteStatus.MSComm1.PortOpen = True
                    Exit Function
                End If
                Pause (1)
            End If
        Loop

        'received at least one character on the receive channel
        iCharReceived = frmSiteStatus.MSComm1.InBufferCount 'zero this out
        Pause (frmConfig.txtWait(1))          'wait another 4 character times
        Do While iCharReceived <> frmSiteStatus.MSComm1.InBufferCount
            frmMain.shpRX.BackColor = vbGreen
            iCharReceived = frmSiteStatus.MSComm1.InBufferCount
            Pause (frmConfig.txtWait(2))
        Loop
        frmMain.shpRX.BackColor = vbBlack
        mb_Rcv = iError
        If iError <> 0 Then
            Exit Function
        End If
        mb_Rcv = ProcessIncomingData
    End If
    bMBActive = False           'clear this flag to indicate others may use the port

'    Debug.Print "E:"; Time$

    Exit Function
mb_Rcv_Error:
    Style = vbYesNo + vbInformation + vbDefaultButton2   ' Define buttons.
    Title = "DG Monitor"   ' Define title.
    Help = App.Path & "\DGMHELP.HLP"   ' Define Help file.
    Ctxt = 1   ' Define topic
    Select Case Err.Number   ' Evaluate error number.
        Case 57     ' Device I/O error
            Close #1   ' Close open file.
            Msg = "Disk hardware failure.  Unable to proceed" & vbCrLf & vbCrLf & "Do you wish to continue running this program?"
            Response = MsgBox(Msg, Style, Title, Help, Ctxt)
        Case 67     'Too many files
            Close #1
            Msg = "Too many files open.  Close unneeded programs and try again" & vbCrLf & vbCrLf & "Do you wish to continue running this program?"
            Response = MsgBox(Msg, Style, Title, Help, Ctxt)
        Case 71
            Close #1
            Msg = "Disk not ready.  Re-insert media and try again." & vbCrLf & vbCrLf & "Do you wish to continue running this program?"
            Response = MsgBox(Msg, Style, Title, Help, Ctxt)
        Case 75
        Case 76
            Close #1
            Msg = "Cannot access file in the location previously attempted.  Close and reopen this program." & vbCrLf & vbCrLf & "Do you wish to continue running this program?"
            Response = MsgBox(Msg, Style, Title, Help, Ctxt)
      Case Else
         ' Handle other situations here...
            Msg = "Unexpected error - " & Err.Number & vbCrLf & "Note error number and situation and contact Cutler-Hammer" & vbCrLf & _
            vbCrLf & "Closing and restarting Windows is recommended." & vbCrLf & vbCrLf & "Do you wish to continue running this program?"
            Response = MsgBox(Msg, Style, Title, Help, Ctxt)
    End Select
    If Response = vbYes Then
        Resume Next
    Else
        bExitProgram = True
        frmMain.ExitProgram
    End If
End Function
Public Function mb_Xmt(ByVal Node As Integer, ByVal ST_ADD As Integer, ByVal iNumReg As Integer, ByRef iData() As Single) As Integer
    Dim Data(200) As Byte, lTemp As Long, i, j, iWaits, iTemp, iTemp2, iError As Integer
    Dim DataSent As String
    Dim iCharReceived, iAttempt, Response As Integer
    Dim bTimeout, bAllReceived As Boolean
    Dim Style, Ctxt As Integer
    Dim Title, Help, Msg, sTemp As String
    If Math.bExitProgram = True Then
        Exit Function
    End If
    Do While frmSiteStatus.MSComm1.InBufferCount <> 0
        sTemp = frmSiteStatus.MSComm1.Input 'clear receive buffer
    Loop

'    On Error GoTo mb_Xmt_Error
'    Debug.Print "S:"; Time$
    If Math.bConnected = True Then
        bMBActive = True    'we have entered the communication routine
        frmSiteStatus.MSComm1.InBufferCount = 0 ' clears out any contents of the Input buffer
        ST_ADD = ST_ADD - 1     'if ask for offset = 1, translates to offset 0 in the table
        'start building string to be sent to GPC
        DataSent = Chr$(Node)
        DataSent = DataSent & Chr$(16)
        DataSent = DataSent & Chr$(ST_ADD \ 256)
        DataSent = DataSent & Chr$(ST_ADD - ((ST_ADD \ 256) * 256))
        DataSent = DataSent & Chr$(iNumReg \ 256)
        DataSent = DataSent & Chr$(iNumReg - ((iNumReg \ 256) * 256))
        DataSent = DataSent & Chr$(iNumReg * 2)   'convert length to bytes
        
        j = 0                                   'start loop at first value to be transmitted
        For i = 7 To (6 + iNumReg * 2) Step 2       'but this value starts at Data(7)
            If iData(j) < 0 Then
                iData(j) = iData(j) + 65536
            End If
            DataSent = DataSent & Chr$(iData(j) \ 256)  'start with iData(0)->Data(7)
            DataSent = DataSent & Chr$(iData(j) - ((iData(j) \ 256) * 256)) 'left over
            
            j = j + 1                           'increment source data pointer
        Next i
        ' set which algorithm to use
        frmMain.CrcCtrl1.CRCType = Modbus
        'reuse j to determine the length of the data to be sent
        j = Len(DataSent)
        ' do the calculation
        frmMain.CrcCtrl1.DoCRC DataSent, j, True, 65535    'j holds the length of the message
        lTemp = (frmMain.CrcCtrl1.GetCRCDecStr) \ 256
        DataSent = DataSent & Chr$(lTemp)
        lTemp = (frmMain.CrcCtrl1.GetCRCDecStr) - ((frmMain.CrcCtrl1.GetCRCDecStr \ 256) * 256)
        DataSent = DataSent & Chr$(lTemp)

        frmSiteStatus.MSComm1.InBufferCount = 0 ' clears out any contents of the Input buffer
        frmSiteStatus.MSComm1.OutBufferCount = 0 ' clears out any contents of the output buffer
        If frmSiteStatus.MSComm1.PortOpen = False Then
            frmSiteStatus.MSComm1.CommPort = frmConfig.Port.Text
            frmSiteStatus.MSComm1.settings = frmConfig.settings.Caption
            frmSiteStatus.MSComm1.PortOpen = True
        End If

        frmSiteStatus.MSComm1.OutBufferCount = 0 ' clears out any contents of the output buffer
        frmMain.shpTX.BackColor = vbGreen
        
        frmSiteStatus.MSComm1.Output = DataSent
        frmMain.shpTX.BackColor = vbBlack

        'now wait for the response
        iWaits = frmConfig.txtTimeout.Text   'timeout
        iTemp = iWaits                    'save this

        Pause (frmConfig.txtWait(0))              'wait 4 character times (at 9600 bps)

        'any new characters?
        Do While (frmSiteStatus.MSComm1.InBufferCount = 0) And bTimeout = False
            If Math.bExitProgram = True Then
                Exit Function
            End If
            bTimeout = False            'clear this
            If frmSiteStatus.MSComm1.InBufferCount <> 0 Then
                frmMain.shpRX.BackColor = vbGreen
                Exit Do         'got something, exit
            Else
                iTemp = iTemp - 1
                If iTemp <= 0 Then
                    bTimeout = True
                    mb_Xmt = 80
                    Exit Function
                End If
                Pause (1)
            End If
        Loop

        'received at least one character on the receive channel
        iCharReceived = frmSiteStatus.MSComm1.InBufferCount 'zero this out
        Pause (frmConfig.txtWait(1))          'wait another 4 character times
        Do While iCharReceived <> frmSiteStatus.MSComm1.InBufferCount
            frmMain.shpRX.BackColor = vbGreen
            iCharReceived = frmSiteStatus.MSComm1.InBufferCount
            Pause (frmConfig.txtWait(2))
        Loop
        frmMain.shpRX.BackColor = vbBlack
        mb_Xmt = iError
        If iError <> 0 Then
            Exit Function
        End If
        mb_Xmt = ProcessIncomingData
    End If
    bMBActive = False           'clear this flag to indicate others may use the port

'    Debug.Print "E:"; Time$

    Exit Function
mb_Xmt_Error:
    Style = vbYesNo + vbInformation + vbDefaultButton2   ' Define buttons.
    Title = "DG Monitor"   ' Define title.
    Help = App.Path & "\DGMHELP.HLP"   ' Define Help file.
    Ctxt = 1   ' Define topic
    Select Case Err.Number   ' Evaluate error number.
        Case 57     ' Device I/O error
            Close #1   ' Close open file.
            Msg = "Disk hardware failure.  Unable to proceed" & vbCrLf & vbCrLf & "Do you wish to continue running this program?"
            Response = MsgBox(Msg, Style, Title, Help, Ctxt)
        Case 67     'Too many files
            Close #1
            Msg = "Too many files open.  Close unneeded programs and try again" & vbCrLf & vbCrLf & "Do you wish to continue running this program?"
            Response = MsgBox(Msg, Style, Title, Help, Ctxt)
        Case 71
            Close #1
            Msg = "Disk not ready.  Re-insert media and try again." & vbCrLf & vbCrLf & "Do you wish to continue running this program?"
            Response = MsgBox(Msg, Style, Title, Help, Ctxt)
        Case 75
        Case 76
            Close #1
            Msg = "Cannot access file in the location previously attempted.  Close and reopen this program." & vbCrLf & vbCrLf & "Do you wish to continue running this program?"
            Response = MsgBox(Msg, Style, Title, Help, Ctxt)
      Case Else
         ' Handle other situations here...
            Msg = "Unexpected error - " & Err.Number & vbCrLf & "Note error number and situation and contact Cutler-Hammer" & vbCrLf & _
            vbCrLf & "Closing and restarting Windows is recommended." & vbCrLf & vbCrLf & "Do you wish to continue running this program?"
            Response = MsgBox(Msg, Style, Title, Help, Ctxt)
    End Select
    If Response = vbYes Then
        Resume Next
    Else
        bExitProgram = True
        frmMain.ExitProgram
    End If
End Function
Public Function mb_WriteBit(ByVal Node As Integer, ByVal ST_ADD As Integer, ByVal bBit As Boolean) As Integer
    Dim Data(200) As Byte, lTemp As Long, i, j, iWaits, iTemp, iTemp2, iError As Integer
    Dim DataSent As String
    Dim iCharReceived, iAttempt, Response As Integer
    Dim bTimeout, bAllReceived As Boolean
    Dim Style, Ctxt As Integer
    Dim Title, Help, Msg, sTemp As String
    If Math.bExitProgram = True Then
        Exit Function
    End If
    Do While frmSiteStatus.MSComm1.InBufferCount <> 0
        sTemp = frmSiteStatus.MSComm1.Input 'clear receive buffer
    Loop

    On Error GoTo mb_WriteBit_Error
'    Debug.Print "S:"; Time$
    If Math.bConnected = True Then
        bMBActive = True    'we have entered the communication routine
        frmSiteStatus.MSComm1.InBufferCount = 0 ' clears out any contents of the Input buffer
        ST_ADD = ST_ADD - 1     'ask for offset = 1, translates to offset 0 in the table
        DataSent = Chr$(Node)
        DataSent = DataSent & Chr$(5)
        DataSent = DataSent & Chr$(ST_ADD \ 256)
        DataSent = DataSent & Chr$(ST_ADD - ((ST_ADD \ 256) * 256))
        If bBit = True Then
            DataSent = DataSent & Chr$(255)
        Else
            DataSent = DataSent & Chr$(0)
        End If
        DataSent = DataSent & Chr$(0)
        
        ' set which algorithm to use
        frmMain.CrcCtrl1.CRCType = Modbus
        ' do the calculation
        frmMain.CrcCtrl1.DoCRC DataSent, 6, True, 65535
        lTemp = (frmMain.CrcCtrl1.GetCRCDecStr) \ 256
        DataSent = DataSent & Chr$(lTemp)
        lTemp = (frmMain.CrcCtrl1.GetCRCDecStr) - ((frmMain.CrcCtrl1.GetCRCDecStr \ 256) * 256)
        DataSent = DataSent & Chr$(lTemp)

        frmSiteStatus.MSComm1.InBufferCount = 0 ' clears out any contents of the Input buffer
        frmSiteStatus.MSComm1.OutBufferCount = 0 ' clears out any contents of the output buffer
        If frmSiteStatus.MSComm1.PortOpen = False Then
            frmSiteStatus.MSComm1.CommPort = frmConfig.Port.Text
            frmSiteStatus.MSComm1.settings = frmConfig.settings.Caption
            frmSiteStatus.MSComm1.PortOpen = True
        End If

        frmSiteStatus.MSComm1.OutBufferCount = 0 ' clears out any contents of the output buffer
        frmMain.shpTX.BackColor = vbGreen
        
        frmSiteStatus.MSComm1.Output = DataSent
        frmMain.shpTX.BackColor = vbBlack

        'now wait for the response
        iWaits = frmConfig.txtTimeout.Text   'timeout
        iTemp = iWaits                    'save this

        Pause (frmConfig.txtWait(0))              'wait 4 character times (at 9600 bps)

        'any new characters?
        Do While (frmSiteStatus.MSComm1.InBufferCount = 0) And bTimeout = False
            If Math.bExitProgram = True Then
                Exit Function
            End If
            bTimeout = False            'clear this
            If frmSiteStatus.MSComm1.InBufferCount <> 0 Then
                frmMain.shpRX.BackColor = vbGreen
                Exit Do         'got something, exit
            Else
                iTemp = iTemp - 1
                If iTemp <= 0 Then
                    bTimeout = True
                    mb_WriteBit = 80
                    Exit Function
                End If
                Pause (1)
            End If
        Loop

        'received at least one character on the receive channel
        iCharReceived = frmSiteStatus.MSComm1.InBufferCount 'zero this out
        Pause (frmConfig.txtWait(1))          'wait another 4 character times
        Do While iCharReceived <> frmSiteStatus.MSComm1.InBufferCount
            frmMain.shpRX.BackColor = vbGreen
            iCharReceived = frmSiteStatus.MSComm1.InBufferCount
            Pause (frmConfig.txtWait(2))
        Loop
        frmMain.shpRX.BackColor = vbBlack
        mb_WriteBit = iError
        If iError <> 0 Then
            Exit Function
        End If
        mb_WriteBit = ProcessIncomingData

    End If
    bMBActive = False           'clear this flag to indicate others may use the port

'    Debug.Print "E:"; Time$

    Exit Function
mb_WriteBit_Error:
    Style = vbYesNo + vbInformation + vbDefaultButton2   ' Define buttons.
    Title = "DG Monitor"   ' Define title.
    Help = App.Path & "\DGMHELP.HLP"   ' Define Help file.
    Ctxt = 1   ' Define topic
    Select Case Err.Number   ' Evaluate error number.
        Case 57     ' Device I/O error
            Close #1   ' Close open file.
            Msg = "Disk hardware failure.  Unable to proceed" & vbCrLf & vbCrLf & "Do you wish to continue running this program?"
            Response = MsgBox(Msg, Style, Title, Help, Ctxt)
        Case 67     'Too many files
            Close #1
            Msg = "Too many files open.  Close unneeded programs and try again" & vbCrLf & vbCrLf & "Do you wish to continue running this program?"
            Response = MsgBox(Msg, Style, Title, Help, Ctxt)
        Case 71
            Close #1
            Msg = "Disk not ready.  Re-insert media and try again." & vbCrLf & vbCrLf & "Do you wish to continue running this program?"
            Response = MsgBox(Msg, Style, Title, Help, Ctxt)
        Case 75
        Case 76
            Close #1
            Msg = "Cannot access file in the location previously attempted.  Close and reopen this program." & vbCrLf & vbCrLf & "Do you wish to continue running this program?"
            Response = MsgBox(Msg, Style, Title, Help, Ctxt)
      Case Else
         ' Handle other situations here...
            Msg = "Unexpected error - " & Err.Number & vbCrLf & "Note error number and situation and contact Cutler-Hammer" & vbCrLf & _
            vbCrLf & "Closing and restarting Windows is recommended." & vbCrLf & vbCrLf & "Do you wish to continue running this program?"
            Response = MsgBox(Msg, Style, Title, Help, Ctxt)
    End Select
    If Response = vbYes Then
        Resume Next
    Else
        bExitProgram = True
        frmMain.ExitProgram
    End If
End Function
Function ProcessIncomingData()
    Dim i, ii, iii, j, Response As Integer
    Dim test As Long
    Dim byteTemp, LocalData(256) As Byte
    Dim sGarbage As String
    Dim CalculatedCRCHigh, CalculatedCRCLow, LData(125) As Single

    Dim strbuffer As String
    Dim Style, Ctxt As Integer
    Dim Title, Help, Msg As String

    On Error GoTo ProcessIncomingError
    If frmSiteStatus.MSComm1.PortOpen = True Then
        frmSiteStatus.MSComm1.InputLen = 0          'read all the characters at once
        
        'guard against incoming burst of noise crashing program
        'test to make sure the incoming length of data is less than size of Math.Data() array
        
        If frmSiteStatus.MSComm1.InBufferCount > 200 Then
            sGarbage = frmSiteStatus.MSComm1.InBufferCount  'get all characters
            ProcessIncomingData = 2001  'signal input data overflow
            Exit Function
        End If
        
        frmSiteStatus.MSComm1.InputMode = comInputModeText
        ii = frmSiteStatus.MSComm1.InBufferCount    'save this
        strbuffer = frmSiteStatus.MSComm1.Input
        iii = Len(strbuffer)
        For i = 0 To iii - 1
            Data_Recv(i) = Asc(Mid$(strbuffer, i + 1, 1)) '** changed to Mid$ in Build 12
        Next i

        'data has been transferred from the comm buffer to Data_Recv() array
        'now check on the CRC to see if valid
        'get the bytes less the CRC on the end
        For i = 0 To iii - 3
            LocalData(i) = Data_Recv(i)
        Next i
        ' set which algorithm to use
        frmMain.CrcCtrl1.CRCType = Modbus

        ' do the calculation
        'make CRC calculation non-reentrant (only one at a time may call this function)
        If Math.bCRCFlag = False And iii > 3 Then
            Math.bCRCFlag = True
            frmMain.CrcCtrl1.DoCRCByteArray LocalData, iii - 2, True, 65535
            Math.bCRCFlag = False
        Else
            ProcessIncomingData = 2002  'signal multiple call to CRC algorithm
            Exit Function
        End If
        
        'now eliminate the possibility of it hearing a copy of its own transmission
        If LocalData(1) = 4 Or LocalData(1) = 3 Or LocalData(1) = 2 Then
            If iii <> (LocalData(2) + 5) Then
                ProcessIncomingData = 2003  'wrong length of response (likely echo)
                Exit Function
            End If
        End If
        CalculatedCRCHigh = (frmMain.CrcCtrl1.GetCRCDecStr) \ 256
        CalculatedCRCLow = (frmMain.CrcCtrl1.GetCRCDecStr) - ((frmMain.CrcCtrl1.GetCRCDecStr \ 256) * 256)
        test = frmMain.CrcCtrl1.GetLastError
        If CalculatedCRCHigh <> Asc(Mid$(strbuffer, (Len(strbuffer) - 1), 1)) Then
            ProcessIncomingData = 100
            Exit Function
        End If
        If CalculatedCRCLow <> Asc(Right$(strbuffer, 1)) Then
            ProcessIncomingData = 100    'CRC error on received data detected
            Exit Function
        End If


        'load data into data array
        For i = 0 To ((Data_Recv(2)) / 2) - 1
            LData(i) = ((Data_Recv(3 + 2 * i) * 256) + Data_Recv(4 + 2 * i)) 'calculate the data variable
            If LData(i) > 32767 Then
                LData(i) = LData(i) - 65536     'convert to 2's complement
            End If
            Data(i) = LData(i)                  'convert to integer
        Next i
    End If
    Exit Function
ProcessIncomingError:
    Style = vbYesNo + vbInformation + vbDefaultButton2   ' Define buttons.
    Title = "DG Monitor"   ' Define title.
    Help = App.Path & "\DGMHELP.HLP"   ' Define Help file.
    Ctxt = 1   ' Define topic
    Select Case Err.Number   ' Evaluate error number.
        Case 53     'file not found
            Close #1
            Msg = "Configuration file 'CONFIG.CSV' missing." & vbCrLf & "Default values are loaded." & vbCrLf & "Select configuration settings to change defaults, and resave (File / Save)" & vbCrLf & vbCrLf & "Do you wish to continue running this program?"
            Response = MsgBox(Msg, Style, Title, Help, Ctxt)
        Case 57     ' Device I/O error
            Close #1   ' Close open file.
            Msg = "Disk hardware failure.  Unable to proceed" & vbCrLf & vbCrLf & "Do you wish to continue running this program?"
            Response = MsgBox(Msg, Style, Title, Help, Ctxt)
        Case 67     'Too many files
            Close #1
            Msg = "Too many files open.  Close unneeded programs and try again" & vbCrLf & vbCrLf & "Do you wish to continue running this program?"
            Response = MsgBox(Msg, Style, Title, Help, Ctxt)
        Case 71
            Close #1
            Msg = "Disk not ready.  Re-insert media and try again." & vbCrLf & vbCrLf & "Do you wish to continue running this program?"
            Response = MsgBox(Msg, Style, Title, Help, Ctxt)
        Case 75
        Case 76
            Close #1
            Msg = "Cannot access file in the location previously attempted.  Close and reopen this program." & vbCrLf & vbCrLf & "Do you wish to continue running this program?"
            Response = MsgBox(Msg, Style, Title, Help, Ctxt)
      Case Else
         ' Handle other situations here...
            Msg = "Unexpected error - " & Err.Number & vbCrLf & "Note error number and situation and contact Cutler-Hammer" & vbCrLf & _
            vbCrLf & "Closing and restarting Windows is recommended." & vbCrLf & vbCrLf & "Do you wish to continue running this program?"
            Response = MsgBox(Msg, Style, Title, Help, Ctxt)
    End Select
    If Response = vbYes Then
        Resume Next
    Else
        Math.bExitProgram = True
        frmMain.ExitProgram
    End If
End Function
Sub UpdateStatus(ByVal Data)
    Dim dt As String
    dt = Now

    frmSystemStatus.Text1.Text = frmSystemStatus.Text1.Text + vbCrLf + dt + " " + Data
    frmSiteStatus.Label5.Caption = Data
End Sub
Sub UpdateWithoutTime(ByVal Data)
    frmSystemStatus.Text1.Text = frmSystemStatus.Text1.Text + Data
End Sub
Public Sub Updatetime()
    Dim dt As String
    dt = Now
    frmSystemStatus.Text1.Text = frmSystemStatus.Text1.Text + vbCrLf + dt + " "
End Sub

Sub Main()
    frmSplash.Show
    frmSplash.Refresh
    Set fMainForm = New frmMain
    Load fMainForm
    Unload frmSplash


    fMainForm.Show
End Sub



Sub LoadResStrings(frm As Form)
    On Error Resume Next


    Dim ctl As Control
    Dim obj As Object
    Dim fnt As Object
    Dim sCtlType As String
    Dim nVal As Integer


    'set the form's caption
    frm.Caption = LoadResString(CInt(frm.Tag))


    'set the font
    Set fnt = frm.Font
    fnt.Name = LoadResString(20)
    fnt.Size = CInt(LoadResString(21))


    'set the controls' captions using the caption
    'property for menu items and the Tag property
    'for all other controls
    For Each ctl In frm.Controls
        Set ctl.Font = fnt
        sCtlType = TypeName(ctl)
        If sCtlType = "Label" Then
            ctl.Caption = LoadResString(CInt(ctl.Tag))
        ElseIf sCtlType = "Menu" Then
            ctl.Caption = LoadResString(CInt(ctl.Caption))
        ElseIf sCtlType = "TabStrip" Then
            For Each obj In ctl.Tabs
                obj.Caption = LoadResString(CInt(obj.Tag))
                obj.ToolTipText = LoadResString(CInt(obj.ToolTipText))
            Next
        ElseIf sCtlType = "Toolbar" Then
            For Each obj In ctl.Buttons
                obj.ToolTipText = LoadResString(CInt(obj.ToolTipText))
            Next
        ElseIf sCtlType = "ListView" Then
            For Each obj In ctl.ColumnHeaders
                obj.Text = LoadResString(CInt(obj.Tag))
            Next
        Else
            nVal = 0
            nVal = Val(ctl.Tag)
            If nVal > 0 Then ctl.Caption = LoadResString(nVal)
            nVal = 0
            nVal = Val(ctl.ToolTipText)
            If nVal > 0 Then ctl.ToolTipText = LoadResString(nVal)
        End If
    Next
End Sub

Function FlushComm()
    FlushFileBuffers (ComNum)
End Function

Function Init_Com(ComNumber As String) As Boolean
On Error GoTo handleinitcom
'    Dim ComSetup As DCB, Answer, Stat As COMSTAT, RetBytes As Long
'    Dim retval As Long
'    Dim CtimeOut As COMMTIMEOUTS, BarDCB As DCB
    ' Open the communications port for read/write (&HC0000000).
    ' Must specify existing file (3).
    ComNumber = "COM" & ComNumber & ":"
'    ComNum = CreateFile(ComNumber, &HC0000000, 0, 0&, &H3, 0, 0)
    ComNum = CreateFile(ComNumber, 0, 0, 0&, &H3, 0, 0) '2nd file 0-desired access check if there but don't read
    If ComNum = -1 Then
'        MsgBox "Com Port " & ComNumber & " not available. Use Serial settings (on the main menu) to setup your ports.", 48
        Init_Com = False
        Exit Function
    Else
        Init_Com = True
    End If
    
    CloseHandle (ComNum)
    Exit Function
handleinitcom:
    CloseHandle (ComNum)
    Exit Function
End Function
Function ForceDCBWrite(ComNumber As String, Comsettings As String) As Boolean
    Dim ComSetup As DCB, Answer, Stat As COMSTAT, RetBytes As Long
    Dim retval As Long
    Dim CtimeOut As COMMTIMEOUTS, BarDCB As DCB
    
    CtimeOut.ReadIntervalTimeout = 20
    CtimeOut.ReadTotalTimeoutConstant = 1
    CtimeOut.ReadTotalTimeoutMultiplier = 1
    CtimeOut.WriteTotalTimeoutConstant = 10
    CtimeOut.WriteTotalTimeoutMultiplier = 1
    retval = SetCommTimeouts(ComNum, CtimeOut)
    If retval = -1 Then
        retval = GetLastError()
        MsgBox "Unable to set timeouts for port " & ComNumber & " Error: " & retval
        retval = CloseHandle(ComNum)
        ForceDCBWrite = False
        Exit Function
    End If
    retval = BuildCommDCB(Comsettings, BarDCB)
    If retval = -1 Then
        retval = GetLastError()
        MsgBox "Unable to build Comm DCB " & Comsettings & " Error: " & retval
        retval = CloseHandle(ComNum)
        ForceDCBWrite = False
        Exit Function
    End If
    retval = SetCommState(ComNum, BarDCB)
    If retval = -1 Then
        retval = GetLastError()
        MsgBox "Unable to set Comm DCB " & Comsettings & " Error: " & retval
        retval = CloseHandle(ComNum)
        ForceDCBWrite = False
        Exit Function
    End If
    
    ForceDCBWrite = True

End Function
Function SetCOM(ComNumber As String, Comsettings As String) As Boolean
On Error GoTo handleinitcom
    Dim ComSetup As DCB, Answer, Stat As COMSTAT, RetBytes As Long
    Dim retval As Long
    Dim CtimeOut As COMMTIMEOUTS, BarDCB As DCB
    ' Open the communications port for read/write (&HC0000000).
    ' Must specify existing file (3).
    ComNumber = "COM" & ComNumber & ":"
    ComNum = CreateFile(ComNumber, &HC0000000, 0, 0&, &H3, 0, 0)

'    ComNum = CreateFile(ComNumber, 0, 0, 0&, &H3, 0, 0)
    If ComNum = -1 Then
'        MsgBox "Com Port " & ComNumber & " not available. Use Serial settings (on the main menu) to setup your ports.", 48
        SetCOM = False
        Exit Function
    End If
    'Setup Time Outs for com port
    CtimeOut.ReadIntervalTimeout = 20
    CtimeOut.ReadTotalTimeoutConstant = 1
    CtimeOut.ReadTotalTimeoutMultiplier = 1
    CtimeOut.WriteTotalTimeoutConstant = 10
    CtimeOut.WriteTotalTimeoutMultiplier = 1
    retval = SetCommTimeouts(ComNum, CtimeOut)
    If retval = -1 Then
        retval = GetLastError()
        MsgBox "Unable to set timeouts for port " & ComNumber & " Error: " & retval
        retval = CloseHandle(ComNum)
        SetCOM = False
        Exit Function
    End If
    retval = BuildCommDCB(Comsettings, BarDCB)
    If retval = -1 Then
        retval = GetLastError()
        MsgBox "Unable to build Comm DCB " & Comsettings & " Error: " & retval
        retval = CloseHandle(ComNum)
        SetCOM = False
        Exit Function
    End If
    retval = SetCommState(ComNum, BarDCB)
    If retval = -1 Then
        retval = GetLastError()
        MsgBox "Unable to set Comm DCB " & Comsettings & " Error: " & retval
        retval = CloseHandle(ComNum)
        SetCOM = False
        Exit Function
    End If
    
    SetCOM = True
handleinitcom:
    Exit Function
End Function
Function fin_com(ComNum As String)
    fin_com = CloseHandle(ComNum)
End Function

Public Function TrimStr(strName As String) As String
    'Finds a null then trims the string
    Dim x As Integer

    x = InStr(strName, vbNullChar)
    If x > 0 Then TrimStr = Left(strName, x - 1) Else TrimStr = strName
End Function
Public Function LPSTRtoSTRING(ByVal lngPointer As Long) As String
    Dim lngLength As Long

    'Get number of characters in string
    lngLength = lstrlenW(lngPointer) * 2
    'Initialize string so we have something to copy the string into
    LPSTRtoSTRING = String(lngLength, 0)
    'Copy the string
    CopyMem ByVal StrPtr(LPSTRtoSTRING), ByVal lngPointer, lngLength
    'Convert to Unicode
    LPSTRtoSTRING = TrimStr(StrConv(LPSTRtoSTRING, vbUnicode))
End Function

'Use ServerName to specify the name of a Remote Workstation i.e. "//WIN95WKST"
'or leave it blank "" to get the ports of the local Machine
Public Function GetAvailablePorts(ServerName As String) As Long
    Dim ret As Long
    Dim PortsStruct(0 To 100) As API_PORT_INFO_2
    Dim pcbNeeded As Long
    Dim pcReturned As Long
    Dim TempBuff As Long
    Dim i As Integer

    'Get the amount of bytes needed to contain the data returned by the API call
    ret = EnumPorts(ServerName, 2, TempBuff, 0, pcbNeeded, pcReturned)
    'Allocate the Buffer
    TempBuff = HeapAlloc(GetProcessHeap(), 0, pcbNeeded)
    ret = EnumPorts(ServerName, 2, TempBuff, pcbNeeded, pcbNeeded, pcReturned)
    If ret Then
        'Convert the returned String Pointer Values to VB String Type
        CopyMem PortsStruct(0), ByVal TempBuff, pcbNeeded
        For i = 0 To pcReturned - 1
            Ports(i).pDescription = LPSTRtoSTRING(PortsStruct(i).pDescription)
            Ports(i).pPortName = LPSTRtoSTRING(PortsStruct(i).pPortName)
            Ports(i).pMonitorName = LPSTRtoSTRING(PortsStruct(i).pMonitorName)
            Ports(i).fPortType = PortsStruct(i).fPortType
        Next
    End If
    GetAvailablePorts = pcReturned
    'Free the Heap Space allocated for the Buffer
    If TempBuff Then HeapFree GetProcessHeap(), 0, TempBuff
End Function


Function ReadCommPure() As String
On Error GoTo handlepurecom
    Dim RetBytes As Long, i As Integer, ReadStr As String, retval As Long
    Dim CheckTotal As Integer, CheckDigitLC As Integer
    retval = ReadFile(ComNum, bRead(0), 255, RetBytes, 0)
    ReadStr = ""
    If (RetBytes > 0) Then
        For i = 0 To RetBytes - 1
            ReadStr = ReadStr & Chr(bRead(i))
        Next i
       Else
        FlushComm
    End If
    'Return the string read from serial port
    ReadCommPure = ReadStr
handlepurecom:
    Exit Function
End Function

Function WriteCOM32(COMString As String) As Integer
On Error GoTo handlewritelpt
    Dim RetBytes As Long, LenVal As Long
    Dim retval As Long
    
    If Len(COMString) > 255 Then
        WriteCOM32 Left$(COMString, 255)
        WriteCOM32 Right$(COMString, Len(COMString) - 255)
        Exit Function
    End If
    
    For LenVal = 0 To Len(COMString) - 1
        bRead(LenVal) = Asc(Mid$(COMString, LenVal + 1, 1))
    Next LenVal
'    bRead(LenVal) = 0
    retval = WriteFile(ComNum, bRead(0), Len(COMString), RetBytes, 0)
'    FlushComm
    WriteCOM32 = RetBytes
    
handlewritelpt:
    Exit Function
End Function

