Does anyone know how to get the CRC16 of a string?
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

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.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
P.S. the code requires one text box (text1), one label (label2) and one command button (command1).

' 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)



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

' '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))

        CRC_Code = Hold
    ElseIf CRC_Make = False Then

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

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

    End If

End Function
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.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.