How to correct the writing of data into the serial port

Here is what I have done so far but still it does not work , but your help was very good and highly appreciated as it lead to the near solution , below is what I have done :

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
    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
    ElseIf lngStatus = 0 Then
    Beep
    MsgBox "The port is Open"
    End If
   

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

    ' Write data to serial port.
    Dim Start As String
Dim strTMP As String
Dim strLength As String, L As Long, L1 As Integer, L2 As Integer, L3 As Integer, L4 As Integer
Start = Chr(&H1A) & Chr(&H5D)
L = Len(strData) 'Only length of content string. May be start, length and CRC should be added
L1 = L Mod 256
L2 = (L - L1) / 256 Mod 256
L3 = ((L - L1) / 256 - L2) / 256 Mod 256
L4 = (((L - L1) / 256 - L2) / 256 - L3) / 256 Mod 256
strLength = Chr(L4) & Chr(L3) & Chr(L2) & Chr(L1)
'next string is filled with command 2 - I'm not sure is it correct or not
strTMP = Start & strLength & Chr(2) & strData
    strData = JsonConverter.ConvertToJson(transaction, Whitespace:=3) & Chr$(13)
    lngStatus = CommWrite(intPortID, strData)
    lngSize = Len(strData)
    If lngStatus <> lngSize Then
    Beep
    MsgBox "No data found"
    ' Handle error.
    End If
   
' Read maximum of 64 bytes from serial port.
Dim Customers As Collection
Dim Itemize As Variant
    lngStatus = CommRead(intPortID, strData, 14400)

Set rs = db.OpenRecordset("tblEfdReceiptsPOS")
    If lngStatus > 0 Then
    Set Customers = 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 Itemize In Customers
            With rs
            .AddNew
            rs![TPIN] = Itemize("TPIN")
            rs![TaxpayerName] = Itemize("TaxpayerName")
            rs![Address] = Itemize("Address")
            rs![ESDTime] = Itemize("ESDTime")
            rs![TerminalID] = Itemize("TerminalID")
            rs![InvoiceCode] = Itemize("InvoiceCode")
            rs![InvoiceNumber] = Itemize("InvoiceNumber")
            rs![FiscalCode] = Itemize("FiscalCode")
            rs![TalkTime] = Itemize("TalkTime")
            rs![Operator] = Itemize("Operator")
            rs![Taxlabel] = Itemize("TaxItems")("TaxLabel")
            rs![CategoryName] = Itemize("TaxItems")("CategoryName")
            rs![Rate] = Itemize("TaxItems")("Rate")
            rs![TaxAmount] = Itemize("TaxItems")("TaxAmount")
            rs![TotalAmount] = Itemize("TaxItems")("TotalAmount")
            rs![VerificationUrl] = Itemize("TaxItems")("VerificationUrl")
            rs![INVID] = Me.ItemSoldID
            .Update
         End With
         Z = Z + 1
    Next
     
      rs.Close
      Set rs = Nothing
      Set db = Nothing
      Set Customers = Nothing
   
    ' Reset modem control lines.
    lngStatus = CommSetLine(intPortID, LINE_RTS, False)
    lngStatus = CommSetLine(intPortID, LINE_DTR, False)

    ' Close communications.
    Call CommClose(intPortID)
End Sub

CRC details

You also wanted the details for the CRC , kindly see below:
unsigned short int cal_crc (unsigned char*ptr,unsigned int.len)

{
unsigned char i;
unsigned int crc = 0;
while(len--!=0)
{
for(i = 0x80;i!=0;i/=2)
{
if((crc&0x8000)!=0)
{
crc*=2;
crc^=0x18005;
}
else
{
crc*=2;
}
if((*ptr&i)!=0)
   crc^=0x18005;
}
 ptr++;
}
return(crc);
}

The problem is just on sending & receiving.

Thank you so much for the kindness , this is really a thorn to me, I just hope you will accomodate me when I come back.

Once again highly appreciated.

Regards


Chris

I have done two codes below by implement the instructions given , but still the data is not going:

VBA Code for Sending Json string & writing

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
    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.
Dim Start As String
Dim strTMP As String
Dim strLength As String, L As Long, L1 As Integer, L2 As Integer, L3 As Integer, L4 As Integer
    strData = JsonConverter.ConvertToJson(transaction, Whitespace:=3) & Chr$(13)
    Start = Chr(&H1A) & Chr(&H5D)
     L = Len(strData) 'Only length of content string. May be start, length and CRC should be added L = Len(strData) + 9 (or 7 without CRC)
     L1 = L Mod 256
     L2 = (L - L1) / 256 Mod 256
     L3 = ((L - L1) / 256 - L2) / 256 Mod 256
     L4 = (((L - L1) / 256 - L2) / 256 - L3) / 256 Mod 256
     strLength = Chr(L4) & Chr(L3) & Chr(L2) & Chr(L1)
    strTMP = Start & Chr(2) & strLength & strData
    strTMP = strTMP & strData
'You need function for CRC calculation
    strTMP = strTMP & CRC(strTMP)
    lngStatus = CommWrite(intPortID, strTMP)
    lngSize = Len(strData)
    If lngStatus <> lngSize Then
    ' Handle error.
Exit_CmdPosJsons_Click:
Exit Sub
Err_Handler:
Resume Exit_CmdPosJsons_Click
    End If
   
' Read maximum of 64 bytes from serial port.

Dim JSONS As Object
Dim Itemiz As Object
    lngStatus = CommRead(intPortID, strTMP, 14400)

Set rs = db.OpenRecordset("tblEfdReceiptsPOS")
    If lngStatus > 0 Then
    Set JSONS = ParseJson(strTMP)
    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
            .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

CRC Function VBA Code

Public Function calculateCRC8(ByVal AppID As String) As String
    Dim CRC8 As Byte
    Dim i As Integer
    Dim J As Integer
    Dim AppIDarray() As Byte  '<--- explicitly dimensioned as a Byte array to avoid confusion
    Dim aidLength As Long

    CRC8 = &HC7

    'The AppID is actually bytes stored in hexadecimal in a string. You have to convert them back to bytes before you can run a crc8 on them.
    AppIDarray = HexToByte(AppID)
    aidLength = UBound(AppIDarray)
            For J = 0 To aidLength
                CRC8 = CRC8 Xor AppIDarray(J)
                For i = 1 To 8
                    If CRC8 And &H80 Then
                     'masking off the left-most bit before shifting prevents the Overflow error.
                     CRC8 = ((&H7F And CRC8) * 2) Xor &H1D
                    Else
                     CRC8 = CRC8 * 2
                    End If
                Next i
            Next J
    calculateCRC8 = CRC8
End Function
Public Function HexToByte(strHex As String) As Byte()
    Dim i As Integer
    Dim tempByte As Byte
    Dim outBytes() As Byte
    ReDim outBytes(Len(strHex) \ 2 - 1)
    For i = 0 To Len(strHex) \ 2 - 1
    Dim J As Integer
    Dim char As String
        For J = 0 To 1
           char = Mid(strHex, i * 2 + J + 1, 1)
            Select Case char
                Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9":
                    tempByte = tempByte Or (Asc(char) - 48)
                Case "A", "B", "C", "D", "E", "F":
                    tempByte = tempByte Or (Asc(char) - 55)
            End Select
            If J = 0 Then
                tempByte = tempByte * 2 ^ 4
            Else
                outBytes(i) = tempByte
                tempByte = 0
            End If
        Next
    Next
    HexToByte = outBytes
End Function

Select allOpen in new window