Announcement

Collapse
No announcement yet.

Calculate the Xor Checksum of a string fro IBUS

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • 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 !!!

  • #2
    maybe can help this code:

    Code:
    del
    Last edited by harryberlin; 04-20-2013, 04:49 PM.
    RR-Skin: BMW OpenBM Skin for E39 [never ending progress :-(]
    RR-Plugin: IBusCommunicatoRR new Updates

    Comment


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

      Comment


      • #4
        :-(

        i asked some forums and users, but ne anser at the time.
        RR-Skin: BMW OpenBM Skin for E39 [never ending progress :-(]
        RR-Plugin: IBusCommunicatoRR new Updates

        Comment


        • #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.

          Comment


          • #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
            Last edited by harryberlin; 04-21-2013, 03:28 AM.
            RR-Skin: BMW OpenBM Skin for E39 [never ending progress :-(]
            RR-Plugin: IBusCommunicatoRR new Updates

            Comment


            • #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

              Comment


              • #8
                Originally posted by JanneH0 View Post
                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
                Last edited by pierrotm777; 04-22-2013, 01:26 PM.

                Comment


                • #9
                  maybe there is missing the "FF"
                  RR-Skin: BMW OpenBM Skin for E39 [never ending progress :-(]
                  RR-Plugin: IBusCommunicatoRR new Updates

                  Comment


                  • #10
                    Originally posted by harryberlin View Post
                    maybe there is missing the "FF"
                    I have tried also without !

                    Comment

                    Working...
                    X