如何利用VB对一串数据进行LRC校验希望给出代码和例子

一、建立一个模块，复制下面代码

Option Explicit

Private Declare Function CryptAcquireContext Lib "advapi32.dll" _

Alias "CryptAcquireContextA" ( _

ByRef phProv As Long, _

ByVal pszContainer As String, _

ByVal pszProvider As String, _

ByVal dwProvType As Long, _

ByVal dwFlags As Long) As Long

Private Declare Function CryptReleaseContext Lib "advapi32.dll" ( _

ByVal hProv As Long, _

ByVal dwFlags As Long) As Long

Private Declare Function CryptCreateHash Lib "advapi32.dll" ( _

ByVal hProv As Long, _

ByVal Algid As Long, _

ByVal hKey As Long, _

ByVal dwFlags As Long, _

ByRef phHash As Long) As Long

Private Declare Function CryptDestroyHash Lib "advapi32.dll" ( _

ByVal hHash As Long) As Long

Private Declare Function CryptHashData Lib "advapi32.dll" ( _

ByVal hHash As Long, _

pbData As Any, _

ByVal dwDataLen As Long, _

ByVal dwFlags As Long) As Long

Private Declare Function CryptGetHashParam Lib "advapi32.dll" ( _

ByVal hHash As Long, _

ByVal dwParam As Long, _

pbData As Any, _

pdwDataLen As Long, _

ByVal dwFlags As Long) As Long

Private Const PROV_RSA_FULL = 1

Private Const CRYPT_NEWKEYSET = &H8

Private Const ALG_CLASS_HASH = 32768

Private Const ALG_TYPE_ANY = 0

Private Const ALG_SID_MD2 = 1

Private Const ALG_SID_MD4 = 2

Private Const ALG_SID_MD5 = 3

Private Const ALG_SID_SHA1 = 4

Enum HashAlgorithm

MD2 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2

MD4 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4

MD5 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5

SHA1 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA1

End Enum

Private Const HP_HASHVAL = 2

Private Const HP_HASHSIZE = 4

Function HashString( _

ByVal Str As String, _

Optional ByVal Algorithm As HashAlgorithm = MD5) As String

Dim hCtx As Long

Dim hHash As Long

Dim lRes As Long

Dim lLen As Long

Dim lIdx As Long

Dim abData() As Byte

' Get default provider context handle

lRes = CryptAcquireContext(hCtx, vbNullString, _

vbNullString, PROV_RSA_FULL, 0)

If lRes <>0 Then

' Create the hash

lRes = CryptCreateHash(hCtx, Algorithm, 0, 0, hHash)

If lRes <>0 Then

' Hash the string

lRes = CryptHashData(hHash, ByVal Str, Len(Str), 0)

If lRes <>0 Then

' Get the hash lenght

lRes = CryptGetHashParam(hHash, HP_HASHSIZE, lLen, 4, 0)

If lRes <>0 Then

' Initialize the buffer

ReDim abData(0 To lLen - 1)

' Get the hash value

lRes = CryptGetHashParam(hHash, HP_HASHVAL, abData(0), lLen, 0)

If lRes <>0 Then

' Convert value to hex string

For lIdx = 0 To UBound(abData)

HashString = HashString &_

Right$("0" &Hex$(abData(lIdx)), 2)

Next

End If

End If

End If

' Release the hash handle

CryptDestroyHash hHash

End If

End If

' Release the provider context

CryptReleaseContext hCtx, 0

' Raise an error if lRes = 0

If lRes = 0 Then Err.Raise Err.LastDllError

End Function

二、函数调用

msgbox HashString(Text1.Text)

Function LRC(ByVal s As String) As String

Dim sa, i As Integer, sum As Long

sa = Split(s)

For i = 0 To UBound(sa)

sum = sum + ("&H" &sa(i))

Next

Lcr = Hex((sum And 255 Xor 255) + 1)