Avatar of Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc
Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc
Flag for Zambia asked on

How to correct the writing of data into the serial port

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
Microsoft AccessVBAJSON

Avatar of undefined
Last Comment
Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc

8/22/2022 - Mon
ASKER CERTIFIED SOLUTION
als315

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
GET A PERSONALIZED SOLUTION
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc

ASKER
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);
}
Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc

ASKER
The problem is just on sending & receiving.
SOLUTION
als315

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
GET A PERSONALIZED SOLUTION
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc

ASKER
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
Experts Exchange is like having an extremely knowledgeable team sitting and waiting for your call. Couldn't do my job half as well as I do without it!
James Murphy
Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc

ASKER
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