Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

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

Status
Not open for further replies.
mwiinde

mwiinde

Programmer
Sep 21, 2019
4
0
0
ZM
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: 
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: 
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: 
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: 
DecimalValue = &H2
BinaryValue = DecToBins(DecimalValue, 8)
Cmdtwo = DecToBins(DecimalValue, 8)
MsgBox "Cmdtwo :" & vbCrLf & Cmdtwo
This has now given me string like = 11111110

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


[b]Step 5 (Final String)[/b]


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"

[b]Question 1[/b]

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>

[b]Question 2[/b]

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

 
Status
Not open for further replies.

Similar threads

sartechy
  • Locked
  • Question
Mobile Data or Pocket WiFi? 1
Replies
3
Views
161
teknance
teknance
DTGMI
  • Locked
  • Question
Netgear Nighthawk M6 Pro - Need to add ext Antenna
Replies
0
Views
104
DTGMI
DTGMI
smittywes38
  • Locked
  • Question
Unable to print to wireless printer connected to VPN
Replies
0
Views
55
smittywes38
smittywes38
johannjoezzz12
  • Locked
  • Question
how do i reload CISCO Air 702i Access point OS?
Replies
0
Views
36
johannjoezzz12
johannjoezzz12
john newman
  • Locked
  • Question
TO START OFF THANK YOU FOR ANY HELP
Replies
2
Views
52
ADB100
ADB100

Part and Inventory Search

Sponsor

Back
Top