0x1A
( the C++ code is 0x1A)Ox5D
( the C++ code is Ox5D)0x 02
as C++ codeConst header1 = &H1A
Const header2 = &H5D
Const cmdSigning = 2
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
' 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:
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
n
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
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
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
Public Function CrcFromString(ByVal CData As String) As Long
Dim Bytes() As Byte
Bytes = CData
CrcFromString = cal_crc(Bytes, UBound(Bytes))
End Function
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
The length of the string is not the length of the byte array. 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
But the problem is the missing answer, what charset is required/allowed in the data packets content.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
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);
}
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.
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
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";
}
}
as a VS C++ console application compiled as x86 or as x64.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
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.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).
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
You're creating a recordset, but you don't use it during the export. 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..?!
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
What about posting to original C source as well as yours with test methods?