Results 1 to 10 of 10

Thread: Calculate the Xor Checksum of a string fro IBUS

  1. #1
    Raw Wave pierrotm777's Avatar
    Join Date
    May 2008
    Location
    Bordeaux, France
    Posts
    2,772

    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. #2
    Variable Bitrate
    Join Date
    Sep 2012
    Location
    Germany - Munich
    Posts
    344
    maybe can help this code:

    Code:
    del
    Last edited by harryberlin; 04-20-2013 at 04:49 PM.

  3. #3
    Raw Wave pierrotm777's Avatar
    Join Date
    May 2008
    Location
    Bordeaux, France
    Posts
    2,772
    Sorry , that don't help me for the checksum calcul !

  4. #4
    Variable Bitrate
    Join Date
    Sep 2012
    Location
    Germany - Munich
    Posts
    344
    :-(

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

  5. #5
    Mod - Driveline forum
    Auto Apps:loading...
    ClockWorK's Avatar
    Join Date
    Oct 2003
    Location
    Michigan
    Posts
    602
    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. #6
    Variable Bitrate
    Join Date
    Sep 2012
    Location
    Germany - Munich
    Posts
    344
    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 at 03:28 AM.

  7. #7
    Low Bitrate
    Join Date
    Nov 2010
    Posts
    72
    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. #8
    Raw Wave pierrotm777's Avatar
    Join Date
    May 2008
    Location
    Bordeaux, France
    Posts
    2,772
    Quote 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

  9. #9
    Variable Bitrate
    Join Date
    Sep 2012
    Location
    Germany - Munich
    Posts
    344
    maybe there is missing the "FF"

  10. #10
    Raw Wave pierrotm777's Avatar
    Join Date
    May 2008
    Location
    Bordeaux, France
    Posts
    2,772
    Quote Originally Posted by harryberlin View Post
    maybe there is missing the "FF"
    I have tried also without !

Similar Threads

  1. OBDII Checksum?
    By chunkyks in forum OBDSim
    Replies: 1
    Last Post: 09-30-2010, 11:28 AM
  2. CMOS checksum error
    By ekaz in forum General Hardware Discussion
    Replies: 0
    Last Post: 05-13-2008, 06:12 PM
  3. My homage to Checksum and his fans
    By Bollwerk in forum Car Audio
    Replies: 0
    Last Post: 09-20-2007, 06:54 PM
  4. Cmos checksum error problem...
    By damixt in forum General Hardware Discussion
    Replies: 11
    Last Post: 06-10-2006, 06:24 PM
  5. What is CMOS CHECKSUM ERROR
    By rcpirate in forum General MP3Car Discussion
    Replies: 2
    Last Post: 12-15-2000, 04:09 PM

Bookmarks

Posting Permissions

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