就是执行CryptEncryp加密的时候总是返回假
如果那位高手做过。能不能加我 QQ75147038:CryptoAPI
非常的感激这是代码:
Public Function CryptoEncrypt(StringToEncrypt As String, _
sPassword As String, ReturnString As String) As Boolean '0D
Dim lHHash As Long, lHkey As Long, lResult As Long
Dim lHExchgKey As Long, lHCryptprov As Long, lCryptLength As Long
Dim lPasswordCount As Long
Dim lcryptBufLen As Long
Dim sContainer As String, InputString As String, sProvider As String
Dim EncryptedText As String
Dim i As Integer
On Error GoTo DecryptError
CryptoEncrypt = False ''''º¯Êý·µ»Ø1
sContainer = vbNullChar
sProvider = vbNullChar
sProvider = MS_DEF_PROV & vbNullChar
PROV_RSA_FULL, 0)
If Not CBool(CryptAcquireContext(lHCryptprov, ByVal sContainer, ByVal sProvider, PROV_RSA_FULL, 0)) Then '''CryptAcquireContextÖ´ÐÐʧ°Üºó¡£¡£¡£
MsgBox "Error" & CStr(GetLastError) & "during CryptAcquireContext! """
GoTo Finished
End If
If Not CBool(CryptCreateHash(lHCryptprov, CALG_MD5, 0, 0, lHHash)) Then
MsgBox "Error" & CStr(GetLastError) & "during CryptCreateHash! """
GoTo Finished
End If
If Not CBool(CryptHashData(lHHash, sPassword, Len(sPassword), 0)) Then
MsgBox "Error" & CStr(GetLastError) & "during CryptHashData! """
GoTo Finished
End If
If Not CBool(CryptDeriveKey(lHCryptprov, ENCRYPT_ALGORITHM, lHHash, 0, lHkey)) Then
MsgBox "Error" & CStr(GetLastError) & "during CryptDeriveKey! """ ''''''
GoTo Finished
End If
CryptDestroyHash (lHHash) '''''''// ɾ³ýÉ¢Áбí ''''
lHHash = 0
ReturnString = ""
For i = 1 To Len(StringToEncrypt) Step 255
InputString = Mid(StringToEncrypt, i, 255)
lCryptLength = Len(InputString)
lcryptBufLen = lCryptLength * 2 就是执行CryptEncryp加密的时候总是返回假
If Not CBool(CryptEncrypt(lHkey, lHHash, True, 0, InputString, lCryptLength, lcryptBufLen)) Then MsgBox "Error" & CStr(GetLastError) & "during CryptDecrypt!" & i '/²úÉú´íÎ󡣡£¼ÓÃܲúÉú´íÎó
GoTo Finished
Else
EncryptedText = EncryptedText & InputString
End If
Next i
ReturnString = EncryptedText
CryptoEncrypt = True ''º¯Êý·µ»Ø2
Finished:
If (lHkey) Then
lResult = CryptDestroyKey(lHkey)
End If
If (lHExchgKey) Then
lResult = CryptDestroyKey(lHExchgKey)
End If
If (lHHash) Then
If (lHCryptprov) Then ''''º¯ÊýCryptReleaseContextÓÃÓÚÊͷź¯ÊýCryptAcquireContext·µ»ØµÄ¾ä±ú
lResult = CryptReleaseContext(lHCryptprov, 0)
End If
End If
Exit Function
DecryptError:
MsgBox "decrypt error:" & Err.Number & Err.Description
'' GoTo Finished
End Function
如果那位高手做过。能不能加我 QQ75147038:CryptoAPI
非常的感激这是代码:
Public Function CryptoEncrypt(StringToEncrypt As String, _
sPassword As String, ReturnString As String) As Boolean '0D
Dim lHHash As Long, lHkey As Long, lResult As Long
Dim lHExchgKey As Long, lHCryptprov As Long, lCryptLength As Long
Dim lPasswordCount As Long
Dim lcryptBufLen As Long
Dim sContainer As String, InputString As String, sProvider As String
Dim EncryptedText As String
Dim i As Integer
On Error GoTo DecryptError
CryptoEncrypt = False ''''º¯Êý·µ»Ø1
sContainer = vbNullChar
sProvider = vbNullChar
sProvider = MS_DEF_PROV & vbNullChar
PROV_RSA_FULL, 0)
If Not CBool(CryptAcquireContext(lHCryptprov, ByVal sContainer, ByVal sProvider, PROV_RSA_FULL, 0)) Then '''CryptAcquireContextÖ´ÐÐʧ°Üºó¡£¡£¡£
MsgBox "Error" & CStr(GetLastError) & "during CryptAcquireContext! """
GoTo Finished
End If
If Not CBool(CryptCreateHash(lHCryptprov, CALG_MD5, 0, 0, lHHash)) Then
MsgBox "Error" & CStr(GetLastError) & "during CryptCreateHash! """
GoTo Finished
End If
If Not CBool(CryptHashData(lHHash, sPassword, Len(sPassword), 0)) Then
MsgBox "Error" & CStr(GetLastError) & "during CryptHashData! """
GoTo Finished
End If
If Not CBool(CryptDeriveKey(lHCryptprov, ENCRYPT_ALGORITHM, lHHash, 0, lHkey)) Then
MsgBox "Error" & CStr(GetLastError) & "during CryptDeriveKey! """ ''''''
GoTo Finished
End If
CryptDestroyHash (lHHash) '''''''// ɾ³ýÉ¢Áбí ''''
lHHash = 0
ReturnString = ""
For i = 1 To Len(StringToEncrypt) Step 255
InputString = Mid(StringToEncrypt, i, 255)
lCryptLength = Len(InputString)
lcryptBufLen = lCryptLength * 2 就是执行CryptEncryp加密的时候总是返回假
If Not CBool(CryptEncrypt(lHkey, lHHash, True, 0, InputString, lCryptLength, lcryptBufLen)) Then MsgBox "Error" & CStr(GetLastError) & "during CryptDecrypt!" & i '/²úÉú´íÎ󡣡£¼ÓÃܲúÉú´íÎó
GoTo Finished
Else
EncryptedText = EncryptedText & InputString
End If
Next i
ReturnString = EncryptedText
CryptoEncrypt = True ''º¯Êý·µ»Ø2
Finished:
If (lHkey) Then
lResult = CryptDestroyKey(lHkey)
End If
If (lHExchgKey) Then
lResult = CryptDestroyKey(lHExchgKey)
End If
If (lHHash) Then
If (lHCryptprov) Then ''''º¯ÊýCryptReleaseContextÓÃÓÚÊͷź¯ÊýCryptAcquireContext·µ»ØµÄ¾ä±ú
lResult = CryptReleaseContext(lHCryptprov, 0)
End If
End If
Exit Function
DecryptError:
MsgBox "decrypt error:" & Err.Number & Err.Description
'' GoTo Finished
End Function
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货