PHP User Warning: fetch_template() calls should be replaced by the vB_Template class. Template name: bbcode_highlight in ..../includes/functions.php on line 4197
[RESOLVED] Vb6 CRC ALGORITHM For Beckman Coulter Analizer-VBForums
Results 1 to 8 of 8

Thread: [RESOLVED] Vb6 CRC ALGORITHM For Beckman Coulter Analizer

  1. #1

    Thread Starter
    New Member
    Join Date
    Oct 2018
    Posts
    5

    Resolved [RESOLVED] Vb6 CRC ALGORITHM For Beckman Coulter Analizer

    I have to make a communication interface with a blood analyzer, but I can not realize the algorithm in vb6 for the calculation of the CRC.
    The manual only reports:

    The CRC algorithm used is a modified CCITT CRC16 algorithm and is the same as used in
    the STKS analyzer.
    The polynomial for this algorithm is: X**16 + X**12 + X**5 + 1.
    Note: D = current data byte that is input to the algorithm.
    CRCLSB,CRCMSB = data byte. Least significant and most significant CRC accumulator
    bytes.
    x>>n means x is shifted n bits to right or is the same as x divided by 2n.
    x<<n means x is shifted n bits to left or is the same as x multiplied by 2n.
    //------------------------------------------------------------------------------------------------------------------
    at beginning,
    CRCLSB = 0FFH (octal 377) (decimal 255)
    CRCMSB = 0FFH (octal 377) (decimal 255)
    then for each data byte in a block,
    X = D XOR CRCMSB
    X = X XOR ( X >> 4 )
    CRCMSB = CRCLSB XOR ( X >> 3 ) XOR ( X << 4 )
    CRCLSB = X XOR ( X << 5 )
    and at end,
    CRCLSB = CRCLSB XOR 0FFH
    CRCMSB = CRCMSB XOR 0FFH
    //------------------------------------------------------------------------------------------------------------------

    can someone help me?
    I really do not know how to do it.
    The program is implemented in Visual Basic 6

    thank you

  2. #2

    Thread Starter
    New Member
    Join Date
    Oct 2018
    Posts
    5

    Re: Vb6 CRC ALGORITHM For Beckman Coulter Analizer

    The code written by me is


    Public Function CRC16(data() As Byte) As String
    Dim CRCLSB As Byte, CRCMSB As Byte
    Dim test As Byte
    Dim X As Byte
    Dim i As Integer

    CRCLSB = &HFF
    CRCMSB = &HFF

    For i = 0 To UBound(data)
    X = data(i) Xor CRCMSB
    X = X Xor (X / (2 ^ 4))
    CRCMSB = CRCLSB Xor (X / (2 ^ 3)) Xor (X * (2 ^ 4))
    CRCLSB = X Xor (X * (2 ^ 5))
    Next i
    CRCLSB = CRCLSB Xor &HFF
    CRCMSB = CRCMSB Xor &HFF

    CRC16 = Hex(CRCLSB) & Hex(CRCMSB)

    End Function

    but at runtime I get the overflow error on the line " CRCMSB = CRCLSB Xor (X / (2 ^ 3)) Xor (X * (2 ^ 4))"

  3. #3
    PowerPoster
    Join Date
    Jun 2015
    Posts
    2,137

    Re: Vb6 CRC ALGORITHM For Beckman Coulter Analizer

    these are what I use, if speed is not the most important.

    Code:
    Public Type LARGE_INTEGER
        LowPart     As Long
        HighPart    As Long
    End Type
    Private Declare Function RtlLargeIntegerShiftLeft Lib "ntdll" (ByVal LowPart As Long, Optional ByVal HighPart As Long, Optional ByVal ShiftCount As Long = 1) As LARGE_INTEGER
    Private Declare Function RtlLargeIntegerShiftRight Lib "ntdll" (ByVal LowPart As Long, Optional ByVal HighPart As Long, Optional ByVal ShiftCount As Long = 1) As LARGE_INTEGER
    
    Public Function Shl(ByVal Value As Long, Optional ByVal ShiftCount As Long = 1) As Long
        Shl = RtlLargeIntegerShiftLeft(Value, 0, ShiftCount).LowPart
    End Function
    
    Public Function Shr(ByVal Value As Long, Optional ByVal ShiftCount As Long = 1, Optional Arithmetic As Boolean) As Long
        Shr = RtlLargeIntegerShiftRight(Value, Arithmetic And Value < 0&, ShiftCount).LowPart
    End Function
    and a basic 16bit CCIT. But you'll have to modify the algorithm to match what you're looking for.
    Notice how I avoided the Overflow, by dealing with the MSB seperately at the end.
    Code:
    Function CRC16(Bytes() As Byte) As Integer
        Const POLY As Long = &H8408&
        Dim i As Byte
        Dim Data As Long
        Dim CRC As Long
        
        CRC = &HFFFF& ' Initial CRC 
        
        Dim Length As Long
        Length = UBound(Bytes) - LBound(Bytes) + 1
        Dim j As Long
        
        If Length = 0 Then _
            Exit Function
        
        For j = LBound(Bytes) To UBound(Bytes)
            Data = Bytes(j)
            For i = 0 To 7
                If (CRC And 1) Xor (Data And 1) Then
                    CRC = Shr(CRC, 1) Xor POLY
                Else
                    CRC = Shr(CRC, 1)
                End If
                Data = Shr(Data, 1)
            Next
        Next
        
        CRC = CRC Xor &HFFFF& ' Reverse Bits
        CRC = Shl(CRC, 8) Or (Shr(CRC, 8) And &HFF&) ' Swap Bytes
        
        CRC16 = CRC And &H7FFF&    ' remove sign bit to avoid overflow
        If CRC < 0 Then CRC16 = CRC16 Or &H8000 ' add the sign bit back in if needed
    End Function
    Last edited by DEXWERX; Oct 12th, 2018 at 12:40 PM.

  4. #4
    Addicted Member
    Join Date
    Sep 2015
    Posts
    152

    Re: Vb6 CRC ALGORITHM For Beckman Coulter Analizer

    Hi dinox

    Could you please post the real data you get from the instrument?
    Last edited by labmany; Oct 13th, 2018 at 02:27 AM.

  5. #5

    Thread Starter
    New Member
    Join Date
    Oct 2018
    Posts
    5

    Re: Vb6 CRC ALGORITHM For Beckman Coulter Analizer

    thanks for the answers. Monday when I will be with the instrument I will test and post what I send and what I receive

  6. #6

    Thread Starter
    New Member
    Join Date
    Oct 2018
    Posts
    5

    Re: Vb6 CRC ALGORITHM For Beckman Coulter Analizer

    The code is fine, but in the specification I can only have 2 bytes (4 char in hex) and currently the function returns me 8 bytes (16 char in hex)

    Code:
    Private Type LARGE_INTEGER
        LowPart     As Long
        HighPart    As Long
    End Type
    Public Type crc_lh5
        CRCLSB As String
        CRCMSB As String
    End Type
    Private Declare Function RtlLargeIntegerShiftLeft Lib "ntdll" (ByVal LowPart As Long, Optional ByVal HighPart As Long, Optional ByVal ShiftCount As Long = 1) As LARGE_INTEGER
    Private Declare Function RtlLargeIntegerShiftRight Lib "ntdll" (ByVal LowPart As Long, Optional ByVal HighPart As Long, Optional ByVal ShiftCount As Long = 1) As LARGE_INTEGER
    
    Private Function Shl(ByVal Value As Long, Optional ByVal ShiftCount As Long = 1) As Long
        Shl = RtlLargeIntegerShiftLeft(Value, 0, ShiftCount).LowPart
    End Function
    
    Private Function Shr(ByVal Value As Long, Optional ByVal ShiftCount As Long = 1, Optional Arithmetic As Boolean) As Long
        Shr = RtlLargeIntegerShiftRight(Value, Arithmetic And Value < 0&, ShiftCount).LowPart
    End Function
    
    Public Function CRC_bec(Data() As Byte) As crc_lh5
    Dim CRCLSB As Long, CRCMSB As Long
    Dim X As Long
    Dim i As Integer
    Dim crc As crc_lh5
    
        CRCLSB = &HFF
        CRCMSB = &HFF
        For i = 0 To UBound(Data)
            X = Data(i) Xor CRCMSB
            X = X Xor Shl(X, 4)
            CRCMSB = CRCLSB Xor Shr(X, 3) Xor Shl(X, 4)
            CRCLSB = X Xor Shl(X, 5)
        Next i
        CRCLSB = CRCLSB Xor &HFF
        CRCMSB = CRCMSB Xor &HFF
        CRC_bec.CRCLSB = Hex(CRCLSB)
        CRC_bec.CRCMSB = Hex(CRCMSB)
    End Function
    the data I send to the instrument are:
    Code:
    <STX>02<CR><LF>
    <SOH>0C<CR><LF>
    WLAD<CR><LF>
    ID 0000000000019099<CR><LF>
    PL PATIENT NAME <CR><LF>
    PL PATIENT SURN <CR><LF>
    SN 000009<CR><LF>
    BD 02/26/1975<CR><LF>
    SX M<CR><LF>
    RP 01<CR><LF>
    ED 10/10/18<CR><LF>
    ET 15:45<CR><LF>
    TS CBC0000000000000009                                             <CR><LF>
    SR 0<CR><LF>
    ST  <CR><LF>
                                           [CRC]<ETX><CR><LF>
    [CRC] is the value of the crc (4 char) I should calculate after <STX>02<CR><LF>
    Last edited by dinox; Oct 15th, 2018 at 03:25 AM.

  7. #7
    Fanatic Member wqweto's Avatar
    Join Date
    May 2011
    Posts
    901

    Re: Vb6 CRC ALGORITHM For Beckman Coulter Analizer

    This line X = X Xor Shl(X, 4) shifts left instead of right.

    Here is a complete rewrite w/ no API calls and no UDT on retval
    thinBasic Code:
    1. Option Explicit
    2.  
    3. Private Function CRC_bec(Data() As Byte) As Long
    4.     Const POW2_3 As Long = 2 ^ 3
    5.     Const POW2_4 As Long = 2 ^ 4
    6.     Const POW2_5 As Long = 2 ^ 5
    7.     Dim CRCLSB  As Long
    8.     Dim CRCMSB  As Long
    9.     Dim X       As Long
    10.     Dim I       As Integer
    11.  
    12.     CRCLSB = &HFF
    13.     CRCMSB = &HFF
    14.     For I = 0 To UBound(Data)
    15.         X = Data(I) Xor CRCMSB
    16.         X = X Xor (X \ POW2_4)
    17.         CRCMSB = CRCLSB Xor (X \ POW2_3) Xor (X * POW2_4) And &HFF
    18.         CRCLSB = X Xor (X * POW2_5) And &HFF
    19. '        Debug.Print X, CRCMSB, CRCLSB
    20.     Next I
    21.     CRCLSB = CRCLSB Xor &HFF
    22.     CRCMSB = CRCMSB Xor &HFF
    23.     CRC_bec = CRCMSB * &H100 + CRCLSB
    24. End Function
    25.  
    26. Private Sub Form_Load()
    27.     Dim b() As Byte
    28.     b = "aaa"
    29.     Debug.Print Hex(CRC_bec(b))
    30. End Sub
    cheers,
    </wqw>

  8. #8

    Thread Starter
    New Member
    Join Date
    Oct 2018
    Posts
    5

    Re: Vb6 CRC ALGORITHM For Beckman Coulter Analizer

    thanks for the answers.
    It works perfectly.

Posting Permissions

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



Featured


Click Here to Expand Forum to Full Width