Solved

hash algorithm

Posted on 2001-06-14
6
498 Views
Last Modified: 2010-08-05
Hi,
I am doing a program which will encrypt and decrypt a word.

Say for example input is :Hello

The code should encrypt and dcerypt the same.

I have been asked to implement md5 hash algorithm.

Can anyone give me a code which will implement the aboove using this algorithm.

Also let me know how we will decrypt the same.

Regds
0
Comment
Question by:gurukg102498
6 Comments
 
LVL 43

Expert Comment

by:TimCottee
Comment Utility
http://www.freevbcode.com/ShowCode.ASP?ID=741

Though MD5 is a one-way hashing algorithm, you cannot decrypt is as I understand the process.
0
 
LVL 3

Expert Comment

by:gmleeman
Comment Utility
Hashing is usually not reversable.  

Encrpyt and decrypt are very different because they are always reversable.

Which one do you need?
0
 
LVL 18

Accepted Solution

by:
deighton earned 100 total points
Comment Utility
'here's a method using api

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Description:  This module provides encryption/decryption through
'               the CryptoAPI. This is the standard API you can use
'               regardless of the underlying dll used to do the encryption.
'               These dlls are called Cryptographic Service Providers (CSPs)
'               and you get one as standard from Microsoft called
'               "Microsoft Base Cryptographic Provider v1.0"
'               This module uses the standard CSP, but this can be changed
'               by changing the constant SERVICE_PROVIDER
'
'               A word of warning:
'               If you are going to use WritePrivateProfileString to write the
'               encrypted value to an ini file, you must write a NULL first
'               to delete the existing entry as it does not clear previous
'               entries when writing binary data. This is a problem if you
'               are overwriting a value with a smaller one.
'
' Example usage:
'
   Private Const MY_PASSWORD As String = "YOUR PASSWORD"

'
'
' Created By:   Barry Dunne
' Date Created: 31 Jan 2000
'
' Public Interface:
'
'   Function EncryptionCSPConnect() As Boolean
'       - Connect to CSP, must be called before using encryption
'   Function EncryptData(ByVal Data As String, ByVal Password As String) As String
'       - Encrypt a string
'   Function DecryptData(ByVal Data As String, ByVal Password As String) As String
'       - Decrypt a string
'   Function GetCSPDetails() As String
'       - Returns the CSP details
'   Sub EncryptionCSPDisconnect()
'       - Release handle, must be called when finished using encryption
'
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Option Explicit

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 CryptGetProvParam Lib "advapi32.dll" _
    (ByVal hProv As Long, _
     ByVal dwParam As Long, _
     ByRef pbData As Any, _
     ByRef pdwDataLen 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

Private Const SERVICE_PROVIDER As String = "Microsoft Base Cryptographic Provider v1.0"
Private Const KEY_CONTAINER As String = "Metallica"
Private Const PROV_RSA_FULL As Long = 1
Private Const PP_NAME As Long = 4
Private Const PP_CONTAINER As Long = 6
Private Const CRYPT_NEWKEYSET As Long = 8
Private Const ALG_CLASS_DATA_ENCRYPT As Long = 24576
Private Const ALG_CLASS_HASH As Long = 32768
Private Const ALG_TYPE_ANY As Long = 0
Private Const ALG_TYPE_STREAM As Long = 2048
Private Const ALG_SID_RC4 As Long = 1
Private Const ALG_SID_MD5 As Long = 3
Private Const CALG_MD5 As Long = ((ALG_CLASS_HASH Or ALG_TYPE_ANY) Or ALG_SID_MD5)
Private Const CALG_RC4 As Long = ((ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_STREAM) Or ALG_SID_RC4)
Private Const ENCRYPT_ALGORITHM As Long = CALG_RC4
Private Const NUMBER_ENCRYPT_PASSWORD As String = "?o?s?PQ]"

Private hCryptProv As Long

Public Function EncryptionCSPConnect() As Boolean
    'Get handle to CSP
    If CryptAcquireContext(hCryptProv, KEY_CONTAINER, SERVICE_PROVIDER, PROV_RSA_FULL, CRYPT_NEWKEYSET) = 0 Then
        If CryptAcquireContext(hCryptProv, KEY_CONTAINER, SERVICE_PROVIDER, PROV_RSA_FULL, 0) = 0 Then
            HandleError "Error during CryptAcquireContext for a new key container." & vbCrLf & _
                        "A container with this name probably already exists."
            EncryptionCSPConnect = False
            Exit Function
        End If
    End If
   
    EncryptionCSPConnect = True
End Function

Public Sub EncryptionCSPDisconnect()
    'Release provider handle.
    If hCryptProv <> 0 Then
        CryptReleaseContext hCryptProv, 0
    End If
End Sub

Public Function EncryptData(ByVal Data As String, ByVal Password As String) As String
    Dim sEncrypted As String
    Dim lEncryptionCount As Long
    Dim sTempPassword As String
   
    'It is possible that the normal encryption will give you a string
    'containing cr or lf characters which make it difficult to write to files
    'Do a loop changing the password and keep encrypting until the result is ok
    'To be able to decrypt we need to also store the number of loops in the result
   
    'Try first encryption
    lEncryptionCount = 0
    sTempPassword = Password & lEncryptionCount
    sEncrypted = EncryptDecrypt(Data, sTempPassword, True)
   
   
    'Build encrypted string, starting with number of encryption iterations
    EncryptData = EncryptNumber(lEncryptionCount) & sEncrypted
End Function

Public Function DecryptData(ByVal Data As String, ByVal Password As String) As String
    Dim lEncryptionCount As Long
    Dim sDecrypted As String
    Dim sTempPassword As String
   
    'When encrypting we may have gone through a number of iterations
    'How many did we go through?
    lEncryptionCount = DecryptNumber(Mid$(Data, 1, 8))
   
    'start with the last password and work back
    sTempPassword = Password & lEncryptionCount
    sDecrypted = EncryptDecrypt(Mid$(Data, 9), sTempPassword, False)
   
    DecryptData = sDecrypted
End Function

Public Function GetCSPDetails() As String
    Dim lLength As Long
    Dim yContainer() As Byte
   
    If hCryptProv = 0 Then
        GetCSPDetails = "Not connected to CSP"
        Exit Function
    End If
   
    'For developer info, show what the CSP & container name is
    lLength = 1000
    ReDim yContainer(lLength)
    If CryptGetProvParam(hCryptProv, PP_NAME, yContainer(0), lLength, 0) <> 0 Then
        GetCSPDetails = "Cryptographic Service Provider name: " & ByteToStr(yContainer, lLength)
    End If
    lLength = 1000
    ReDim yContainer(lLength)
    If CryptGetProvParam(hCryptProv, PP_CONTAINER, yContainer(0), lLength, 0) <> 0 Then
        GetCSPDetails = GetCSPDetails & vbCrLf & "Key Container name: " & ByteToStr(yContainer, lLength)
    End If
End Function

Private Function EncryptDecrypt(ByVal Data As String, ByVal Password As String, ByVal Encrypt As Boolean) As String
    Dim lLength As Long
    Dim sTemp As String
    Dim hHash As Long
    Dim hKey As Long
   
    If hCryptProv = 0 Then
        HandleError "Not connected to CSP"
        Exit Function
    End If
   
    '--------------------------------------------------------------------
    'The data will be encrypted with a session key derived from the
    'password.
    'The session key will be recreated when the data is decrypted
    'only if the password used to create the key is available.
    '--------------------------------------------------------------------

    'Create a hash object.
    If CryptCreateHash(hCryptProv, CALG_MD5, 0, 0, hHash) = 0 Then
        HandleError "Error during CryptCreateHash!"
    End If

    'Hash the password.
    If CryptHashData(hHash, Password, Len(Password), 0) = 0 Then
        HandleError "Error during CryptHashData."
    End If
   
    'Derive a session key from the hash object.
    If CryptDeriveKey(hCryptProv, ENCRYPT_ALGORITHM, hHash, 0, hKey) = 0 Then
        HandleError "Error during CryptDeriveKey!"
    End If
   
    'Do the work
    sTemp = Data
    lLength = Len(Data)
    If Encrypt Then
        'Encrypt data.
        If CryptEncrypt(hKey, 0, 1, 0, sTemp, lLength, lLength) = 0 Then
            HandleError "Error during CryptEncrypt."
        End If
    Else
        'Encrypt data.
        If CryptDecrypt(hKey, 0, 1, 0, sTemp, lLength) = 0 Then
            HandleError "Error during CryptDecrypt."
        End If
    End If

    'This is what we return.
    EncryptDecrypt = Mid$(sTemp, 1, lLength)
   
    'Destroy session key.
    If hKey <> 0 Then
        CryptDestroyKey hKey
    End If

    'Destroy hash object.
    If hHash <> 0 Then
        CryptDestroyHash hHash
    End If
End Function

Private Sub HandleError(ByVal Error As String)
    'You could write the error to the screen or to a file
    Debug.Print Error
End Sub

Private Function ByteToStr(ByRef ByteArray() As Byte, ByVal lLength As Long) As String
    Dim i As Long
    For i = LBound(ByteArray) To (LBound(ByteArray) + lLength)
        ByteToStr = ByteToStr & Chr$(ByteArray(i))
    Next i
End Function

Private Function EncryptNumber(ByVal lNumber As Long) As String
    Dim i As Long
    Dim sNumber As String
   
    sNumber = Format$(lNumber, "00000000")
   
    For i = 1 To 8
        EncryptNumber = EncryptNumber & Chr$(Asc(Mid$(NUMBER_ENCRYPT_PASSWORD, i, 1)) + Val(Mid$(sNumber, i, 1)))
    Next i
End Function

Private Function DecryptNumber(ByVal sNumber As String) As Long
    Dim i As Long
   
    For i = 1 To 8
        DecryptNumber = (10 * DecryptNumber) + (Asc(Mid$(sNumber, i, 1)) - Asc(Mid$(NUMBER_ENCRYPT_PASSWORD, i, 1)))
    Next i
End Function



    Public Sub Main()
   
    'example of use
   
        Dim sEncrypted As String
        EncryptionCSPConnect
        sEncrypted = EncryptData("hello world", MY_PASSWORD)
        MsgBox DecryptData(sEncrypted, MY_PASSWORD)
        EncryptionCSPDisconnect
    End Sub

0
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 
LVL 2

Expert Comment

by:bhh
Comment Utility
Listening...
0
 
LVL 5

Expert Comment

by:Netminder
Comment Utility
0
 
LVL 5

Expert Comment

by:Netminder
Comment Utility
Admin notified of User neglect. Force-accepted by
Netminder
CS Moderator
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

763 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

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now