- Microsoft Access
- VBA
- Golang
Help required to convert C++ Code to VBA in Ms Access
I need help to convert the header 1 , 2 & commandID C++ Code into VBA so that I can easily code them into a proper VBA serial Packet :
C++ codes
Header1 = The first byte of package header
Header2 = The second byte of package header
CommandID =
Example of the VBA Code for the three above C++ codes
' First two bytes of data packet are always these
' 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:
Current Dump results:
C++ codes
Header1 = The first byte of package header
0x1A
Header2 = The second byte of package header
Ox5D
CommandID =
0x 02
Example of the VBA Code for the three above C++ codes
' First two bytes of data packet are always these
Const header1 = &H1A
Const header2 = &H5D
Const cmdSigning = 2
' 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:
Current Dump results:
0000 = 1A 5D 02 00 00 07 75 7B 0D 0A 20 20 20 22 50 6F | ]u{ "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 = 32 32 31 34 34 34 37 22 2C 0D 0A 20 20 20 22 54 | 2214447", "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 46 75 72 69 74 79 | iption": "Furity
0260 = 20 44 72 69 6E 6B 20 6D 6C 73 20 33 35 30 22 2C | Drink mls 350",
0270 = 0D 0A 20 20 20 20 20 20 20 20 20 22 42 61 72 43 | "BarC
0280 = 6F 64 65 22 3A 20 31 34 2C 0D 0A 20 20 20 20 20 | ode": 14,
0290 = 20 20 20 20 22 51 75 61 6E 74 69 74 79 22 3A 20 | "Quantity":
02A0 = 31 2C 0D 0A 20 20 20 20 20 20 20 20 20 22 55 6E | 1, "Un
02B0 = 69 74 50 72 69 63 65 22 3A 20 38 32 2E 37 36 2C | itPrice": 82.76,
02C0 = 0D 0A 20 20 20 20 20 20 20 20 20 22 44 69 73 63 | "Disc
02D0 = 6F 75 6E 74 22 3A 20 30 2C 0D 0A 20 20 20 20 20 | ount": 0,
02E0 = 20 20 20 20 22 54 61 78 4C 61 62 65 6C 73 22 3A | "TaxLabels":
02F0 = 20 5B 0D 0A 20 20 20 20 20 20 20 20 20 20 20 20 | [
0300 = 22 41 22 0D 0A 20 20 20 20 20 20 20 20 20 5D 2C | "A" ],
0310 = 0D 0A 20 20 20 20 20 20 20 20 20 22 54 6F 74 61 | "Tota
0320 = 6C 41 6D 6F 75 6E 74 22 3A 20 39 36 2E 30 30 31 | lAmount": 96.001
0330 = 36 2C 0D 0A 20 20 20 20 20 20 20 20 20 22 49 73 | 6, "Is
0340 = 54 61 78 49 6E 63 6C 75 73 69 76 65 22 3A 20 74 | TaxInclusive": t
0350 = 72 75 65 2C 0D 0A 20 20 20 20 20 20 20 20 20 22 | rue, "
0360 = 52 52 50 22 3A 20 39 36 0D 0A 20 20 20 20 20 20 | RRP": 96
0370 = 7D 2C 0D 0A 20 20 20 20 20 20 7B 0D 0A 20 20 20 | }, {
0380 = 20 20 20 20 20 20 22 49 74 65 6D 49 64 22 3A 20 | "ItemId":
0390 = 32 2C 0D 0A 20 20 20 20 20 20 20 20 20 22 44 65 | 2, "De
03A0 = 73 63 72 69 70 74 69 6F 6E 22 3A 20 22 4D 69 78 | scription": "Mix
03B0 = 65 64 20 46 72 75 69 74 65 20 44 72 69 6E 6B 20 | ed Fruite Drink
03C0 = 33 35 30 20 6D 6C 73 22 2C 0D 0A 20 20 20 20 20 | 350 mls",
03D0 = 20 20 20 20 22 42 61 72 43 6F 64 65 22 3A 20 31 | "BarCode": 1
03E0 = 36 2C 0D 0A 20 20 20 20 20 20 20 20 20 22 51 75 | 6, "Qu
03F0 = 61 6E 74 69 74 79 22 3A 20 31 2C 0D 0A 20 20 20 | antity": 1,
0400 = 20 20 20 20 20 20 22 55 6E 69 74 50 72 69 63 65 | "UnitPrice
0410 = 22 3A 20 38 32 2E 37 36 2C 0D 0A 20 20 20 20 20 | ": 82.76,
0420 = 20 20 20 20 22 44 69 73 63 6F 75 6E 74 22 3A 20 | "Discount":
0430 = 30 2C 0D 0A 20 20 20 20 20 20 20 20 20 22 54 61 | 0, "Ta
0440 = 78 4C 61 62 65 6C 73 22 3A 20 5B 0D 0A 20 20 20 | xLabels": [
0450 = 20 20 20 20 20 20 20 20 20 22 41 22 0D 0A 20 20 | "A"
0460 = 20 20 20 20 20 20 20 5D 2C 0D 0A 20 20 20 20 20 | ],
0470 = 20 20 20 20 22 54 6F 74 61 6C 41 6D 6F 75 6E 74 | "TotalAmount
0480 = 22 3A 20 39 36 2E 30 30 31 36 2C 0D 0A 20 20 20 | ": 96.0016,
0490 = 20 20 20 20 20 20 22 49 73 54 61 78 49 6E 63 6C | "IsTaxIncl
04A0 = 75 73 69 76 65 22 3A 20 74 72 75 65 2C 0D 0A 20 | usive": true,
04B0 = 20 20 20 20 20 20 20 20 22 52 52 50 22 3A 20 39 | "RRP": 9
04C0 = 36 0D 0A 20 20 20 20 20 20 7D 2C 0D 0A 20 20 20 | 6 },
04D0 = 20 20 20 7B 0D 0A 20 20 20 20 20 20 20 20 20 22 | { "
04E0 = 49 74 65 6D 49 64 22 3A 20 33 2C 0D 0A 20 20 20 | ItemId": 3,
04F0 = 20 20 20 20 20 20 22 44 65 73 63 72 69 70 74 69 | "Descripti
0500 = 6F 6E 22 3A 20 22 4F 72 61 6E 67 65 20 44 72 69 | on": "Orange Dri
0510 = 6E 6B 20 33 35 30 20 6D 6C 73 22 2C 0D 0A 20 20 | nk 350 mls",
0520 = 20 20 20 20 20 20 20 22 42 61 72 43 6F 64 65 22 | "BarCode"
0530 = 3A 20 31 33 2C 0D 0A 20 20 20 20 20 20 20 20 20 | : 13,
0540 = 22 51 75 61 6E 74 69 74 79 22 3A 20 31 2C 0D 0A | "Quantity": 1,
0550 = 20 20 20 20 20 20 20 20 20 22 55 6E 69 74 50 72 | "UnitPr
0560 = 69 63 65 22 3A 20 38 32 2E 37 36 2C 0D 0A 20 20 | ice": 82.76,
0570 = 20 20 20 20 20 20 20 22 44 69 73 63 6F 75 6E 74 | "Discount
0580 = 22 3A 20 30 2C 0D 0A 20 20 20 20 20 20 20 20 20 | ": 0,
0590 = 22 54 61 78 4C 61 62 65 6C 73 22 3A 20 5B 0D 0A | "TaxLabels": [
05A0 = 20 20 20 20 20 20 20 20 20 20 20 20 22 41 22 0D | "A"
05B0 = 0A 20 20 20 20 20 20 20 20 20 5D 2C 0D 0A 20 20 | ],
05C0 = 20 20 20 20 20 20 20 22 54 6F 74 61 6C 41 6D 6F | "TotalAmo
05D0 = 75 6E 74 22 3A 20 39 36 2E 30 30 31 36 2C 0D 0A | unt": 96.0016,
05E0 = 20 20 20 20 20 20 20 20 20 22 49 73 54 61 78 49 | "IsTaxI
05F0 = 6E 63 6C 75 73 69 76 65 22 3A 20 74 72 75 65 2C | nclusive": true,
0600 = 0D 0A 20 20 20 20 20 20 20 20 20 22 52 52 50 22 | "RRP"
0610 = 3A 20 39 36 0D 0A 20 20 20 20 20 20 7D 2C 0D 0A | : 96 },
0620 = 20 20 20 20 20 20 7B 0D 0A 20 20 20 20 20 20 20 | {
0630 = 20 20 22 49 74 65 6D 49 64 22 3A 20 34 2C 0D 0A | "ItemId": 4,
0640 = 20 20 20 20 20 20 20 20 20 22 44 65 73 63 72 69 | "Descri
0650 = 70 74 69 6F 6E 22 3A 20 22 50 69 6E 65 61 70 6C | ption": "Pineapl
0660 = 65 20 20 44 72 69 6E 6B 20 33 35 30 20 6D 6C 73 | e Drink 350 mls
0670 = 22 2C 0D 0A 20 20 20 20 20 20 20 20 20 22 42 61 | ", "Ba
0680 = 72 43 6F 64 65 22 3A 20 31 35 2C 0D 0A 20 20 20 | rCode": 15,
0690 = 20 20 20 20 20 20 22 51 75 61 6E 74 69 74 79 22 | "Quantity"
06A0 = 3A 20 31 2C 0D 0A 20 20 20 20 20 20 20 20 20 22 | : 1, "
06B0 = 55 6E 69 74 50 72 69 63 65 22 3A 20 38 32 2E 37 | UnitPrice": 82.7
06C0 = 36 2C 0D 0A 20 20 20 20 20 20 20 20 20 22 44 69 | 6, "Di
06D0 = 73 63 6F 75 6E 74 22 3A 20 30 2C 0D 0A 20 20 20 | scount": 0,
06E0 = 20 20 20 20 20 20 22 54 61 78 4C 61 62 65 6C 73 | "TaxLabels
06F0 = 22 3A 20 5B 0D 0A 20 20 20 20 20 20 20 20 20 20 | ": [
0700 = 20 20 22 41 22 0D 0A 20 20 20 20 20 20 20 20 20 | "A"
0710 = 5D 2C 0D 0A 20 20 20 20 20 20 20 20 20 22 54 6F | ], "To
0720 = 74 61 6C 41 6D 6F 75 6E 74 22 3A 20 39 36 2E 30 | talAmount": 96.0
0730 = 30 31 36 2C 0D 0A 20 20 20 20 20 20 20 20 20 22 | 016, "
0740 = 49 73 54 61 78 49 6E 63 6C 75 73 69 76 65 22 3A | IsTaxInclusive":
0750 = 20 74 72 75 65 2C 0D 0A 20 20 20 20 20 20 20 20 | true,
0760 = 20 22 52 52 50 22 3A 20 39 36 0D 0A 20 20 20 20 | "RRP": 96
0770 = 20 20 7D 0D 0A 20 20 20 5D 0D 0A 7D 38 F4 | } ]}8
With the given information, your dump looks correct.
What about posting to original C source as well as yours with test methods?
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:
Okay, on to this new question. You mention:
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
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
»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
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
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
»bp
Thank you BP for the help this is really tough for me , I have encountered this issue before.
Regards
Chris
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
»bp
Well, as far as I can tell from a quick test using 2016:
![Capture.PNG]()
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:
![Capture.PNG]()
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
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
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
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
»bp
It's about the parameters when calling the functions:
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:
See also:
![Capture.PNG]()
Public Function CrcFromString(ByVal CData As String) As Long
Dim Bytes() As Byte
Bytes = CData
CrcFromString = cal_crc(Bytes, UBound(Bytes))
End Function
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
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
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
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.
»bp
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);
}
»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
»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
Regards
Chris
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.
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:
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.
![Capture.PNG]()
![Capture.PNG]()
And this is how I would implement it normally:
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
#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";
}
}
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
Worked on this a bit further and found a few issues. Depending on feedback from the vendor, I think this may get you to correct CRC added to the packet.
»bp
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 = StrConv(dataString, vbFromUnicode)
' 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 Function
»bp
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:
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
Thank you so much ste5an , kindly see the screen shoot for the Python CRC computation based on "abcd" data.
![Screen-of-Crc-Python-value.png]()
I hope this will help
Regards
Chris
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
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:
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
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
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.
![Capture.PNG]()
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.
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:
Regards
Chris
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
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
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
»bp
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?
![sshot-167.png]()
![sshot-168.png]()
»bp
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.
![main-error-1024.png]()
![parsing-Json.png]()
See also the actual database sample
MathChris2020.accdb
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
Premium Content
You need an Expert Office subscription to comment.Start Free Trial