Problems sending VBA formatted data to the serial port

Option Compare Database

Option Explicit

Public Function DecToBins(ByVal lngNumber As Long, Optional bytLength As Byte) As String

' Returns string that represents the binary expression for lngNumber.
'
' If bytLength is specified, returned string will be filled with
' leading zeroes up to this length.

  Dim strBin As String
 
  While lngNumber > 0
    strBin = (lngNumber Mod 2) & strBin
    lngNumber = lngNumber \ 2
  Wend
  If bytLength > 0 Then
    strBin = Right(String(bytLength, "0") & strBin, bytLength)
  End If
 
  DecToBins = strBin

End Function:

Select allOpen in new window

Option Compare Database

Option Explicit
Sub Test()
    Dim data() As Byte
    Dim crc As Long

    data = StrConv("0123456789", vbFromUnicode)
    crc = cal_crc(data, 10)
    Debug.Print crc
End Sub

Private Function cal_crc(ptr() As Byte, size As Integer) As Long
    Dim i As Byte
    Dim crc As Long
    Dim ptrIndex As Long

    crc = 0

    For ptrIndex = 0 To size - 1
        i = &H80
        Do While i <> 0
            If (crc And &H8000&) <> 0 Then
                crc = (crc * 2) And &HFFFF&
                crc = crc Xor &H18005
            Else
                crc = (crc * 2) And &HFFFF&
            End If
            If (ptr(ptrIndex) And i) <> 0 Then
                crc = crc Xor &H18005
            End If
            i = i / 2
        Loop
    Next ptrIndex

    cal_crc = crc And &HFFFF&
End Function

Select allOpen in new window

• DecToBinLength()
• DecToBinContent()
• DecToBincrc()
• cal_crc()

• Perform Serial Port Communication from VB

its the same code for hex in order to help me to calculate the other numbers

DecToBinLength()
DecToBinContent()
DecToBincrc()
cal_crc()

Attribute VB_Name = "modCOMM"
Option Explicit

'-------------------------------------------------------------------------------
' modCOMM - Written by: David M. Hitchner
'
' This VB module is a collection of routines to perform serial port I/O without
' using the Microsoft Comm Control component.  This module uses the Windows API
' to perform the overlapped I/O operations necessary for serial communications.
'
' The routine can handle up to 4 serial ports which are identified with a
' Port ID.
'
' All routines (with the exception of CommRead and CommWrite) return an error
' code or 0 if no error occurs.  The routine CommGetError can be used to get
' the complete error message.
'-------------------------------------------------------------------------------

'-------------------------------------------------------------------------------
' Public Constants
'-------------------------------------------------------------------------------

' Output Control Lines (CommSetLine)
Public Const LINE_BREAK = 1
Public Const LINE_DTR = 2
Public Const LINE_RTS = 3

' Input Control Lines  (CommGetLine)
Public Const LINE_CTS = &H10&
Public Const LINE_DSR = &H20&
Public Const LINE_RING = &H40&
Public Const LINE_RLSD = &H80&
Public Const LINE_CD = &H80&

'-------------------------------------------------------------------------------
' System Constants
'-------------------------------------------------------------------------------
Private Const ERROR_IO_INCOMPLETE = 996&
Private Const ERROR_IO_PENDING = 997
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_FLAG_OVERLAPPED = &H40000000
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const OPEN_EXISTING = 3

' COMM Functions
Private Const MS_CTS_ON = &H10&
Private Const MS_DSR_ON = &H20&
Private Const MS_RING_ON = &H40&
Private Const MS_RLSD_ON = &H80&
Private Const PURGE_RXABORT = &H2
Private Const PURGE_RXCLEAR = &H8
Private Const PURGE_TXABORT = &H1
Private Const PURGE_TXCLEAR = &H4

' COMM Escape Functions
Private Const CLRBREAK = 9
Private Const CLRDTR = 6
Private Const CLRRTS = 4
Private Const SETBREAK = 8
Private Const SETDTR = 5
Private Const SETRTS = 3

'-------------------------------------------------------------------------------
' System Structures
'-------------------------------------------------------------------------------
Private Type COMSTAT
        fBitFields As Long ' See Comment in Win32API.Txt
        cbInQue As Long
        cbOutQue As Long
End Type

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

'
' The DCB structure defines the control setting for a serial
' communications device.
'
Private Type DCB
        DCBlength As Long
        BaudRate As Long
        fBitFields As Long ' See Comments in Win32API.Txt
        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
        wReserved1 As Integer 'Reserved; Do Not Use
End Type

Private Type OVERLAPPED
        Internal As Long
        InternalHigh As Long
        offset As Long
        OffsetHigh As Long
        hEvent As Long
End Type

Private Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End Type

'-------------------------------------------------------------------------------
' System Functions
'-------------------------------------------------------------------------------
'
' Fills a specified DCB structure with values specified in
' a device-control string.
'
Declare Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" _
    (ByVal lpDef As String, lpDCB As DCB) As Long
'
' Retrieves information about a communications error and reports
' the current status of a communications device. The function is
' called when a communications error occurs, and it clears the
' device's error flag to enable additional input and output
' (I/O) operations.
'
Declare Function ClearCommError Lib "kernel32" _
    (ByVal hFile As Long, lpErrors As Long, lpStat As COMSTAT) As Long
'
' Closes an open communications device or file handle.
'
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'
' Creates or opens a communications resource and returns a handle
' that can be used to access the resource.
'
Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
    (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
    ByVal dwShareMode As Long, lpSecurityAttributes As Any, _
    ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As Long) As Long
'
' Directs a specified communications device to perform a function.
'
Declare Function EscapeCommFunction Lib "kernel32" _
    (ByVal nCid As Long, ByVal nFunc As Long) As Long
'
' Formats a message string such as an error string returned
' by anoher function.
'
Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _
    (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, _
    ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, _
    Arguments As Long) As Long
'
' Retrieves modem control-register values.
'
Declare Function GetCommModemStatus Lib "kernel32" _
    (ByVal hFile As Long, lpModemStat As Long) As Long
'
' Retrieves the current control settings for a specified
' communications device.
'
Declare Function GetCommState Lib "kernel32" _
    (ByVal nCid As Long, lpDCB As DCB) As Long
'
' Retrieves the calling thread's last-error code value.
'
Declare Function GetLastError Lib "kernel32" () As Long
'
' Retrieves the results of an overlapped operation on the
' specified file, named pipe, or communications device.
'
Declare Function GetOverlappedResult Lib "kernel32" _
    (ByVal hFile As Long, lpOverlapped As OVERLAPPED, _
    lpNumberOfBytesTransferred As Long, ByVal bWait As Long) As Long
'
' Discards all characters from the output or input buffer of a
' specified communications resource. It can also terminate
' pending read or write operations on the resource.
'
Declare Function PurgeComm Lib "kernel32" _
    (ByVal hFile As Long, ByVal dwFlags As Long) As Long
'
' Reads data from a file, starting at the position indicated by the
' file pointer. After the read operation has been completed, the
' file pointer is adjusted by the number of bytes actually read,
' unless the file handle is created with the overlapped attribute.
' If the file handle is created for overlapped input and output
' (I/O), the application must adjust the position of the file pointer
' after the read operation.
'
Declare Function ReadFile Lib "kernel32" _
    (ByVal hFile As Long, ByVal lpBuffer As String, _
    ByVal nNumberOfBytesToRead As Long, ByRef lpNumberOfBytesRead As Long, _
    lpOverlapped As OVERLAPPED) As Long
'
' Configures a communications device according to the specifications
' in a device-control block (a DCB structure). The function
' reinitializes all hardware and control settings, but it does not
' empty output or input queues.
'
Declare Function SetCommState Lib "kernel32" _
    (ByVal hCommDev As Long, lpDCB As DCB) As Long
'
' Sets the time-out parameters for all read and write operations on a
' specified communications device.
'
Declare Function SetCommTimeouts Lib "kernel32" _
    (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
'
' Initializes the communications parameters for a specified
' communications device.
'
Declare Function SetupComm Lib "kernel32" _
    (ByVal hFile As Long, ByVal dwInQueue As Long, ByVal dwOutQueue As Long) As Long
'
' Writes data to a file and is designed for both synchronous and a
' synchronous operation. The function starts writing data to the file
' at the position indicated by the file pointer. After the write
' operation has been completed, the file pointer is adjusted by the
' number of bytes actually written, except when the file is opened with
' FILE_FLAG_OVERLAPPED. If the file handle was created for overlapped
' input and output (I/O), the application must adjust the position of
' the file pointer after the write operation is finished.
'
Declare Function WriteFile Lib "kernel32" _
    (ByVal hFile As Long, ByVal lpBuffer As String, _
    ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, _
    lpOverlapped As OVERLAPPED) As Long

'-------------------------------------------------------------------------------
' Program Constants
'-------------------------------------------------------------------------------

Private Const MAX_PORTS = 4

'-------------------------------------------------------------------------------
' Program Structures
'-------------------------------------------------------------------------------

Private Type COMM_ERROR
    lngErrorCode As Long
    strFunction As String
    strErrorMessage As String
End Type

Private Type COMM_PORT
    lngHandle As Long
    blnPortOpen As Boolean
    udtDCB As DCB
End Type

'-------------------------------------------------------------------------------
' Program Storage
'-------------------------------------------------------------------------------

Private udtCommOverlap As OVERLAPPED
Private udtCommError As COMM_ERROR
Private udtPorts(1 To MAX_PORTS) As COMM_PORT
'-------------------------------------------------------------------------------
' GetSystemMessage - Gets system error text for the specified error code.
'-------------------------------------------------------------------------------
Public Function GetSystemMessage(lngErrorCode As Long) As String
Dim intPos As Integer
Dim strMessage As String, strMsgBuff As String * 256

    Call FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0, lngErrorCode, 0, strMsgBuff, 255, 0)

    intPos = InStr(1, strMsgBuff, vbNullChar)
    If intPos > 0 Then
        strMessage = Trim$(Left$(strMsgBuff, intPos - 1))
    Else
        strMessage = Trim$(strMsgBuff)
    End If
    
    GetSystemMessage = strMessage
    
End Function


'-------------------------------------------------------------------------------
' CommOpen - Opens/Initializes serial port.
'
'
' Parameters:
'   intPortID   - Port ID used when port was opened.
'   strPort     - COM port name. (COM1, COM2, COM3, COM4)
'   strSettings - Communication settings.
'                 Example: "baud=9600 parity=N data=8 stop=1"
'
' Returns:
'   Error Code  - 0 = No Error.
'
'-------------------------------------------------------------------------------
Public Function CommOpen(intPortID As Integer, strPort As String, _
    strSettings As String) As Long
    
Dim lngStatus       As Long
Dim udtCommTimeOuts As COMMTIMEOUTS

    On Error GoTo Routine_Error
    
    ' See if port already in use.
    If udtPorts(intPortID).blnPortOpen Then
        lngStatus = -1
        With udtCommError
            .lngErrorCode = lngStatus
            .strFunction = "CommOpen"
            .strErrorMessage = "Port in use."
        End With
        
        GoTo Routine_Exit
    End If

    ' Open serial port.
    udtPorts(intPortID).lngHandle = CreateFile(strPort, GENERIC_READ Or _
        GENERIC_WRITE, 0, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)

    If udtPorts(intPortID).lngHandle = -1 Then
        lngStatus = SetCommError("CommOpen (CreateFile)")
        GoTo Routine_Exit
    End If

    udtPorts(intPortID).blnPortOpen = True

    ' Setup device buffers (1K each).
    lngStatus = SetupComm(udtPorts(intPortID).lngHandle, 1024, 1024)
    
    If lngStatus = 0 Then
        lngStatus = SetCommError("CommOpen (SetupComm)")
        GoTo Routine_Exit
    End If

    ' Purge buffers.
    lngStatus = PurgeComm(udtPorts(intPortID).lngHandle, PURGE_TXABORT Or _
        PURGE_RXABORT Or PURGE_TXCLEAR Or PURGE_RXCLEAR)

    If lngStatus = 0 Then
        lngStatus = SetCommError("CommOpen (PurgeComm)")
        GoTo Routine_Exit
    End If

    ' Set serial port timeouts.
    With udtCommTimeOuts
        .ReadIntervalTimeout = -1
        .ReadTotalTimeoutMultiplier = 0
        .ReadTotalTimeoutConstant = 1000
        .WriteTotalTimeoutMultiplier = 0
        .WriteTotalTimeoutMultiplier = 1000
    End With

    lngStatus = SetCommTimeouts(udtPorts(intPortID).lngHandle, udtCommTimeOuts)

    If lngStatus = 0 Then
        lngStatus = SetCommError("CommOpen (SetCommTimeouts)")
        GoTo Routine_Exit
    End If

    ' Get the current state (DCB).
    lngStatus = GetCommState(udtPorts(intPortID).lngHandle, _
        udtPorts(intPortID).udtDCB)

    If lngStatus = 0 Then
        lngStatus = SetCommError("CommOpen (GetCommState)")
        GoTo Routine_Exit
    End If

    ' Modify the DCB to reflect the desired settings.
    lngStatus = BuildCommDCB(strSettings, udtPorts(intPortID).udtDCB)

    If lngStatus = 0 Then
        lngStatus = SetCommError("CommOpen (BuildCommDCB)")
        GoTo Routine_Exit
    End If

    ' Set the new state.
    lngStatus = SetCommState(udtPorts(intPortID).lngHandle, _
        udtPorts(intPortID).udtDCB)

    If lngStatus = 0 Then
        lngStatus = SetCommError("CommOpen (SetCommState)")
        GoTo Routine_Exit
    End If

    lngStatus = 0

Routine_Exit:
    CommOpen = lngStatus
    Exit Function

Routine_Error:
    lngStatus = Err.Number
    With udtCommError
        .lngErrorCode = lngStatus
        .strFunction = "CommOpen"
        .strErrorMessage = Err.Description
    End With
    Resume Routine_Exit
End Function


Private Function SetCommError(strFunction As String) As Long
    
    With udtCommError
        .lngErrorCode = Err.LastDllError
        .strFunction = strFunction
        .strErrorMessage = GetSystemMessage(.lngErrorCode)
        SetCommError = .lngErrorCode
    End With
    
End Function

Private Function SetCommErrorEx(strFunction As String, lngHnd As Long) As Long
Dim lngErrorFlags As Long
Dim udtCommStat As COMSTAT
    
    With udtCommError
        .lngErrorCode = GetLastError
        .strFunction = strFunction
        .strErrorMessage = GetSystemMessage(.lngErrorCode)
    
        Call ClearCommError(lngHnd, lngErrorFlags, udtCommStat)
    
        .strErrorMessage = .strErrorMessage & "  COMM Error Flags = " & _
                Hex$(lngErrorFlags)
        
        SetCommErrorEx = .lngErrorCode
    End With
    
End Function

'-------------------------------------------------------------------------------
' CommSet - Modifies the serial port settings.
'
' Parameters:
'   intPortID   - Port ID used when port was opened.
'   strSettings - Communication settings.
'                 Example: "baud=9600 parity=N data=8 stop=1"
'
' Returns:
'   Error Code  - 0 = No Error.
'-------------------------------------------------------------------------------
Public Function CommSet(intPortID As Integer, strSettings As String) As Long
    
Dim lngStatus As Long
    
    On Error GoTo Routine_Error

    lngStatus = GetCommState(udtPorts(intPortID).lngHandle, _
        udtPorts(intPortID).udtDCB)

    If lngStatus = 0 Then
        lngStatus = SetCommError("CommSet (GetCommState)")
        GoTo Routine_Exit
    End If

    lngStatus = BuildCommDCB(strSettings, udtPorts(intPortID).udtDCB)

    If lngStatus = 0 Then
        lngStatus = SetCommError("CommSet (BuildCommDCB)")
        GoTo Routine_Exit
    End If

    lngStatus = SetCommState(udtPorts(intPortID).lngHandle, _
        udtPorts(intPortID).udtDCB)

    If lngStatus = 0 Then
        lngStatus = SetCommError("CommSet (SetCommState)")
        GoTo Routine_Exit
    End If

    lngStatus = 0

Routine_Exit:
    CommSet = lngStatus
    Exit Function

Routine_Error:
    lngStatus = Err.Number
    With udtCommError
        .lngErrorCode = lngStatus
        .strFunction = "CommSet"
        .strErrorMessage = Err.Description
    End With
    Resume Routine_Exit
End Function

'-------------------------------------------------------------------------------
' CommClose - Close the serial port.
'
' Parameters:
'   intPortID   - Port ID used when port was opened.
'
' Returns:
'   Error Code  - 0 = No Error.
'-------------------------------------------------------------------------------
Public Function CommClose(intPortID As Integer) As Long
    
Dim lngStatus As Long
    
    On Error GoTo Routine_Error

    If udtPorts(intPortID).blnPortOpen Then
        lngStatus = CloseHandle(udtPorts(intPortID).lngHandle)
    
        If lngStatus = 0 Then
            lngStatus = SetCommError("CommClose (CloseHandle)")
            GoTo Routine_Exit
        End If
    
        udtPorts(intPortID).blnPortOpen = False
    End If

    lngStatus = 0

Routine_Exit:
    CommClose = lngStatus
    Exit Function

Routine_Error:
    lngStatus = Err.Number
    With udtCommError
        .lngErrorCode = lngStatus
        .strFunction = "CommClose"
        .strErrorMessage = Err.Description
    End With
    Resume Routine_Exit
End Function

'-------------------------------------------------------------------------------
' CommFlush - Flush the send and receive serial port buffers.
'
' Parameters:
'   intPortID   - Port ID used when port was opened.
'
' Returns:
'   Error Code  - 0 = No Error.
'-------------------------------------------------------------------------------
Public Function CommFlush(intPortID As Integer) As Long
    
Dim lngStatus As Long
    
    On Error GoTo Routine_Error

    lngStatus = PurgeComm(udtPorts(intPortID).lngHandle, PURGE_TXABORT Or _
        PURGE_RXABORT Or PURGE_TXCLEAR Or PURGE_RXCLEAR)

    If lngStatus = 0 Then
        lngStatus = SetCommError("CommFlush (PurgeComm)")
        GoTo Routine_Exit
    End If

    lngStatus = 0

Routine_Exit:
    CommFlush = lngStatus
    Exit Function

Routine_Error:
    lngStatus = Err.Number
    With udtCommError
        .lngErrorCode = lngStatus
        .strFunction = "CommFlush"
        .strErrorMessage = Err.Description
    End With
    Resume Routine_Exit
End Function

'-------------------------------------------------------------------------------
' CommRead - Read serial port input buffer.
'
' Parameters:
'   intPortID   - Port ID used when port was opened.
'   strData     - Data buffer.
'   lngSize     - Maximum number of bytes to be read.
'
' Returns:
'   Error Code  - 0 = No Error.
'-------------------------------------------------------------------------------
Public Function CommRead(intPortID As Integer, strData As String, _
    lngSize As Long) As Long

Dim lngStatus As Long
Dim lngRdSize As Long, lngBytesRead As Long
Dim lngRdStatus As Long, strRdBuffer As String * 1024
Dim lngErrorFlags As Long, udtCommStat As COMSTAT
    
    On Error GoTo Routine_Error

    strData = ""
    lngBytesRead = 0
    DoEvents
    
    ' Clear any previous errors and get current status.
    lngStatus = ClearCommError(udtPorts(intPortID).lngHandle, lngErrorFlags, _
        udtCommStat)

    If lngStatus = 0 Then
        lngBytesRead = -1
        lngStatus = SetCommError("CommRead (ClearCommError)")
        GoTo Routine_Exit
    End If
        
    If udtCommStat.cbInQue > 0 Then
        If udtCommStat.cbInQue > lngSize Then
            lngRdSize = udtCommStat.cbInQue
        Else
            lngRdSize = lngSize
        End If
    Else
        lngRdSize = 0
    End If

    If lngRdSize Then
        lngRdStatus = ReadFile(udtPorts(intPortID).lngHandle, strRdBuffer, _
            lngRdSize, lngBytesRead, udtCommOverlap)

        If lngRdStatus = 0 Then
            lngStatus = GetLastError
            If lngStatus = ERROR_IO_PENDING Then
                ' Wait for read to complete.
                ' This function will timeout according to the
                ' COMMTIMEOUTS.ReadTotalTimeoutConstant variable.
                ' Every time it times out, check for port errors.

                ' Loop until operation is complete.
                While GetOverlappedResult(udtPorts(intPortID).lngHandle, _
                    udtCommOverlap, lngBytesRead, True) = 0
                                    
                    lngStatus = GetLastError
                                        
                    If lngStatus <> ERROR_IO_INCOMPLETE Then
                        lngBytesRead = -1
                        lngStatus = SetCommErrorEx( _
                            "CommRead (GetOverlappedResult)", _
                            udtPorts(intPortID).lngHandle)
                        GoTo Routine_Exit
                    End If
                Wend
            Else
                ' Some other error occurred.
                lngBytesRead = -1
                lngStatus = SetCommErrorEx("CommRead (ReadFile)", _
                    udtPorts(intPortID).lngHandle)
                GoTo Routine_Exit
            
            End If
        End If
    
        strData = Left$(strRdBuffer, lngBytesRead)
    End If

Routine_Exit:
    CommRead = lngBytesRead
    Exit Function

Routine_Error:
    lngBytesRead = -1
    lngStatus = Err.Number
    With udtCommError
        .lngErrorCode = lngStatus
        .strFunction = "CommRead"
        .strErrorMessage = Err.Description
    End With
    Resume Routine_Exit
End Function

'-------------------------------------------------------------------------------
' CommWrite - Output data to the serial port.
'
' Parameters:
'   intPortID   - Port ID used when port was opened.
'   strData     - Data to be transmitted.
'
' Returns:
'   Error Code  - 0 = No Error.
'-------------------------------------------------------------------------------
Public Function CommWrite(intPortID As Integer, strData As String) As Long
    
Dim i As Integer
Dim lngStatus As Long, lngSize As Long
Dim lngWrSize As Long, lngWrStatus As Long
    
    On Error GoTo Routine_Error
    
    ' Get the length of the data.
    lngSize = Len(strData)

    ' Output the data.
    lngWrStatus = WriteFile(udtPorts(intPortID).lngHandle, strData, lngSize, _
        lngWrSize, udtCommOverlap)

    ' Note that normally the following code will not execute because the driver
    ' caches write operations. Small I/O requests (up to several thousand bytes)
    ' will normally be accepted immediately and WriteFile will return true even
    ' though an overlapped operation was specified.
        
    DoEvents
    
    If lngWrStatus = 0 Then
        lngStatus = GetLastError
        If lngStatus = 0 Then
            GoTo Routine_Exit
        ElseIf lngStatus = ERROR_IO_PENDING Then
            ' We should wait for the completion of the write operation so we know
            ' if it worked or not.
            '
            ' This is only one way to do this. It might be beneficial to place the
            ' writing operation in a separate thread so that blocking on completion
            ' will not negatively affect the responsiveness of the UI.
            '
            ' If the write takes long enough to complete, this function will timeout
            ' according to the CommTimeOuts.WriteTotalTimeoutConstant variable.
            ' At that time we can check for errors and then wait some more.

            ' Loop until operation is complete.
            While GetOverlappedResult(udtPorts(intPortID).lngHandle, _
                udtCommOverlap, lngWrSize, True) = 0
                                
                lngStatus = GetLastError
                                    
                If lngStatus <> ERROR_IO_INCOMPLETE Then
                    lngStatus = SetCommErrorEx( _
                        "CommWrite (GetOverlappedResult)", _
                        udtPorts(intPortID).lngHandle)
                    GoTo Routine_Exit
                End If
            Wend
        Else
            ' Some other error occurred.
            lngWrSize = -1
                    
            lngStatus = SetCommErrorEx("CommWrite (WriteFile)", _
                udtPorts(intPortID).lngHandle)
            GoTo Routine_Exit
        
        End If
    End If
    
    For i = 1 To 10
        DoEvents
    Next
    
Routine_Exit:
    CommWrite = lngWrSize
    Exit Function

Routine_Error:
    lngStatus = Err.Number
    With udtCommError
        .lngErrorCode = lngStatus
        .strFunction = "CommWrite"
        .strErrorMessage = Err.Description
    End With
    Resume Routine_Exit
End Function

'-------------------------------------------------------------------------------
' CommGetLine - Get the state of selected serial port control lines.
'
' Parameters:
'   intPortID   - Port ID used when port was opened.
'   intLine     - Serial port line. CTS, DSR, RING, RLSD (CD)
'   blnState    - Returns state of line (Cleared or Set).
'
' Returns:
'   Error Code  - 0 = No Error.
'-------------------------------------------------------------------------------
Public Function CommGetLine(intPortID As Integer, intLine As Integer, _
   blnState As Boolean) As Long
    
Dim lngStatus As Long
Dim lngComStatus As Long, lngModemStatus As Long
    
    On Error GoTo Routine_Error

    lngStatus = GetCommModemStatus(udtPorts(intPortID).lngHandle, lngModemStatus)

    If lngStatus = 0 Then
        lngStatus = SetCommError("CommReadCD (GetCommModemStatus)")
        GoTo Routine_Exit
    End If

    If (lngModemStatus And intLine) Then
        blnState = True
    Else
        blnState = False
    End If
        
    lngStatus = 0
        
Routine_Exit:
    CommGetLine = lngStatus
    Exit Function

Routine_Error:
    lngStatus = Err.Number
    With udtCommError
        .lngErrorCode = lngStatus
        .strFunction = "CommReadCD"
        .strErrorMessage = Err.Description
    End With
    Resume Routine_Exit
End Function

'-------------------------------------------------------------------------------
' CommSetLine - Set the state of selected serial port control lines.
'
' Parameters:
'   intPortID   - Port ID used when port was opened.
'   intLine     - Serial port line. BREAK, DTR, RTS
'                 Note: BREAK actually sets or clears a "break" condition on
'                 the transmit data line.
'   blnState    - Sets the state of line (Cleared or Set).
'
' Returns:
'   Error Code  - 0 = No Error.
'-------------------------------------------------------------------------------
Public Function CommSetLine(intPortID As Integer, intLine As Integer, _
   blnState As Boolean) As Long
   
Dim lngStatus As Long
Dim lngNewState As Long
    
    On Error GoTo Routine_Error
    
    If intLine = LINE_BREAK Then
        If blnState Then
            lngNewState = SETBREAK
        Else
            lngNewState = CLRBREAK
        End If
    
    ElseIf intLine = LINE_DTR Then
        If blnState Then
            lngNewState = SETDTR
        Else
            lngNewState = CLRDTR
        End If
    
    ElseIf intLine = LINE_RTS Then
        If blnState Then
            lngNewState = SETRTS
        Else
            lngNewState = CLRRTS
        End If
    End If

    lngStatus = EscapeCommFunction(udtPorts(intPortID).lngHandle, lngNewState)

    If lngStatus = 0 Then
        lngStatus = SetCommError("CommSetLine (EscapeCommFunction)")
        GoTo Routine_Exit
    End If

    lngStatus = 0
        
Routine_Exit:
    CommSetLine = lngStatus
    Exit Function

Routine_Error:
    lngStatus = Err.Number
    With udtCommError
        .lngErrorCode = lngStatus
        .strFunction = "CommSetLine"
        .strErrorMessage = Err.Description
    End With
    Resume Routine_Exit
End Function



'-------------------------------------------------------------------------------
' CommGetError - Get the last serial port error message.
'
' Parameters:
'   strMessage  - Error message from last serial port error.
'
' Returns:
'   Error Code  - Last serial port error code.
'-------------------------------------------------------------------------------
Public Function CommGetError(strMessage As String) As Long
    
    With udtCommError
        CommGetError = .lngErrorCode
        strMessage = "Error (" & CStr(.lngErrorCode) & "): " & .strFunction & _
            " - " & .strErrorMessage
    End With
    
End Function

Select allOpen in new window

Private Sub CmdPosJsons_Click()

  Dim db As DAO.Database
  Dim rs As DAO.Recordset
  Dim fld As DAO.Field
  Dim qdf As DAO.QueryDef
  Dim prm As DAO.Parameter
  Dim root As Dictionary
    Set root = New Dictionary
    Dim transaction As Dictionary
    Dim transactions As Collection
    Dim item As Dictionary
    Dim items As Collection
    Dim Tax As Collection
    Dim i As Long
    Dim Z As Integer
    Dim j As Long
    Dim t As Long
    Set transactions = New Collection
  Set db = CurrentDb
  Set qdf = db.QueryDefs("QryJsonPos")
For Each prm In qdf.Parameters
    prm = Eval(prm.Name)
Next prm
Set rs = qdf.OpenRecordset(dbOpenSnapshot, dbSeeChanges)

Set qdf = Nothing
 rs.MoveFirst
    Do While Not rs.EOF
        Set transaction = New Dictionary
        transaction.Add "PosVendor", "Nector Prime Accounting Solutions"
        transaction.Add "SoftwareVersion", "1.0.0.1"
        transaction.Add "Model", "CaP-2017"
        transaction.Add "PosSerialNumber", Nz(Me.Id.Column(1), "")
        transaction.Add "IssueTime", Nz(Me.txtJsonsDate, "")
        transaction.Add "TransactionTyp", Nz(Me.TransactionType, "")
        transaction.Add "PaymentMode", Nz(Me.PaymentMode, "")
        transaction.Add "SaleType", Nz(Me.SalesType, "")
        transaction.Add "LocalPurchaseOrder", Nz(Me.LocalPurchaseOrder, "")
        transaction.Add "Cashier", Nz(Me.Cashier, "")
        transaction.Add "BuyerTPIN", Nz(Me.BuyerTPIN, "")
        transaction.Add "BuyerName", Nz(Me.BuyerName, "")
        transaction.Add "BuyerTaxAccountName", Nz(Me.BuyerTaxAccountName, "")
        transaction.Add "BuyerAddress", Nz(Me.BuyerAddress, "")
        transaction.Add "BuyerTel", Nz(Me.BuyerTel, "")
        transaction.Add "OriginalInvoiceCode", Nz(Me.OrignalInvoiceCode, "")
        transaction.Add "OriginalInvoiceNumber", Nz(Me.OrignalInvoiceNumber, "")
        transaction.Add "Memo", Nz(Me.TheNotes, "")
        '--- loop over all the items
        Dim itemCount As Long
        itemCount = Me.txtsquence
        Set items = New Collection
        For i = 1 To itemCount
            Set item = New Dictionary
            item.Add "ItemID", i
            item.Add "Description", DLookup("ProductName", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "BarCode", DLookup("ProductID", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "Quantity", DLookup("QtySold", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "UnitPrice", DLookup("SellingPrice", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "Discount", DLookup("Discount", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            '--- loop over all the taxes
            Dim taxCount As Long
            taxCount = 1
            Set Tax = New Collection
            Dim strTaxes As Boolean
            strTaxes = DLookup("CGControl", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            '--- loop over all the invoices
            Dim invoiceCount As Long
            invoiceCount = 1
            For j = 1 To invoiceCount
                            
                For t = 1 To taxCount
            Next t
            item.Add "Taxable", Tax
            
            Tax.Add DLookup("TaxClassA", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
                 If Len(Nz(DLookup("TaxClassB", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i)), "")) > 0 Then
                 Tax.Add Nz(DLookup("TaxClassB", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i)), "")
                 End If
                item.Add "Total", DLookup("TotalAmount", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
                item.Add "IsTaxInclusive", strTaxes
                item.Add "RRP", DLookup("RRP", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
                
            Next j
            
            
            items.Add item
        Next i
        transaction.Add "Items", items
        
        rs.MoveNext
    Loop
    
    root.Add "", transaction
            
    Dim json As String
    Dim intPortID As Integer ' Ex. 1, 2, 3, 4 for COM1 - COM4
    Dim lngStatus As Long
    Dim strError  As String
    Dim strData   As String
    Dim strDataToSend As String
    Dim lngSize As Long
    Dim sendData As String
    intPortID = Forms!frmLogin!txtFinComPort.value
    ' Initialize Communications
    lngStatus = CommOpen(intPortID, "COM" & CStr(intPortID), _
        "baud=115200 parity=N data=8 stop=1")
    
    If lngStatus <> 0 Then
    ' Handle error.
        lngStatus = CommGetError(strError)
    MsgBox "COM Error: " & strError
    End If
    

    ' Set modem control lines.
    lngStatus = CommSetLine(intPortID, LINE_RTS, True)
    lngStatus = CommSetLine(intPortID, LINE_DTR, True)

    ' Write data to serial port.
    sendData = ShowHex(TestData("1001810", "Nector"))
    strData = sendData & JsonConverter.ConvertToJson(transaction, Whitespace:=3)
    MsgBox "strData:" & vbCrLf & strData
    lngSize = Len(strData)
    lngStatus = CommWrite(intPortID, strData)
    If lngStatus <> lngSize Then
    ' Handle error.
' Handle error.
        On Error Resume Next
    End If
   
  Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim Fileout As Object
    Set Fileout = fso.CreateTextFile("C:\Users\chris.hankwembo\Desktop\Others\Json.txt", True, True)
    Fileout.Write sendData & JsonConverter.ConvertToJson(transaction, Whitespace:=3)
    Fileout.Close
   
' Read maximum of 64 bytes from serial port.

Dim Jsons As Dictionary
Set Jsons = New Dictionary
Dim itemiz As Dictionary
    lngStatus = CommRead(intPortID, strData, 14400)

Set rs = db.OpenRecordset("tblEfdReceiptsPOS")
    If lngStatus > 0 Then
    Set Jsons = JsonConverter.ParseJson(strData)
    Z = 2
    ElseIf lngStatus < 0 Then
    Beep
    MsgBox "Please note that there is no data to read", vbOKOnly, "The Comm Port has no data"
        ' Handle error.
        On Error Resume Next
    End If
        ' Process data.
    For Each itemiz In Jsons
            With rs
            .AddNew
            rs![TPIN] = item("TPIN")
            rs![TaxpayerName] = itemiz("TaxpayerName")
            rs![Address] = itemiz("Address")
            rs![ESDTime] = itemiz("ESDTime")
            rs![TerminalID] = itemiz("TerminalID")
            rs![InvoiceCode] = itemiz("InvoiceCode")
            rs![InvoiceNumber] = itemiz("InvoiceCode")
            rs![FiscalCode] = itemiz("FiscalCode")
            rs![TalkTime] = itemiz("TalkTime")
            rs![Operator] = itemiz("Operator")
            rs![Taxlabel] = itemiz("TaxItems")("TaxLabel")
            rs![CategoryName] = itemiz("TaxItems")("CategoryName")
            rs![Rate] = itemiz("TaxItems")("Rate")
            rs![TaxAmount] = item("TaxItems")("TaxAmount")
            rs![VerificationUrl] = itemiz("TaxItems")("VerificationUrl")
            rs![INVID] = Me.ItemSoldID
            rs.Update
         End With
         Z = Z + 1
    Next
      
      rs.Close
      Set rs = Nothing
      Set db = Nothing
      Set Jsons = Nothing
    
    ' Reset modem control lines.
    lngStatus = CommSetLine(intPortID, LINE_RTS, False)
    lngStatus = CommSetLine(intPortID, LINE_DTR, False)

    ' Close communications.
    Call CommClose(intPortID)
End Sub

Select allOpen in new window

0000 =  1A 5D 01 00 00 00 34 7B 22 50 6F 73 53 65 72 69 | .]....4{"PosSeri
0010 =  61 6C 4E 75 6D 62 65 72 22 3A 20 22 31 30 30 31 | alNumber": "1001
0020 =  38 31 30 22 20 22 50 6F 73 56 65 6E 64 6F 72 22 | 810" "PosVendor"
0030 =  3A 20 22 4E 65 63 74 6F 72 22 7D A2 D2          | : "Nector"}..{
   "PosVendor": "Nector",
   "SoftwareVersion": "1.0.0.1",
   "Model": "CaP-2017",
   "PosSerialNumber": "1001810",
   "IssueTime": "20200214113845",
   "TransactionTyp": 0,
   "PaymentMode": 0,
   "SaleType": "",
   "LocalPurchaseOrder": "",
   "Cashier": "Admin Manager",
   "BuyerTPIN": "",
   "BuyerName": "",
   "BuyerTaxAccountName": "",
   "BuyerAddress": "",
   "BuyerTel": "",
   "OriginalInvoiceCode": "",
   "OriginalInvoiceNumber": "",
   "Memo": "",
   "Items": [
      {
         "ItemID": 1,
         "Description": "Cleaning Materials",
         "BarCode": 19,
         "Quantity": 1,
         "UnitPrice": 56,
         "Discount": 0,
         "Taxable": [
            "A"
         ],
         "Total": 64.96,
         "IsTaxInclusive": true,
         "RRP": 0
      }
   ]
} 

Select allOpen in new window

Function BuildData(cmd As Int, content As String) As String
    Const header1 = &H1A
    Const header2 = &H5D
    
    Dim data() As Byte

    data = TestData
    TestData = Chr(header1) & Chr(header2) & Chr(cmd) & Dec2Bin(Len(content), 4) & content & Dec2Bin(cal_crc(data, Len(TestData)), 2)
End Function

Select allOpen in new window

Function BuildData(cmd As Integer, content As String) As String
    ' First two bytes of data packet are always these
    Const header1 = &H1A
    Const header2 = &H5D
    
    ' Work areas for byte and string representation of data packet (entire packet up to CRC bytes)    
    Dim dataByte() As Byte
    Dim dataString As String

    ' Assemble the packet up to final CRC bytes
    dataString = Chr(header1) & Chr(header2) & Chr(cmd) & Dec2Bin(Len(content), 4) & content

    ' Convert to a byte array
    dataByte = dataString

    ' Calculate CRC for packet and add to end of packet returned from function
    BuildData = dataString & Dec2Bin(cal_crc(dataByte, Len(dataString)), 2)
End Function

Select allOpen in new window

Private Sub CmdPosJsons_Click()
    Const cmdStatus = 1
    Const cmdSigning = 2
    Const cmdError = 3

    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim fld As DAO.Field
    Dim qdf As DAO.QueryDef
    Dim prm As DAO.Parameter
    Dim root As Dictionary
    Dim transaction As Dictionary
    Dim transactions As Collection
    Dim item As Dictionary
    Dim items As Collection
    Dim Tax As Collection
    Dim i As Long
    Dim Z As Integer
    Dim j As Long
    Dim t As Long
    Dim itemCount As Long
    Dim taxCount As Long
    Dim strTaxes As Boolean
    Dim invoiceCount As Long
    Dim json As String
    Dim intPortID As Integer ' Ex. 1, 2, 3, 4 for COM1 - COM4
    Dim lngStatus As Long
    Dim strError  As String
    Dim strData   As String
    Dim strDataToSend As String
    Dim fso As Object
    Dim Fileout As Object
    Dim Jsons As Dictionary
    Dim itemiz As Dictionary

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set root = New Dictionary
    Set transactions = New Collection

    Set db = CurrentDb
    Set qdf = db.QueryDefs("QryJsonPos")
    For Each prm In qdf.Parameters
        prm = Eval(prm.Name)
    Next prm
    Set rs = qdf.OpenRecordset(dbOpenSnapshot, dbSeeChanges)

    Set qdf = Nothing
    rs.MoveFirst
    Do While Not rs.EOF
        Set transaction = New Dictionary
        transaction.Add "PosVendor", "Nector Prime Accounting Solutions"
        transaction.Add "SoftwareVersion", "1.0.0.1"
        transaction.Add "Model", "CaP-2017"
        transaction.Add "PosSerialNumber", Nz(Me.Id.Column(1), "")
        transaction.Add "IssueTime", Nz(Me.txtJsonsDate, "")
        transaction.Add "TransactionTyp", Nz(Me.TransactionType, "")
        transaction.Add "PaymentMode", Nz(Me.PaymentMode, "")
        transaction.Add "SaleType", Nz(Me.SalesType, "")
        transaction.Add "LocalPurchaseOrder", Nz(Me.LocalPurchaseOrder, "")
        transaction.Add "Cashier", Nz(Me.Cashier, "")
        transaction.Add "BuyerTPIN", Nz(Me.BuyerTPIN, "")
        transaction.Add "BuyerName", Nz(Me.BuyerName, "")
        transaction.Add "BuyerTaxAccountName", Nz(Me.BuyerTaxAccountName, "")
        transaction.Add "BuyerAddress", Nz(Me.BuyerAddress, "")
        transaction.Add "BuyerTel", Nz(Me.BuyerTel, "")
        transaction.Add "OriginalInvoiceCode", Nz(Me.OrignalInvoiceCode, "")
        transaction.Add "OriginalInvoiceNumber", Nz(Me.OrignalInvoiceNumber, "")
        transaction.Add "Memo", Nz(Me.TheNotes, "")
        '--- loop over all the items
        itemCount = Me.txtsquence
        Set items = New Collection
        For i = 1 To itemCount
            Set item = New Dictionary
            item.Add "ItemID", i
            item.Add "Description", DLookup("ProductName", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "BarCode", DLookup("ProductID", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "Quantity", DLookup("QtySold", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "UnitPrice", DLookup("SellingPrice", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "Discount", DLookup("Discount", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            '--- loop over all the taxes
            taxCount = 1
            Set Tax = New Collection
            strTaxes = DLookup("CGControl", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            '--- loop over all the invoices
            invoiceCount = 1
            For j = 1 To invoiceCount
                For t = 1 To taxCount
            Next t
            item.Add "Taxable", Tax
            
            Tax.Add DLookup("TaxClassA", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            If Len(Nz(DLookup("TaxClassB", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i)), "")) > 0 Then
                Tax.Add Nz(DLookup("TaxClassB", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i)), "")
            End If
            item.Add "Total", DLookup("TotalAmount", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "IsTaxInclusive", strTaxes
            item.Add "RRP", DLookup("RRP", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
                
            Next j
            
            items.Add item
        Next i
        transaction.Add "Items", items
        
        rs.MoveNext
    Loop
    
    root.Add "", transaction
            
    intPortID = Forms!frmLogin!txtFinComPort.value
    ' Initialize Communications
    lngStatus = CommOpen(intPortID, "COM" & CStr(intPortID), "baud=115200 parity=N data=8 stop=1")
    If lngStatus <> 0 Then
        ' Handle error.
        lngStatus = CommGetError(strError)
        MsgBox "COM Error: " & strError
    End If
    
    ' Set modem control lines.
    lngStatus = CommSetLine(intPortID, LINE_RTS, True)
    lngStatus = CommSetLine(intPortID, LINE_DTR, True)
    
    ' Write data to serial port.
    ' Build data packet to transmit (passing command code, and data to package)
    strData = BuildData(cmdSigning, JsonConverter.ConvertToJson(transaction, Whitespace:=3))
    ' Display a "dump" for debugging
    MsgBox "strData:" & vbCrLf & strData
    ' Send the data packet and check for error
    lngStatus = CommWrite(intPortID, strData)
    If lngStatus <> Len(strData) Then
        ' Handle error.
        On Error Resume Next
    End If
   
    ' Read maximum of 64 bytes from serial port.
    Set Jsons = New Dictionary
    lngStatus = CommRead(intPortID, strData, 14400)

    Set rs = db.OpenRecordset("tblEfdReceiptsPOS")
    If lngStatus > 0 Then
        Set Jsons = JsonConverter.ParseJson(strData)
        Z = 2
    ElseIf lngStatus < 0 Then
        Beep
        MsgBox "Please note that there is no data to read", vbOKOnly, "The Comm Port has no data"
        ' Handle error.
        On Error Resume Next
    End If

   ' Process data.
    For Each itemiz In Jsons
            With rs
            .AddNew
            rs![TPIN] = itemiz("TPIN")
            rs![TaxpayerName] = itemiz("TaxpayerName")
            rs![Address] = itemiz("Address")
            rs![ESDTime] = itemiz("ESDTime")
            rs![TerminalID] = itemiz("TerminalID")
            rs![InvoiceCode] = itemiz("InvoiceCode")
            rs![InvoiceNumber] = itemiz("InvoiceCode")
            rs![FiscalCode] = itemiz("FiscalCode")
            rs![TalkTime] = itemiz("TalkTime")
            rs![Operator] = itemiz("Operator")
            rs![Taxlabel] = itemiz("TaxItems")("TaxLabel")
            rs![CategoryName] = itemiz("TaxItems")("CategoryName")
            rs![Rate] = itemiz("TaxItems")("Rate")
            rs![TaxAmount] = itemiz("TaxItems")("TaxAmount")
            rs![VerificationUrl] = itemiz("TaxItems")("VerificationUrl")
            rs![INVID] = Me.ItemSoldID
            rs.Update
         End With
         Z = Z + 1
    Next
      
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Set Jsons = Nothing
    
    ' Reset modem control lines.
    lngStatus = CommSetLine(intPortID, LINE_RTS, False)
    lngStatus = CommSetLine(intPortID, LINE_DTR, False)

    ' Close communications.
    Call CommClose(intPortID)
End Sub

Function BuildData(cmd As Integer, content As String) As String
    ' First two bytes of data packet are always these
    Const header1 = &H1A
    Const header2 = &H5D
    
    ' Work areas for byte and string representation of data packet (entire packet up to CRC bytes)
    Dim dataByte() As Byte
    Dim dataString As String

    ' Assemble the packet up to final CRC bytes
    dataString = Chr(header1) & Chr(header2) & Chr(cmd) & Dec2Bin(Len(content), 4) & content

    ' Convert to a byte array
    dataByte = dataString

    ' Calculate CRC for packet and add to end of packet returned from function
    BuildData = dataString & Dec2Bin(cal_crc(dataByte, Len(dataString)), 2)
End Function

Function cal_crc(ptr() As Byte, size As Integer) As Long
    Dim i As Byte
    Dim crc As Long
    Dim ptrIndex As Long

    crc = 0

    For ptrIndex = 0 To size - 1
        i = &H80
        Do While i <> 0
            If (crc And &H8000&) <> 0 Then
                crc = (crc * 2) And &HFFFF&
                crc = crc Xor &H18005
            Else
                crc = (crc * 2) And &HFFFF&
            End If
            If (ptr(ptrIndex) And i) <> 0 Then
                crc = crc Xor &H18005
            End If
            i = i / 2
        Loop
    Next ptrIndex

    cal_crc = crc And &HFFFF&
End Function

Function Dec2Bin(value As Long, bytes As Long) As String
    Dim s As String
    Dim l As Integer
    Dim i As Integer
    
    Dec2Bin = ""
    
    s = Hex(value)
    l = Len(s)
    If l < 2 Then
        s = "0" & s
        l = Len(s)
    End If
    
    For i = l - 1 To 1 Step -2
        Dec2Bin = Chr("&H" & Mid(s, i, 2)) & Dec2Bin
    Next i
    
    If Len(Dec2Bin) < bytes Then
        Dec2Bin = String(bytes - Len(Dec2Bin), Chr(0)) & Dec2Bin
    End If

End Function

Function RPad(strText As String, intLen As Integer, chrPad As String) As String
  RPad = Left(strText & String(intLen, chrPad), intLen)
End Function

Function LPad(strText As String, intLen As Integer, chrPad As String) As String
  LPad = Right(String(intLen, chrPad) & strText, intLen)
End Function

Select allOpen in new window

Function Dec2Bin(value As Long, bytes As Long) As String
    Dim s As String
    Dim l As Integer
    Dim i As Integer
    
    Dec2Bin = ""
    
    s = Hex(value)
    l = Len(s)
    If l Mod 2 = 1 Then
        s = "0" & s
        l = Len(s)
    End If
    
    For i = l - 1 To 1 Step -2
        Dec2Bin = Chr("&H" & Mid(s, i, 2)) & Dec2Bin
    Next i
    
    If Len(Dec2Bin) < bytes Then
        Dec2Bin = String(bytes - Len(Dec2Bin), Chr(0)) & Dec2Bin
    End If

End Function

Select allOpen in new window

Below is my preliminary issue that represent the Dump code but in message type:

Private Sub CmdPosJsons_Click()
    Const cmdStatus = 1
    Const cmdSigning = 2
    Const cmdError = 3

    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim fld As DAO.Field
    Dim qdf As DAO.QueryDef
    Dim prm As DAO.Parameter
    Dim root As Dictionary
    Dim transaction As Dictionary
    Dim transactions As Collection
    Dim item As Dictionary
    Dim items As Collection
    Dim Tax As Collection
    Dim i As Long
    Dim Z As Integer
    Dim j As Long
    Dim t As Long
    Dim itemCount As Long
    Dim taxCount As Long
    Dim strTaxes As Boolean
    Dim invoiceCount As Long
    Dim json As String
    Dim intPortID As Integer ' Ex. 1, 2, 3, 4 for COM1 - COM4
    Dim lngStatus As Long
    Dim strError  As String
    Dim strData   As String
    Dim strDataToSend As String
    Dim fso As Object
    Dim Fileout As Object
    Dim Jsons As Dictionary
    Dim itemiz As Dictionary
    Dim s As String
    Dim n As Integer
    Set fso = CreateObject("Scripting.FileSystemObject")

    Set root = New Dictionary
    Set transactions = New Collection

    Set db = CurrentDb
    Set qdf = db.QueryDefs("QryJsonPos")
    For Each prm In qdf.Parameters
        prm = Eval(prm.Name)
    Next prm
    Set rs = qdf.OpenRecordset(dbOpenSnapshot, dbSeeChanges)

    Set qdf = Nothing
    rs.MoveFirst
    Do While Not rs.EOF
        Set transaction = New Dictionary
        transaction.Add "PosVendor", "Nector Prime Accounting Solutions"
        transaction.Add "SoftwareVersion", "1.0.0.1"
        transaction.Add "Model", "CaP-2017"
        transaction.Add "PosSerialNumber", Nz(Me.Id.Column(1), "")
        transaction.Add "IssueTime", Nz(Me.txtJsonsDate, "")
        transaction.Add "TransactionTyp", Nz(Me.TransactionType, "")
        transaction.Add "PaymentMode", Nz(Me.PaymentMode, "")
        transaction.Add "SaleType", Nz(Me.SalesType, "")
        transaction.Add "LocalPurchaseOrder", Nz(Me.LocalPurchaseOrder, "")
        transaction.Add "Cashier", Nz(Me.Cashier, "")
        transaction.Add "BuyerTPIN", Nz(Me.BuyerTPIN, "")
        transaction.Add "BuyerName", Nz(Me.BuyerName, "")
        transaction.Add "BuyerTaxAccountName", Nz(Me.BuyerTaxAccountName, "")
        transaction.Add "BuyerAddress", Nz(Me.BuyerAddress, "")
        transaction.Add "BuyerTel", Nz(Me.BuyerTel, "")
        transaction.Add "OriginalInvoiceCode", Nz(Me.OrignalInvoiceCode, "")
        transaction.Add "OriginalInvoiceNumber", Nz(Me.OrignalInvoiceNumber, "")
        transaction.Add "Memo", Nz(Me.TheNotes, "")
        '--- loop over all the items
        itemCount = Me.txtsquence
        Set items = New Collection
        For i = 1 To itemCount
            Set item = New Dictionary
            item.Add "ItemID", i
            item.Add "Description", DLookup("ProductName", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "BarCode", DLookup("ProductID", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "Quantity", DLookup("QtySold", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "UnitPrice", DLookup("SellingPrice", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "Discount", DLookup("Discount", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            '--- loop over all the taxes
            taxCount = 1
            Set Tax = New Collection
            strTaxes = DLookup("CGControl", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            '--- loop over all the invoices
            invoiceCount = 1
            For j = 1 To invoiceCount
                For t = 1 To taxCount
            Next t
            item.Add "Taxable", Tax
            
            Tax.Add DLookup("TaxClassA", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            If Len(Nz(DLookup("TaxClassB", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i)), "")) > 0 Then
                Tax.Add Nz(DLookup("TaxClassB", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i)), "")
            End If
            item.Add "Total", DLookup("TotalAmount", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "IsTaxInclusive", strTaxes
            item.Add "RRP", DLookup("RRP", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
                
            Next j
            
            items.Add item
        Next i
        transaction.Add "Items", items
        
        rs.MoveNext
    Loop
    
    root.Add "", transaction

n = FreeFile()
Open "C:\Users\chris.hankwembo\Desktop\ZRA Final\test.txt" For Output As #n

s = ShowHex(BuildData(cmdSigning, JsonConverter.ConvertToJson(transaction, Whitespace:=3)))
Print #n, s ' write to file

Close #n
            
    intPortID = Forms!frmLogin!txtFinComPort.value
    ' Initialize Communications
    lngStatus = CommOpen(intPortID, "COM" & CStr(intPortID), "baud=115200 parity=N data=8 stop=1")
    If lngStatus <> 0 Then
        ' Handle error.
        lngStatus = CommGetError(strError)
        MsgBox "COM Error: " & strError
    End If
    
    ' Set modem control lines.
    lngStatus = CommSetLine(intPortID, LINE_RTS, True)
    lngStatus = CommSetLine(intPortID, LINE_DTR, True)
    
    ' Write data to serial port.
    ' Build data packet to transmit (passing command code, and data to package)
    strData = ShowHex(BuildData(cmdSigning, JsonConverter.ConvertToJson(transaction, Whitespace:=3)))
    ' Display a "dump" for debugging
    MsgBox "strData:" & vbCrLf & strData
    ' Send the data packet and check for error
    lngStatus = CommWrite(intPortID, strData)
    If lngStatus <> Len(strData) Then
        ' Handle error.
        On Error Resume Next
    End If
   
    ' Read maximum of 64 bytes from serial port.
    Set Jsons = New Dictionary
    lngStatus = CommRead(intPortID, strData, 14400)

    Set rs = db.OpenRecordset("tblEfdReceiptsPOS")
    If lngStatus > 0 Then
        Set Jsons = JsonConverter.ParseJson(strData)
        Z = 2
    ElseIf lngStatus < 0 Then
        Beep
        MsgBox "Please note that there is no data to read", vbOKOnly, "The Comm Port has no data"
        ' Handle error.
        On Error Resume Next
    End If

   ' Process data.
    For Each itemiz In Jsons
            With rs
            .AddNew
            rs![TPIN] = itemiz("TPIN")
            rs![TaxpayerName] = itemiz("TaxpayerName")
            rs![Address] = itemiz("Address")
            rs![ESDTime] = itemiz("ESDTime")
            rs![TerminalID] = itemiz("TerminalID")
            rs![InvoiceCode] = itemiz("InvoiceCode")
            rs![InvoiceNumber] = itemiz("InvoiceCode")
            rs![FiscalCode] = itemiz("FiscalCode")
            rs![TalkTime] = itemiz("TalkTime")
            rs![Operator] = itemiz("Operator")
            rs![Taxlabel] = itemiz("TaxItems")("TaxLabel")
            rs![CategoryName] = itemiz("TaxItems")("CategoryName")
            rs![Rate] = itemiz("TaxItems")("Rate")
            rs![TaxAmount] = itemiz("TaxItems")("TaxAmount")
            rs![VerificationUrl] = itemiz("TaxItems")("VerificationUrl")
            rs![INVID] = Me.ItemSoldID
            rs.Update
         End With
         Z = Z + 1
    Next
      
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Set Jsons = Nothing
    
    ' Reset modem control lines.
    lngStatus = CommSetLine(intPortID, LINE_RTS, False)
    lngStatus = CommSetLine(intPortID, LINE_DTR, False)

    ' Close communications.
    Call CommClose(intPortID)
End Sub

Function BuildData(cmd As Integer, content As String) As String
    ' First two bytes of data packet are always these
    Const header1 = &H1A
    Const header2 = &H5D
    
    ' Work areas for byte and string representation of data packet (entire packet up to CRC bytes)
    Dim dataByte() As Byte
    Dim dataString As String

    ' Assemble the packet up to final CRC bytes
    dataString = Chr(header1) & Chr(header2) & Chr(cmd) & Dec2Bin(Len(content), 4) & content

    ' Convert to a byte array
    dataByte = dataString

    ' Calculate CRC for packet and add to end of packet returned from function
    BuildData = dataString & Dec2Bin(cal_crc(dataByte, Len(dataString)), 2)
End Function
Function cal_crc(ptr() As Byte, size As Integer) As Long
    Dim i As Byte
    Dim crc As Long
    Dim ptrIndex As Long

    crc = 0

    For ptrIndex = 0 To size - 1
        i = &H80
        Do While i <> 0
            If (crc And &H8000&) <> 0 Then
                crc = (crc * 2) And &HFFFF&
                crc = crc Xor &H18005
            Else
                crc = (crc * 2) And &HFFFF&
            End If
            If (ptr(ptrIndex) And i) <> 0 Then
                crc = crc Xor &H18005
            End If
            i = i / 2
        Loop
    Next ptrIndex

    cal_crc = crc And &HFFFF&
End Function

Function Dec2Bin(value As Long, bytes As Long) As String
    Dim s As String
    Dim l As Integer
    Dim i As Integer
    
    Dec2Bin = ""
    
    s = Hex(value)
    l = Len(s)
    If l Mod 2 = 1 Then
        s = "0" & s
        l = Len(s)
    End If
    
    For i = l - 1 To 1 Step -2
        Dec2Bin = Chr("&H" & Mid(s, i, 2)) & Dec2Bin
    Next i
    
    If Len(Dec2Bin) < bytes Then
        Dec2Bin = String(bytes - Len(Dec2Bin), Chr(0)) & Dec2Bin
    End If

End Function
Function RPad(strText As String, intLen As Integer, chrPad As String) As String
  RPad = Left(strText & String(intLen, chrPad), intLen)
End Function

Function LPad(strText As String, intLen As Integer, chrPad As String) As String
  LPad = Right(String(intLen, chrPad) & strText, intLen)
End Function
Function ShowHex(sIn As String) As String
    Dim sLeft As String
    Dim sRight As String
    Dim iOffset As Integer
    Dim i As Integer
    Dim c As String

   ShowHex = ""
   sLeft = ""
   sRight = ""
   iOffset = 0
   For i = 0 To Len(sIn) - 1
      c = Mid(sIn, i + 1, 1)
      If (i > 0) And (i Mod 16 = 0) Then
         ShowHex = ShowHex & vbCrLf & LPad(Hex(iOffset), 4, "0") & " = " & sLeft & " | " & sRight
         sLeft = ""
         sRight = ""
         iOffset = iOffset + 16
      End If
      sLeft = sLeft & " " & LPad(Hex(Asc(c)), 2, "0")
      If Asc(c) > 31 And Asc(c) < 127 Then
         sRight = sRight & c
      Else
         sRight = sRight & "."
      End If
   Next
   If sLeft <> "" Then
      ShowHex = ShowHex & vbCrLf & LPad(Hex(iOffset), 4, "0") & " = " & RPad(sLeft, 48, " ") & " | " & sRight
   End If
End Function

Select allOpen in new window

Private Sub CmdPosJsons_Click()
    Const cmdStatus = 1
    Const cmdSigning = 2
    Const cmdError = 3

    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim fld As DAO.Field
    Dim qdf As DAO.QueryDef
    Dim prm As DAO.Parameter
    Dim root As Dictionary
    Dim transaction As Dictionary
    Dim transactions As Collection
    Dim item As Dictionary
    Dim items As Collection
    Dim Tax As Collection
    Dim i As Long
    Dim Z As Integer
    Dim j As Long
    Dim t As Long
    Dim itemCount As Long
    Dim taxCount As Long
    Dim strTaxes As Boolean
    Dim invoiceCount As Long
    Dim json As String
    Dim intPortID As Integer ' Ex. 1, 2, 3, 4 for COM1 - COM4
    Dim lngStatus As Long
    Dim strError  As String
    Dim strData   As String
    Dim strDataToSend As String
    Dim fso As Object
    Dim Fileout As Object
    Dim Jsons As Dictionary
    Dim itemiz As Dictionary
    Dim s As String
    Dim n As Integer
    Set fso = CreateObject("Scripting.FileSystemObject")

    Set root = New Dictionary
    Set transactions = New Collection

    Set db = CurrentDb
    Set qdf = db.QueryDefs("QryJsonPos")
    For Each prm In qdf.Parameters
        prm = Eval(prm.Name)
    Next prm
    Set rs = qdf.OpenRecordset(dbOpenSnapshot, dbSeeChanges)

    Set qdf = Nothing
    rs.MoveFirst
    Do While Not rs.EOF
        Set transaction = New Dictionary
        transaction.Add "PosVendor", "Nector Prime Accounting Solutions"
        transaction.Add "SoftwareVersion", "1.0.0.1"
        transaction.Add "Model", "CaP-2017"
        transaction.Add "PosSerialNumber", Nz(Me.Id.Column(1), "")
        transaction.Add "IssueTime", Nz(Me.txtJsonsDate, "")
        transaction.Add "TransactionTyp", Nz(Me.TransactionType, "")
        transaction.Add "PaymentMode", Nz(Me.PaymentMode, "")
        transaction.Add "SaleType", Nz(Me.SalesType, "")
        transaction.Add "LocalPurchaseOrder", Nz(Me.LocalPurchaseOrder, "")
        transaction.Add "Cashier", Nz(Me.Cashier, "")
        transaction.Add "BuyerTPIN", Nz(Me.BuyerTPIN, "")
        transaction.Add "BuyerName", Nz(Me.BuyerName, "")
        transaction.Add "BuyerTaxAccountName", Nz(Me.BuyerTaxAccountName, "")
        transaction.Add "BuyerAddress", Nz(Me.BuyerAddress, "")
        transaction.Add "BuyerTel", Nz(Me.BuyerTel, "")
        transaction.Add "OriginalInvoiceCode", Nz(Me.OrignalInvoiceCode, "")
        transaction.Add "OriginalInvoiceNumber", Nz(Me.OrignalInvoiceNumber, "")
        transaction.Add "Memo", Nz(Me.TheNotes, "")
        '--- loop over all the items
        itemCount = Me.txtsquence
        Set items = New Collection
        For i = 1 To itemCount
            Set item = New Dictionary
            item.Add "ItemID", i
            item.Add "Description", DLookup("ProductName", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "BarCode", DLookup("ProductID", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "Quantity", DLookup("QtySold", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "UnitPrice", DLookup("SellingPrice", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "Discount", DLookup("Discount", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            '--- loop over all the taxes
            taxCount = 1
            Set Tax = New Collection
            strTaxes = DLookup("CGControl", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            '--- loop over all the invoices
            invoiceCount = 1
            For j = 1 To invoiceCount
                For t = 1 To taxCount
            Next t
            item.Add "Taxable", Tax
            
            Tax.Add DLookup("TaxClassA", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            If Len(Nz(DLookup("TaxClassB", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i)), "")) > 0 Then
                Tax.Add Nz(DLookup("TaxClassB", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i)), "")
            End If
            item.Add "Total", DLookup("TotalAmount", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "IsTaxInclusive", strTaxes
            item.Add "RRP", DLookup("RRP", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
                
            Next j
            
            items.Add item
        Next i
        transaction.Add "Items", items
        
        rs.MoveNext
    Loop
    
    root.Add "", transaction

    intPortID = Forms!frmLogin!txtFinComPort.value
    ' Initialize Communications
    lngStatus = CommOpen(intPortID, "COM" & CStr(intPortID), "baud=115200 parity=N data=8 stop=1")
    If lngStatus <> 0 Then
        ' Handle error.
        lngStatus = CommGetError(strError)
        MsgBox "COM Error: " & strError
    End If
    
    ' Set modem control lines.
    lngStatus = CommSetLine(intPortID, LINE_RTS, True)
    lngStatus = CommSetLine(intPortID, LINE_DTR, True)
    
    ' Write data to serial port.
    ' Build data packet to transmit (passing command code, and data to package)
    strData = BuildData(cmdSigning, JsonConverter.ConvertToJson(transaction, Whitespace:=3))

    ' v v v v v v v v v v   D E B U G   C O D E   v v v v v v v v v v
    ' Write a dump of the packet to a file and to the screen for debugging
    n = FreeFile()
    Open "C:\Users\chris.hankwembo\Desktop\ZRA Final\test.txt" For Output As #n
    Print #n, ShowHex(strData)
    Close #n
    MsgBox "strData:" & vbCrLf & ShowHex(strData)
    ' ^ ^ ^ ^ ^ ^ ^ ^ ^ ^   D E B U G   C O D E   ^ ^ ^ ^ ^ ^ ^ ^ ^ ^

    ' Send the data packet and check for error
    lngStatus = CommWrite(intPortID, strData)
    If lngStatus <> Len(strData) Then
        ' Handle error.
        On Error Resume Next
    End If
   
    ' Read maximum of 64 bytes from serial port.
    Set Jsons = New Dictionary
    lngStatus = CommRead(intPortID, strData, 14400)

    Set rs = db.OpenRecordset("tblEfdReceiptsPOS")
    If lngStatus > 0 Then
        Set Jsons = JsonCon^erter.ParseJson(strData)
        Z = 2
    ElseIf lngStatus < 0 Then
        Beep
        MsgBox "Please note that there is no data to read", vbOKOnly, "The Comm Port has no data"
        ' Handle error.
        On Error Resume Next
    End If

   ' Process data.
    For Each itemiz In Jsons
            With rs
            .AddNew
            rs![TPIN] = itemiz("TPIN")
            rs![TaxpayerName] = itemiz("TaxpayerName")
            rs![Address] = itemiz("Address")
            rs![ESDTime] = itemiz("ESDTime")
            rs![TerminalID] = itemiz("TerminalID")
            rs![InvoiceCode] = itemiz("InvoiceCode")
            rs![InvoiceNumber] = itemiz("InvoiceCode")
            rs![FiscalCode] = itemiz("FiscalCode")
            rs![TalkTime] = itemiz("TalkTime")
            rs![Operator] = itemiz("Operator")
            rs![Taxlabel] = itemiz("TaxItems")("TaxLabel")
            rs![CategoryName] = itemiz("TaxItems")("CategoryName")
            rs![Rate] = itemiz("TaxItems")("Rate")
            rs![TaxAmount] = itemiz("TaxItems")("TaxAmount")
            rs![VerificationUrl] = itemiz("TaxItems")("VerificationUrl")
            rs![INVID] = Me.ItemSoldID
            rs.Update
         End With
         Z = Z + 1
    Next
      
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Set Jsons = Nothing
    
    ' Reset modem control lines.
    lngStatus = CommSetLine(intPortID, LINE_RTS, False)
    lngStatus = CommSetLine(intPortID, LINE_DTR, False)

    ' Close communications.
    Call CommClose(intPortID)
End Sub

Function BuildData(cmd As Integer, content As String) As String
    ' First two bytes of data packet are always these
    Const header1 = &H1A
    Const header2 = &H5D
    
    ' Work areas for byte and string representation of data packet (entire packet up to CRC bytes)
    Dim dataByte() As Byte
    Dim dataString As String

    ' Assemble the packet up to final CRC bytes
    dataString = Chr(header1) & Chr(header2) & Chr(cmd) & Dec2Bin(Len(content), 4) & content

    ' Convert to a byte array
    dataByte = dataString

    ' Calculate CRC for packet and add to end of packet returned from function
    BuildData = dataString & Dec2Bin(cal_crc(dataByte, Len(dataString)), 2)
End Function

Function cal_crc(ptr() As Byte, size As Integer) As Long
    Dim i As Byte
    Dim crc As Long
    Dim ptrIndex As Long

    crc = 0

    For ptrIndex = 0 To size - 1
        i = &H80
        Do While i <> 0
            If (crc And &H8000&) <> 0 Then
                crc = (crc * 2) And &HFFFF&
                crc = crc Xor &H18005
            Else
                crc = (crc * 2) And &HFFFF&
            End If
            If (ptr(ptrIndex) And i) <> 0 Then
                crc = crc Xor &H18005
            End If
            i = i / 2
        Loop
    Next ptrIndex

    cal_crc = crc And &HFFFF&
End Function

Function Dec2Bin(value As Long, bytes As Long) As String
    Dim s As String
    Dim l As Integer
    Dim i As Integer
    
    Dec2Bin = ""
    
    s = Hex(value)
    l = Len(s)
    If l Mod 2 = 1 Then
        s = "0" & s
        l = Len(s)
    End If
    
    For i = l - 1 To 1 Step -2
        Dec2Bin = Chr("&H" & Mid(s, i, 2)) & Dec2Bin
    Next i
    
    If Len(Dec2Bin) < bytes Then
        Dec2Bin = String(bytes - Len(Dec2Bin), Chr(0)) & Dec2Bin
    End If

End Function

Function RPad(strText As String, intLen As Integer, chrPad As String) As String
  RPad = Left(strText & String(intLen, chrPad), intLen)
End Function

Function LPad(strText As String, intLen As Integer, chrPad As String) As String
  LPad = Right(String(intLen, chrPad) & strText, intLen)
End Function

Function ShowHex(sIn As String) As String
    Dim sLeft As String
    Dim sRight As String
    Dim iOffset As Integer
    Dim i As Integer
    Dim c As String

   ShowHex = ""
   sLeft = ""
   sRight = ""
   iOffset = 0
   For i = 0 To Len(sIn) - 1
      c = Mid(sIn, i + 1, 1)
      If (i > 0) And (i Mod 16 = 0) Then
         ShowHex = ShowHex & vbCrLf & LPad(Hex(iOffset), 4, "0") & " = " & sLeft & " | " & sRight
         sLeft = ""
         sRight = ""
         iOffset = iOffset + 16
      End If
      sLeft = sLeft & " " & LPad(Hex(Asc(c)), 2, "0")
      If Asc(c) > 31 And Asc(c) < 127 Then
         sRight = sRight & c
      Else
         sRight = sRight & "."
      End If
   Next
   If sLeft <> "" Then
      ShowHex = ShowHex & vbCrLf & LPad(Hex(iOffset), 4, "0") & " = " & RPad(sLeft, 48, " ") & " | " & sRight
   End If
End Function

Select allOpen in new window

dataString = Chr(header1) & Chr(header2) & Chr(cmdStatus) & Chr(cmdSigning) & Chr(cmdError) & Dec2Bin(Len(content), 4) & content

Select allOpen in new window

Private Sub CmdPosJsons_Click()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim fld As DAO.Field
    Dim qdf As DAO.QueryDef
    Dim prm As DAO.Parameter
    Dim root As Dictionary
    Dim transaction As Dictionary
    Dim transactions As Collection
    Dim item As Dictionary
    Dim items As Collection
    Dim Tax As Collection
    Dim i As Long
    Dim Z As Integer
    Dim j As Long
    Dim t As Long
    Dim itemCount As Long
    Dim taxCount As Long
    Dim strTaxes As Boolean
    Dim invoiceCount As Long
    Dim json As String
    Dim intPortID As Integer ' Ex. 1, 2, 3, 4 for COM1 - COM4
    Dim lngStatus As Long
    Dim strError  As String
    Dim strData   As String
    Dim Jsons As Dictionary
    Dim itemiz As Dictionary
    Dim s As String
    Dim n As Integer
    
    Set root = New Dictionary
    Set transactions = New Collection

    Set db = CurrentDb
    Set qdf = db.QueryDefs("QryJsonPos")
    For Each prm In qdf.Parameters
        prm = Eval(prm.Name)
    Next prm
    Set rs = qdf.OpenRecordset(dbOpenSnapshot, dbSeeChanges)

    Set qdf = Nothing
    rs.MoveFirst
    Do While Not rs.EOF
        Set transaction = New Dictionary
        transaction.Add "PosVendor", "Nector Prime Accounting Solutions"
        transaction.Add "SoftwareVersion", "1.0.0.1"
        transaction.Add "Model", "CaP-2017"
        transaction.Add "PosSerialNumber", Nz(Me.Id.Column(1), "")
        transaction.Add "IssueTime", Nz(Me.txtJsonsDate, "")
        transaction.Add "TransactionTyp", Nz(Me.TransactionType, "")
        transaction.Add "PaymentMode", Nz(Me.PaymentMode, "")
        transaction.Add "SaleType", Nz(Me.SalesType, "")
        transaction.Add "LocalPurchaseOrder", Nz(Me.LocalPurchaseOrder, "")
        transaction.Add "Cashier", Nz(Me.Cashier, "")
        transaction.Add "BuyerTPIN", Nz(Me.BuyerTPIN, "")
        transaction.Add "BuyerName", Nz(Me.BuyerName, "")
        transaction.Add "BuyerTaxAccountName", Nz(Me.BuyerTaxAccountName, "")
        transaction.Add "BuyerAddress", Nz(Me.BuyerAddress, "")
        transaction.Add "BuyerTel", Nz(Me.BuyerTel, "")
        transaction.Add "OriginalInvoiceCode", Nz(Me.OrignalInvoiceCode, "")
        transaction.Add "OriginalInvoiceNumber", Nz(Me.OrignalInvoiceNumber, "")
        transaction.Add "Memo", Nz(Me.TheNotes, "")
        '--- loop over all the items
        itemCount = Me.txtsquence
        Set items = New Collection
        For i = 1 To itemCount
            Set item = New Dictionary
            item.Add "ItemID", i
            item.Add "Description", DLookup("ProductName", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "BarCode", DLookup("ProductID", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "Quantity", DLookup("QtySold", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "UnitPrice", DLookup("SellingPrice", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "Discount", DLookup("Discount", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            '--- loop over all the taxes
            taxCount = 1
            Set Tax = New Collection
            strTaxes = DLookup("CGControl", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            '--- loop over all the invoices
            invoiceCount = 1
            For j = 1 To invoiceCount
                For t = 1 To taxCount
            Next t
            item.Add "Taxable", Tax
            
            Tax.Add DLookup("TaxClassA", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            If Len(Nz(DLookup("TaxClassB", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i)), "")) > 0 Then
                Tax.Add Nz(DLookup("TaxClassB", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i)), "")
            End If
            item.Add "Total", DLookup("TotalAmount", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "IsTaxInclusive", strTaxes
            item.Add "RRP", DLookup("RRP", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
                
            Next j
            
            items.Add item
        Next i
        transaction.Add "Items", items
        
        rs.MoveNext
    Loop
    
    root.Add "", transaction

    intPortID = Forms!frmLogin!txtFinComPort.value
    ' Initialize Communications
    lngStatus = CommOpen(intPortID, "COM" & CStr(intPortID), "baud=115200 parity=N data=8 stop=1")
    If lngStatus <> 0 Then
        ' Handle error.
        lngStatus = CommGetError(strError)
        MsgBox "COM Error: " & strError
    End If
    
    ' Set modem control lines.
    lngStatus = CommSetLine(intPortID, LINE_RTS, True)
    lngStatus = CommSetLine(intPortID, LINE_DTR, True)
    
    ' Write data to serial port.
    ' Build data packet to transmit (passing command code, and data to package)
    strData = BuildData(JsonConverter.ConvertToJson(transaction, Whitespace:=3))

    ' Write a dump of the packet to a file and to the screen for debugging
    n = FreeFile()
    Open "C:\Users\chris.hankwembo\Desktop\ZRA Final\test.txt" For Output As #n
    Print #n, ShowHex(strData)
    Close #n
    MsgBox "strData:" & vbCrLf & ShowHex(strData)
    
    ' Send the data packet and check for error
    lngStatus = CommWrite(intPortID, strData)
    If lngStatus <> Len(strData) Then
        ' Handle error.
        On Error Resume Next
    End If
   
    ' Read maximum of 64 bytes from serial port.
    Set Jsons = New Dictionary
    lngStatus = CommRead(intPortID, strData, 14400)

    Set rs = db.OpenRecordset("tblEfdReceiptsPOS")
    If lngStatus > 0 Then
        Set Jsons = JsonConverter.ParseJson(strData)
        Z = 2
    ElseIf lngStatus < 0 Then
        Beep
        MsgBox "Please note that there is no data to read", vbOKOnly, "The Comm Port has no data"
        ' Handle error.
        On Error Resume Next
    End If

   ' Process data.
    For Each itemiz In Jsons
            With rs
            .AddNew
            rs![TPIN] = itemiz("TPIN")
            rs![TaxpayerName] = itemiz("TaxpayerName")
            rs![Address] = itemiz("Address")
            rs![ESDTime] = itemiz("ESDTime")
            rs![TerminalID] = itemiz("TerminalID")
            rs![InvoiceCode] = itemiz("InvoiceCode")
            rs![InvoiceNumber] = itemiz("InvoiceCode")
            rs![FiscalCode] = itemiz("FiscalCode")
            rs![TalkTime] = itemiz("TalkTime")
            rs![Operator] = itemiz("Operator")
            rs![Taxlabel] = itemiz("TaxItems")("TaxLabel")
            rs![CategoryName] = itemiz("TaxItems")("CategoryName")
            rs![Rate] = itemiz("TaxItems")("Rate")
            rs![TaxAmount] = itemiz("TaxItems")("TaxAmount")
            rs![VerificationUrl] = itemiz("TaxItems")("VerificationUrl")
            rs![INVID] = Me.ItemSoldID
            rs.Update
         End With
         Z = Z + 1
    Next
      
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Set Jsons = Nothing
    
    ' Reset modem control lines.
    lngStatus = CommSetLine(intPortID, LINE_RTS, False)
    lngStatus = CommSetLine(intPortID, LINE_DTR, False)

    ' Close communications.
    Call CommClose(intPortID)
End Sub

Function BuildData(content As String) As String
    ' First two bytes of data packet are always these
    Const header1 = &H1A
    Const header2 = &H5D
    Const cmdStatus = 1
    Const cmdSigning = 2
    Const cmdError = 3
    
    ' Work areas for byte and string representation of data packet (entire packet up to CRC bytes)
    Dim dataByte() As Byte
    Dim dataString As String

    ' Assemble the packet up to final CRC bytes
    dataString = Chr(header1) & Chr(header2) & Chr(cmdStatus) & Chr(cmdSigning) & Chr(cmdError) & Dec2Bin(Len(content), 4) & content

    ' Convert to a byte array
    dataByte = dataString

    ' Calculate CRC for packet and add to end of packet returned from function
    BuildData = dataString & Dec2Bin(cal_crc(dataByte, Len(dataString)), 2)
End Function

Function cal_crc(ptr() As Byte, size As Integer) As Long
    Dim i As Byte
    Dim crc As Long
    Dim ptrIndex As Long

    crc = 0

    For ptrIndex = 0 To size - 1
        i = &H80
        Do While i <> 0
            If (crc And &H8000&) <> 0 Then
                crc = (crc * 2) And &HFFFF&
                crc = crc Xor &H18005
            Else
                crc = (crc * 2) And &HFFFF&
            End If
            If (ptr(ptrIndex) And i) <> 0 Then
                crc = crc Xor &H18005
            End If
            i = i / 2
        Loop
    Next ptrIndex

    cal_crc = crc And &HFFFF&
End Function

Function Dec2Bin(value As Long, bytes As Long) As String
    Dim s As String
    Dim l As Integer
    Dim i As Integer
    
    Dec2Bin = ""
    
    s = Hex(value)
    l = Len(s)
    If l Mod 2 = 1 Then
        s = "0" & s
        l = Len(s)
    End If
    
    For i = l - 1 To 1 Step -2
        Dec2Bin = Chr("&H" & Mid(s, i, 2)) & Dec2Bin
    Next i
    
    If Len(Dec2Bin) < bytes Then
        Dec2Bin = String(bytes - Len(Dec2Bin), Chr(0)) & Dec2Bin
    End If

End Function

Function RPad(strText As String, intLen As Integer, chrPad As String) As String
  RPad = Left(strText & String(intLen, chrPad), intLen)
End Function

Function LPad(strText As String, intLen As Integer, chrPad As String) As String
  LPad = Right(String(intLen, chrPad) & strText, intLen)
End Function

Function ShowHex(sIn As String) As String
    Dim sLeft As String
    Dim sRight As String
    Dim iOffset As Integer
    Dim i As Integer
    Dim c As String

   ShowHex = ""
   sLeft = ""
   sRight = ""
   iOffset = 0
   For i = 0 To Len(sIn) - 1
      c = Mid(sIn, i + 1, 1)
      If (i > 0) And (i Mod 16 = 0) Then
         ShowHex = ShowHex & vbCrLf & LPad(Hex(iOffset), 4, "0") & " = " & sLeft & " | " & sRight
         sLeft = ""
         sRight = ""
         iOffset = iOffset + 16
      End If
      sLeft = sLeft & " " & LPad(Hex(Asc(c)), 2, "0")
      If Asc(c) > 31 And Asc(c) < 127 Then
         sRight = sRight & c
      Else
         sRight = sRight & "."
      End If
   Next
   If sLeft <> "" Then
      ShowHex = ShowHex & vbCrLf & LPad(Hex(iOffset), 4, "0") & " = " & RPad(sLeft, 48, " ") & " | " & sRight
   End If
End Function

Select allOpen in new window

0000 =  1A 5D 01 02 03 00 00 07 18 7B 0D 0A 20 20 20 22 | .].......{..   "
0010 =  50 6F 73 56 65 6E 64 6F 72 22 3A 20 22 4E 65 63 | PosVendor": "Nec
0020 =  74 6F 72 20 50 72 69 6D 65 20 41 63 63 6F 75 6E | tor Prime Accoun
0030 =  74 69 6E 67 20 53 6F 6C 75 74 69 6F 6E 73 22 2C | ting Solutions",
0040 =  0D 0A 20 20 20 22 53 6F 66 74 77 61 72 65 56 65 | ..   "SoftwareVe
0050 =  72 73 69 6F 6E 22 3A 20 22 31 2E 30 2E 30 2E 31 | rsion": "1.0.0.1
0060 =  22 2C 0D 0A 20 20 20 22 4D 6F 64 65 6C 22 3A 20 | ",..   "Model": 
0070 =  22 43 61 50 2D 32 30 31 37 22 2C 0D 0A 20 20 20 | "CaP-2017",..   
0080 =  22 50 6F 73 53 65 72 69 61 6C 4E 75 6D 62 65 72 | "PosSerialNumber
0090 =  22 3A 20 22 31 30 30 31 30 30 30 30 31 38 32 39 | ": "100100001829
00A0 =  22 2C 0D 0A 20 20 20 22 49 73 73 75 65 54 69 6D | ",..   "IssueTim
00B0 =  65 22 3A 20 22 32 30 32 30 30 32 32 38 30 39 35 | e": "20200228095
00C0 =  35 31 36 22 2C 0D 0A 20 20 20 22 54 72 61 6E 73 | 516",..   "Trans
00D0 =  61 63 74 69 6F 6E 54 79 70 22 3A 20 30 2C 0D 0A | actionTyp": 0,..
00E0 =  20 20 20 22 50 61 79 6D 65 6E 74 4D 6F 64 65 22 |    "PaymentMode"
00F0 =  3A 20 30 2C 0D 0A 20 20 20 22 53 61 6C 65 54 79 | : 0,..   "SaleTy
0100 =  70 65 22 3A 20 22 22 2C 0D 0A 20 20 20 22 4C 6F | pe": "",..   "Lo
0110 =  63 61 6C 50 75 72 63 68 61 73 65 4F 72 64 65 72 | calPurchaseOrder
0120 =  22 3A 20 22 22 2C 0D 0A 20 20 20 22 43 61 73 68 | ": "",..   "Cash
0130 =  69 65 72 22 3A 20 22 41 64 6D 69 6E 20 4D 61 6E | ier": "Admin Man
0140 =  61 67 65 72 22 2C 0D 0A 20 20 20 22 42 75 79 65 | ager",..   "Buye
0150 =  72 54 50 49 4E 22 3A 20 22 22 2C 0D 0A 20 20 20 | rTPIN": "",..   
0160 =  22 42 75 79 65 72 4E 61 6D 65 22 3A 20 22 22 2C | "BuyerName": "",
0170 =  0D 0A 20 20 20 22 42 75 79 65 72 54 61 78 41 63 | ..   "BuyerTaxAc
0180 =  63 6F 75 6E 74 4E 61 6D 65 22 3A 20 22 22 2C 0D | countName": "",.
0190 =  0A 20 20 20 22 42 75 79 65 72 41 64 64 72 65 73 | .   "BuyerAddres
01A0 =  73 22 3A 20 22 22 2C 0D 0A 20 20 20 22 42 75 79 | s": "",..   "Buy
01B0 =  65 72 54 65 6C 22 3A 20 22 22 2C 0D 0A 20 20 20 | erTel": "",..   
01C0 =  22 4F 72 69 67 69 6E 61 6C 49 6E 76 6F 69 63 65 | "OriginalInvoice
01D0 =  43 6F 64 65 22 3A 20 22 22 2C 0D 0A 20 20 20 22 | Code": "",..   "
01E0 =  4F 72 69 67 69 6E 61 6C 49 6E 76 6F 69 63 65 4E | OriginalInvoiceN
01F0 =  75 6D 62 65 72 22 3A 20 22 22 2C 0D 0A 20 20 20 | umber": "",..   
0200 =  22 4D 65 6D 6F 22 3A 20 22 22 2C 0D 0A 20 20 20 | "Memo": "",..   
0210 =  22 49 74 65 6D 73 22 3A 20 5B 0D 0A 20 20 20 20 | "Items": [..    
0220 =  20 20 7B 0D 0A 20 20 20 20 20 20 20 20 20 22 49 |   {..         "I
0230 =  74 65 6D 49 44 22 3A 20 31 2C 0D 0A 20 20 20 20 | temID": 1,..    
0240 =  20 20 20 20 20 22 44 65 73 63 72 69 70 74 69 6F |      "Descriptio
0250 =  6E 22 3A 20 22 42 75 74 74 65 72 20 4D 69 6C 6B | n": "Butter Milk
0260 =  22 2C 0D 0A 20 20 20 20 20 20 20 20 20 22 42 61 | ",..         "Ba
0270 =  72 43 6F 64 65 22 3A 20 31 38 2C 0D 0A 20 20 20 | rCode": 18,..   
0280 =  20 20 20 20 20 20 22 51 75 61 6E 74 69 74 79 22 |       "Quantity"
0290 =  3A 20 31 2C 0D 0A 20 20 20 20 20 20 20 20 20 22 | : 1,..         "
02A0 =  55 6E 69 74 50 72 69 63 65 22 3A 20 32 36 2C 0D | UnitPrice": 26,.
02B0 =  0A 20 20 20 20 20 20 20 20 20 22 44 69 73 63 6F | .         "Disco
02C0 =  75 6E 74 22 3A 20 30 2C 0D 0A 20 20 20 20 20 20 | unt": 0,..      
02D0 =  20 20 20 22 54 61 78 61 62 6C 65 22 3A 20 5B 0D |    "Taxable": [.
02E0 =  0A 20 20 20 20 20 20 20 20 20 20 20 20 22 42 22 | .            "B"
02F0 =  0D 0A 20 20 20 20 20 20 20 20 20 5D 2C 0D 0A 20 | ..         ],.. 
0300 =  20 20 20 20 20 20 20 20 22 54 6F 74 61 6C 22 3A |         "Total":
0310 =  20 33 30 2E 31 36 2C 0D 0A 20 20 20 20 20 20 20 |  30.16,..       
0320 =  20 20 22 49 73 54 61 78 49 6E 63 6C 75 73 69 76 |   "IsTaxInclusiv
0330 =  65 22 3A 20 74 72 75 65 2C 0D 0A 20 20 20 20 20 | e": true,..     
0340 =  20 20 20 20 22 52 52 50 22 3A 20 32 39 0D 0A 20 |     "RRP": 29.. 
0350 =  20 20 20 20 20 7D 2C 0D 0A 20 20 20 20 20 20 7B |      },..      {
0360 =  0D 0A 20 20 20 20 20 20 20 20 20 22 49 74 65 6D | ..         "Item
0370 =  49 44 22 3A 20 32 2C 0D 0A 20 20 20 20 20 20 20 | ID": 2,..       
0380 =  20 20 22 44 65 73 63 72 69 70 74 69 6F 6E 22 3A |   "Description":
0390 =  20 22 43 6C 65 61 6E 69 6E 67 20 4D 61 74 65 72 |  "Cleaning Mater
03A0 =  69 61 6C 73 22 2C 0D 0A 20 20 20 20 20 20 20 20 | ials",..        
03B0 =  20 22 42 61 72 43 6F 64 65 22 3A 20 31 39 2C 0D |  "BarCode": 19,.
03C0 =  0A 20 20 20 20 20 20 20 20 20 22 51 75 61 6E 74 | .         "Quant
03D0 =  69 74 79 22 3A 20 31 2C 0D 0A 20 20 20 20 20 20 | ity": 1,..      
03E0 =  20 20 20 22 55 6E 69 74 50 72 69 63 65 22 3A 20 |    "UnitPrice": 
03F0 =  35 36 2C 0D 0A 20 20 20 20 20 20 20 20 20 22 44 | 56,..         "D
0400 =  69 73 63 6F 75 6E 74 22 3A 20 30 2C 0D 0A 20 20 | iscount": 0,..  
0410 =  20 20 20 20 20 20 20 22 54 61 78 61 62 6C 65 22 |        "Taxable"
0420 =  3A 20 5B 0D 0A 20 20 20 20 20 20 20 20 20 20 20 | : [..           
0430 =  20 22 41 22 0D 0A 20 20 20 20 20 20 20 20 20 5D |  "A"..         ]
0440 =  2C 0D 0A 20 20 20 20 20 20 20 20 20 22 54 6F 74 | ,..         "Tot
0450 =  61 6C 22 3A 20 36 34 2E 39 36 2C 0D 0A 20 20 20 | al": 64.96,..   
0460 =  20 20 20 20 20 20 22 49 73 54 61 78 49 6E 63 6C |       "IsTaxIncl
0470 =  75 73 69 76 65 22 3A 20 74 72 75 65 2C 0D 0A 20 | usive": true,.. 
0480 =  20 20 20 20 20 20 20 20 22 52 52 50 22 3A 20 30 |         "RRP": 0
0490 =  0D 0A 20 20 20 20 20 20 7D 2C 0D 0A 20 20 20 20 | ..      },..    
04A0 =  20 20 7B 0D 0A 20 20 20 20 20 20 20 20 20 22 49 |   {..         "I
04B0 =  74 65 6D 49 44 22 3A 20 33 2C 0D 0A 20 20 20 20 | temID": 3,..    
04C0 =  20 20 20 20 20 22 44 65 73 63 72 69 70 74 69 6F |      "Descriptio
04D0 =  6E 22 3A 20 22 4D 69 6C 6B 20 43 68 69 6C 6C 65 | n": "Milk Chille
04E0 =  64 22 2C 0D 0A 20 20 20 20 20 20 20 20 20 22 42 | d",..         "B
04F0 =  61 72 43 6F 64 65 22 3A 20 31 37 2C 0D 0A 20 20 | arCode": 17,..  
0500 =  20 20 20 20 20 20 20 22 51 75 61 6E 74 69 74 79 |        "Quantity
0510 =  22 3A 20 31 2C 0D 0A 20 20 20 20 20 20 20 20 20 | ": 1,..         
0520 =  22 55 6E 69 74 50 72 69 63 65 22 3A 20 33 35 2C | "UnitPrice": 35,
0530 =  0D 0A 20 20 20 20 20 20 20 20 20 22 44 69 73 63 | ..         "Disc
0540 =  6F 75 6E 74 22 3A 20 30 2C 0D 0A 20 20 20 20 20 | ount": 0,..     
0550 =  20 20 20 20 22 54 61 78 61 62 6C 65 22 3A 20 5B |     "Taxable": [
0560 =  0D 0A 20 20 20 20 20 20 20 20 20 20 20 20 22 41 | ..            "A
0570 =  22 0D 0A 20 20 20 20 20 20 20 20 20 5D 2C 0D 0A | "..         ],..
0580 =  20 20 20 20 20 20 20 20 20 22 54 6F 74 61 6C 22 |          "Total"
0590 =  3A 20 34 30 2E 36 2C 0D 0A 20 20 20 20 20 20 20 | : 40.6,..       
05A0 =  20 20 22 49 73 54 61 78 49 6E 63 6C 75 73 69 76 |   "IsTaxInclusiv
05B0 =  65 22 3A 20 74 72 75 65 2C 0D 0A 20 20 20 20 20 | e": true,..     
05C0 =  20 20 20 20 22 52 52 50 22 3A 20 34 35 0D 0A 20 |     "RRP": 45.. 
05D0 =  20 20 20 20 20 7D 2C 0D 0A 20 20 20 20 20 20 7B |      },..      {
05E0 =  0D 0A 20 20 20 20 20 20 20 20 20 22 49 74 65 6D | ..         "Item
05F0 =  49 44 22 3A 20 34 2C 0D 0A 20 20 20 20 20 20 20 | ID": 4,..       
0600 =  20 20 22 44 65 73 63 72 69 70 74 69 6F 6E 22 3A |   "Description":
0610 =  20 22 4D 69 78 65 64 20 46 72 75 69 74 22 2C 0D |  "Mixed Fruit",.
0620 =  0A 20 20 20 20 20 20 20 20 20 22 42 61 72 43 6F | .         "BarCo
0630 =  64 65 22 3A 20 32 30 2C 0D 0A 20 20 20 20 20 20 | de": 20,..      
0640 =  20 20 20 22 51 75 61 6E 74 69 74 79 22 3A 20 31 |    "Quantity": 1
0650 =  2C 0D 0A 20 20 20 20 20 20 20 20 20 22 55 6E 69 | ,..         "Uni
0660 =  74 50 72 69 63 65 22 3A 20 31 38 2E 35 35 2C 0D | tPrice": 18.55,.
0670 =  0A 20 20 20 20 20 20 20 20 20 22 44 69 73 63 6F | .         "Disco
0680 =  75 6E 74 22 3A 20 30 2C 0D 0A 20 20 20 20 20 20 | unt": 0,..      
0690 =  20 20 20 22 54 61 78 61 62 6C 65 22 3A 20 5B 0D |    "Taxable": [.
06A0 =  0A 20 20 20 20 20 20 20 20 20 20 20 20 22 41 22 | .            "A"
06B0 =  0D 0A 20 20 20 20 20 20 20 20 20 5D 2C 0D 0A 20 | ..         ],.. 
06C0 =  20 20 20 20 20 20 20 20 22 54 6F 74 61 6C 22 3A |         "Total":
06D0 =  20 32 31 2E 35 31 38 2C 0D 0A 20 20 20 20 20 20 |  21.518,..      
06E0 =  20 20 20 22 49 73 54 61 78 49 6E 63 6C 75 73 69 |    "IsTaxInclusi
06F0 =  76 65 22 3A 20 66 61 6C 73 65 2C 0D 0A 20 20 20 | ve": false,..   
0700 =  20 20 20 20 20 20 22 52 52 50 22 3A 20 32 35 0D |       "RRP": 25.
0710 =  0A 20 20 20 20 20 20 7D 0D 0A 20 20 20 5D 0D 0A | .      }..   ]..
0720 =  7D 9E A8                                        | }..

Select allOpen in new window