VB6 to VB.NET Convert decrypt function

Public 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

Public 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

Public Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, _
ByVal pbData As String, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long

Public 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

Public Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long

Public Declare Function CryptDestroyKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Public 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

Public 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

Public Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, _
ByVal dwFlags As Long) As Long

Public Declare Function GetLastError Lib "kernel32" () As Long

'constants for Cryptography API functions
Private Const CRYPT_NEWKEYSET = &H8
Private Const MS_DEF_PROV = "Microsoft Base Cryptographic Provider v1.0"
Private Const PROV_RSA_FULL = 1
Private Const ALG_CLASS_DATA_ENCRYPT = 24576
Private Const ALG_CLASS_HASH = 32768

Private Const ALG_TYPE_ANY = 0
Private Const ALG_TYPE_BLOCK = 1536
Private Const ALG_TYPE_STREAM = 2048

Private Const ALG_SID_RC2 = 2

Private Const ALG_SID_RC4 = 1
Private Const ALG_SID_SHA1 = 4
Private Const ALG_SID_MD5 = 3
Private Const CALG_SHA1 = ((ALG_CLASS_HASH Or ALG_TYPE_ANY) Or ALG_SID_SHA1)
Private Const CALG_MD5 = ((ALG_CLASS_HASH Or ALG_TYPE_ANY) Or ALG_SID_MD5)
Private Const CALG_RC2 = ((ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK) Or ALG_SID_RC2)
Private Const CALG_RC4 = ((ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_STREAM) Or ALG_SID_RC4)

Private Const ENCRYPT_ALGORITHM = CALG_RC2
Private Const ENCRYPT_BLOCK_SIZE = 1

Private Const CRYPT_EXPORTABLE = 1

' used to specify not to use any salt value while deriving the key
Private Const CRYPT_NO_SALT As Long = &H10

Private Function CryptoDecrypt(sInputBuffer As String, sPassword As String, ByRef sErrore As String) As String
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
   
   'get handle to the default CSP.
   sProvider = vbNullChar
   sProvider = MS_DEF_PROV & vbNullChar
   If Not CBool(CryptAcquireContext(lHCryptprov, 0&, sProvider, PROV_RSA_FULL, 0)) Then
      'If there is no default key container then create one using Flags field
      If GetLastError = 0 Then
         If Not CBool(CryptAcquireContext(lHCryptprov, 0&, sProvider, PROV_RSA_FULL, CRYPT_NEWKEYSET)) Then
              GoTo Finished
         End If
      End If
   End If
   
   'Create a hash object
   If Not CBool(CryptCreateHash(lHCryptprov, CALG_SHA1, 0, 0, lHHash)) Then
         GoTo Finished
   End If
   
   'Hash in the password text
   If Not CBool(CryptHashData(lHHash, sPassword, Len(sPassword), 0)) Then
         GoTo Finished
   End If
   
   'Create a session key from the hash object
   If Not CBool(CryptDeriveKey(lHCryptprov, ENCRYPT_ALGORITHM, lHHash, ByVal CRYPT_NO_SALT, lHkey)) Then
         GoTo Finished
   End If
   
   'Destroy the hash object.
   CryptDestroyHash (lHHash)
   lHHash = 0
   
   'Prepare sCryptBuffer for CryptDecrypt
   lCryptBufLen = Len(sInputBuffer)
   sCryptBuffer = String(lCryptBufLen, vbNullChar)
   LSet sCryptBuffer = sInputBuffer
   
   'Decrypt data
   If Not CBool(CryptDecrypt(lHkey, 0, 1, 0, sCryptBuffer, lCryptBufLen)) Then
         GoTo Finished
   End If
   
   'Setup output buffer with just decrypted data
   CryptoDecrypt = Mid(sCryptBuffer, 1, lCryptBufLen)
   
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 Function
   
DecryptError:
   msgbox (GetLastError )

End Function

Select allOpen in new window