就是执行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