DES encryption with ASP

I was wondering if there is a easy way to do DES encryption in ASP.  I am trying to take a password, encrypt it, and then write it to a file.  I know how to do everthing else, it's just the encryption part that I'm not getting.

Thanks.
recusancyAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

sagebrushCommented:
We created a VB6 COM component and registered it on our ASP server.  

ASP side is fairly simple then


 Set objEncrypt=server.CreateObject("OurSecurity.Encryption")  

 objEncrypt.Encrypt(strPassword,strEncryptedPassword,strError

 We store ours on a database instead of a file

Here's a the class for building the COM component in VB6, no idea who  JEC is

Option Explicit

'Local Strings
Private mstrPassword As String
Private mstrInputBuffer As String
Private mstrOutputBuffer As String
Private mstrErrorMsg As String
Private mblnError As Boolean

Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (phProv As Long, ByVal pszContainer As Long, 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, 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, phKey As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long
Private Declare Function CryptDestroyKey Lib "advapi32.dll" (ByVal hKey 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, 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, pdwDataLen As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function WinGetLastError Lib "kernel32" Alias "GetLastError" () As Long

'Constants for Cryptography API functions

Private Const CRYPT_VERIFYCONTEXT = &HF0000000
Private Const MS_DEF_PROV = "Microsoft Base Cryptographic Provider v1.0"
Private Const PROV_RSA_FULL = 1

Private Const ALG_CLASS_HASH = 32768
Private Const ALG_TYPE_ANY = 0
Private Const ALG_SID_MD5 = 3
Private Const ALG_SID_RC4 = 1

Private Const ALG_CLASS_DATA_ENCRYPT = 24576
Private Const ALG_TYPE_STREAM = 2048

Private Const CALG_MD5 = ((ALG_CLASS_HASH Or ALG_TYPE_ANY) Or ALG_SID_MD5)
Private Const CALG_RC4 = ((ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_STREAM) Or ALG_SID_RC4)

Public Function Encrypt( _
   ByVal varPassword As Variant, _
   ByRef varEncryptedPassword As Variant, _
   ByRef varError As Variant) As Boolean

   On Error GoTo Eh
     
   mblnError = False
   mstrErrorMsg = ""
   
   mstrInputBuffer = varPassword
   mstrPassword = varPassword
   
   Call CryptoEncrypt
   
   varEncryptedPassword = mstrOutputBuffer
   
   Encrypt = Not mblnError
   If mblnError Then GoTo Eh
   Exit Function

Eh:
   varError = "Encrypt::" & mstrErrorMsg
End Function

Public Function EncryptText( _
   ByVal varPassword As Variant, _
   ByVal varText As Variant, _
   ByRef varEncryptedText As Variant, _
   ByRef varError As Variant) As Boolean

   On Error GoTo Eh
     
   mblnError = False
   mstrErrorMsg = ""
   
   mstrInputBuffer = varText
   mstrPassword = varPassword
   
   Call CryptoEncrypt
   
   varEncryptedText = mstrOutputBuffer
   
   EncryptText = Not mblnError
   If mblnError Then GoTo Eh
   Exit Function

Eh:
   varError = "EncryptText::" & mstrErrorMsg
End Function

Public Function DecryptText( _
   ByVal varPassword As Variant, _
   ByVal varText As Variant, _
   ByRef varDecryptedText As Variant, _
   ByRef varError As Variant) As Boolean

   On Error GoTo Eh
     
   mblnError = False
   mstrErrorMsg = ""
   
   mstrInputBuffer = varText
   mstrPassword = varPassword
   
   Call CryptoDecrypt
   
   varDecryptedText = mstrOutputBuffer
   
   DecryptText = Not mblnError
   If mblnError Then GoTo Eh
   Exit Function

Eh:
   varError = "DecryptText::" & mstrErrorMsg
End Function

Private Sub CryptoDecrypt()

   Dim lHExchgKey As Long
   Dim lHCryptprov As Long
   Dim lHHash As Long
   Dim lHkey As Long
   Dim lResult As Long
   Dim sProvider As String
   Dim sCryptBuffer As String
   Dim lCryptBufLen As Long
   Dim lCryptPoint As Long
   Dim lPasswordPoint As Long
   Dim lPasswordCount As Long
   
   On Error GoTo DecryptError

   'Clear the Output buffer
   mstrOutputBuffer = ""

  If CryptAcquireContext(lHCryptprov, 0, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) = 0 Then
    TrapError "Error " & CStr(WinGetLastError) & " during CryptAcquireContext"
    GoTo Finished
  End If

   'Create a hash object
   If Not CBool(CryptCreateHash(lHCryptprov, CALG_MD5, 0, 0, lHHash)) Then
      TrapError "Error " & CStr(WinGetLastError) & " during CryptCreateHash!"
      GoTo Finished
   End If

   'Hash in the password text
   If Not CBool(CryptHashData(lHHash, mstrPassword, Len(mstrPassword), 0)) Then
      TrapError "Error " & CStr(WinGetLastError) & " during CryptHashData!"
      GoTo Finished
   End If
   
   'Create a session key from the hash object
   If Not CBool(CryptDeriveKey(lHCryptprov, CALG_RC4, lHHash, 0, lHkey)) Then
      TrapError "Error " & CStr(WinGetLastError) & " during CryptDeriveKey!"
      GoTo Finished
   End If

   'Destroy the hash object.
   CryptDestroyHash (lHHash)
   lHHash = 0

   'Prepare sCryptBuffer for CryptDecrypt
   lCryptBufLen = Len(mstrInputBuffer) * 2
   sCryptBuffer = String(lCryptBufLen, vbNullChar)
   LSet sCryptBuffer = mstrInputBuffer

   'Decrypt data
   If Not CBool(CryptDecrypt(lHkey, 0, 1, 0, sCryptBuffer, lCryptBufLen)) Then
      TrapError "bytes required:" & CStr(lCryptBufLen) & _
         "Error " & CStr(WinGetLastError) & " during CryptDecrypt!"
      GoTo Finished
   End If

   'Setup output buffer with just decrypted data
   mstrOutputBuffer = Mid$(sCryptBuffer, 1, lCryptBufLen / 2)

Finished:

   'Destroy session key
   If (lHkey) Then lResult = CryptDestroyKey(lHkey)

   'Destroy key exchange key handle
   If lHExchgKey Then CryptDestroyKey (lHExchgKey)

   'Destroy hash object
   If lHHash Then CryptDestroyHash (lHHash)

   'Release Context provider handle
   If lHCryptprov Then lResult = CryptReleaseContext(lHCryptprov, 0)

Exit Sub

DecryptError:
TrapError "Decrypt Error: " & Error$
GoTo Finished
End Sub

Private Sub TrapError(ByVal istrErrorMsg As String)
   mblnError = True
   mstrErrorMsg = istrErrorMsg
End Sub

Private Sub CryptoEncrypt()

   Dim lHHash As Long
   Dim lHkey As Long
   Dim lResult As Long
   Dim lHExchgKey As Long
   Dim lHCryptprov As Long
   
   Dim sContainer As String
   Dim lCryptLength As Long
   Dim lCryptBufLen As Long
   Dim sCryptBuffer As String
   Dim sProvider As String
   
   On Error GoTo EncryptError

   'Get handle to the default CSP
   
  If CryptAcquireContext(lHCryptprov, 0, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) = 0 Then
    TrapError "Error " & CStr(WinGetLastError) & " during CryptAcquireContext"
    GoTo Finished
  End If
   
   'Create a hash object
   If Not CBool(CryptCreateHash(lHCryptprov, CALG_MD5, 0, 0, lHHash)) Then
       TrapError "Error " & CStr(WinGetLastError) & " during CryptCreateHash!"
       GoTo Finished
   End If
 
   'Hash in the password text
   If Not CBool(CryptHashData(lHHash, mstrPassword, Len(mstrPassword), 0)) Then
      TrapError "Error " & CStr(WinGetLastError) & " during CryptHashData!"
      GoTo Finished
   End If
 
   'Create a session key from the hash object.
   If Not CBool(CryptDeriveKey(lHCryptprov, CALG_RC4, lHHash, 0, lHkey)) Then
      TrapError "Error " & CStr(WinGetLastError) & " during CryptDeriveKey!"
      GoTo Finished
   End If

   'Destroy the hash object.
   CryptDestroyHash (lHHash)
   lHHash = 0

   'Create a buffer for the CryptEncrypt function
   lCryptLength = Len(mstrInputBuffer)
   lCryptBufLen = lCryptLength * 2
   sCryptBuffer = String(lCryptBufLen, vbNullChar)
   LSet sCryptBuffer = mstrInputBuffer

   'Encrypt the text data
   If Not CBool(CryptEncrypt(lHkey, 0, 1, 0, sCryptBuffer, lCryptLength, lCryptBufLen)) Then
       TrapError "bytes required:" & CStr(lCryptLength) & _
         "Error " & CStr(WinGetLastError) & " during CryptEncrypt!"
   End If

   mstrOutputBuffer = Mid$(sCryptBuffer, 1, lCryptLength)
   
Finished:

   'Destroy session key.
   If (lHkey) Then lResult = CryptDestroyKey(lHkey)
   'Destroy key exchange key handle
   If lHExchgKey Then CryptDestroyKey (lHExchgKey)
   'Destroy hash object
   If lHHash Then CryptDestroyHash (lHHash)
   'Release Context provider handle
   If lHCryptprov Then lResult = CryptReleaseContext(lHCryptprov, 0)

Exit Sub

EncryptError:

   TrapError "Encrypt Error: " & Error$
   GoTo Finished

End Sub




 
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Programming

From novice to tech pro — start learning today.