# Thread: Calculate the Xor Checksum of a string fro IBUS

1. ## Calculate the Xor Checksum of a string fro IBUS

I try to create a little converter for a RR users with a RR plugin that create a compatible string from a phone number for the' IBUS RR plugin !
My string is F0 0f C8 2D 00 11 30 38 30 30 31 32 33 34 35 36 and the result must to be 04 but my calcul is bad and tmy result is 34 !

See the web page:
http://www.dela.ws/bmw/chk.php
My code is :
Code:
```    'calculating IBUS checksum: http://www.dela.ws/bmw/chk.php
'the CMD to RR looks like: IBusCommunicatoRR;sendtoibus;F0 0F C8 2D 00 11 30 38 30 30 31 32 33 34 35 36 04
Public Function ConvertPhoneNumberToIbus(ByVal phonenumber As String)
Dim PreFixIbus As String = "F0 0F C8 2D 00 11 "
Dim CheckSumIbus As String = ""
Dim SuffixIbus As String = "CK"
Dim arrayLetters As Array = phonenumber.ToCharArray()
For i = 0 To arrayLetters.Length - 1
If i < arrayLetters.Length - 1 Then PhoneNumberToIbus = PhoneNumberToIbus + "3" + arrayLetters(i) + " "
If i = arrayLetters.Length - 1 Then PhoneNumberToIbus = PhoneNumberToIbus + "3" + arrayLetters(i)
Next
PhoneNumberToIbus = PreFixIbus + PhoneNumberToIbus '+ SuffixIbus
'CheckSumIbus = Calc_CheckSum(PhoneNumberToIbus.Replace("F0 ", ""))
CheckSumIbus = Calc_CheckSum(PhoneNumberToIbus)
PhoneNumberToIbus = PhoneNumberToIbus + " " + CheckSumIbus
Return PhoneNumberToIbus
End Function```

2. maybe can help this code:

Code:
`del`

3. Sorry , that don't help me for the checksum calcul !

4. :-(

i asked some forums and users, but ne anser at the time.

5. Check your value of PhoneNumberToIbus after the FOR loop to make sure it matches the expected string.

I tried using the example string and the XOR command in CALC and got 04 as a check digit. But, I can't see your CheckSum function.

6. i'm bad to code in vb, but can do some things in excel.

here is my last excel macro to calc checksum for ibus:
Code:
```Sub Checksum_for_Ibus()

Dim ibusstr As Variant
Dim result As String
Dim numa As String
Dim numb As String

'Clear Value of Cell B23
Cells(23, 2).Value = ""

'get the string of Cell B21 and split
ibusstr = Split(Cells(21, 2), " ")

'*********************************************************
'correct/set the length
ibusstr(1) = Hex(UBound(ibusstr))

'fill hex string to 2 positions
If Len(ibusstr(1)) < 2 Then
ibusstr(1) = "0" & ibusstr(1)
End If

MsgBox ("Length in Hex: " & ibusstr(1))

'*********************************************************
'calc checksum
For n = 0 To UBound(ibusstr)
If n = 0 Then
result = HexToBin(H + ibusstr(0))
End If

If n > 0 Then
numa = result
numb = HexToBin(H + ibusstr(n))

'xor both numbers
result = Calc_CK(numa, numb)

End If
Next n

MsgBox ("Bin Xor: " & result)

'bin xor to hex
checksum = BinToHex(result)

MsgBox ("Hex Xor: " & checksum)

'assemble the whole telegram
fsh = Join(ibusstr, " ") & " " & checksum

MsgBox ("The whole new Telegram: " & fsh)

'set cell B23 with string
Cells(23, 2).Value = fsh

End Sub

Public Function Calc_CK(num1in As String, num2in As String) As String
Dim l
Dim num1out(8)
Dim num2out(8)
Dim num3(8)

'split binary in separet letters
For pos = 1 To 8
num1out(pos) = Mid(num1in, pos, 1)
num2out(pos) = Mid(num2in, pos, 1)
Next pos

'xor seperated letters
For l = 1 To 8
num3(l) = num1out(l) Xor num2out(l)
Next l

'assamble the new letters to binary
Calc_CK = Join(num3, "")

End Function

Public Function HexToBin(HexNum As String) As String
Dim BinNum As Variant
Dim lHexNum As Long
Dim i As Integer

On Error GoTo ErrorHandler

'  Check the string for invalid characters
For i = 1 To Len(HexNum)
If ((Asc(Mid(HexNum, i, 1)) < 48) Or _
(Asc(Mid(HexNum, i, 1)) > 57 And _
Asc(UCase(Mid(HexNum, i, 1))) < 65) Or _
(Asc(UCase(Mid(HexNum, i, 1))) > 70)) Then
BinNum = ""
Err.Raise 1016, "HexToBin", "Invalid Input"
End If
Next i

i = 0
lHexNum = Val("&h" & HexNum)
Do
If lHexNum And 2 ^ i Then
BinNum = "1" & BinNum
Else
BinNum = "0" & BinNum
End If
i = i + 1
Loop Until 2 ^ i > lHexNum

'fill binary string to 8 positions
Do
If Len(BinNum) < 8 Then
BinNum = "0" & BinNum
End If
Loop Until Len(BinNum) = 8

'  Return BinNum as a String
HexToBin = BinNum
ErrorHandler:
End Function

Function BinToHex(Binary As String) As String

Dim HexNum
Dim Value&, i&, Base#: Base = 1
For i = Len(Binary) To 1 Step -1
Value = Value + IIf(Mid(Binary, i, 1) = "1", Base, 0)
Base = Base * 2
Next i
HexNum = Hex(Value)

'fill hex string to 2 positions
If Len(HexNum) < 2 Then
HexNum = "0" & HexNum
End If

BinToHex = HexNum
End Function```

7. This works for me

Code:
```'============================================================================
' Calculate an XOR checksum
'============================================================================
Public Function Calc_CheckSum(Message) As Integer

Dim i As Integer
Dim Chk As Integer ' Checksum - will work for up to msg length of 255 bytes

Chk = 0
For i = 1 To Len(Message)
Chk = Chk Xor Asc(Mid\$(Message, i, 1)) ' XOR all bytes in message
Next i
Calc_CheckSum = (Chk And &HFF) ' get least significant byte by ANDing with FF

End Function```

8. Originally Posted by JanneH0
This works for me

Code:
```'============================================================================
' Calculate an XOR checksum
'============================================================================
Public Function Calc_CheckSum(Message) As Integer

Dim i As Integer
Dim Chk As Integer ' Checksum - will work for up to msg length of 255 bytes

Chk = 0
For i = 1 To Len(Message)
Chk = Chk Xor Asc(Mid\$(Message, i, 1)) ' XOR all bytes in message
Next i
Calc_CheckSum = (Chk And &HFF) ' get least significant byte by ANDing with FF

End Function```
I don't know why that don't run for me !
I have addapted the VBA code to VB.NET and run very well !
Code:
```    Public PhoneNumberToIbus As String
Dim PreFixIbus As String = "F0 LL C8 2D 00 11 "
Dim CheckSumIbus As String
Dim IbusLenghtSentence As String

...

Public Function ConvertPhoneNumberToIbus(ByVal phonenumber As String)
If phonenumber.Contains("+") Then phonenumber = phonenumber.Replace("+", "00")
'If phonenumber.Length = 10 Then
IbusLenghtSentence = Nothing
PhoneNumberToIbus = Nothing
CheckSumIbus = Nothing
'Dim PreFixIbus As String = "F0 0F C8 2D 00 11 "
'Dim CheckSumIbus As String = ""
Dim arrayLetters As Array = phonenumber.ToCharArray()
For i = 0 To arrayLetters.Length - 1
If i < arrayLetters.Length - 1 Then PhoneNumberToIbus = PhoneNumberToIbus + "3" + arrayLetters(i) + " "
If i = arrayLetters.Length - 1 Then PhoneNumberToIbus = PhoneNumberToIbus + "3" + arrayLetters(i)
Next

'length calcul
IbusLenghtSentence = Hex(5 + phonenumber.Length)
If IbusLenghtSentence.Length = 1 Then IbusLenghtSentence = "0" & IbusLenghtSentence
'replace LL by the good length
PreFixIbus = PreFixIbus.Replace("F0 LL", "F0 " & IbusLenghtSentence)
PhoneNumberToIbus = PreFixIbus + PhoneNumberToIbus
CheckSumIbus = Checksum_for_Ibus(PhoneNumberToIbus)
SDK.SetUserVar("IBusCommunicatoRR_CALCCK", CheckSumIbus)
'complet sentence to send to ibus
PhoneNumberToIbus = PhoneNumberToIbus + " " + CheckSumIbus
Return PhoneNumberToIbus
'End If
End Function

'after you has sampled the values
'F0 LL C8 2D 00 11 + 30 38 30 30 31 32 33 34 35 36 + CK
'set LL(all after LL) to Lenght 15 = 0F
'1    2     3    4      5    6   7   8   9  10 11  12 13 14   15
'F0 LL C8 2D 00 11 + 30 38 30 30 31 32 33 34 35 36 + CK
'then
'calculate the checksum of the whole string without CK and add the checksum to the end
'F0 0F C8 2D 00 11 30 38 30 30 31 32 33 34 35 36
'the output must be:
'F0 0F C8 2D 00 11 30 38 30 30 31 32 33 34 35 36 04
Function Checksum_for_Ibus(ByRef mymsg As Object)
Dim ibusstr As Object
Dim result As String
Dim numa As String
Dim numb As String

'get the string of Cell B21 and split
ibusstr = Split(mymsg, " ")
'*********************************************************
'correct/set the length
ibusstr(1) = Hex(UBound(ibusstr))
'fill hex string to 2 positions
If Len(ibusstr(1)) < 2 Then
ibusstr(1) = "0" & ibusstr(1)
End If
'MsgBox("Length in Hex: " & ibusstr(1))
'*********************************************************
'calc checksum
For n = 0 To UBound(ibusstr)
If n = 0 Then
'result = HexToBin(H + ibusstr(0))
result = HexToBin(ibusstr(0))
End If

If n > 0 Then
numa = result
'numb = HexToBin(H + ibusstr(n))
numb = HexToBin(ibusstr(n))
'xor both numbers
result = Calc_CK(numa, numb)

End If
Next n
'MsgBox("Bin Xor: " & result)
'bin xor to hex
Dim checksum = BinToHex(result)
'MsgBox("Hex Xor: " & checksum)
'assemble the whole telegram
'CheckSumIbus = Join(ibusstr, " ") & " " & checksum
CheckSumIbus = checksum
'MsgBox("The whole new Telegram: " & Checksum_for_Ibus)
'set cell B23 with string
Return CheckSumIbus
End Function

Public Function Calc_CK(num1in As String, num2in As String) As String
Dim l
Dim num1out(8)
Dim num2out(8)
Dim num3(8)
'split binary in separet letters
For pos = 1 To 8
num1out(pos) = Mid(num1in, pos, 1)
num2out(pos) = Mid(num2in, pos, 1)
Next pos
'xor seperated letters
For l = 1 To 8
num3(l) = num1out(l) Xor num2out(l)
Next l
'assamble the new letters to binary
Calc_CK = Join(num3, "")
End Function

Public Function HexToBin(HexNum As String) As String
Dim BinNum As Object
Dim lHexNum As Long
Dim i As Integer
On Error GoTo ErrorHandler
'  Check the string for invalid characters
For i = 1 To Len(HexNum)
If ((Asc(Mid(HexNum, i, 1)) < 48) Or _
(Asc(Mid(HexNum, i, 1)) > 57 And _
Asc(UCase(Mid(HexNum, i, 1))) < 65) Or _
(Asc(UCase(Mid(HexNum, i, 1))) > 70)) Then
BinNum = ""
Err.Raise(1016, "HexToBin", "Invalid Input")
End If
Next i
i = 0
lHexNum = Val("&h" & HexNum)
Do
If lHexNum And 2 ^ i Then
BinNum = "1" & BinNum
Else
BinNum = "0" & BinNum
End If
i = i + 1
Loop Until 2 ^ i > lHexNum

'fill binary string to 8 positions
Do
If Len(BinNum) < 8 Then
BinNum = "0" & BinNum
End If
Loop Until Len(BinNum) = 8

'  Return BinNum as a String
HexToBin = BinNum
ErrorHandler:
End Function

Function BinToHex(Binary As String) As String
Dim HexNum
Dim Value&, i&, Base# : Base = 1
For i = Len(Binary) To 1 Step -1
Value = Value + IIf(Mid(Binary, i, 1) = "1", Base, 0)
Base = Base * 2
Next i
HexNum = Hex(Value)
'fill hex string to 2 positions
If Len(HexNum) < 2 Then
HexNum = "0" & HexNum
End If
BinToHex = HexNum
End Function

#End Region

#Region "Debug Log"
Public Sub ToLog(ByVal TheMessage As String)
If TempPluginSettings.Debug = True Then
Dim DebugLog As StreamWriter
If Not File.Exists(DebuglogPath) Then
DebugLog = New StreamWriter(DebuglogPath)
Else
DebugLog = File.AppendText(DebuglogPath)
End If
' Write to the file:
DebugLog.WriteLine(DateTime.Now + "-->" & TheMessage)
' Close the stream:
DebugLog.Close()
End If
End Sub```

9. maybe there is missing the "FF"

10. Originally Posted by harryberlin
maybe there is missing the "FF"
I have tried also without !

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•