[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

advapi encryption breaks in asp

Posted on 2005-04-27
7
Medium Priority
?
827 Views
Last Modified: 2008-03-10
I have an encryption class for VB that I got from here:

http://www.experts-exchange.com/Programming/Programming_Languages/Visual_Basic/Q_21403385.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

0
Comment
Question by:SweatCoder
  • 3
  • 2
  • 2
7 Comments
 
LVL 20

Expert Comment

by:jitganguly
ID: 13876532
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
0
 
LVL 20

Expert Comment

by:jitganguly
ID: 13876560
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 ?
0
 
LVL 8

Accepted Solution

by:
anthonywjones66 earned 2000 total points
ID: 13877175
the call to CryptAcquireContext is not appropriate for ASP.

Make the following changes:-


Add these enums to your module:-

Private Enum AquireContextFlags
    CRYPT_VERIFYCONTEXT = &HF0000000
    CRYPT_NEWKEYSET = &H8
    CRYPT_DELETEKEYSET = &H10
    CRYPT_MACHINE_KEYSET = &H20
    CRYPT_SILENT = &H40
End Enum

Private Enum ProviderType
    PROV_RSA_FULL = 1
End Enum

Tweak CryptAquireContextLib definition: (Not required but I prefer it)

Private Declare Function CryptAcquireContext Lib "advapi32.dll" _
   Alias "CryptAcquireContextA" ( _
   ByRef phProv As Long, _
   ByVal pszContainer As String, _
   ByVal pszProvider As String, _
   ByVal dwProvType As ProviderType, _
   ByVal dwFlags As AquireContextFlags) As Long



Now change the call to:-

CryptAcquireContext lngCryptProv, vbNullString, _
                                    vbNullString, _
                                    PROV_RSA_FULL, _
                                    CRYPT_MACHINE_KEYSET Or CRYPT_SILENT Or CRYPT_VERIFYCONTEXT


The original call was trying to create a new container of keys under the current user.  It also failed to ensure that crypto api did not popup any UI elements.  Since you are using a seed password and only want to create a symetric key you don't need a  private key store.

The in the above call eliminate any chance of a UI trying to pop up and doesn't try to create a key store.

Anthony.
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
LVL 11

Author Comment

by:SweatCoder
ID: 13877210
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.
0
 
LVL 11

Author Comment

by:SweatCoder
ID: 13877218
oops, i was late on the post. i'll try your suggested changes soon.
0
 
LVL 11

Author Comment

by:SweatCoder
ID: 13877573
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!
0
 
LVL 8

Expert Comment

by:anthonywjones66
ID: 13877999
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.
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Have you ever needed to get an ASP script to wait for a while? I have, just to let something else happen. Or in my case, to allow other stuff to happen while I was murdering my MySQL database with an update. The Original Issue This was written…
This demonstration started out as a follow up to some recently posted questions on the subject of logging in: http://www.experts-exchange.com/Programming/Languages/Scripting/JavaScript/Q_28634665.html and http://www.experts-exchange.com/Programming/…
Integration Management Part 2
Please read the paragraph below before following the instructions in the video — there are important caveats in the paragraph that I did not mention in the video. If your PaperPort 12 or PaperPort 14 is failing to start, or crashing, or hanging, …
Suggested Courses

834 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question