SweatCoder
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_ENCRYP T 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(strV alue, True)
End Function
Public Function Decrypt(ByVal strValue As String) As String
Decrypt = strEncrypt_Or_Decrypt(HexS tringToByt eArray(str Value), False)
End Function
Private Function strEncrypt_Or_Decrypt(ByVa l 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(lngCr yptProv, strKEY_CONTAINER, strSERVICE_PROVIDER, lngPROV_RSA_FULL, lngCRYPT_NEWKEYSET) = 0) Then
If (CryptAcquireContext(lngCr yptProv, 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(lngCryptP rov, 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(lngCryptPr ov, 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(lngCry ptProv, 0)
strEncrypt_Or_Decrypt = ErrText
Exit Function
End Function
Private Function ByteArrayToHexString(byteA rr() 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.cls CryptoAPI" )
GetHash = objCrypto.CreateHash(StrVa l, 1, True, False, IsCaseSensitive)
Set objCrypto = Nothing
End Function
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_ENCRYP
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(strV
End Function
Public Function Decrypt(ByVal strValue As String) As String
Decrypt = strEncrypt_Or_Decrypt(HexS
End Function
Private Function strEncrypt_Or_Decrypt(ByVa
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(lngCr
If (CryptAcquireContext(lngCr
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(lngCryptP
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)
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(lngCryptPr
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$
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(lngCry
strEncrypt_Or_Decrypt = ErrText
Exit Function
End Function
Private Function ByteArrayToHexString(byteA
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.cls
GetHash = objCrypto.CreateHash(StrVa
Set objCrypto = Nothing
End Function
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 ?
Also does this DLL where this crypt code exists has enough permission ?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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.
So I don't believe it's a permissions issue.
ASKER
oops, i was late on the post. i'll try your suggested changes soon.
ASKER
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!
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.
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.