Help required to convert C++ Code to VBA in Ms Access

With the given information, your dump looks correct.

What about posting to original C source as well as yours with test methods?

For other readers benefit, this is a follow on to a solution provided in this earlier question:

• Problems sending VBA formatted data to the serial port Solutions | Experts Exchange

Okay, on to this new question.  You mention:

' Assemble the packet up to final CRC bytes
  dataString = Chr(header1) & Chr(header2) & Chr(cmdSigning) & Dec2Bin(Len(content), 4) & content

Please note the Json Part is 100% correct, its just the first three codes  1A, 5D & 02 are incorrect , that is where help is required here:

That code looks right and the dump looks right.  Why are you thinking that it isn't correct, I assume the device receiving the data packet isn't accepting it?  Do you get any indication that the problem lies in one of these first three bytes, as opposed to say the calculated CRC, etc?  Or is it a general error of some sort?  Are you getting a 1000 series error back from the device when you send data, and if so what error?  Or no error at all, it just doesn't accept the packet.

If you can describe a bit more about the process and what results you are (or are not) getting that may help.

---

»bp

The length bytes (0x07, 0x75) seem to be correct and match the length of the JSON data.  As long as we interpreted the data specification correctly that the length was just for the JSON content that followed it.

---

»bp

Dear BP

There is no error whatsoever , I have just talked to the taxman a few minutes a ago , they confirmed also that the data is good but the CRC is not being calculated correctly that the reasons why the there no response from the device. Full codes are below:

VBA Code

Private Sub CmdPosJsons_Click()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim fld As DAO.Field
    Dim qdf As DAO.QueryDef
    Dim prm As DAO.Parameter
    Dim root As Dictionary
    Dim transaction As Dictionary
    Dim transactions As Collection
    Dim item As Dictionary
    Dim items As Collection
    Dim Tax As Collection
    Dim i As Long
    Dim Z As Integer
    Dim j As Long
    Dim t As Long
    Dim itemCount As Long
    Dim taxCount As Long
    Dim strTaxes As Boolean
    Dim invoiceCount As Long
    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 Jsons As Dictionary
    Dim itemiz As Dictionary
    Dim s As String
    Dim n As Integer
    Set root = New Dictionary
    Set transactions = New Collection
    Set db = CurrentDb
    Set qdf = db.QueryDefs("QryJsonPos")
    For Each prm In qdf.Parameters
        prm = Eval(prm.Name)
    Next prm
    Set rs = qdf.OpenRecordset(dbOpenSnapshot, dbSeeChanges)
    Set qdf = Nothing
    rs.MoveFirst
    Do While Not rs.EOF
        Set transaction = New Dictionary
        transaction.Add "PosVendor", "Nector Prime Accounting Solutions"
        transaction.Add "PosSoftwareVersion", "2.0.0.1"
        transaction.Add "PosModel", "Cap-2017"
        transaction.Add "PosSerialNumber", Nz(Me.Id.Column(1), "")
        transaction.Add "IssueTime", Nz(Me.txtJsonsDate, "")
        transaction.Add "TransactionType", Nz(Me.TransactionType, "")
        transaction.Add "PaymentMode", Nz(Me.PaymentMode, "")
        transaction.Add "SaleType", Nz(Me.SalesType, "")
        transaction.Add "LocalPurchaseOrder", Nz(Me.LocalPurchaseOrder, "")
        transaction.Add "Cashier", Nz(Me.Cashier, "")
        transaction.Add "BuyerTPIN", Nz(Me.BuyerTPIN, "")
        transaction.Add "BuyerName", Nz(Me.BuyerName, "")
        transaction.Add "BuyerTaxAccountName", Nz(Me.BuyerTaxAccountName, "")
        transaction.Add "BuyerAddress", Nz(Me.BuyerAddress, "")
        transaction.Add "BuyerTel", Nz(Me.BuyerTel, "")
        transaction.Add "OriginalInvoiceCode", Nz(Me.OrignalInvoiceCode, "")
        transaction.Add "OriginalInvoiceNumber", Nz(Me.OrignalInvoiceNumber, "")
        transaction.Add "Memo", Nz(Me.TheNotes, "")
        '--- loop over all the items
        itemCount = Me.txtsquence
        Set items = New Collection
        For i = 1 To itemCount
            Set item = New Dictionary
            item.Add "ItemId", i
            item.Add "Description", DLookup("ProductName", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "BarCode", DLookup("ProductID", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "Quantity", DLookup("QtySold", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "UnitPrice", DLookup("SellingPrice", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "Discount", DLookup("Discount", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            '--- loop over all the taxes
            taxCount = 1
            Set Tax = New Collection
            strTaxes = DLookup("CGControl", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            '--- loop over all the invoices
            invoiceCount = 1
            For j = 1 To invoiceCount
                For t = 1 To taxCount
            Next t
            item.Add "TaxLabels", Tax
            
            Tax.Add DLookup("TaxClassA", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            If Len(Nz(DLookup("TaxClassB", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i)), "")) > 0 Then
                Tax.Add Nz(DLookup("TaxClassB", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i)), "")
            End If
            item.Add "TotalAmount", DLookup("TotalAmount", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
            item.Add "IsTaxInclusive", strTaxes
            item.Add "RRP", DLookup("RRP", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
                
            Next j
            
            items.Add item
        Next i
        transaction.Add "Items", items
        
        rs.MoveNext
    Loop
    
    root.Add "", transaction

    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.
    ' Build data packet to transmit (passing command code, and data to package)
    strData = BuildData(JsonConverter.ConvertToJson(transaction, Whitespace:=3))

    ' Write a dump of the packet to a file and to the screen for debugging
    n = FreeFile()
    Open "C:\Users\CHank\Desktop\Leader\test.txt" For Output As #n
    Print #n, ShowHex(strData)
    Close #n
    MsgBox "strData:" & vbCrLf & ShowHex(strData)
    
    ' Send the data packet and check for error
    lngStatus = CommWrite(intPortID, strData)
    If lngStatus <> Len(strData) Then
        ' Handle error.
        On Error Resume Next
    End If
   
    ' Read maximum of 64 bytes from serial port.
    Set Jsons = New 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] = 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
            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)
End Sub

Function BuildData(content As String) As String
    ' First two bytes of data packet are always these
    Const header1 = &H1A
    Const header2 = &H5D
    Const cmdSigning = 2
    
    ' Work areas for byte and string representation of data packet (entire packet up to CRC bytes)
    Dim dataByte() As Byte
    Dim dataString As String

    ' Assemble the packet up to final CRC bytes
    dataString = Chr(header1) & Chr(header2) & Chr(cmdSigning) & Dec2Bin(Len(content), 4) & content

    ' Convert to a byte array
    dataByte = dataString

    ' Calculate CRC for packet and add to end of packet returned from function
    BuildData = dataString & Dec2Bin(cal_crc(dataByte, Len(dataString)), 2)
End Function

Function cal_crc(ptr() As Byte, size As Integer) As Long
    Dim i As Byte
    Dim crc As Long
    Dim ptrIndex As Long

    crc = 0

    For ptrIndex = 0 To size - 1
        i = &H80
        Do While i <> 0
            If (crc And &H8000&) <> 0 Then
                crc = (crc * 2) And &HFFFF&
                crc = crc Xor &H18005
            Else
                crc = (crc * 2) And &HFFFF&
            End If
            If (ptr(ptrIndex) And i) <> 0 Then
                crc = crc Xor &H18005
            End If
            i = i / 2
        Loop
    Next ptrIndex

    cal_crc = crc And &HFFFF&
End Function

Function Dec2Bin(value As Long, bytes As Long) As String
    Dim s As String
    Dim l As Integer
    Dim i As Integer
    
    Dec2Bin = ""
    
    s = Hex(value)
    l = Len(s)
    If l Mod 2 = 1 Then
        s = "0" & s
        l = Len(s)
    End If
    
    For i = l - 1 To 1 Step -2
        Dec2Bin = Chr("&H" & Mid(s, i, 2)) & Dec2Bin
    Next i
    
    If Len(Dec2Bin) < bytes Then
        Dec2Bin = String(bytes - Len(Dec2Bin), Chr(0)) & Dec2Bin
    End If

End Function

Function RPad(strText As String, intLen As Integer, chrPad As String) As String
  RPad = Left(strText & String(intLen, chrPad), intLen)
End Function

Function LPad(strText As String, intLen As Integer, chrPad As String) As String
  LPad = Right(String(intLen, chrPad) & strText, intLen)
End Function

Function ShowHex(sIn As String) As String
    Dim sLeft As String
    Dim sRight As String
    Dim iOffset As Integer
    Dim i As Integer
    Dim c As String

   ShowHex = ""
   sLeft = ""
   sRight = ""
   iOffset = 0
   For i = 0 To Len(sIn) - 1
      c = Mid(sIn, i + 1, 1)
      If (i > 0) And (i Mod 16 = 0) Then
         ShowHex = ShowHex & vbCrLf & LPad(Hex(iOffset), 4, "0") & " = " & sLeft & " | " & sRight
         sLeft = ""
         sRight = ""
         iOffset = iOffset + 16
      End If
      sLeft = sLeft & " " & LPad(Hex(Asc(c)), 2, "0")
      If Asc(c) > 31 And Asc(c) < 127 Then
         sRight = sRight & c
      Else
         sRight = sRight & ""
      End If
   Next
   If sLeft <> "" Then
      ShowHex = ShowHex & vbCrLf & LPad(Hex(iOffset), 4, "0") & " = " & RPad(sLeft, 48, " ") & " | " & sRight
   End If
End Functio

Select allOpen in new window

n

Okay, I can revisit the CRC calculation that we ported from C++, as you know it was a bit tricky since C++ language has certain behavior that VBA doesn't, like handling overflow gracefully, etc.  I will do additional testing between the VBA version and the C++ version on a wider sample and see what I can find.

---

»bp

Thank you BP for the help this is really tough for me , I have encountered this issue before.

Regards

Chris

In a quick look I think there is a difference between the results from the C++ crc logic and the VBA C++ logic.  I'll poke at this in detail in the next day or few and see if I can nail down the cause, and a solution.

---

»bp

Thank you so BP, I wait

Regards

Chris

Well, as far as I can tell from a quick test using 2016:

Option Compare Database
Option Explicit

Public Sub RunTest()

    Dim dataByte() As Byte
    Dim dataString As String
    
    dataString = "TEST"
    dataByte = dataString
    Debug.Print LBound(dataByte), UBound(dataByte), Len(dataString)
    Debug.Print ShowHex(dataString)
    Debug.Print ShowHex2(dataByte)
    
End Sub

Public Function ShowHex(sIn As String) As String
    Dim sLeft As String
    Dim sRight As String
    Dim iOffset As Integer
    Dim i As Integer
    Dim c As String

   ShowHex = ""
   sLeft = ""
   sRight = ""
   iOffset = 0
   For i = 0 To Len(sIn) - 1
      c = Mid(sIn, i + 1, 1)
      If (i > 0) And (i Mod 16 = 0) Then
         ShowHex = ShowHex & vbCrLf & LPad(Hex(iOffset), 4, "0") & " = " & sLeft & " | " & sRight
         sLeft = ""
         sRight = ""
         iOffset = iOffset + 16
      End If
      sLeft = sLeft & " " & LPad(Hex(Asc(c)), 2, "0")
      If Asc(c) > 31 And Asc(c) < 127 Then
         sRight = sRight & c
      Else
         sRight = sRight & ""
      End If
   Next
   If sLeft <> "" Then
      ShowHex = ShowHex & vbCrLf & LPad(Hex(iOffset), 4, "0") & " = " & RPad(sLeft, 48, " ") & " | " & sRight
   End If
End Function

Public Function ShowHex2(sIn() As Byte) As String

  Dim sLeft As String
  Dim sRight As String
  Dim iOffset As Integer
  Dim i As Integer
  Dim c As Byte
  Dim Result As String

  Result = ""
  sLeft = ""
  sRight = ""
  iOffset = 0
  For i = LBound(sIn) To UBound(sIn)
    c = sIn(i)
    If (i > 0) And (i Mod 16 = 0) Then
      ShowHex2 = Result & vbCrLf & LPad(Hex(iOffset), 4, "0") & " = " & sLeft & " | " & sRight
      Result = ""
      sRight = ""
      iOffset = iOffset + 16
    End If
  
    sLeft = sLeft & " " & LPad(Hex(c), 2, "0")
    If c > 31 And c < 127 Then
      sRight = sRight & Chr(c)
    Else
      sRight = sRight & "#"
    End If
  Next i
  
  If sLeft <> "" Then
    Result = Result & vbCrLf & LPad(Hex(iOffset), 4, "0") & " = " & RPad(sLeft, 48, " ") & " | " & sRight
  End If
  
  ShowHex2 = Result
  
End Function

Private Function LPad(strText As String, intLen As Integer, chrPad As String) As String
  LPad = Right(String(intLen, chrPad) & strText, intLen)
End Function

Private Function RPad(strText As String, intLen As Integer, chrPad As String) As String
  RPad = Left(strText & String(intLen, chrPad), intLen)
End Function

Select allOpen in new window

It's a charset/Unicode problem.

Your currently using the wrong length in your BuildData method.
And when I need to guess, you must send ASCII7 or ASCII8 only. Thus review the specs again.

To correct it:

Option Compare Database
Option Explicit

Public Function BuildData(ByVal CContent As String) As String
    
    Const HEADER_BYTE_1 As Byte = &H1A
    Const HEADER_BYTE_2 As Byte = &H5D
    Const HEADER_SIGNING_MODE As Byte = 2
    
    Dim Data As String

    Data = Chr(HEADER_BYTE_1) & Chr(HEADER_BYTE_2) & Chr(HEADER_SIGNING_MODE) & Dec2Bin(Len(CContent), 4) & CContent
    BuildData = Data & Dec2Bin(CrcFromString(Data), 2)
    
End Function

Public Function CrcFromString(ByVal CData As String) As Long

  Dim Bytes() As Byte
  
  Bytes = CData
  CrcFromString = cal_crc(Bytes, UBound(Bytes))
  
End Function

Select allOpen in new window

Caveat: While the above correction should work, it is just that a correction of an symptom. Thus picking up my guess about ASCII from above, maybe the better correction is using StrConv(), when your current code page (locale) is non-Unicode:

Option Compare Database
Option Explicit

Public Sub RunTest()

    Dim dataByte() As Byte
    Dim dataString As String
    
    dataString = "TEST"
    dataByte = dataString
    Debug.Print LBound(dataByte), UBound(dataByte), Len(dataString), dataString
    Debug.Print HexDumpFromString(dataString)
    Debug.Print HexDumpFromBytes(dataByte)
    
    dataString = "TEST"
    dataString = StrConv(dataString, vbFromUnicode)
    dataByte = dataString
    Debug.Print LBound(dataByte), UBound(dataByte), Len(dataString), dataString
    Debug.Print HexDumpFromString(dataString)
    Debug.Print HexDumpFromBytes(dataByte)
    
End Sub

Public Function HexDumpFromString(ByVal CData As String) As String

  Dim Bytes() As Byte
  
  Bytes = CData
  HexDumpFromString = HexDumpFromBytes(Bytes)
  
End Function

Public Function HexDumpFromBytes(ABytes() As Byte) As String

  Dim sLeft As String
  Dim sRight As String
  Dim iOffset As Integer
  Dim i As Integer
  Dim c As Byte
  Dim Result As String

  Result = ""
  sLeft = ""
  sRight = ""
  iOffset = 0
  For i = LBound(ABytes) To UBound(ABytes)
    c = ABytes(i)
    If (i > 0) And (i Mod 16 = 0) Then
      Result = Result & vbCrLf & LPad(Hex(iOffset), 4, "0") & " = " & sLeft & " | " & sRight
      Result = ""
      sRight = ""
      iOffset = iOffset + 16
    End If
  
    sLeft = sLeft & " " & LPad(Hex(c), 2, "0")
    If c > 31 And c < 127 Then
      sRight = sRight & Chr(c)
    Else
      sRight = sRight & "#"
    End If
  Next i
  
  If sLeft <> "" Then
    Result = Result & vbCrLf & LPad(Hex(iOffset), 4, "0") & " = " & RPad(sLeft, 48, " ") & " | " & sRight
  End If
  
  HexDumpFromBytes = Result
  
End Function

Private Function LPad(strText As String, intLen As Integer, chrPad As String) As String
  LPad = Right(String(intLen, chrPad) & strText, intLen)
End Function

Private Function RPad(strText As String, intLen As Integer, chrPad As String) As String
  RPad = Left(strText & String(intLen, chrPad), intLen)
End Function

Select allOpen in new window

Yes, I had noticed the Unicode issue and corrected for that.  But the CRC generated was still difference in VBA than C++, so have to dig deeper into that logic.

---

»bp

It's about the parameters when calling the functions:

Public Function CrcFromString(ByVal CData As String) As Long

  Dim Bytes() As Byte
  
  Bytes = CData
  CrcFromString = cal_crc(Bytes, UBound(Bytes))
  
End Function

Select allOpen in new window

vs.

Function BuildData(content As String) As String
    '...

    ' Calculate CRC for packet and add to end of packet returned from function
    BuildData = dataString & Dec2Bin(cal_crc(dataByte, Len(dataString)), 2)
End Function

Select allOpen in new window

The length of the string is not the length of the byte array.
The byte array contains Unicode, where as Len(dataString) return the number of characters. 2 byte per character, thus the CRC returned does only calculate over half of the buffer.

Imho there are three solutions:

Option Compare Database
Option Explicit

Public Function BuildData1(ByVal CContent As String) As String
    
    Const HEADER_BYTE_1 As Byte = &H1A
    Const HEADER_BYTE_2 As Byte = &H5D
    Const HEADER_SIGNING_MODE As Byte = 2
    
    Dim Data As String

    Data = Chr(HEADER_BYTE_1) & Chr(HEADER_BYTE_2) & Chr(HEADER_SIGNING_MODE) & Dec2Bin(Len(CContent), 4) & CContent
    BuildData1 = Data & Dec2Bin(CrcFromString(Data), 2)
    
End Function

Function BuildData2(ByVal CContent As String) As String
    
    Const HEADER_BYTE_1 As Byte = &H1A
    Const HEADER_BYTE_2 As Byte = &H5D
    Const HEADER_SIGNING_MODE As Byte = 2
    
    Dim Bytes() As Byte
    Dim Data As String

    Data = Chr(HEADER_BYTE_1) & Chr(HEADER_BYTE_2) & Chr(HEADER_SIGNING_MODE) & Dec2Bin(Len(CContent), 4) & CContent
    Data = StrConv(Data, vbFromUnicode)
    Bytes() = Data
    BuildData2 = Data & Dec2Bin(cal_crc(Bytes, Len(Data)), 2)
    
End Function

Function BuildData3(ByVal CContent As String) As String
    
    Const HEADER_BYTE_1 As Byte = &H1A
    Const HEADER_BYTE_2 As Byte = &H5D
    Const HEADER_SIGNING_MODE As Byte = 2
    
    Dim Bytes() As Byte
    Dim Data As String

    Data = Chr(HEADER_BYTE_1) & Chr(HEADER_BYTE_2) & Chr(HEADER_SIGNING_MODE) & Dec2Bin(Len(CContent), 4) & CContent
    Bytes() = Data
    BuildData3 = Data & Dec2Bin(cal_crc(Bytes, UBound(Bytes)), 2)
    
End Function

Public Function CrcFromString(ByVal CData As String) As Long

  Dim Bytes() As Byte

  Bytes = CData
  CrcFromString = cal_crc(Bytes, UBound(Bytes))

End Function

Select allOpen in new window

But the problem is the missing answer, what charset is required/allowed in the data packets content.

See also:

Option Compare Database
Option Explicit

Public Sub aRunTest()
    
    Dim Bytes() As Byte
    Dim Data As String

    Data = "TEST"
    Bytes = Data
    Debug.Print Data; ";"; Len(Data); ";"; UBound(Bytes()); ";"; Hex(cal_crc(Bytes, Len(Data))); ";"; Hex(cal_crc(Bytes, UBound(Bytes())));
    Debug.Print HexDumpFromString(Data)
    Debug.Print HexDumpFromBytes(Bytes)
    
    Data = StrConv(Data, vbFromUnicode)
    Bytes = Data
    Debug.Print Data; ";"; Len(Data); ";"; UBound(Bytes()); ";"; Hex(cal_crc(Bytes, Len(Data))); ";"; Hex(cal_crc(Bytes, UBound(Bytes())))
    Debug.Print HexDumpFromString(Data)
    Debug.Print HexDumpFromBytes(Bytes)
    
End Sub

Public Function HexDumpFromBytes(ABytes() As Byte) As String

  Dim sLeft As String
  Dim sRight As String
  Dim iOffset As Integer
  Dim i As Integer
  Dim c As Byte
  Dim Result As String

  Result = ""
  sLeft = ""
  sRight = ""
  iOffset = 0
  For i = LBound(ABytes) To UBound(ABytes)
    c = ABytes(i)
    If (i > 0) And (i Mod 16 = 0) Then
      Result = Result & vbCrLf & LPad(Hex(iOffset), 4, "0") & " = " & sLeft & " | " & sRight
      Result = ""
      sRight = ""
      iOffset = iOffset + 16
    End If
  
    sLeft = sLeft & " " & LPad(Hex(c), 2, "0")
    If c > 31 And c < 127 Then
      sRight = sRight & Chr(c)
    Else
      sRight = sRight & "#"
    End If
  Next i
  
  If sLeft <> "" Then
    Result = Result & vbCrLf & LPad(Hex(iOffset), 4, "0") & " = " & RPad(sLeft, 48, " ") & " | " & sRight
  End If
  
  HexDumpFromBytes = Result
  
End Function

Public Function HexDumpFromString(ByVal CData As String) As String

  Dim Bytes() As Byte
  
  Bytes = CData
  HexDumpFromString = HexDumpFromBytes(Bytes)
  
End Function

Private Function cal_crc(ptr() As Byte, size As Integer) As Long
    Dim i As Byte
    Dim crc As Long
    Dim ptrIndex As Long

    crc = 0

    For ptrIndex = 0 To size - 1
        i = &H80
        Do While i <> 0
            If (crc And &H8000&) <> 0 Then
                crc = (crc * 2) And &HFFFF&
                crc = crc Xor &H18005
            Else
                crc = (crc * 2) And &HFFFF&
            End If
            If (ptr(ptrIndex) And i) <> 0 Then
                crc = crc Xor &H18005
            End If
            i = i / 2
        Loop
    Next ptrIndex

    cal_crc = crc And &HFFFF&
End Function

Private Function Dec2Bin(value As Long, Bytes As Long) As String
    Dim s As String
    Dim l As Integer
    Dim i As Integer
    
    Dec2Bin = ""
    
    s = Hex(value)
    l = Len(s)
    If l Mod 2 = 1 Then
        s = "0" & s
        l = Len(s)
    End If
    
    For i = l - 1 To 1 Step -2
        Dec2Bin = Chr("&H" & Mid(s, i, 2)) & Dec2Bin
    Next i
    
    If Len(Dec2Bin) < Bytes Then
        Dec2Bin = String(Bytes - Len(Dec2Bin), Chr(0)) & Dec2Bin
    End If

End Function

Private Function LPad(strText As String, intLen As Integer, chrPad As String) As String
  LPad = Right(String(intLen, chrPad) & strText, intLen)
End Function

Private Function RPad(strText As String, intLen As Integer, chrPad As String) As String
  RPad = Left(strText & String(intLen, chrPad), intLen)
End Function

Select allOpen in new window

One question that did come to mind as I was working back through this relates to the CRC calculation sample code they supply in their documentation.  That C++ code is included at the bottom of this comment.

Can you contact the vendor to clarify what the size of an unsigned int is in that routine?  I'm assuming that's 32 bits, but they only send 16 bits in the data packet as the CRC value.  So want to confirm.

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);
}

Select allOpen in new window

---

»bp

Also, are you going to run this on a 64 bit version of Office.  I think that will be needed since I believe I will need to use the LongLong data type in the VBA, which is only available in a 64 bit version of Office.

---

»bp

Thank you all for the great help on this matter I have just contacted the vendor , now being a Saturday today we will expect the answer on Monday morning. I'm running Ms Access 2016 32 BIT.

Regards

Chris

Is there any chance that you could switch to Access 64 bit, or is that out of the question?

---

»bp

Is there any chance that you could switch to Access 64 bit, or is that out of the question?

Actually, I worked on this a bit more and I think I have a working version of the CRC calcs that works with Long's and seems to produce the same result as the C++ logic.  I want to do some more testing / cleanup here, but this would work in 32 bit Office.

---

»bp

Btw, does the specs have some samples for CRC input and output? When not, then ask the vendor for some samples.

They should be part of the spec cause there are so many CRC flavors out there, that imho this mandatory.

After playing with CRC in C++ and Bill's translation, I found my basic error..

I was off by one (line 34) while calculating the value for the length. And using StrConv() seems to be the easiest charset solution:

Option Compare Database
Option Explicit

Public Sub aRunTest()

    Dim Bytes() As Byte
    Dim Data As String

    ReDim Bytes(3)
    Bytes(0) = &H54
    Bytes(1) = &H45
    Bytes(2) = &H53
    Bytes(3) = &H54
    Debug.Print "CRC: "; Hex(CrcFromBytes(Bytes))

    Data = "TEST"
    Debug.Print "CRC: "; Hex(CrcFromString(Data))

    ReDim Bytes(3)
    Bytes(0) = &H74
    Bytes(1) = &H65
    Bytes(2) = &H73
    Bytes(3) = &H74
    Debug.Print "CRC: "; Hex(CrcFromBytes(Bytes))

    Data = "test"
    Debug.Print "CRC: "; Hex(CrcFromString(Data))

End Sub

Public Function CrcFromBytes(AData() As Byte) As Long

  Debug.Print HexDumpFromBytes(AData)
  CrcFromBytes = InternalCalculateCrc(AData, UBound(AData) + 1)

End Function

Public Function CrcFromString(ByVal CData As String) As Long

  Dim Bytes() As Byte

  Bytes = StrConv(CData, vbFromUnicode)
  CrcFromString = CrcFromBytes(Bytes)

End Function

Private Function InternalCalculateCrc(AData() As Byte, ByVal CSize As Long) As Long

  Dim i As Byte
  Dim crc As Long
  Dim ptr As Long

  crc = 0
  For ptr = 0 To CSize - 1
    i = &H80
    Do While i <> 0
      If (crc And &H8000&) <> 0 Then
        crc = (crc * 2) And &HFFFF&
        crc = crc Xor &H18005
      Else
        crc = (crc * 2) And &HFFFF&
      End If

      If (AData(ptr) And i) <> 0 Then
        crc = crc Xor &H18005
      End If

      i = i / 2
    Loop
  Next ptr

  InternalCalculateCrc = crc And &HFFFF&

End Function

Public Function HexDumpFromBytes(ABytes() As Byte) As String

  Dim sLeft As String
  Dim sRight As String
  Dim iOffset As Integer
  Dim i As Integer
  Dim c As Byte
  Dim Result As String

  Result = ""
  sLeft = ""
  sRight = ""
  iOffset = 0
  For i = LBound(ABytes) To UBound(ABytes)
    c = ABytes(i)
    If (i > 0) And (i Mod 16 = 0) Then
      Result = Result & vbCrLf & LPad(Hex(iOffset), 4, "0") & " = " & sLeft & " | " & sRight
      Result = ""
      sRight = ""
      iOffset = iOffset + 16
    End If

    sLeft = sLeft & " " & LPad(Hex(c), 2, "0")
    If c > 31 And c < 127 Then
      sRight = sRight & Chr(c)
    Else
      sRight = sRight & "#"
    End If
  Next i

  If sLeft <> "" Then
    Result = Result & vbCrLf & LPad(Hex(iOffset), 4, "0") & " = " & RPad(sLeft, 48, " ") & " | " & sRight
  End If

  HexDumpFromBytes = Result

End Function

Private Function LPad(strText As String, intLen As Integer, chrPad As String) As String

  LPad = Right(String(intLen, chrPad) & strText, intLen)

End Function

Private Function RPad(strText As String, intLen As Integer, chrPad As String) As String

  RPad = Left(strText & String(intLen, chrPad), intLen)

End Function

Select allOpen in new window

returns the same CRC as in C++:

#include <iostream>

unsigned short int calculate_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++;
    }

    std::cout << "calculate_crc:\t" << std::hex << crc << "\n";
    return(crc);
}

int main(int argc, char* argv[])
{
    if (argc == 2) {
        unsigned char* data = reinterpret_cast<unsigned char*>(argv[1]);
        unsigned int data_length = strlen(argv[1]);
        std::cout << "data:\t\t" << data << "\n";
        std::cout << "data_length:\t" << data_length << "\n";
        unsigned short int crc = calculate_crc(data, data_length);
        std::cout << "CRC:\t\t" << crc << "\n";
    }
}

Select allOpen in new window

as a VS C++ console application compiled as x86 or as x64.

The CRC is 7ea1 for TEST and bcee for test now in all implementations and variants, so I assume it's correct without further samples to test.


And this is how I would implement it normally:

Option Compare Database
Option Explicit

#Const SHOW_DEBUG_INFO = True

Public Sub RunTest()
    
  Dim Bytes() As Byte
  Dim Data As String
  Dim Crc As Long
  
  ReDim Bytes(3)
  Bytes(0) = &H54
  Bytes(1) = &H45
  Bytes(2) = &H53
  Bytes(3) = &H54
  Crc = CrcFromBytes(Bytes)
    
  Data = "TEST"
  Crc = CrcFromString(Data, True)
    
  ReDim Bytes(3)
  Bytes(0) = &H74
  Bytes(1) = &H65
  Bytes(2) = &H73
  Bytes(3) = &H74
  Crc = CrcFromBytes(Bytes)
    
  Data = "test"
  Crc = CrcFromString(Data, True)
    
  Debug.Print "---"
  Debug.Print HexDumpFromString(BuildDatagram(Data), True)
   
End Sub

Public Function BinaryFromLong(ByVal CValue As Long, Optional ByVal CNumberOfBytes As Long = 4) As String

  Dim Count As Integer
  Dim HexString As String
  Dim Length As Integer
  Dim Result As String
  
  Result = ""
  HexString = Hex(CValue)
  Length = Len(HexString)
  If Length Mod 2 = 1 Then
    HexString = "0" & HexString
    Length = Len(HexString)
  End If
    
  For Count = Length - 1 To 1 Step -2
    Result = Chr("&H" & Mid(HexString, Count, 2)) & Result
  Next Count
   
  If Len(Result) < CNumberOfBytes Then
    Result = String(CNumberOfBytes - Len(Result), Chr(0)) & Result
  End If
  
  BinaryFromLong = Result

End Function

Public Function BuildDatagram(ByVal CContent As String) As String
    
  Const HEADER_BYTE_1 As Byte = &H1A
  Const HEADER_BYTE_2 As Byte = &H5D
  Const HEADER_SIGNING_MODE As Byte = 2
   
  Dim Data As String

  Data = Chr(HEADER_BYTE_1) & Chr(HEADER_BYTE_2) & Chr(HEADER_SIGNING_MODE) & BinaryFromLong(Len(CContent), 4) & CContent
  BuildDatagram = Data & BinaryFromLong(CrcFromString(Data, True), 2)
    
End Function

Public Function CrcFromBytes(AData() As Byte) As Long
  
  Const INITIAL_CRC As Long = 0
  
  Dim BitMask As Byte
  Dim Crc As Long
  Dim Index As Long

  Crc = INITIAL_CRC
  For Index = LBound(AData()) To UBound(AData())
    BitMask = &H80
    Do While BitMask <> 0
      If (Crc And &H8000&) <> 0 Then
        Crc = (Crc * 2) And &HFFFF&
        Crc = Crc Xor &H18005
      Else
        Crc = (Crc * 2) And &HFFFF&
      End If
      
      If (AData(Index) And BitMask) <> 0 Then
        Crc = Crc Xor &H18005
      End If
      
      BitMask = BitMask / 2
    Loop
  Next Index

  CrcFromBytes = Crc And &HFFFF&
#If SHOW_DEBUG_INFO Then
  Debug.Print HexDumpFromBytes(AData)
  Debug.Print "CRC: "; Hex(CrcFromBytes)
  Debug.Print
#End If

End Function

Public Function CrcFromString(ByVal CData As String, Optional ByVal CConvertFromUnicode = False) As Long

  Dim Data() As Byte
  
  If CConvertFromUnicode Then
    Data = StrConv(CData, vbFromUnicode)
  Else
    Data = CData
  End If
  
  CrcFromString = CrcFromBytes(Data)

End Function

Public Function HexDumpFromBytes(AData() As Byte) As String

  Const NON_PRINTABLE_CHAR As String = "·" ' Alt+0183
  
  Dim Char As Byte
  Dim CharValues As String
  Dim Count As Integer
  Dim HexValues As String
  Dim Result As String
  Dim Offset As Integer

  CharValues = ""
  HexValues = ""
  Result = ""
  Offset = 0
  For Count = LBound(AData) To UBound(AData)
    Char = AData(Count)
    If (Count > 0) And (Count Mod 16 = 0) Then
      Result = Result & vbCrLf & LPad(Hex(Offset), 8, "0") & " |" & HexValues & " | " & CharValues & " |"
      CharValues = ""
      HexValues = ""
      Offset = Offset + 16
    End If
  
    HexValues = HexValues & " " & LPad(Hex(Char), 2, "0")
    If Char > 31 And Char < 127 Then
      CharValues = CharValues & Chr(Char)
    Else
      CharValues = CharValues & NON_PRINTABLE_CHAR
    End If
  Next Count
  
  If HexValues <> "" Then
    Result = Result & vbCrLf & LPad(Hex(Offset), 8, "0") & " |" & RPad(HexValues, 48, " ") & " | " & CharValues
  End If
  
  If (Count > 0) And (Count Mod 16 > 0) Then
    Result = Result & " |"
  End If
    
  Result = "Offset   | 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F | 0123456789ABCDEF |" & Result & vbCrLf
  HexDumpFromBytes = Result
  
End Function

Public Function HexDumpFromString(ByVal CData As String, Optional ByVal CConvertFromUnicode = False) As String

  Dim Data() As Byte
  
  If CConvertFromUnicode Then
    Data = StrConv(CData, vbFromUnicode)
  Else
    Data = CData
  End If
  
  HexDumpFromString = HexDumpFromBytes(Data)
  
End Function

Public Function LPad(ByVal CText As String, ByVal CLength As Integer, ByVal CPaddingCharacter As String) As String

  LPad = Right(String(CLength, CPaddingCharacter) & CText, CLength)
  
End Function

Public Function RPad(ByVal CText As String, ByVal CLength As Integer, ByVal CPaddingCharacter As String) As String

  RPad = Left(CText & String(CLength, CPaddingCharacter), CLength)
  
End Function

Select allOpen in new window

EE29175444.accdb

Consider a better structural approach..
EE29175444-.accdb

Thank you so much to both of you BP & Ste5an for the great job you have done so far , I will pick up the gadget from the taxman this evening and test all your suggestions , then i will provide the results very soon together with the length of the unsigned Int.

So far the taxman provided the same CRC in python also , see below:

def crc(self, data: Bytes, poly = 0x18005):
  ""
": param data: byte array of data: param poly:
  : return :CRC value of input data
crc = 0x0000
for b in data:
  ""
"
cur_byte = 0xFF & b
i = 0x80
for _ in range(0, 8):
  if crc & 0x8000! = 0:
  crc = (crc << 1) ^ poly

else :

  crc <<= 1
if cur_byte & i != 0:
  crc = crc ^ poly
i >>= 1
return crc & 0xFFFF

Select allOpen in new window

Ask the vendor for sample data, files or strings, and their CRC for testing.

Thank you so much ste5an , kindly see the screen shoot for the Python CRC computation based on "abcd" data.



I hope this will help


Regards

Chris

Thank you so much ste5an , kindly see the screen shoot for the Python CRC computation based on "abcd" data.

That is the result my latest code yields now, and I believe ste5an's code will produce same (it was matching mine in other tests last night).

---

»bp

Thank you so much BP, I will test this evening and report back soon.

Many many thank for the hard work.

Regards

Chris

After a further review, your logic contains too much dead code. That the request JSON looks okay is mere coincidence. E.g. from your code above:

Set rs = qdf.OpenRecordset(dbOpenSnapshot, dbSeeChanges)
Set qdf = Nothing
rs.MoveFirst
Do While Not rs.EOF
	Set transaction = New Dictionary
	transaction.Add "PosVendor", "Nector Prime Accounting Solutions"        
	transaction.Add "PosSerialNumber", Nz(Me.Id.Column(1), "")
' [..]
	'--- loop over all the items
	itemCount = Me.txtsquence
	Set items = New Collection
	For i = 1 To itemCount
		Set item = New Dictionary
		item.Add "ItemId", i
		item.Add "Description", DLookup("ProductName", "QryJsonPos", "ItemSoldID =" & Me.ItemSoldID & " AND ItemesID =" & CStr(i))
' [..]            
		items.Add item
	Next i
	
	transaction.Add "Items", items        
	rs.MoveNext
Loop   

Select allOpen in new window

You're creating a recordset, but you don't use it during the export.

Then there are unused loops (j, t).

Remember when I said "Consider a better structural approach.."?
This is no longer an option. You need to clean up your code!

Attached the code how I think it should look like. It should work after you've copied the modules and the forms code.
EE29175444.accdb

Again, ask the vendor for data samples with their CRC's.

I'm pretty sure, that also python has some implementation details, which can return some different values in edge cases.

Thank you so much ste5an , kindly see the screen shoot for the Python CRC computation based on "abcd" data.

Why do you use a different string than I? Using a different string means you cannot compare it easily. And why don't you run it in one of the above sample databases..?!


My code samples are not just an illustration. They are meant to be examined by you. Take them, copy them into your (test) database, and play with them. That is the only way to gain deeper understanding.

Dear ste5an;

Thank you so much for the advice I will clean up that , below is the latest dump data as per your requirements:

0000 =  1A 5D 02 00 00 03 6B 7B 0D 0A 20 20 20 22 50 6F | ]k{   "Po
0010 =  73 56 65 6E 64 6F 72 22 3A 20 22 4E 65 63 74 6F | sVendor": "Necto
0020 =  72 20 50 72 69 6D 65 20 41 63 63 6F 75 6E 74 69 | r Prime Accounti
0030 =  6E 67 20 53 6F 6C 75 74 69 6F 6E 73 22 2C 0D 0A | ng Solutions",
0040 =  20 20 20 22 50 6F 73 53 6F 66 74 77 61 72 65 56 |    "PosSoftwareV
0050 =  65 72 73 69 6F 6E 22 3A 20 22 32 2E 30 2E 30 2E | ersion": "2.0.0.
0060 =  31 22 2C 0D 0A 20 20 20 22 50 6F 73 4D 6F 64 65 | 1",   "PosMode
0070 =  6C 22 3A 20 22 43 61 70 2D 32 30 31 37 22 2C 0D | l": "Cap-2017",
0080 =  0A 20 20 20 22 50 6F 73 53 65 72 69 61 6C 4E 75 |    "PosSerialNu
0090 =  6D 62 65 72 22 3A 20 22 31 30 30 31 30 30 30 30 | mber": "10010000
00A0 =  31 38 32 39 22 2C 0D 0A 20 20 20 22 49 73 73 75 | 1829",   "Issu
00B0 =  65 54 69 6D 65 22 3A 20 22 32 30 32 30 30 33 31 | eTime": "2020031
00C0 =  36 31 35 33 32 31 32 22 2C 0D 0A 20 20 20 22 54 | 6153212",   "T
00D0 =  72 61 6E 73 61 63 74 69 6F 6E 54 79 70 65 22 3A | ransactionType":
00E0 =  20 30 2C 0D 0A 20 20 20 22 50 61 79 6D 65 6E 74 |  0,   "Payment
00F0 =  4D 6F 64 65 22 3A 20 30 2C 0D 0A 20 20 20 22 53 | Mode": 0,   "S
0100 =  61 6C 65 54 79 70 65 22 3A 20 22 22 2C 0D 0A 20 | aleType": "", 
0110 =  20 20 22 4C 6F 63 61 6C 50 75 72 63 68 61 73 65 |   "LocalPurchase
0120 =  4F 72 64 65 72 22 3A 20 22 22 2C 0D 0A 20 20 20 | Order": "",   
0130 =  22 43 61 73 68 69 65 72 22 3A 20 22 41 64 6D 69 | "Cashier": "Admi
0140 =  6E 20 4D 61 6E 61 67 65 72 22 2C 0D 0A 20 20 20 | n Manager",   
0150 =  22 42 75 79 65 72 54 50 49 4E 22 3A 20 22 22 2C | "BuyerTPIN": "",
0160 =  0D 0A 20 20 20 22 42 75 79 65 72 4E 61 6D 65 22 |    "BuyerName"
0170 =  3A 20 22 22 2C 0D 0A 20 20 20 22 42 75 79 65 72 | : "",   "Buyer
0180 =  54 61 78 41 63 63 6F 75 6E 74 4E 61 6D 65 22 3A | TaxAccountName":
0190 =  20 22 22 2C 0D 0A 20 20 20 22 42 75 79 65 72 41 |  "",   "BuyerA
01A0 =  64 64 72 65 73 73 22 3A 20 22 22 2C 0D 0A 20 20 | ddress": "",  
01B0 =  20 22 42 75 79 65 72 54 65 6C 22 3A 20 22 22 2C |  "BuyerTel": "",
01C0 =  0D 0A 20 20 20 22 4F 72 69 67 69 6E 61 6C 49 6E |    "OriginalIn
01D0 =  76 6F 69 63 65 43 6F 64 65 22 3A 20 22 22 2C 0D | voiceCode": "",
01E0 =  0A 20 20 20 22 4F 72 69 67 69 6E 61 6C 49 6E 76 |    "OriginalInv
01F0 =  6F 69 63 65 4E 75 6D 62 65 72 22 3A 20 22 22 2C | oiceNumber": "",
0200 =  0D 0A 20 20 20 22 4D 65 6D 6F 22 3A 20 22 22 2C |    "Memo": "",
0210 =  0D 0A 20 20 20 22 49 74 65 6D 73 22 3A 20 5B 0D |    "Items": [
0220 =  0A 20 20 20 20 20 20 7B 0D 0A 20 20 20 20 20 20 |       {      
0230 =  20 20 20 22 49 74 65 6D 49 64 22 3A 20 31 2C 0D |    "ItemId": 1,
0240 =  0A 20 20 20 20 20 20 20 20 20 22 44 65 73 63 72 |          "Descr
0250 =  69 70 74 69 6F 6E 22 3A 20 22 43 6C 65 61 6E 69 | iption": "Cleani
0260 =  6E 67 20 4D 61 74 65 72 69 61 6C 73 22 2C 0D 0A | ng Materials",
0270 =  20 20 20 20 20 20 20 20 20 22 42 61 72 43 6F 64 |          "BarCod
0280 =  65 22 3A 20 31 39 2C 0D 0A 20 20 20 20 20 20 20 | e": 19,       
0290 =  20 20 22 51 75 61 6E 74 69 74 79 22 3A 20 31 2C |   "Quantity": 1,
02A0 =  0D 0A 20 20 20 20 20 20 20 20 20 22 55 6E 69 74 |          "Unit
02B0 =  50 72 69 63 65 22 3A 20 35 36 2C 0D 0A 20 20 20 | Price": 56,   
02C0 =  20 20 20 20 20 20 22 44 69 73 63 6F 75 6E 74 22 |       "Discount"
02D0 =  3A 20 30 2C 0D 0A 20 20 20 20 20 20 20 20 20 22 | : 0,         "
02E0 =  54 61 78 4C 61 62 65 6C 73 22 3A 20 5B 0D 0A 20 | TaxLabels": [ 
02F0 =  20 20 20 20 20 20 20 20 20 20 20 22 41 22 0D 0A |            "A"
0300 =  20 20 20 20 20 20 20 20 20 5D 2C 0D 0A 20 20 20 |          ],   
0310 =  20 20 20 20 20 20 22 54 6F 74 61 6C 41 6D 6F 75 |       "TotalAmou
0320 =  6E 74 22 3A 20 36 34 2E 39 36 2C 0D 0A 20 20 20 | nt": 64.96,   
0330 =  20 20 20 20 20 20 22 49 73 54 61 78 49 6E 63 6C |       "IsTaxIncl
0340 =  75 73 69 76 65 22 3A 20 74 72 75 65 2C 0D 0A 20 | usive": true, 
0350 =  20 20 20 20 20 20 20 20 22 52 52 50 22 3A 20 30 |         "RRP": 0
0360 =  0D 0A 20 20 20 20 20 20 7D 0D 0A 20 20 20 5D 0D |       }   ]
0370 =  0A 7D 70 D9                                     | }p

Select allOpen in new window

Regards

Chris

Here is what the taxman the vendor replied to me:


Like I pointed out in my last email, I have no idea what you mean by unsigned int, please use google for the general programming queries you have.


I'm now complete stuck. I do not know whether to give up or not.


However thank you so BP for the great you have done so far it will sure help me pursuing this project further .


Regards
Chris

I believe at this point we are calculating the CRC value properly, so I would suggest you do a test with the device and using the most recent code changes.  It wasn't being calculated properly before, so it may change the results now.

---

»bp

Thank you so much bp,

I will surely follow your advice.


Regards

Chris

Also, I'm not sure of the details on the device interface, but looking at the Word document that describes the protocol, it seems to me that before you can do "transactions" you have to "initialize" the ESD device by sending it a GetStatus command (type 1).  But I don't think your code is doing that.

Honestly, their documentation isn't the best, so it's hard for me to tell how and when this should happen.  Or if you have already done it using some configuration utility or tool they have provided?

---

»bp

Dear BP;

Thank you so much for the great job, it seam like you have fixed the problem at-least to the response stage & sending data, for the first time I'm  getting an error number 1046 from the gadget, you can see it from the same document you have and I have fixed that one.

The remaining part is now how to put the received Json data into the table, that is where I have some challenges. I have also opened a new question for same in order to avoid confusion & also I have attached a working sample database for easy referencing.






See also the actual database sample
MathChris2020.accdb

Excellent, glad to hear you made some progress and have moved forward a bit - making progress!  Sorry that took so long, but an interesting question.

---

»bp

Thank you so much BP without your great help nothing would have worked.

Many thanks once again

Regards

Chris