# Calculate the Xor Checksum of a string fro IBUS

• 04-20-2013, 03:58 AM
pierrotm777
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```
Thanks for your help !!!:D
• 04-20-2013, 08:42 AM
harryberlin
maybe can help this code:

Code:

`del`
• 04-20-2013, 10:19 AM
pierrotm777
Sorry , that don't help me for the checksum calcul !
• 04-20-2013, 10:22 AM
harryberlin
:-(

i asked some forums and users, but ne anser at the time.
• 04-20-2013, 04:41 PM
ClockWorK
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.
• 04-20-2013, 04:52 PM
harryberlin
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```
• 04-22-2013, 09:05 AM
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```
• 04-22-2013, 01:23 PM
pierrotm777
Quote:

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```
:o
• 04-22-2013, 01:28 PM
harryberlin
maybe there is missing the "FF"
• 04-22-2013, 01:29 PM
pierrotm777
Quote:

Originally Posted by harryberlin
maybe there is missing the "FF"

I have tried also without !