请教关于加密的API－advapi32.dll

Question

我使用advapi32.dll提供的函数（没找到文档）加密数据（每次长为8的字符串），解密输出后的字符串经常有乱码（如“="Micros”，加密后是“?ec;7k ”，解密后则成了“?#o;~38葿”）。我想是Unicode或DBCS方面出的问题，不知如何解决，或有更友好的API没有？
请教高手指南，多谢！

Answer 1

注意VB调用API时对字符串的自动转换。把你的代码贴上来看看。

Answer 2

先把类代码附上，这是用前辈现成代码：－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
类初始化
－－－－
Private Function InitUser() As Long
    Dim lHCryptprov As Long, lHCryptKey As Long, avProviderData(1000) As Byte
    Dim lProviderDataAddress As Long, lProviderDataLen As Long, lDataSize As Long
    Dim lResult As Long, sContainer As String, sProvider As String
    Dim sUserName As String, lPoint As Long, lMemHandle As Long
    Dim lReturn As Long, sBuffer As String    On Error GoTo ErrInitUser
    'prepare string buffers    sContainer = vbNullChar
    sProvider = MS_DEF_PROV & vbNullChar    'Attempt to acquire a handle to the default key container.
    If Not CBool(CryptAcquireContext(lHCryptprov, ByVal sContainer, ByVal sProvider, PROV_RSA_FULL, 0)) Then        'Create default key container.
        If Not CBool(CryptAcquireContext(lHCryptprov, ByVal sContainer, ByVal sProvider, PROV_RSA_FULL, CRYPT_NEWKEYSET)) Then
            MsgBox ("Error creating key container! " & CStr(GetLastError))
            Exit Function
        End If        'Get name of default key container.
        lProviderDataLen = Len(avProviderData(0)) * (UBound(avProviderData) + 1)
        If Not CBool(CryptGetProvParam(lHCryptprov, PP_CONTAINER, avProviderData(0), lProviderDataLen, 0)) Then
            MsgBox ("Error getting user name! " & CStr(GetLastError))
            avProviderData(0) = 0
        End If        'Get sUserName from avProviderData()
        lPoint = LBound(avProviderData)
        While lPoint <= UBound(avProviderData)
            If avProviderData(lPoint) <> 0 Then
                sUserName = sUserName & Chr$(avProviderData(lPoint))
            Else
                lPoint = UBound(avProviderData)
            End If
            lPoint = lPoint + 1
        Wend        MsgBox ("Create key container " & sUserName)    End If    'Attempt to get handle to signature key
    If Not CBool(CryptGetUserKey(lHCryptprov, AT_SIGNATURE, lHCryptKey)) Then
        If GetLastError = NTE_NO_KEY Then
            MsgBox ("Create key exchange key pair")
            If Not CBool(CryptGenKey(lHCryptprov, AT_SIGNATURE, 0, lHCryptKey)) Then
                MsgBox ("Error during CryptGenKey! " & CStr(GetLastError))
                Exit Function
            Else
                lResult = CryptDestroyKey(lHCryptprov)
            End If
        Else
            MsgBox ("Error during CryptGetUserKey! " & CStr(GetLastError))
            Exit Function
        End If
    End If    'Attempt to get handle to exchange key
    If Not CBool(CryptGetUserKey(lHCryptprov, AT_KEYEXCHANGE, lHCryptKey)) Then
        If GetLastError = NTE_NO_KEY Then
            MsgBox ("Create key exchange key pair")
            If Not CBool(CryptGenKey(lHCryptprov, AT_KEYEXCHANGE, 0, lHCryptKey)) Then
                MsgBox ("Error during CryptGenKey! " & CStr(GetLastError))
                Exit Function
            Else
                lResult = CryptDestroyKey(lHCryptprov)
            End If
        Else
            MsgBox ("Error during CryptGetUserKey! " & CStr(GetLastError))
            Exit Function
        End If
    End If    'release handle to provider
    lResult = CryptReleaseContext(lHCryptprov, 0)
    InitUser = TrueExit FunctionErrInitUser:
    MsgBox ("ErrInitUser " & Error$)
    ResumeEnd Function
Private Sub Class_Initialize()
    If InitUser = True Then
        MsgBox ("InitUser OK")
    Else
        MsgBox ("InitUser failed")
    End If
End Sub

Answer 3

Public Sub EnCrypt()
'Encrypt InBuffer into OutBufferDim lHExchgKey As Long, lHCryptprov As Long, lHHash As Long, lHkey As Long
Dim lResult As Long, sContainer As String, sProvider As String, sCryptBuffer As String
Dim lCryptLength As Long, lCryptBufLen As LongOn Error GoTo ErrEncrypt'switch Status property
lStatus = CFB_BUSY'Get handle to the default provider
sContainer = vbNullChar
sProvider = vbNullChar
sProvider = MS_DEF_PROV & vbNullChar
If Not CBool(CryptAcquireContext(lHCryptprov, ByVal sContainer, ByVal sProvider, PROV_RSA_FULL, 0)) Then
    MsgBox ("Error " & CStr(GetLastError) & " during CryptAcquireContext!")
    GoTo Done
End If'Create a hash object.
If Not CBool(CryptCreateHash(lHCryptprov, CALG_MD5, 0, 0, lHHash)) Then
    MsgBox ("Error " & CStr(GetLastError) & " during CryptCreateHash!")
    GoTo Done
End If'Hash in the password data.
If Not CBool(CryptHashData(lHHash, sPassword, Len(sPassword), 0)) Then
    MsgBox ("Error " & CStr(GetLastError) & " during CryptHashData!")
    GoTo Done
End If'Derive a session key from the hash object.
If Not CBool(CryptDeriveKey(lHCryptprov, ENCRYPT_ALGORITHM, lHHash, 0, lHkey)) Then
    MsgBox ("Error " & CStr(GetLastError) & " during CryptDeriveKey!")
    GoTo Done
End If'Destroy the hash object.
CryptDestroyHash (lHHash)
lHHash = 0'Prepare a string buffer for the CryptEncrypt function
lCryptLength = Len(sInBuffer)
lCryptBufLen = lCryptLength * 2
sCryptBuffer = String(lCryptBufLen, vbNullChar)
LSet sCryptBuffer = sInBuffer'Encrypt data
If Not CBool(CryptEncrypt(lHkey, 0, 1, 0, sCryptBuffer, lCryptLength, lCryptBufLen)) Then
    MsgBox ("bytes required:" & CStr(lCryptLength))
    MsgBox ("Error " & CStr(GetLastError) & " during CryptEncrypt!")
    'GoTo Done
End IfsOutBuffer = Mid$(sCryptBuffer, 1, lCryptLength)Done:'Destroy session key.
If (lHkey) Then lResult = CryptDestroyKey(lHkey)'Release key exchange key handle.
If lHExchgKey Then CryptDestroyKey (lHExchgKey)'Destroy hash object.
If lHHash Then CryptDestroyHash (lHHash)'Release provider handle.
If lHCryptprov Then lResult = CryptReleaseContext(lHCryptprov, 0)'switch Status property
lStatus = CFB_READYExit SubErrEncrypt:MsgBox ("ErrEncrypt " & Error$)
ResumeEnd SubPublic Property Let InBuffer(vNewValue As String)
    sInBuffer = vNewValue
End Property
Public Property Get OutBuffer() As String
    OutBuffer = sOutBuffer
End Property

Answer 4

Public Sub DeCrypt()
'Decrypt InBuffer into OutBuffer
Dim lHExchgKey As Long, lHCryptprov As Long, lHHash As Long, lHkey As Long
Dim lResult As Long, sContainer As String, sProvider As String
Dim sCryptBuffer As String, lCryptBufLen As Long, lCryptPoint As Long
Dim lPasswordPoint As Long, lPasswordCount As LongOn Error GoTo ErrDecrypt'switch Status property
lStatus = CFB_BUSY'Init sOutBuffer
sOutBuffer = ""'Get handle to the default provider.
sContainer = vbNullChar
sProvider = vbNullChar
sProvider = MS_DEF_PROV & vbNullChar
If Not CBool(CryptAcquireContext(lHCryptprov, ByVal sContainer, ByVal sProvider, PROV_RSA_FULL, 0)) Then
    MsgBox ("Error " & CStr(GetLastError) & " during CryptAcquireContext!")
    GoTo Done
End If'Create a hash object.
If Not CBool(CryptCreateHash(lHCryptprov, CALG_MD5, 0, 0, lHHash)) Then
    MsgBox ("Error " & CStr(GetLastError) & " during CryptCreateHash!")
    GoTo Done
End If'Hash in the password data.
If Not CBool(CryptHashData(lHHash, sPassword, Len(sPassword), 0)) Then
    MsgBox ("Error " & CStr(GetLastError) & " during CryptHashData!")
    GoTo Done
End If'Derive a session key from the hash object.
If Not CBool(CryptDeriveKey(lHCryptprov, ENCRYPT_ALGORITHM, lHHash, 0, lHkey)) Then
    MsgBox ("Error " & CStr(GetLastError) & " during CryptDeriveKey!")
    GoTo Done
End If'Destroy the hash object.
CryptDestroyHash (lHHash)
lHHash = 0'Prepare sCryptBuffer for CryptDecrypt
lCryptBufLen = Len(sInBuffer) * 2
sCryptBuffer = String(lCryptBufLen, vbNullChar)
LSet sCryptBuffer = sInBuffer'Decrypt data
If Not CBool(CryptDecrypt(lHkey, 0, 1, 0, sCryptBuffer, lCryptBufLen)) Then
    MsgBox ("bytes required:" & CStr(lCryptBufLen))
    MsgBox ("Error " & CStr(GetLastError) & " during CryptDecrypt!")
    GoTo Done
End If'Apply decrypted string from sCryptBuffer to private buffer for OutBuffer property
sOutBuffer = Mid$(sCryptBuffer, 1, Len(sInBuffer))Done:'Destroy session key.
If (lHkey) Then lResult = CryptDestroyKey(lHkey)'Release key exchange key handle.
If lHExchgKey Then CryptDestroyKey (lHExchgKey)'Destroy hash object.
If lHHash Then CryptDestroyHash (lHHash)'Release provider handle.
If lHCryptprov Then lResult = CryptReleaseContext(lHCryptprov, 0)'switch Status property
lStatus = CFB_READYExit SubErrDecrypt:
MsgBox ("ErrDecrypt " & Error$)
GoTo DoneEnd Sub

Answer 5

修改加密API的Declare：
'Private Declare Function CryptEncrypt Lib "advapi32.dll" (ByVal hKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, 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, ByVal pbData As String, ByRef pdwDataLen 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, ByVal pbData As Long, 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, ByVal pbData As Long, ByRef pdwDataLen As Long) As Long然后调用的时候用：
CryptEncrypt lngKey, 0, 1, 0, StrPtr(strCryptBuffer), lngCryptLen * 2, lngCryptBuffLen
CryptDecrypt lngKey, 0, 1, 0, StrPtr(strCryptBuffer), lngCryptBuffLen然后注意修改解密后的数据长度就可以了。

Answer 6

应该是解决了，但是只能用于ASCII码文件。请教一下，对于中文字符与ASCII字符并存的文件如何处理

Answer 7

这个是针对字符串的，你说只适用于ASCII码，大概跟你对文件的操作有关。