VB加密类修改后实现不了解密，解密也变成了加密
使用的类是http://bbs.csdn.net/topics/390591087中1楼所说的类
我做了点小修改，修改后就不能解密了
CryptoAPI类文件内容如下：（此文件是在下载下来的文件上做的增加：DecryptsData2，EncryptsDate2，PrintBytes；其主体函数没有修改过）
由于内容过多，我把版权修改及一些注释删了
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 CryptDeriveKey Lib "advapi32.dll" ( _
ByVal hProv As Long, _
ByVal Algid As Long, _
ByVal hBaseData As Long, _
ByVal dwFlags As Long, _
ByRef phKey As Long) As Long
Private Declare Function CryptDestroyKey Lib "advapi32.dll" ( _
ByVal hKey As Long) As Long
Private Declare Function CryptEncrypt Lib "advapi32.dll" ( _
ByVal hKey As Long, _
ByVal hHash As Long, _
ByVal Final As Long, _
ByVal dwFlags As Long, _
pbData As Any, _
ByRef pdwDataLen As Long, _
ByVal dwBufLen As Long) As Long
Private Declare Function CryptDecrypt Lib "advapi32.dll" ( _
ByVal hKey As Long, _
ByVal hHash As Long, _
ByVal Final As Long, _
ByVal dwFlags As Long, _
pbData As Any, _
ByRef pdwDataLen As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32" _
Alias "RtlMoveMemory" ( _
Dest As Any, _
Src As Any, _
ByVal Ln As Long)
Private Const PROV_RSA_FULL = 1
Private Const CRYPT_NEWKEYSET = &H8
Private Const ALG_CLASS_HASH = 32768
Private Const ALG_CLASS_DATA_ENCRYPT = 24576&
Private Const ALG_TYPE_ANY = 0
Private Const ALG_TYPE_BLOCK = 1536&
Private Const ALG_TYPE_STREAM = 2048&
Private Const ALG_SID_MD2 = 1
Private Const ALG_SID_MD4 = 2
Private Const ALG_SID_MD5 = 3
Private Const ALG_SID_SHA1 = 4
Private Const ALG_SID_DES = 1
Private Const ALG_SID_3DES = 3
Private Const ALG_SID_RC2 = 2
Private Const ALG_SID_RC4 = 1
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
Enum encAlgorithm
DES = ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_DES
[3DES] = ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_3DES
RC2 = ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_RC2
rc4 = ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_STREAM Or ALG_SID_RC4
End Enum
' Procedure : EncryptData
' Purpose : Encrypts a byte array.
Public Function EncryptsDate2(ByVal data As String) As String
Dim aData() As Byte
Dim hashAlgorithm As hashAlgorithm
Dim encAlgorithm As encAlgorithm
Dim password As String
aData = data
hashAlgorithm = md5
encAlgorithm = rc4
password = "1234"
EncryptsDate2 = PrintBytes(EncryptData(aData, password, hashAlgorithm, encAlgorithm))
End Function
Public Function EncryptData( _
data() As Byte, _
ByVal password As String, _
Optional ByVal hashAlgorithm As hashAlgorithm = md5, _
Optional ByVal encAlgorithm As encAlgorithm = rc4) As Byte()
Dim lRes As Long
Dim hProv As Long
Dim hHash As Long
Dim hKey As Long
Dim lBufLen As Long
Dim lDataLen As Long
Dim abData() As Byte
lRes = CryptAcquireContext(hProv, vbNullString, _
vbNullString, PROV_RSA_FULL, 0)
If lRes = 0 And Err.LastDllError = &H80090016 Then
lRes = CryptAcquireContext(hProv, vbNullString, _
vbNullString, PROV_RSA_FULL, CRYPT_NEWKEYSET)
End If
If lRes <> 0 Then
' Create a hash object
lRes = CryptCreateHash(hProv, hashAlgorithm, 0, 0, hHash)
If lRes <> 0 Then
' Hash the password
lRes = CryptHashData(hHash, ByVal password, Len(password), 0)
If lRes <> 0 Then
' Derive a key from the hash
lRes = CryptDeriveKey(hProv, encAlgorithm, hHash, 0, hKey)
If lRes <> 0 Then
' Calculate the array size
lBufLen = UBound(data) - LBound(data) + 1
lDataLen = lBufLen
' Get required buffer size
lRes = CryptEncrypt(hKey, 0&, 1, 0, ByVal 0&, lBufLen, 0)
If lRes <> 0 Then
' Initialize the buffer
If lBufLen < lDataLen Then lBufLen = lDataLen
ReDim abData(0 To lBufLen - 1)
MoveMemory abData(0), data(LBound(data)), lDataLen
' Encrypt the data
lRes = CryptEncrypt(hKey, 0&, 1, 0, abData(0), lBufLen, lDataLen)
If lRes <> 0 Then
If lDataLen <> lBufLen Then
ReDim Preserve abData(0 To lBufLen - 1)
End If
' Return the encrypted data
EncryptData = abData
End If
End If
End If
' Destroy the key
CryptDestroyKey hKey
End If
' Destroy the hash
CryptDestroyHash hHash
End If
' Release the provider context
CryptReleaseContext hProv, 0
End If
' Raise an error if lRes = 0
If lRes = 0 Then Err.Raise Err.LastDllError
End Function
' Procedure : DecryptData
' Purpose : Decrypts a byte array.
Public Function DecryptsData2(ByVal data As String) As String
Dim aData() As Byte
Dim hashAlgorithm As hashAlgorithm
Dim encAlgorithm As encAlgorithm
Dim password As String
aData = data
hashAlgorithm = md5
encAlgorithm = rc4
password = "1234"
DecryptsData2 = PrintBytes(DecryptData(aData, password, hashAlgorithm, encAlgorithm))
End Function
Public Function DecryptData( _
data() As Byte, _
ByVal password As String, _
Optional ByVal hashAlgorithm As hashAlgorithm = md5, _
Optional ByVal encAlgorithm As encAlgorithm = rc4) As Byte()
Dim lRes As Long
Dim hProv As Long
Dim hHash As Long
Dim hKey As Long
Dim lBufLen As Long
Dim abData() As Byte
' Get default provider context handle
lRes = CryptAcquireContext(hProv, vbNullString, _
vbNullString, PROV_RSA_FULL, 0)
' 贩贩----==== Added 11/04/2003 ====----贩贩
If lRes = 0 And Err.LastDllError = &H80090016 Then
lRes = CryptAcquireContext(hProv, vbNullString, _
vbNullString, PROV_RSA_FULL, CRYPT_NEWKEYSET)
End If
' 贩贩----========----贩贩
If lRes <> 0 Then
' Create a hash
lRes = CryptCreateHash(hProv, hashAlgorithm, 0, 0, hHash)
If lRes <> 0 Then
' Hash the password
lRes = CryptHashData(hHash, ByVal password, Len(password), 0)
If lRes <> 0 Then
' Derive a key from the hash
lRes = CryptDeriveKey(hProv, encAlgorithm, hHash, 0, hKey)
If lRes <> 0 Then
' Calculate the array size
lBufLen = UBound(data) - LBound(data) + 1
' Initialize the buffer
ReDim abData(0 To lBufLen - 1)
MoveMemory abData(0), data(LBound(data)), lBufLen
' Decrypt the data
lRes = CryptDecrypt(hKey, 0&, 1, 0, abData(0), lBufLen)
If lRes <> 0 Then
ReDim Preserve abData(0 To lBufLen - 1)
' Return the encrypted data
DecryptData = abData
End If
End If
' Destroy the key
CryptDestroyKey hKey
End If
' Destroy the hash
CryptDestroyHash hHash
End If
' Release the provider context
CryptReleaseContext hProv, 0
End If
' Raise an error if lRes = 0
If lRes = 0 Then Err.Raise Err.LastDllError
End Function
Private Function PrintBytes(a() As Byte) As String
Dim i As Long
Dim str As String
str = ""
For i = 0 To UBound(a)
'If i > 0 Then
'Debug.Print "-";
'str = str + "-"
'End If
'Debug.Print Right$("0" & Hex(a(i)), 2);
str = str + Right$("0" & Hex(a(i)), 2)
Next
'Debug.Print
PrintBytes = str
End Function
然后一个窗体调用：（窗体上两个文本框Text1,Text2,一个按钮Command1，点击按钮进行加解密）
Private e As New CryptoAPI
Private Sub Command1_Click()
Dim hashAlgorithm As hashAlgorithm
Dim encAlgorithm As encAlgorithm
hashAlgorithm = md5
encAlgorithm = rc4
Text1.Text = e.EncryptsDate2("中文english")
sText = e.DecryptsData2(Text1.Text)
Text2.Text = sText
End Sub
加密得到的内容是一样的，但是解密也变成加密了，不知道为什么，能麻烦看下吗？谢谢了
加密后内容：DD05BB1763F211EB7FB1E56AAB07F6C9F023
解密后内容：B44B787236F24AEB5AB1CB6AF307B2C9AE236FF8261F483C951AF005451D5F51EDE705155ECB0229B82F26167E2DC704E8EF35C4081AA6A3E2EC3CB66F22D059D440874FEA8BF5FD
[解决办法]
你的类代码中，DecryptsData2() 函数这样改：
Public Function DecryptsData2(ByVal data As String) As String
Dim aData() As Byte
Dim hashAlgorithm As hashAlgorithm
Dim encAlgorithm As encAlgorithm
Dim password As String
'aData = data
aData = TextToBytes(data)
hashAlgorithm = md5
encAlgorithm = rc4
password = "1234"
'DecryptsData2 = PrintBytes(DecryptData(aData, password, hashAlgorithm, encAlgorithm))
DecryptsData2 = DecryptData(aData, password, hashAlgorithm, encAlgorithm)
End Function
Private Function TextToBytes(sText As String) As Byte()
' 没容错处理，只要传入的是 PrintBytes()函数得来的文本就没问题
Dim aBuffer() As Byte
Dim i As Long, j As Long
i = Len(sText)
j = i \ 2 - 1
ReDim aBuffer(j)
For i = 0 To j
aBuffer(i) = CByte("&H" & Mid$(sText, i + i + 1, 2))
Next
TextToBytes = aBuffer()
End Function
