We help IT Professionals succeed at work.

How to correct the writing of data into the serial port

Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc
Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc asked
on
Dear Experts!

Here is my problem in Ms Access VBA Code , the code which is supposed to write to the serial port is not fed with data as a result it cannot write anything to the port, below is the actual peice of code that require fixing:

VBA CODE 1

' Write data to serial port.

   
 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

Open in new window



Audit proof

If I send the same data to a text file , I'm able to see the actual Json data in text form by using the CODE below:


VBA CODE 2

Dim json As String
Dim theFileName  As Variant
json = JsonConverter.ConvertToJson(transaction, Whitespace:=3) & Chr$(13)
theFileName = "C:\Users\admini\Desktop\Leaders\VBA Json.txt"
Dim handle As Integer
handle = FreeFile
Open theFileName For Output As #handle
Print #handle, json 'jsonSerialization
Close #handle

Open in new window



See also screen shoot which confirms that there is no data at all written the port:

No-data-found.png
Comment
Watch Question

Christopher, you should divide your question into parts:
1. JSON string
2. Sending data to COM port
Let's start from second part. As I can see from your questions you have some gadget, connected to RS-232 port. If you can give link to description of this gadget, it will simplify our task.
From your comments I see following:
Data should have some structure:
Data Structure as per gadget
<Header1><Header2><CmdID><Length><Content><CRC>
Field                                       Length(Byte)   Description
Header 1                                                   1       The first byte of package header 0x1A
Header 2                                                   1       The second byte of package header Ox5D
CmdID                                                           1       Command IDs:
                                                                    0x01 acquire the status of ESD
                                                                    0x02 invoice signing
                                                                    0x03 Error code
Length                                                     4       The length of the content, big-endian
Content                                                    ?       The Json based business data
CRC                                                     2       Two-Byte verification (CRC), it will be generated by bytes start from Header 1 up to content
Almost all is clear, and you can start testing with any fixed json string.
Fill strdata with this string statically (It allow not to think about  length of data)
Add start bytes to string:
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

Open in new window

Now you should add CRC. Is it 2-byte standard CRC16 or anything else? May be better to open separate question about conversion of c++ code from your comment to vba code (you need function for CRC calculation from text string).
Add CRC to strTMP and try send it to com 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.
You have wrong sequence here:
strTMP = Start & strLength & Chr(2) & strData
    strData = JsonConverter.ConvertToJson(transaction, Whitespace:=3) & Chr$(13)
    lngStatus = CommWrite(intPortID, strData)

Open in new window

Should be:
strData = JsonConverter.ConvertToJson(transaction, Whitespace:=3) & Chr$(13)
     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 & strLength & Chr(2) & strData
    strTMP = strTMP & strData
'You need function for CRC calculation
    strTMP =  strTMP & CRC(strTMP)
    lngStatus = CommWrite(intPortID, strTMP)

Open in new window

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

Open 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

Open in new window