Italian Calcolare CRC16 Modbus

Sub CRC(buf() As Byte, lbuf As Int) As Int
   Dim CRC1 As Int
   CRC1 = 0xffff
   For i = 0 To lbuf - 1
     CRC1 = Bit.Xor(CRC1, buf(i))
     For j = 0 To 7
       Dim k As Int = Bit.AND(crc1, 1)
       CRC1 = Bit.AND(Bit.AND(CRC1, 0xfffe) / 2, 0xf777)
       If k > 0 Then CRC1 = Bit.Xor(CRC1, 0xa001)
     Next
   Next
   Return CRC1
End Sub

#Region  Project Attributes
   #ApplicationLabel: B4A Example
   #VersionCode: 1
   #VersionName:
   'SupportedOrientations possible values: unspecified, landscape or portrait.
   #SupportedOrientations: unspecified
   #CanInstallToExternalStorage: False
#End Region

#Region  Activity Attributes
   #FullScreen: False
   #IncludeTitle: True
#End Region

Sub Process_Globals
   'These global variables will be declared once when the application starts.
   'These variables can be accessed from all modules.
     

End Sub

Sub Globals
   'These global variables will be redeclared each time the activity is created.
   'These variables can only be accessed from this module.

   Private Button1 As Button
   Private EditText1 As EditText
   Private EditText2 As EditText
   
   
End Sub

Sub Activity_Create(FirstTime As Boolean)
   'Do not forget to load the layout file created with the visual designer. For example:
   'Activity.LoadLayout("Layout1")
   Activity.LoadLayout("Main")
   
   EditText1.Text = "0x19 0x03 0x00 0x44 0x 00 0x03"
   
   CRC(EditText1.Text)
   
   
End Sub

Sub Activity_Resume

End Sub

Sub Activity_Pause (UserClosed As Boolean)

End Sub


Sub Button1_Click
   
End Sub

Sub CRC(DialString As String) As String
  Dim Res As String

  Dim G As Long, A As Long, AUX As Long
  Dim ALow As Long, AHigh As Long, AL As Long
  Dim Carry As Int
  Dim i, J As Int
  Dim cA As Long

  A = 65535
  G = 40961
  i = 0
  Do While i < DialString.Length
  J = 0
  ALow = A / 256
  ALow = ALow * 256
  ALow = A - ALow
  AHigh = (A / 256) * 256
  'cA =  Asc(Mid$(DialString, i + 1, 1))
  cA = DialString.SubString2(i, i + 1)
  AL = Bit.Xor(cA, ALow)
  AUX = AHigh + AL
  A = AUX
  Do While J < 8
  J = J + 1
  AUX = A
  A = A / 2
  Carry = AUX Mod 2
  If Carry = 1 Then
  A = Bit.Xor(G, A)
  End If
  Loop
  i = i + 1
  Loop
  ALow = A - (A / 256) * 256
  AHigh = A / 256
  Res = Chr(ALow) & Chr(AHigh)
   
 ' Return Res
   
   EditText2.Text = Res
   
End Sub

#Region  Project Attributes
  #ApplicationLabel: B4A Example
  #VersionCode: 1
  #VersionName:
  'SupportedOrientations possible values: unspecified, landscape or portrait.
  #SupportedOrientations: unspecified
  #CanInstallToExternalStorage: False
#End Region

#Region  Activity Attributes
  #FullScreen: False
  #IncludeTitle: True
#End Region

Sub Process_Globals
  'These global variables will be declared once when the application starts.
  'These variables can be accessed from all modules.
 
End Sub

Sub Globals
  'These global variables will be redeclared each time the activity is created.
  'These variables can only be accessed from this module.

  Private Button1 As Button
  Private EditText1 As EditText
  Private EditText2 As EditText
 
 
End Sub

Sub Activity_Create(FirstTime As Boolean)
  'Do not forget to load the layout file created with the visual designer. For example:
  'Activity.LoadLayout("Layout1")
  Activity.LoadLayout("Main")
 
  'EditText1.Text = "0x19 0x03 0x00 0x44 0x 00 0x03"
 
  EditText1.Text = "11010003000C"
 
End Sub

Sub Activity_Resume

End Sub

Sub Activity_Pause (UserClosed As Boolean)

End Sub


Sub Button1_Click
  EditText2.Text = Modbus_CRC(EditText1.Text)
End Sub

Sub Modbus_CRC(strInput As String) As String
    Dim RetCRC As String
    Dim RetStr As String
   
    Dim CRCREG As Int
    Dim MVAL As Int
   
    Dim R As Short
    Dim I As Short
    Dim A As Int
    Dim B As Int
   
    CRCREG = 0xFFFF

    For R = 0 To strInput.Length - 1 Step 2
        RetStr = strInput.SubString2(R, R + 2)
        MVAL = Bit.ParseInt(RetStr, 16)
       
        CRCREG = Bit.Xor(CRCREG, MVAL)
        CRCREG = Bit.AND(CRCREG, 0xFFFF)

        For I = 1 To 8 Step 1
            If Bit.AND(CRCREG, 0x01) = 1 Then
                CRCREG = Bit.Xor(Bit.UnsignedShiftRight(CRCREG, 1), 0xA001)
                CRCREG = Bit.AND(CRCREG, 0xFFFF)
            Else
                CRCREG = Bit.UnsignedShiftRight(CRCREG, 1)
                CRCREG = Bit.AND(CRCREG, 0xFFFF)
            End If
        Next
    Next

    A = Bit.AND(CRCREG, 0xFF)
    B = Bit.AND(CRCREG, 0xFF00)
    A = A * 256
    B = B / 256

    If (A + B) < 16 Then
        RetCRC = "000" & (A + B)
    Else If (A + B) < 256 Then
        RetCRC = "00" & Bit.ToHexString(A + B)
    Else If (A + B) < 4096 Then
        RetCRC = "0" & Bit.ToHexString(A + B)
    Else
        RetCRC = Bit.ToHexString(A + B)
    End If
   
    Return RetCRC.ToUpperCase
End Sub