How to correct the writing of data into the serial port
Dear Experts!
Here is my problem in Ms Access VBA Code , the code which is supposed to write to the serial port is not fed with data as a result it cannot write anything to the port, below is the actual peice of code that require fixing:
VBA CODE 1
' Write data to serial port.
Audit proof
If I send the same data to a text file , I'm able to see the actual Json data in text form by using the CODE below:
VBA CODE 2
See also screen shoot which confirms that there is no data at all written the port:
Here is my problem in Ms Access VBA Code , the code which is supposed to write to the serial port is not fed with data as a result it cannot write anything to the port, below is the actual peice of code that require fixing:
VBA CODE 1
' Write data to serial port.
strData = JsonConverter.ConvertToJson(transaction, Whitespace:=3) & Chr$(13)
lngStatus = CommWrite(intPortID, strData)
lngSize = Len(strData)
If lngStatus <> lngSize Then
Beep
MsgBox "No data found"
' Handle error.
End If
Audit proof
If I send the same data to a text file , I'm able to see the actual Json data in text form by using the CODE below:
VBA CODE 2
Dim json As String
Dim theFileName As Variant
json = JsonConverter.ConvertToJson(transaction, Whitespace:=3) & Chr$(13)
theFileName = "C:\Users\admini\Desktop\Leaders\VBA Json.txt"
Dim handle As Integer
handle = FreeFile
Open theFileName For Output As #handle
Print #handle, json 'jsonSerialization
Close #handle
See also screen shoot which confirms that there is no data at all written the port:
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
The problem is just on sending & receiving.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thank you so much for the kindness , this is really a thorn to me, I just hope you will accomodate me when I come back.
Once again highly appreciated.
Regards
Chris
Once again highly appreciated.
Regards
Chris
ASKER
I have done two codes below by implement the instructions given , but still the data is not going:
VBA Code for Sending Json string & writing
CRC Function VBA Code
VBA Code for Sending Json string & writing
Dim json As String
Dim intPortID As Integer ' Ex. 1, 2, 3, 4 for COM1 - COM4
Dim lngStatus As Long
Dim strError As String
Dim strData As String
Dim strDataToSend As String
Dim lngSize As Long
intPortID = Forms!frmLogin!txtFinComPort.Value
' Initialize Communications
lngStatus = CommOpen(intPortID, "COM" & CStr(intPortID), _
"baud=115200 parity=N data=8 stop=1")
If lngStatus <> 0 Then
' Handle error.
lngStatus = CommGetError(strError)
MsgBox "COM Error: " & strError
End If
' Set modem control lines.
lngStatus = CommSetLine(intPortID, LINE_RTS, True)
lngStatus = CommSetLine(intPortID, LINE_DTR, True)
' Write data to serial port.
Dim Start As String
Dim strTMP As String
Dim strLength As String, L As Long, L1 As Integer, L2 As Integer, L3 As Integer, L4 As Integer
strData = JsonConverter.ConvertToJson(transaction, Whitespace:=3) & Chr$(13)
Start = Chr(&H1A) & Chr(&H5D)
L = Len(strData) 'Only length of content string. May be start, length and CRC should be added L = Len(strData) + 9 (or 7 without CRC)
L1 = L Mod 256
L2 = (L - L1) / 256 Mod 256
L3 = ((L - L1) / 256 - L2) / 256 Mod 256
L4 = (((L - L1) / 256 - L2) / 256 - L3) / 256 Mod 256
strLength = Chr(L4) & Chr(L3) & Chr(L2) & Chr(L1)
strTMP = Start & Chr(2) & strLength & strData
strTMP = strTMP & strData
'You need function for CRC calculation
strTMP = strTMP & CRC(strTMP)
lngStatus = CommWrite(intPortID, strTMP)
lngSize = Len(strData)
If lngStatus <> lngSize Then
' Handle error.
Exit_CmdPosJsons_Click:
Exit Sub
Err_Handler:
Resume Exit_CmdPosJsons_Click
End If
' Read maximum of 64 bytes from serial port.
Dim JSONS As Object
Dim Itemiz As Object
lngStatus = CommRead(intPortID, strTMP, 14400)
Set rs = db.OpenRecordset("tblEfdReceiptsPOS")
If lngStatus > 0 Then
Set JSONS = ParseJson(strTMP)
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
.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
CRC Function VBA Code
Public Function calculateCRC8(ByVal AppID As String) As String
Dim CRC8 As Byte
Dim i As Integer
Dim J As Integer
Dim AppIDarray() As Byte '<--- explicitly dimensioned as a Byte array to avoid confusion
Dim aidLength As Long
CRC8 = &HC7
'The AppID is actually bytes stored in hexadecimal in a string. You have to convert them back to bytes before you can run a crc8 on them.
AppIDarray = HexToByte(AppID)
aidLength = UBound(AppIDarray)
For J = 0 To aidLength
CRC8 = CRC8 Xor AppIDarray(J)
For i = 1 To 8
If CRC8 And &H80 Then
'masking off the left-most bit before shifting prevents the Overflow error.
CRC8 = ((&H7F And CRC8) * 2) Xor &H1D
Else
CRC8 = CRC8 * 2
End If
Next i
Next J
calculateCRC8 = CRC8
End Function
Public Function HexToByte(strHex As String) As Byte()
Dim i As Integer
Dim tempByte As Byte
Dim outBytes() As Byte
ReDim outBytes(Len(strHex) \ 2 - 1)
For i = 0 To Len(strHex) \ 2 - 1
Dim J As Integer
Dim char As String
For J = 0 To 1
char = Mid(strHex, i * 2 + J + 1, 1)
Select Case char
Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9":
tempByte = tempByte Or (Asc(char) - 48)
Case "A", "B", "C", "D", "E", "F":
tempByte = tempByte Or (Asc(char) - 55)
End Select
If J = 0 Then
tempByte = tempByte * 2 ^ 4
Else
outBytes(i) = tempByte
tempByte = 0
End If
Next
Next
HexToByte = outBytes
End Function
ASKER
Dim intPortID As Integer ' Ex. 1, 2, 3, 4 for COM1 - COM4
Dim lngStatus As Long
Dim strError As String
Dim strData As String
Dim strDataToSend As String
Dim lngSize As Long
intPortID = Forms!frmLogin!txtFinComPo
' 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
ElseIf lngStatus = 0 Then
Beep
MsgBox "The port is Open"
End If
' Set modem control lines.
lngStatus = CommSetLine(intPortID, LINE_RTS, True)
lngStatus = CommSetLine(intPortID, LINE_DTR, True)
' Write data to serial port.
Dim Start As String
Dim strTMP As String
Dim strLength As String, L As Long, L1 As Integer, L2 As Integer, L3 As Integer, L4 As Integer
Start = Chr(&H1A) & Chr(&H5D)
L = Len(strData) 'Only length of content string. May be start, length and CRC should be added
L1 = L Mod 256
L2 = (L - L1) / 256 Mod 256
L3 = ((L - L1) / 256 - L2) / 256 Mod 256
L4 = (((L - L1) / 256 - L2) / 256 - L3) / 256 Mod 256
strLength = Chr(L4) & Chr(L3) & Chr(L2) & Chr(L1)
'next string is filled with command 2 - I'm not sure is it correct or not
strTMP = Start & strLength & Chr(2) & strData
strData = JsonConverter.ConvertToJso
lngStatus = CommWrite(intPortID, strData)
lngSize = Len(strData)
If lngStatus <> lngSize Then
Beep
MsgBox "No data found"
' Handle error.
End If
' Read maximum of 64 bytes from serial port.
Dim Customers As Collection
Dim Itemize As Variant
lngStatus = CommRead(intPortID, strData, 14400)
Set rs = db.OpenRecordset("tblEfdRe
If lngStatus > 0 Then
Set Customers = 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 Itemize In Customers
With rs
.AddNew
rs![TPIN] = Itemize("TPIN")
rs![TaxpayerName] = Itemize("TaxpayerName")
rs![Address] = Itemize("Address")
rs![ESDTime] = Itemize("ESDTime")
rs![TerminalID] = Itemize("TerminalID")
rs![InvoiceCode] = Itemize("InvoiceCode")
rs![InvoiceNumber] = Itemize("InvoiceNumber")
rs![FiscalCode] = Itemize("FiscalCode")
rs![TalkTime] = Itemize("TalkTime")
rs![Operator] = Itemize("Operator")
rs![Taxlabel] = Itemize("TaxItems")("TaxLa
rs![CategoryName] = Itemize("TaxItems")("Categ
rs![Rate] = Itemize("TaxItems")("Rate"
rs![TaxAmount] = Itemize("TaxItems")("TaxAm
rs![TotalAmount] = Itemize("TaxItems")("Total
rs![VerificationUrl] = Itemize("TaxItems")("Verif
rs![INVID] = Me.ItemSoldID
.Update
End With
Z = Z + 1
Next
rs.Close
Set rs = Nothing
Set db = Nothing
Set Customers = Nothing
' Reset modem control lines.
lngStatus = CommSetLine(intPortID, LINE_RTS, False)
lngStatus = CommSetLine(intPortID, LINE_DTR, False)
' Close communications.
Call CommClose(intPortID)
End Sub
CRC details
You also wanted the details for the CRC , kindly see below:
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);
}