×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

How to Send Data Packet From Ms Access 2016 to Rs 232 Serial Port

How to Send Data Packet From Ms Access 2016 to Rs 232 Serial Port

How to Send Data Packet From Ms Access 2016 to Rs 232 Serial Port

(OP)
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

CODE --> VBA

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

CODE --> VBA

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

CODE --> VBA

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

CODE --> VBA

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

CODE --> VBA

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)

CODE --> VBA

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

CODE --> VBA

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

CODE --> VBA

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)

CODE --> VBA

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 5 (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:

CODE --> VBA

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 


To fully understand the requirement here see the guide booklet:

https://drive.google.com/open?id=1F2iPYQmwY56eX48d...






















Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close