troubleshooting Question

Problems sending VBA formatted data to the serial port

Avatar of Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc
Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.ScFlag for Zambia asked on
MiscellaneousVBAJSON
34 Comments2 Solutions295 ViewsLast Modified:
I have some issues concerning the sending of the correctly formatted Json data to the serial as per manual description below:
Manual Serial port sending details
All the data will be organized in JSON format starting with package header and ending with checksum. It consists of Header, Command ID, Length of data, Content and Verification Code (CRC):

String: <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


Work Done Step by step

Step 1

(Header 1) 1 The first byte of package header 0x1A

Dim Header1 As String, DecimalValue As Integer, BinaryValue As String
DecimalValue = &H1A
BinaryValue = DecToBins(DecimalValue, 8)
Header1 = DecToBins(DecimalValue, 8)
MsgBox "Header1 :" & vbCrLf & Header1

This has now given me string like = 11111010

Step 2

Dim Header2 As String
DecimalValue = &H5D
BinaryValue = DecToBins(DecimalValue, 8)
Header2 = DecToBins(DecimalValue, 8)
MsgBox "Header2 :" & vbCrLf & Header2

This has now given me string like = 11011101

Step 3

Dim CmdID As String, CmdOne As String, Cmdtwo As String, Cmdthree As String
DecimalValue = &H1
BinaryValue = DecToBins(DecimalValue, 8)
CmdOne = DecToBins(DecimalValue, 8)
MsgBox "CmdOne :" & vbCrLf & CmdOne

This has now given me string like = 11111111

DecimalValue = &H2
BinaryValue = DecToBins(DecimalValue, 8)
Cmdtwo = DecToBins(DecimalValue, 8)
MsgBox "Cmdtwo :" & vbCrLf & Cmdtwo
This has now given me string like = 11111110

DecimalValue = &H3
BinaryValue = DecToBins(DecimalValue, 8)
Cmdthree = DecToBins(DecimalValue, 8)
MsgBox "Cmdthree :" & vbCrLf & Cmdthree

This has now given me string like = 11111111

Summary for (H1, H2 & H3)

CmdID = CmdOne & "><" & Cmdtwo & "><" & Cmdthree
MsgBox "CmdID :" & vbCrLf & CmdID
This has now given me string like = 11111111><11111110><11111111



Step 4

Dim length As String, LengthFinal As String

LengthFinal = Len(Trim(CStr(JsonConverter.ConvertToJson(transaction, Whitespace:=3))) & Chr$(13))
DecimalValue = LengthFinal
BinaryValue = DecToBinLength(DecimalValue, 8)
length = DecToBinLength(DecimalValue, 8)
MsgBox "length :" & vbCrLf & length
This has now given me string like = 01010111

Step 5

Dim Content As String, cont As String, fulldata As String
cont = Len(Trim(CStr(JsonConverter.ConvertToJson(transaction, Whitespace:=3))) & Chr$(13))
DecimalValue = cont
BinaryValue = DecToBinContent(DecimalValue, 8)
Content = DecToBinContent(DecimalValue, 8)
MsgBox "Content :" & vbCrLf & Content

This has now given me string like = 01010111

Step 5 (CRC)

fulldata = "<" & Header1 & "><" & Header2 & "><" & CmdID & "><" & length & "><" & Content & ">"
Dim data() As Byte
Dim CRCs As String
data = StrConv(fulldata, vbFromUnicode)
    CRCs = cal_crc(data, 10)
    MsgBox "CRCs :" & vbCrLf & CRCs
    
Dim crc As String
DecimalValue = Len(CRCs)
BinaryValue = DecToBincrc(DecimalValue, 8)
crc = DecToBincrc(DecimalValue, 8)
MsgBox "CRC :" & vbCrLf & crc
This has now given me string like = 11111101


Step 6 (Final String)


String: <Header1><Header2><CmdID ><Length ><Content><CRC>


strData = "<" & Header1 & "><" & Header2 & "><" & CmdID & "><" & length & "><" & Content & "><" & crc & ">"
MsgBox "strData :" & vbCrLf & strData


This has now given me string like
=(strData) <11111010><11011101><11111111><11111110><11111111><01010111>01010111><11111101>

Requirements its seams like this is the only code that is supposed to be sent to this serial gadget but it must accommodate the following:

"baud=115200 parity=N data=8 stop=1"

Question 1

How do I frame the VBA code to send (write to the port) the string as per below together with the required "baud=115200 parity=N data=8 stop=1"

=(strData) <11111010><11011101><11111111><11111110><11111111><01010111>01010111><11111101>

Question 2

The manual says receiving data from the gadget follows the same pattern, then how do I frame the VBA to receive (reading the data) the data from the gadget using the same string as below:

=(strData) <11111010><11011101><11111111><11111110><11111111><01010111>01010111><11111101>
Current status
I have tried to use the VBA code below it failed to work; please see how you can help.

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)

lngSize = Len(strData)
    lngStatus = CommWrite(intPortID, strData)
    If lngStatus <> lngSize Then
    ' Handle error.
' Handle error.
        On Error Resume Next
    End If
‘Receing part of the VBA code

' Read maximum of 14400 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)

Miscellaneous

(1)      Could it be I misinterpreted the whole requirements, I have run out of ideas now.  
(2)      I also doubt strong the final potion of the vba code shown below I still think something is missing here:

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
ASKER CERTIFIED SOLUTION
Join our community to see this answer!
Unlock 2 Answers and 34 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 2 Answers and 34 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros