Attribute VB_Name = "basScaleTest"
Option Explicit

'**********************************************************************************************************
' NAME:  ScaleTest.BAS
' TITLE: General module file for OPOS applications.
' DESCR: This file defines some helper routines that are specific to the scale driver.
' NOTES: 1)
'
'**********************************************************************************************************

'----------------------------------------------------------------------------------------------------------
' Application Global Constants
'----------------------------------------------------------------------------------------------------------

' Miscellaneous Boolean Definitions:
    Const PASSED = True                 'function/test return value
    Const FAILED = False                'function/test return value

' Miscellaneous Constant Definitions:
    Const ETX = &H3                     '<ETX>
    Const CR = &HD                      '<CR>
    Const LF = &HA                      '<LF>

'----------------------------------------------------------------------------------------------------------
' Global Variables
'----------------------------------------------------------------------------------------------------------
' Miscellaneous:
    Public bWaiting As Boolean              'waiting for message from scale
    Public bMessageReceived As Boolean      'message received from scale

Public Function WT_OpenSerialPort(sioport As Integer) As Boolean

    ' This function is used to attempt to open the specified serial port that will be used to communicate with the
    ' Weigh-Tronix/NCI scale.
    
    ' Setup the error handler:
    On Error GoTo sioopenerr

    ' Close the comm port if it's already open:
    winMain.MSComm1.CommPort = sioport
    
    If (winMain.MSComm1.PortOpen = True) Then
        winMain.MSComm1.PortOpen = False
    End If

    ' Attempt to open the serial port:
    winMain.MSComm1.PortOpen = True             'this could generate an open error
    winMain.MSComm1.OutBufferCount = 0          'clear the output buffer
    WT_OpenSerialPort = True                    'the function return value
    Exit Function

sioopenerr:
    ' Error, can't open the serial port:
    MsgBox ("WT_OpenSerialPort failed to open COM:" & Str$(sioport)), vbExclamation, "Communications Error"
    WT_OpenSerialPort = False
    Exit Function

End Function

Public Function WT_ScaleCommand(sclcmd As String) As String

    ' This routine accepts a standard scale command code string, terminates it with a carriage return and then
    ' transmits the entire string to the scalethrough the currently selected serial port.
    '
    ' All standard transmissions to the scale should be performed using this routine.
    '

    Dim response As String

    ' Set the default response:
    response = ""
 
    If (WT_TransmitToScale(sclcmd & Chr$(CR)) = PASSED) Then
        response = WT_ReceiveFromScale()
    End If
    
    WT_ScaleCommand = response
    
End Function

Public Function WT_TransmitToScale(cmdstr As String) As Boolean
    
    ' This function transmits all characters in the command string out the
    ' currently selected serial port. It returns a PASSED/FAILED status to
    ' the calling routine.
        
    ' Set up the error handler:
    On Error GoTo xmiterr

    ' Send the string out the serial communications port:
    winMain.MSComm1.InBufferCount = 0               'flush the receiver buffer
    winMain.MSComm1.OutBufferCount = 0              'clear the output buffer
    winMain.MSComm1.Output = cmdstr                 'write command string out

    WT_TransmitToScale = PASSED                     'end function
    Exit Function

xmiterr:
    'Error, can't write out to the comm port !
    MsgBox "WT_TransmitToScale failed", vbExclamation, "Communications Error"
    WT_TransmitToScale = FAILED
    Exit Function
    Resume Next

End Function

Public Function WT_ReceiveFromScale() As String

    ' This is a convenient place to poll (i.e. wait) for a response (from the scale), to a scale command that expects
    ' data to be returned. Unfortunately, we have to poll for the response because VB does not support an event for a
    ' user defined terminating character. Note, it has an event for EOF but not for ETX.
    '
    ' A communications timeout timer is used so that if the scale does not respond within the specified period, the
    ' wait will be aborted and a null string will be returned as the "error" response.
    '
    ' The successful way out of the loop is to receive a valid response string from the scale.
    ' A valid command response is:   <LF> XXXX.XX uu <CR> <LF> sss <CR> <ETX>
    '                          or:   <LF> sss <CR> <ETX>
    ' An unrecognized command response is:
    '                                <LF> ? <CR> <ETX>
    '
    ' If a valid scale response is received, the entire message, will be returned to the calling routine.
    ' If an invalid response is received (or the timeout timer expires), a null string will be returned.
        

    Dim all_bytes As String
    Dim these_bytes As String

    bWaiting = True                             'initialize flag
    bMessageReceived = False                    'initialize flag
    winMain.timCommTimeout.Enabled = True       'start the timeout timer
    winMain.MSComm1.InputLen = 0                'read all characters each time
    all_bytes = ""

    ' Wait for scale to return response string or for the timeout timer to expire:
    Do
        If (winMain.MSComm1.InBufferCount) > 0 Then
            these_bytes = winMain.MSComm1.Input
            all_bytes = all_bytes & these_bytes 'concatenate received char(s)
          
            ' Check for <LF> preamble and <CR><ETX> postamble:
            If (Left(all_bytes, 1) = Chr$(LF)) And _
               (InStr(all_bytes, (Chr$(CR) & Chr$(ETX))) > 0) Then
                winMain.timCommTimeout.Enabled = False
                bWaiting = False
                bMessageReceived = True
            End If
        End If

        ' Return some time to windows to allow scale timeout:
        DoEvents

    Loop While ((bWaiting = True) And (bMessageReceived = False))
    
    If (bMessageReceived = True) Then
        WT_ReceiveFromScale = all_bytes
    Else
        WT_ReceiveFromScale = ""
    End If

End Function

Private Function WT_HexByteStr(ByVal c As String) As String
 
    Dim s As String
           
    Select Case (Asc(c))
        Case &H0:   s = "<NUL>"
        Case &H1:   s = "<SOH>"
        Case &H2:   s = "<STX>"
        Case &H3:   s = "<ETX>"
        Case &H4:   s = "<EOT>"
        Case &H5:   s = "<ENQ>"
        Case &H6:   s = "<ACK>"
        Case &H7:   s = "<BEL>"
        Case &H8:   s = "<BS>"
        Case &H9:   s = "<HT>"
        Case &HA:   s = "<LF>"
        Case &HB:   s = "<VT>"
        Case &HC:   s = "<FF>"
        Case &HD:   s = "<CR>"
        Case &HE:   s = "<SO>"
        Case &HF:   s = "<SI>"
        Case &H10:  s = "<DLE>"
        Case &H11:  s = "<DC1>"
        Case &H12:  s = "<DC2>"
        Case &H13:  s = "<DC3>"
        Case &H14:  s = "<DC4>"
        Case &H15:  s = "<NAK>"
        Case &H16:  s = "<SYN>"
        Case &H17:  s = "<ETB>"
        Case &H18:  s = "<CAN>"
        Case &H19:  s = "<EM>"
        Case &H1A:  s = "<SUB>"
        Case &H1B:  s = "<ESC>"
        Case &H1C:  s = "<FS>"
        Case &H1D:  s = "<GS>"
        Case &H1E:  s = "<RS>"
        Case &H1F:  s = "<US>"
        Case &H20:  s = "<SP>"
        
        Case &H21 To &H7E:  s = c
        Case &H7F:  s = "<DEL>"
        Case Else:  s = "|"           'unrecognized above 0x7F
         
    End Select
    
    WT_HexByteStr = s

End Function

Private Function WT_NullCtrl(ByVal c As String) As String
 
    Dim s As String
           
    Select Case (Asc(c))
        Case &H0 To &H1F: s = ""
        Case &H20 To &H7E:  s = c
        Case &H7F:  s = ""
        Case Else:  s = "<*>"           'unrecognized above 0x7F
    End Select
    
    WT_NullCtrl = s

End Function

Public Function WT_ExpandAscStr(ByVal compressed_str As String) As String

    Dim i As Integer
    Dim expanded_str As String
    
    expanded_str = ""
    
    For i = 1 To Len(compressed_str)
        expanded_str = expanded_str + WT_HexByteStr(Mid$(compressed_str, i, 1))
    Next i
    
    WT_ExpandAscStr = expanded_str
    
End Function

Private Function WT_StripAscStr(ByVal complete_str As String) As String

    Dim i As Integer
    Dim stripped_str As String
    
    stripped_str = ""
    
    For i = 1 To Len(complete_str)
        stripped_str = stripped_str + WT_NullCtrl(Mid$(complete_str, i, 1))
    Next i
    
    WT_StripAscStr = stripped_str
    
End Function

Public Function WT_CloseSerialPort(sioport As Integer)

    ' This function is used to attempt to close the specified serial port.
    
    ' Setup the error handler
    On Error GoTo siocloseerr

    ' Close the COM port if it's open:
    If (winMain.MSComm1.PortOpen = True) Then
        winMain.MSComm1.PortOpen = False
    End If

    WT_CloseSerialPort = True               'the function return value
    Exit Function

siocloseerr:
    ' Error, can't open comm port:
    MsgBox ("WT_CloseSerialPort failed to close COM:" & Str$(sioport)), vbExclamation, "Communications Error"
    WT_CloseSerialPort = False
    Exit Function

End Function