CRC16...

Does anyone know how to get the CRC16 of a string?
Thanks.
user1000Asked:
Who is Participating?

[Webinar] Streamline your web hosting managementRegister Today

x
 
kamallConnect With a Mentor Commented:
Try this code:

Private Function CRC16(strToCheck As String) As Long

    Dim nPower(0 To 7) As Integer
    Dim CRC As Long
    Dim I As Integer
    Dim J As Integer
    Dim bytOfChar As Byte
    Dim lTestBit As Long


    For I = 0 To 7
        nPower(I) = 2 ^ I
    Next I
       
    CRC = 0
    For I = 1 To Len(strToCheck)
        bytOfChar = Asc(Mid$(strToCheck, I, 1))
        For J = 7 To 0 Step -1
            lTestBit = ((CRC And 32768) = 32768) Xor ((bytOfChar And nPower(J)) = nPower(J))
            CRC = ((CRC And 32767&) * 2&)
            If lTestBit Then CRC = CRC Xor &H1021
        Next J
    Next I
    CRC16 = CRC

End Function

Private Sub Command1_Click()

    Label2 = CRC16(Text1)

End Sub

Hope that helps.
Regards.
0
 
kamallCommented:
P.S. the code requires one text box (text1), one label (label2) and one command button (command1).
0
 
setiawanCommented:
'***************************************************************

' Name: CRC Codes

' Description:Creates a number that coresponds to a specific stri

'     ng. Allows you to check if the string has been modified. Usefull



'     for sensitive data. Hard to crack since user does not know how th

    '     e CRC code was created.

' By: Jan Nawara

'

'

' Inputs:When making a code requires a string and CRC_Make must b

'     e true.

When checking a code requires a string, CRC_Make must be False and the original CRC code.
'

' Returns:When making returns the CRC code, when checking returns

'     true if code matches string.

'

'Assumes:Assumes there are not NULL cahracters in the string.

'

'Side Effects:May have trouble with international systems. (Untes

'     ted)

'

'Warranty:

'Code provided by Planet Source Code(tm) (http://www.Planet-Sourc

'     e-Code.com) 'as is', without warranties as to performance, fitnes

'     s, merchantability,and any other warranty (whether expressed or i

'     mplied).

'Terms of Agreement:

'By using this source code, you agree to the following terms...

' 1) You may use this source code in personal projects and may co

'     mpile it into an .exe/.dll/.ocx and distribute it in binary forma

'     t freely and with no charge.

' 2) You MAY NOT redistribute this source code (for example to a

'     web site) without written permission from the original author.Fai

'     lure to do so is a violation of copyright laws.

' 3) You may link to this code from another website, provided it

'     is not wrapped in a frame.

' 4) The author of this code may have retained certain additional

'     copyright rights.If so, this is indicated in the author's descrip

'     tion.

'***************************************************************




Public Function CRC_Code(CRC_String As String, CRC_Make As Boolean, Optional CRC_Number As Variant)

    'Pass a string to derive CRC code from or to check against a CRC

    '     code

    'To make a CRC code pass a string to make the code from and pass

    '     true to CRC_Make

    'Eg. Some_CRC_Number = CRC_Code (Some_String, True)

    'Returns the CRC Number derived from the string

    'To check a CRC code pass a string to check against, pass False t

    '     o CRC_Make and pass the CRC code to check

    'Eg. CRC_Match_Boolean = CRC_Code (Some_String, False, Some_CRC_N

    '     umber)

    'Returns True if the CRC code matches the string

    Dim Hold As Long
    Dim A as Integer


    If CRC_Make = True Then


        For A = 1 To Len(CRC_String)
            Hold = Hold + Asc(Mid(CRC_String, A, 1))
        Next

        CRC_Code = Hold
    ElseIf CRC_Make = False Then


        For A = 1 To Len(CRC_String)
            Hold = Hold + Asc(Mid(CRC_String, A, 1))
        Next



        If Hold = CLng(CRC_Number) Then
            CRC_Code = True
        Else
            CRC_Code = False
        End If

    End If

End Function
0
 
user1000Author Commented:
kamall, the code works great. Thank you very much.
I will give you 100 additional points for your fast reply.
Also thanks for setiawan for his code.
0
All Courses

From novice to tech pro — start learning today.