Calculating hashes: MD2, MD4, MD5, SHA1, SHA2-256, SHA2-384, and SHA2-512

It works with MD2, MD4, MD5, SHA1, SHA2-256, SHA2-384, and SHA2-512. Put the below code in a module (BAS file). It does everything that CAPICOM does regarding hashes, but without using any ActiveX DLL files. It depends entirely on the standard cryptographic API DLL files, using declare statements. There are several publicly accessible functions. These are

HashBytes

HashStringA

HashStringU

HashArbitraryData

BytesToHex

BytesToB64

HashBytes computes a hash of a 1D byte array, who's lower bound is 0.

HashStringA computes the hash of an Ascii/Ansi (1 byte per character) string. As VB6 strings are actually Unicode (2 bytes per character), and due to the fact that this function is intended to calculate the hash of the Ascii version of the string, the function first converts VB6's unicode characters to true Ascii characters via VB6's StrConv function. However, because characters with an Ascii value above 127 will differ between locales, the LocaleID is needed to be known for this conversion. As such, LocaleID is a parameter for this function. By default, the LocaleID used by the program is the LocaleID of the PC that the program is running on. This should be used in most situations, as this will generate a hash that will match the output of most other programs that generate a hash (such as the program called Easy Hash).

HashStringU computes the hash of a Unicode (2 bytes per character) string. As VB6 strings are actually Unicode, there is no conversion needed, and thus is no need to specify LocaleID. Therefore, this function doesn't have a LocaleID parameter. Because each character is defined by 2 bytes, rather than 1, the output of this hash function will obviously differ from the hash calculated by HashStringA, and thus will differ from the hash calculated by most other hash calculating programs (such as the freeware one that I used for testing called Easy Hash). For example, a string with 3 spaces " " is represented as the byte array (shown in hex) 20 00 20 00 20 00 in Unicode encoding, but as 20 20 20 in Ascii encoding. These are 2 distinctly different byte arrays, and thus will produce 2 completely different hashes.

Side-Note regarding Unicode in VB6: Despite this fact, that internally in VB6 all the strings are Unicode, the implementation of Unicode in VB6 is VERY LIMITED. That is, it won't display any Unicode character that can't also be displayed as an extended ascii character for the computer's current locale. Instead it will show it as a question mark. This won't effect how this function works (or the above function, as it's computing a hash, not displaying anything), but it will effect whether or not a given string will be properly displayed.

HashArbitraryData computes the hash of absolutely anything. It just needs to know where in memory the first byte of data is, and how many bytes long the data is. It will work with multidimensional byte arrays, arrays of other data types, arrays that start with with a lower bound other than zero, user defined types, sections of memory allocated with API functions, etc. There's nothing that it can't compute the hash of. Of course this gives you the added responsibility of needing to know where exactly in memory the data is, and the size of the data in bytes.

BytesToHex. This is a function intended to convert the raw bytes output from a hash function to a displayable hexadecimal string.

BytesToB64. This is a function intended to convert the raw bytes output from a hash function to a displayable base64 string.

Code:

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
 
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, ByRef pbData As Any, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptGetHashParam Lib "advapi32.dll" (ByVal hHash As Long, ByVal dwParam As Long, ByRef pByte As Any, ByRef pdwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptBinaryToString Lib "Crypt32.dll" Alias "CryptBinaryToStringA" (ByRef pbBinary As Any, ByVal cbBinary As Long, ByVal dwFlags As Long, ByVal pszString As String, ByRef pcchString As Long) As Long
 
Private Const PROV_RSA_AES As Long = 24
Private Const CRYPT_VERIFYCONTEXT As Long = &HF0000000
 
Public Enum HashAlgo
    HALG_MD2 = &H8001&
    HALG_MD4 = &H8002&
    HALG_MD5 = &H8003&
    HALG_SHA1 = &H8004&
    HALG_SHA2_256 = &H800C&
    HALG_SHA2_384 = &H800D&
    HALG_SHA2_512 = &H800E&
End Enum
 
Private Const HP_HASHSIZE As Long = &H4&
Private Const HP_HASHVAL As Long = &H2&
 
 
Public Function HashBytes(ByRef Data() As Byte, Optional ByVal HashAlgorithm As HashAlgo = HALG_MD5) As Byte()
Dim hProv As Long
Dim hHash As Long
Dim Hash() As Byte
Dim HashSize As Long
 
CryptAcquireContext hProv, vbNullString, vbNullString, 24, CRYPT_VERIFYCONTEXT
CryptCreateHash hProv, HashAlgorithm, 0, 0, hHash
CryptHashData hHash, Data(0), UBound(Data) + 1, 0
CryptGetHashParam hHash, HP_HASHSIZE, HashSize, 4, 0
ReDim Hash(HashSize - 1)
CryptGetHashParam hHash, HP_HASHVAL, Hash(0), HashSize, 0
CryptDestroyHash hHash
CryptReleaseContext hProv, 0
 
HashBytes = Hash()
End Function
 
 
 
Public Function HashStringA(ByVal Text As String, Optional ByVal LocaleID As Long, Optional ByVal HashAlgorithm As HashAlgo = HALG_MD5) As Byte()
Dim Data() As Byte
Data() = StrConv(Text, vbFromUnicode, LocaleID)
HashStringA = HashBytes(Data, HashAlgorithm)
End Function
 
Public Function HashStringU(ByVal Text As String, Optional ByVal HashAlgorithm As HashAlgo = HALG_MD5) As Byte()
Dim Data() As Byte
Data() = Text
HashStringU = HashBytes(Data, HashAlgorithm)
End Function
 
Public Function HashArbitraryData(ByVal MemAddress As Long, ByVal ByteCount As Long, Optional ByVal HashAlgorithm As HashAlgo = HALG_MD5) As Byte()
Dim Data() As Byte
ReDim Data(ByteCount - 1)
CopyMemory Data(0), ByVal MemAddress, ByteCount
HashArbitraryData = HashBytes(Data, HashAlgorithm)
End Function
 
 
 
 
Public Function BytesToHex(ByRef Bytes() As Byte) As String
Dim HexStringLen As Long
Dim HexString As String
 
CryptBinaryToString Bytes(0), UBound(Bytes) + 1, 12, vbNullString, HexStringLen
HexString = String$(HexStringLen, vbNullChar)
CryptBinaryToString Bytes(0), UBound(Bytes) + 1, 12, HexString, HexStringLen
 
BytesToHex = UCase$(HexString)
End Function
 
Public Function BytesToB64(ByRef Bytes() As Byte) As String
Dim B64StringLen As Long
Dim B64String As String
 
CryptBinaryToString Bytes(0), UBound(Bytes) + 1, 1, vbNullString, B64StringLen
B64String = String$(B64StringLen, vbNullChar)
CryptBinaryToString Bytes(0), UBound(Bytes) + 1, 1, B64String, B64StringLen
 
BytesToB64 = B64String
End Function

Source:
http://earlier189.rssing.com/browser.php?indx=6373759&item=379