‘***
‘ MODULE: CSHA256
‘ FILENAME: CSHA256.cls
‘ AUTHOR: Phil Fresle
‘ CREATED: 10-Apr-2001
‘ COPYRIGHT: Copyright 2001 Phil Fresle. All Rights Reserved.
‘
‘ DESCRIPTION:
‘ This class is used to generate a SHA-256 ‘digest’ or ‘signature’ of a string.
‘ The SHA-256 algorithm is one of the industry standard methods for generating
‘ digital signatures. It is generically known as a digest, digital signature,
‘ one-way encryption, hash or checksum algorithm. A common use for SHA-256 is
‘ for password encryption as it is one-way in nature, that does not mean that
‘ your passwords are not free from a dictionary attack. If you are using the
‘ routine for passwords, you can make it a little more secure by concatenating
‘ some known random characters to the password before you generate the signature
‘ and on subsequent tests, so even if a hacker knows you are using SHA-256 for
‘ your passwords, the random characters will make it harder to dictionary attack.
‘
‘ *** CAUTION
‘ See the comment attached to the SHA256 method below regarding use on systems
‘ with different character sets.
‘
‘ This is ‘free’ software with the following restrictions:
‘
‘ You may not redistribute this code as a ‘sample’ or ‘demo’. However, you are free
‘ to use the source code in your own code, but you may not claim that you created
‘ the sample code. It is expressly forbidden to sell or profit from this source code
‘ other than by the knowledge gained or the enhanced value added by your own code.
‘
‘ Use of this software is also done so at your own risk. The code is supplied as
‘ is without warranty or guarantee of any kind.
‘
‘ Should you wish to commission some derivative work based on this code provided
‘ here, or any consultancy work, please do not hesitate to contact us.
‘
‘ Web Site: http://www.frez.co.uk
‘ E-mail: sales@frez.co.uk
‘
‘ MODIFICATION HISTORY:
‘ 10-Apr-2001 Phil Fresle Initial Version
‘**
Option Explicit

Private m_lOnBits(30) As Long
Private m_l2Power(30) As Long
Private K(63) As Long

‘***
‘ LShift (FUNCTION)
‘
‘ PARAMETERS:
‘ (In) - lValue - Long - The value to be shifted
‘ (In) - iShiftBits - Integer - The number of bits to shift the value by
‘
‘ RETURN VALUE:
‘ Long - The shifted long integer
‘
‘ DESCRIPTION:
‘ A left shift takes all the set binary bits and moves them left, in-filling
‘ with zeros in the vacated bits on the right. This function is equivalent to
‘ the << operator in Java and C++
‘***
Private Function LShift(ByVal lValue As Long, _
ByVal iShiftBits As Integer) As Long
‘ NOTE: If you can guarantee that the Shift parameter will be in the
‘ range 1 to 30 you can safely strip of this first nested if structure for
‘ speed.
‘
‘ A shift of zero is no shift at all.
If iShiftBits = 0 Then
LShift = lValue
Exit Function

' A shift of 31 will result in the right most bit becoming the left most
' bit and all other bits being cleared
ElseIf iShiftBits = 31 Then
If lValue And 1 Then
LShift = &H80000000
Else
LShift = 0
End If
Exit Function
' A shift of less than zero or more than 31 is undefined
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise 6
End If
' If the left most bit that remains will end up in the negative bit
' position (&H80000000) we would end up with an overflow if we took the
' standard route. We need to strip the left most bit and add it back
' afterwards.
If (lValue And m_l2Power(31 - iShiftBits)) Then
' (Value And OnBits(31 - (Shift + 1))) chops off the left most bits that
' we are shifting into, but also the left most bit we still want as this
' is going to end up in the negative bit marker position (&H80000000).
' After the multiplication/shift we Or the result with &H80000000 to
' turn the negative bit on.
LShift = ((lValue And m\_lOnBits(31 - (iShiftBits + 1))) * \_
m_l2Power(iShiftBits)) Or &H80000000
Else
' (Value And OnBits(31-Shift)) chops off the left most bits that we are
' shifting into so we do not get an overflow error when we do the
' multiplication/shift
LShift = ((lValue And m\_lOnBits(31 - iShiftBits)) * \_
m_l2Power(iShiftBits))
End If

End Function

‘***
‘ RShift (FUNCTION)
‘
‘ PARAMETERS:
‘ (In) - lValue - Long - The value to be shifted
‘ (In) - iShiftBits - Integer - The number of bits to shift the value by
‘
‘ RETURN VALUE:
‘ Long - The shifted long integer
‘
‘ DESCRIPTION:
‘ The right shift of an unsigned long integer involves shifting all the set bits
‘ to the right and in-filling on the left with zeros. This function is
‘ equivalent to the >>> operator in Java or the >> operator in C++ when used on
‘ an unsigned long.
‘***
Private Function RShift(ByVal lValue As Long, _
ByVal iShiftBits As Integer) As Long

' NOTE: If you can guarantee that the Shift parameter will be in the
' range 1 to 30 you can safely strip of this first nested if structure for
' speed.
'
' A shift of zero is no shift at all
If iShiftBits = 0 Then
RShift = lValue
Exit Function
' A shift of 31 will clear all bits and move the left most bit to the right
' most bit position
ElseIf iShiftBits = 31 Then
If lValue And &H80000000 Then
RShift = 1
Else
RShift = 0
End If
Exit Function
' A shift of less than zero or more than 31 is undefined
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise 6
End If
' We do not care about the top most bit or the final bit, the top most bit
' will be taken into account in the next stage, the final bit (whether it
' is an odd number or not) is being shifted into, so we do not give a jot
' about it
RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)
' If the top most bit (&H80000000) was set we need to do things differently
' as in a normal VB signed long integer the top most bit is used to indicate
' the sign of the number, when it is set it is a negative number, so just
' deviding by a factor of 2 as above would not work.
' NOTE: (lValue And &H80000000) is equivalent to (lValue < 0), you could
' get a very marginal speed improvement by changing the test to (lValue < 0)
If (lValue And &H80000000) Then
' We take the value computed so far, and then add the left most negative
' bit after it has been shifted to the right the appropriate number of
' places
RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
End If

‘***
‘ ConvertToWordArray (FUNCTION)
‘
‘ PARAMETERS:
‘ (In/Out) - sMessage - String - String message
‘
‘ RETURN VALUE:
‘ Long() - Converted message as long array
‘
‘ DESCRIPTION:
‘ Takes the string message and puts it in a long array with padding according to
‘ the SHA-256 rules (similar to MD5 routine).
‘***
Private Function ConvertToWordArray(sMessage As String) As Long()
Dim lMessageLength As Long
Dim lNumberOfWords As Long
Dim lWordArray() As Long
Dim lBytePosition As Long
Dim lByteCount As Long
Dim lWordCount As Long
Dim lByte As Long

Const MODULUS_BITS As Long = 512
Const CONGRUENT_BITS As Long = 448
lMessageLength = Len(sMessage)
' Get padded number of words. Message needs to be congruent to 448 bits,
' modulo 512 bits. If it is exactly congruent to 448 bits, modulo 512 bits
' it must still have another 512 bits added. 512 bits = 64 bytes
' (or 16 * 4 byte words), 448 bits = 56 bytes. This means lNumberOfWords must
' be a multiple of 16 (i.e. 16 * 4 (bytes) * 8 (bits))
lNumberOfWords = (((lMessageLength + _
((MODULUS\_BITS - CONGRUENT\_BITS) \ BITS\_TO\_A\_BYTE)) \ \_
(MODULUS\_BITS \ BITS\_TO\_A\_BYTE)) + 1) * _
(MODULUS\_BITS \ BITS\_TO\_A\_WORD)
ReDim lWordArray(lNumberOfWords - 1)
' Combine each block of 4 bytes (ascii code of character) into one long
' value and store in the message. The high-order (most significant) bit of
' each byte is listed first. However, unlike MD5 we put the high-order
' (most significant) byte first in each word.
lBytePosition = 0
lByteCount = 0
Do Until lByteCount >= lMessageLength
' Each word is 4 bytes
lWordCount = lByteCount \ BYTES\_TO\_A_WORD
lBytePosition = (3 - (lByteCount Mod BYTES\_TO\_A\_WORD)) * BITS\_TO\_A\_BYTE
' NOTE: This is where we are using just the first byte of each unicode
' character, you may want to make the change here, or to the SHA256 method
' so it accepts a byte array.
lByte = AscB(Mid(sMessage, lByteCount + 1, 1))
lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(lByte, lBytePosition)
lByteCount = lByteCount + 1
Loop
' Terminate according to SHA-256 rules with a 1 bit, zeros and the length in
' bits stored in the last two words
lWordCount = lByteCount \ BYTES\_TO\_A_WORD
lBytePosition = (3 - (lByteCount Mod BYTES\_TO\_A\_WORD)) * BITS\_TO\_A\_BYTE
' Add a terminating 1 bit, all the rest of the bits to the end of the
' word array will default to zero
lWordArray(lWordCount) = lWordArray(lWordCount) Or _
LShift(&H80, lBytePosition)
' We put the length of the message in bits into the last two words, to get
' the length in bits we need to multiply by 8 (or left shift 3). This left
' shifted value is put in the last word. Any bits shifted off the left edge
' need to be put in the penultimate word, we can work out which bits by shifting
' right the length by 29 bits.
lWordArray(lNumberOfWords - 1) = LShift(lMessageLength, 3)
lWordArray(lNumberOfWords - 2) = RShift(lMessageLength, 29)
ConvertToWordArray = lWordArray

End Function

‘***
‘ SHA256 (FUNCTION)
‘
‘ PARAMETERS:
‘ (In/Out) - sMessage - String - Message to digest
‘
‘ RETURN VALUE:
‘ String - The digest
‘
‘ DESCRIPTION:
‘ Takes a string and uses the SHA-256 digest to produce a signature for it.
‘
‘ NOTE: Due to the way in which the string is processed the routine assumes a
‘ single byte character set. VB passes unicode (2-byte) character strings, the
‘ ConvertToWordArray function uses on the first byte for each character. This
‘ has been done this way for ease of use, to make the routine truely portable
‘ you could accept a byte array instead, it would then be up to the calling
‘ routine to make sure that the byte array is generated from their string in
‘ a manner consistent with the string type.
‘***
Public Function SHA256(sMessage As String) As String
Dim HASH(7) As Long
Dim M() As Long
Dim W(63) As Long
Dim a As Long
Dim b As Long
Dim c As Long
Dim d As Long
Dim e As Long
Dim f As Long
Dim g As Long
Dim h As Long
Dim i As Long
Dim j As Long
Dim T1 As Long
Dim T2 As Long