Link to home
Start Free TrialLog in
Avatar of SweatCoder
SweatCoderFlag for United States of America

asked on

advapi encryption breaks in asp

I have an encryption class for VB that I got from here:

https://www.experts-exchange.com/questions/21403385/need-encryption-module.html

I have modified it slightly to produce the code sample below. It works great in VB from a test harness, and also works great when calling it from a .vbs file. But when I call the compiled class (DLL) from asp (not .net), I get the following error:

"Error during CryptAcquireContext for a new key container. A container with this name probably already exists. Err.Description: Err.LastDllError: -2146893802"

500 points if you can tell me what I need to change to get this to work when called from asp.

=============================================================

' Copyright (c) 2005 Clearlogic Concepts (UK) Limited
'
' N.Lee [ http://NigelLee.info ] - 27 April 2005

Private Const lngALG_CLASS_DATA_ENCRYPT                 As Long = 24576&
Private Const lngALG_CLASS_HASH                         As Long = 32768
Private Const lngALG_SID_MD5                            As Long = 3&
Private Const lngALG_SID_RC4                            As Long = 1&
Private Const lngALG_TYPE_ANY                           As Long = 0&
Private Const lngALG_TYPE_STREAM                        As Long = 2048&
Private Const lngCALG_MD5                               As Long = ((lngALG_CLASS_HASH Or lngALG_TYPE_ANY) Or lngALG_SID_MD5)
Private Const lngCALG_RC4                               As Long = ((lngALG_CLASS_DATA_ENCRYPT Or lngALG_TYPE_STREAM) Or lngALG_SID_RC4)
Private Const lngCRYPT_NEWKEYSET                        As Long = 8&
Private Const lngENCRYPT_ALGORITHM                      As Long = lngCALG_RC4
Private Const lngPROV_RSA_FULL                          As Long = 1&
Private Const strKEY_CONTAINER                          As String = "TestString"
Private Const strSERVICE_PROVIDER                       As String = "Microsoft Base Cryptographic Provider v1.0"
Private Const strMODULE_NAME                            As String = "clsCryptography"
Private Const lngERR_NUMBER_SUCCESS                     As Long = 0
Private Const strEncryptionPassword                     As String = "h&*#4Tv(@!"

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 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 CryptHashData _
                     Lib "advapi32.dll" _
                         (ByVal hHash As Long, _
                          ByVal pbData As String, _
                          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 CryptDestroyHash _
                     Lib "advapi32.dll" _
                         (ByVal hHash 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 String, _
                          ByRef pdwDataLen As Long, _
                          ByVal dwBufLen As Long) As Long
                         
Private Declare Function CryptDestroyKey _
                     Lib "advapi32.dll" _
                         (ByVal hKey As Long) As Long
                         
Private Declare Function CryptReleaseContext _
                     Lib "advapi32.dll" _
                         (ByVal hProv As Long, _
                          ByVal dwFlags 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
Public Function Encrypt(ByVal strValue As String) As String
    Encrypt = strEncrypt_Or_Decrypt(strValue, True)
End Function
Public Function Decrypt(ByVal strValue As String) As String
  Decrypt = strEncrypt_Or_Decrypt(HexStringToByteArray(strValue), False)
End Function
Private Function strEncrypt_Or_Decrypt(ByVal strValue As String, _
                                       ByVal blnEncrypt As Boolean) As String

    Dim lngCryptProv  As Long
    Dim lngHash       As Long
    Dim lngKey        As Long
    Dim lngLength     As Long
    Dim strReturn     As String
    strReturn = ""
    ErrText = ""
   
    On Error Resume Next
 
    If (CryptAcquireContext(lngCryptProv, strKEY_CONTAINER, strSERVICE_PROVIDER, lngPROV_RSA_FULL, lngCRYPT_NEWKEYSET) = 0) Then
       If (CryptAcquireContext(lngCryptProv, strKEY_CONTAINER, strSERVICE_PROVIDER, lngPROV_RSA_FULL, 0&) = 0) Then
          ErrText = ErrText & "Error during CryptAcquireContext for a new key container." & vbCrLf
          ErrText = ErrText & "A container with this name probably already exists." & vbCrLf
          ErrText = ErrText & "Err.Description: " & Err.Description & vbCrLf
          ErrText = ErrText & "Err.LastDllError: " & Err.LastDllError & vbCrLf
          GoTo Cleanup
       End If
    End If
   
    If Err.Number = 0 Then
       If (CryptCreateHash(lngCryptProv, lngCALG_MD5, 0&, 0&, lngHash) = 0) Then
          ErrText = ErrText & "Could not create a Hash Object (CryptCreateHash API)." & vbCrLf
          ErrText = ErrText & "Err.Description: " & Err.Description & vbCrLf
          ErrText = ErrText & "Err.LastDllError: " & Err.LastDllError & vbCrLf
          GoTo Cleanup
       End If
    End If
 
    If Err.Number = 0 Then
       If (CryptHashData(lngHash, strEncryptionPassword, Len(strEncryptionPassword), 0&) = 0) Then
          ErrText = ErrText & "Could not calculate a Hash Value (CryptHashData API)." & vbCrLf
          ErrText = ErrText & "Err.Description: " & Err.Description & vbCrLf
          ErrText = ErrText & "Err.LastDllError: " & Err.LastDllError & vbCrLf
          GoTo Cleanup
       End If
    Else
     
    End If
 
    If Err.Number = 0 Then
       If (CryptDeriveKey(lngCryptProv, lngENCRYPT_ALGORITHM, lngHash, 0&, lngKey) = 0) Then
          ErrText = ErrText & "Could not create a session key (CryptDeriveKey API)." & vbCrLf
          ErrText = ErrText & "Err.Description: " & Err.Description & vbCrLf
          ErrText = ErrText & "Err.LastDllError: " & Err.LastDllError & vbCrLf
          GoTo Cleanup
       End If
    End If
   
    If Err.Number = 0 Then
       lngLength = Len(strValue)
   
       If (blnEncrypt) Then
          If (CryptEncrypt(lngKey, 0&, 1&, 0&, strValue, lngLength, lngLength) = 0) Then
             ErrText = ErrText & "Error during CryptEncrypt." & vbCrLf
             ErrText = ErrText & "Err.Description: " & Err.Description & vbCrLf
             ErrText = ErrText & "Err.LastDllError: " & Err.LastDllError & vbCrLf
             GoTo Cleanup
          End If
       Else
          If (CryptDecrypt(lngKey, 0&, 1&, 0&, strValue, lngLength) = 0) Then
             ErrText = ErrText & "Error during CryptDecrypt." & vbCrLf
             ErrText = ErrText & "Err.Description: " & Err.Description & vbCrLf
             ErrText = ErrText & "Err.LastDllError: " & Err.LastDllError & vbCrLf
             GoTo Cleanup
          End If
       End If
    End If
   
    If Err.Number = 0 Then
        If blnEncrypt Then 'encrypt
            strEncrypt_Or_Decrypt = ByteArrayToHexString(Left$(strValue, lngLength))
        Else 'decrypt
            strEncrypt_Or_Decrypt = Left$(strValue, lngLength)
        End If
        Exit Function
    Else
        strEncrypt_Or_Decrypt = "Err.Description: " & Err.Description & vbCrLf
    End If
 
Cleanup:
    Call CryptDestroyKey(lngKey)
    Call CryptDestroyHash(lngHash)
    Call CryptReleaseContext(lngCryptProv, 0)
    strEncrypt_Or_Decrypt = ErrText
    Exit Function
End Function
Private Function ByteArrayToHexString(byteArr() As Byte) As String
    tmp = ""
    If ArraySize(byteArr) > 0 Then
        Dim i As Integer
        For i = LBound(byteArr) To UBound(byteArr)
            tmp = tmp & Right("00" & Hex(byteArr(i)), 2)
        Next i
    End If
    ByteArrayToHexString = tmp
End Function
Public Function HexStringToByteArray(str As String) As Byte()
    If str <> vbNullString Then
        Dim i As Integer, byteArr() As Byte, counter As Integer
        ReDim byteArr(0 To (Len(str) / 2) - 1) As Byte
        For i = 1 To Len(str) Step 2
            byteArr(counter) = CDbl(Val("&H" & Mid(str, i, 2)))
            counter = counter + 1
        Next i
        HexStringToByteArray = byteArr
    End If
End Function
Private Function ArraySize(ByRef byteArr() As Byte) As Long
    On Error Resume Next
    ArraySize = UBound(byteArr) - LBound(byteArr) + 1
    If Err.Number <> 0 Then ArraySize = 0
End Function
Public Function GetHash(StrVal As String, IsCaseSensitive As Boolean) As String
    'gets MD5 hash
    Set objCrypto = CreateObject("PDCrypto.clsCryptoAPI")
    GetHash = objCrypto.CreateHash(StrVal, 1, True, False, IsCaseSensitive)
    Set objCrypto = Nothing
End Function

Avatar of jitganguly
jitganguly

This will not work that easily on Web enviornment. You are trying to use some Windows API and your web user i.e. IUSR_{yourservername} does not have enough permission to  access windows API
So the first thing is try giving enough permission to advapi32.dll. Choose that DLL, R click to properties, security and add IUSR_{yourservername} admin/ or somethign higher and try running

Also does this DLL where this crypt code exists has enough permission ?
ASKER CERTIFIED SOLUTION
Avatar of anthonywjones66
anthonywjones66

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of SweatCoder

ASKER

That's the 1st thing I had already tried. I granted Everyone, Full Control to advapi.dll.

So I don't believe it's a permissions issue.
oops, i was late on the post. i'll try your suggested changes soon.
Anthony, well done! Works perfectly.

Please tell me: What type of encryption is being employed here, exactly? I'm vaguely familiar with the different varieties: AES,DES,SHA-1,MD5, etc. . .do you know?

THANKS!
The code uses an MD5 hash to use in creating a key.  

MD5 is described briefly here:-

http://www.rsasecurity.com/rsalabs/node.asp?id=2253

Then the RC4 stream encryption is being used it is briefly described here:-

http://www.rsasecurity.com/rsalabs/node.asp?id=2250

Anthony.