Android Question CRC16A problrem

Olaan · Jan 25, 2023

I would like the experts to help me about the code ,I have VB6.0 code is

Code:

Function CRC16A(buffer() As Byte) As Long

Dim i As Long
Dim Temp As Long
Dim crc As Long
Dim j As Integer
    crc = &HFFFF&
    For i = LBound(buffer) To UBound(buffer)
        Temp = buffer(i) * &H100&
        crc = crc Xor Temp
           
           For j = 0 To 7
                If (crc And &H8000&) Then
                    crc = ((crc * 2) Xor &H1021&) And &HFFFF&
                Else
                    crc = (crc * 2) And &HFFFF&
                End If
            Next j
Next i
CRC16A = crc And &HFFFF
    
End Function

and

Code:

...
...
Dim m As String
m = IIf(Val(Text5.Text) = 0, QRCodePromptPayPart1 & QRCodePromptPayPart3, QRCodePromptPayPart1 & QRCodePromptPayPart2 & QRCodePromptPayPart3)
Dim aBuf() As Byte
    
    Dim crc As Long
    
    aBuf = StrConv(m, vbFromUnicode)

    
     crc = CRC16A(aBuf)
    
    
    QRCodePromptPayIs = m & Hex(crc)
...
...

I would like to use in B4A ,I don't know how to code these line as belows

Code:

    aBuf = StrConv(m, vbFromUnicode)

and

Code:

  QRCodePromptPayIs = m & Hex(crc)

I have coded function CRC() is belows

Code:

Private Sub CRC16A(Buffer() As Byte) As Long

Dim i As Long
Dim Temp As Long
Dim crc As Long
Dim j As Int
    crc = 0xHFFFF
    'For i = LBound(Buffer) To UBound(Buffer)
    For i = 0 To Buffer.Length - 1
        Temp = Buffer(i) * 0xH100
        'crc = crc Bit.Xor Temp
        crc = Bit.Xor (crc ,Temp)
           
           For j = 0 To 7
                'If (crc Bit.And 0xH8000) Then
            If  Bit.And(crc, 0xH8000) Then
                   ' crc = ((crc * 2) Bit.Xor 0xH1021) And 0xHFFFF
                crc = Bit.And( Bit.Xor((crc * 2), 0xH1021), 0xHFFFF)
                Else
                    'crc = (crc * 2) Bit.And 0xHFFFF
                crc =  Bit.And( (crc * 2), 0xHFFFF)
                End If
           Next 
   Next 


    Return  Bit.And( crc,0xHFFFF)

End Sub

emexes · Jan 28, 2023

Theera said:
After I have test.My poblem is rather to the line, I will try to code.

Code:

If Bit.And(crc1, 0x8000) Then

Let's at least get the first half of your troubles wrapped up ? try this (ie, copy and paste on top of the existing - not-working? - function):

B4X:

Private Sub CRC16A(Buffer() As Byte) As Int
 
    Dim Temp As Int
    Dim crc1 As Int
 
    crc1 = 0xFFFF
 
    For i = 0 To Buffer.Length - 1
        Temp = Bit.And(Buffer(i), 0xFF) * 0x0100
    
        crc1 = Bit.Xor(crc1 ,Temp)
      
        For j = 0 To 7
            If Bit.And(crc1, 0x8000) <> 0 Then
                crc1 = Bit.And( Bit.Xor((crc1 * 2), 0x1021), 0xFFFF)
            Else
                crc1 =  Bit.And( (crc1 * 2), 0xFFFF)
            End If
        Next
    Next
 
    Return crc1
 
End Sub

with test it with this:

Code:

Dim bc As ByteConverter

Dim MessageString As String = "THEERA 2023"
Log("MessageString = " & MessageString)
 
Dim MessageBytes() As Byte = bc.StringToBytes(MessageString, "UTF-8")

Dim sb As StringBuilder
sb.Initialize
For i = 0 To MessageBytes.Length - 1
    sb.Append(" ")
    sb.Append(Bit.And(MessageBytes(i), 0xFF))
Next
Log("MessageBytes =" & sb.ToString)

Dim MessageCRC As Int = CRC16A(MessageBytes)
Log("CRC decimal = " & MessageCRC)
Log("CRC hexadecimal = " & Bit.ToHexString(MessageCRC))

and you should get something like this:

Code:

Waiting for debugger to connect...
Program started.
MessageString = THEERA 2023
MessageBytes = 84 72 69 69 82 65 32 50 48 50 51
CRC decimal = 63001
CRC hexadecimal = f619

which matches CRC type CRC-16/CCITT-FALSE according to online CRC calculator at:

https://crccalc.com/?crc=THEERA 2023&method=crc16&datatype=ascii&outtype=0

but a better test would be to check the function input and results against your existing (working?) VB6 program.

Olaan · Jan 30, 2023

I found algorithm of crc16A() and Vb6.0 source code,but I can't code crc16A() in B4A.

crc16 ccitt calculation

ccitt crc16 algoritham the polynomial for this algorithm is X**16+X**12+X**5+1 D = current data byte that is input to the algorithm CRCLSB,CRCMSB=data byte.least significant and most significant CRC accumulator bytes x>>n means x is shifted n bits to right or is the same as x divided by 2...

www.tek-tips.com

aeric · Jan 30, 2023

Theera said:
This is my the small code.

This is not small enough. There are some unknown modules, StringFunction2 and AwesomeQrCode_1. I am not familiar with these 2 class or modules and unable to compile the project.

As mentioned repeatedly above, you should provide some "test inputs" and "expected outputs". You failed to provide the requirements and keep posting VB source code which doesn't help much.

Please post your SAMPLE INPUTS and OUTPUTS so someone can verify!
or else consider to change your question, because I see you actually not only facing issue with CRC algorithm but the problem is how to parse or extract the input string.

Have you tried the code posted by emexes?

aeric · Jan 30, 2023

B4X:

Dim bc As ByteConverter
Dim PromptPayAccount As String = "A000000677010111"
Dim ReferAccNo As String = "004999054061618"
Dim cashmoney As String = "150.00 Bahts"
cashmoney = cashmoney.ToLowerCase.Replace("bahts", "").Trim
Dim cashvalue As Int = cashmoney
Dim content1 As String = "00020101021129390016" & PromptPayAccount & "0315" & ReferAccNo
Dim tmp As Int = cashvalue.As(String).Length
Dim content2 As String = "54" & IIf(tmp > 9, tmp, "0" & tmp)
Dim content3 As String
Dim m As String
If cashvalue = 0 Then
    content3 = "53037645802TH6304"
    m = content1 & content3
Else
    content3 = "5802TH53037646304"
    m = content1 & content2 & content3
End If
Dim IntCRC As Int = CRC16A(m.GetBytes("UTF8"))
Log(IntCRC)
Dim intArr() As Int = Array As Int(IntCRC)
Dim HexCRC As String = bc.HexFromBytes(bc.IntsToBytes(intArr))
Dim result As String = m & HexCRC
Log(result) ' use result to generate QRCode ?

Attached B4J test app.
TEST INPUT = "150.00 Bahts"
TEST OUTPUT = "00020101021129390016A000000677010111031500499905406161854035802TH5303764630400003926"

generated from https://qr.io/

Olaan · Jan 30, 2023

aeric said:

B4X:

Dim bc As ByteConverter
Dim PromptPayAccount As String = "A000000677010111"
Dim ReferAccNo As String = "004999054061618"
Dim cashmoney As String = "150.00 Bahts"
cashmoney = cashmoney.ToLowerCase.Replace("bahts", "").Trim
Dim cashvalue As Int = cashmoney
Dim content1 As String = "00020101021129390016" & PromptPayAccount & "0315" & ReferAccNo
Dim tmp As Int = cashvalue.As(String).Length
Dim content2 As String = "54" & IIf(tmp > 9, tmp, "0" & tmp)
Dim content3 As String
Dim m As String
If cashvalue = 0 Then
    content3 = "53037645802TH6304"
    m = content1 & content3
Else
    content3 = "5802TH53037646304"
    m = content1 & content2 & content3
End If
Dim IntCRC As Int = CRC16A(m.GetBytes("UTF8"))
Log(IntCRC)
Dim intArr() As Int = Array As Int(IntCRC)
Dim HexCRC As String = bc.HexFromBytes(bc.IntsToBytes(intArr))
Dim result As String = m & HexCRC
Log(result) ' use result to generate QRCode ?

Attached B4J test app.
TEST INPUT = "150.00 Bahts"
TEST OUTPUT = "00020101021129390016A000000677010111031500499905406161854035802TH5303764630400003926"

View attachment 138668
generated from https://qr.io/

I have test your qrcode. It's error.about.crc16A()

If you change 340 bahts, crc16A() must be 50D4.

aeric · Jan 30, 2023

Theera said:
If you change 340 bahts, crc16A() must be 50D4

This is what I refer to TEST INPUT and EXPECTED OUTPUT.
So you are expecting the function to return a Hexadecimal format instead of an Integer. You need to modify the return value as String.

aeric · Jan 30, 2023

The actual cash money is never used, it only get the length of the value and passed to tmp. This is not making sense. You didn't provide the formula to generate the input string to pass to CRC16A().

Code:

Dim cashmoney As String=sf2.Mid(sf2.Trim("150 Bahts"),0,sf2.Len(sf2.Trim("150 Bahts"))-sf2.Len("Bahts"))
Dim content1 As String="00020101021129390016"&PromptPayAccount&"0315"&ReferAccNo
Dim tmp As String=sf2.Len(NumberFormat2(cashmoney,1,0,0,False))
Dim content2 As String=sf2.Trim("54")&NumberFormat(tmp,2,0)
Dim content3 As String=sf2.iif(sf2.Val(cashmoney) = 0, sf2.Trim("53037645802TH6304"), sf2.Trim("5802TH53037646304"))
Dim m As String=sf2.iif(sf2.Val(cashmoney)=0,cs1.Append(content1).Append(content3),cs1.Append(content1).Append(content2).Append(content3))

aeric · Jan 30, 2023

B4X:

Dim bc As ByteConverter
Dim PromptPayAccount As String = "A000000677010111"
'Dim ReferAccNo As String = "0105540087061"
Dim ReferAccNo As String = "004999054061618"
Dim cashmoney As String = "340 Bahts"
cashmoney = cashmoney.ToLowerCase.Replace("bahts", "").Trim
Dim cashvalue As Double = cashmoney
cashmoney = NumberFormat2(cashvalue, 1, 2, 2, False)
'Dim content1 As String = "00020101021129370016" & PromptPayAccount & "0213" & ReferAccNo
Dim content1 As String = "00020101021129390016" & PromptPayAccount & "0315" & ReferAccNo
Dim tmp As Int = cashmoney.Length
Dim content2 As String = "54" & IIf(tmp > 9, tmp, "0" & tmp)
Dim content3 As String
Dim m As String
If cashvalue = 0 Then
    'content3 = "53037645802TH6304"
    content3 = "5303764" & "5802TH" & "6304"
    m = content1 & content3
Else
    'content3 = "5802TH53037646304"
    content3 = "5802TH" & "5303764"
    m = content1 & content3 & content2 & cashmoney & "6304"
    'Log("00020101021129390016" & "-" & PromptPayAccount & "-" & "0213" & "-" & ReferAccNo & "-" & "5802TH" & "-" & "5303764" & "-" & content2 & "-" & cashmoney & "-" & "6304")
    Log("00020101021129390016" & "-" & PromptPayAccount & "-" & "0315" & "-" & ReferAccNo & "-" & "5802TH" & "-" & "5303764" & "-" & content2 & "-" & cashmoney & "-" & "6304")
End If
Log(m)
Dim IntCRC As Int = CRC16A(m.GetBytes("UTF8"))
Log(IntCRC)
Dim intArr() As Int = Array As Int(IntCRC)
Dim HexCRC As String = bc.HexFromBytes(bc.IntsToBytes(intArr))
HexCRC = IIf(HexCRC.StartsWith("0000"), HexCRC.SubString(4), HexCRC)
Log(HexCRC)
Dim result As String = m & HexCRC
Log(result) ' use result to generate QRCode ?

reference: https://github.com/Frontware/promptpay

OliverA · Jan 31, 2023

This one was based on the same polynomial: Post in thread 'Calculating CRC16-CCITT FCS to match C implementation [solved]' https://www.b4x.com/android/forum/t...ch-c-implementation-solved.121872/post-761929

Olaan · Jan 31, 2023

I create the shortest code in order to check crc16A is the correct code,isn't it? Now ,my problem is only crc16A().
my cash money is 340.00 the result for checksum of crc16A() should be 50D4.

aeric · Jan 31, 2023

Theera said:
I create the shortest code in order to check crc16A is the correct code,isn't it? Now ,my problem is only crc16A().
my cash money is 340.00 the result for checksum of crc16A() should be 50D4.

If I understand correctly, you are not only passing 340.00 to crc16A(). You are required to passing a combination of strings and you didn't provide a correct formula.

aeric · Jan 31, 2023

Now I see the formula:
m = content1 & content2 & cashmoney & content3 & "6304"

Here:

B4X:

Dim bc As ByteConverter
Dim PromptPayAccount As String = "A000000677010111"
Dim ReferAccNo As String = "004999054061618"
Dim cashmoney As String = "340.00 Bahts"
cashmoney = cashmoney.ToLowerCase.Replace("bahts", "").Trim
Dim cashvalue As Double = cashmoney
cashmoney = NumberFormat2(cashvalue, 1, 2, 2, False)
Dim content1 As String = "00020101021129390016" & PromptPayAccount & "0315" & ReferAccNo
Dim tmp As Int = cashmoney.Length
Dim content2 As String = "54" & IIf(tmp > 9, tmp, "0" & tmp)
Dim content3 As String
Dim m As String
If cashvalue = 0 Then
    content3 = "5303764" & "5802TH"
    m = content1 & content3 & "6304"
Else
    content3 = "5802TH" & "5303764"
    'm = content1 & content3 & content2 & cashmoney & "6304"
    m = content1 & content2 & cashmoney & content3 & "6304"
    'Log("00020101021129390016" & "-" & PromptPayAccount & "-" & "0315" & "-" & ReferAccNo & "-" & "5802TH" & "-" & "5303764" & "-" & content2 & "-" & cashmoney & "-" & "6304")
    Log("00020101021129390016" & "-" & PromptPayAccount & "-" & "0315" & "-" & ReferAccNo & "-" & content2 & "-" & cashmoney & "-" & "5802TH" & "-" & "5303764" & "-" & "6304")
End If
Log(m)
Dim IntCRC As Int = CRC16A(m.GetBytes("UTF8"))
Log(IntCRC)
Dim intArr() As Int = Array As Int(IntCRC)
Dim HexCRC As String = bc.HexFromBytes(bc.IntsToBytes(intArr))
HexCRC = IIf(HexCRC.StartsWith("0000"), HexCRC.SubString(4), HexCRC)
Log(HexCRC)
Dim result As String = m & HexCRC
Log(result) ' use result to generate QRCode ?

teddybear · Jan 31, 2023

Theera said:
I create the shortest code in order to check crc16A is the correct code,isn't it? Now ,my problem is only crc16A().
my cash money is 340.00 the result for checksum of crc16A() should be 50D4.

It is correct 50D4,just you did convertion is wrong.convert it as aeric doing.

aeric · Jan 31, 2023

B4A project attached.

Olaan · Feb 1, 2023

Many thank you,Aeric,Emexes,OliverA,Teddybear. Aeric'sTestedCrc16A.zip is correct code. I will return to learn my code comparing to his code again.

Android Question CRC16A problrem

Olaan

Expert

emexes

Expert

Olaan

Expert

crc16 ccitt calculation

aeric

Expert

aeric

Expert

Attachments

Olaan

Expert

aeric

Expert

aeric

Expert

aeric

Expert

Attachments

OliverA

Expert

Olaan

Expert

Attachments

aeric

Expert

aeric

Expert

Attachments

teddybear

Well-Known Member

aeric

Expert

Attachments

Olaan

Expert

Similar Threads