csha256.cls

sample login method made in visual basic

    ' 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
End Function

'*******************************************************************************
' AddUnsigned (FUNCTION)
'
' PARAMETERS:
' (In) - lX - Long - First value
' (In) - lY - Long - Second value
'
' RETURN VALUE:
' Long - Result
'
' DESCRIPTION:
' Adds two potentially large unsigned numbers without overflowing
'*******************************************************************************
Private Function AddUnsigned(ByVal lX As Long, _
                             ByVal lY As Long) As Long
    Dim lX4     As Long
    Dim lY4     As Long
    Dim lX8     As Long
    Dim lY8     As Long
    Dim lResult As Long
 
    lX8 = lX And &H80000000
    lY8 = lY And &H80000000
    lX4 = lX And &H40000000
    lY4 = lY And &H40000000
 
    lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)
 
    If lX4 And lY4 Then
        lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
    ElseIf lX4 Or lY4 Then
        If lResult And &H40000000 Then
            lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
        Else
            lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
        End If
    Else
        lResult = lResult Xor lX8 Xor lY8
    End If
 
    AddUnsigned = lResult
End Function

'*******************************************************************************
' Ch (FUNCTION)
'
' DESCRIPTION:
' SHA-256 function
'*******************************************************************************
Private Function Ch(ByVal x As Long, _
                    ByVal y As Long, _
                    ByVal z As Long) As Long
    Ch = ((x And y) Xor ((Not x) And z))
End Function

'*******************************************************************************
' Maj (FUNCTION)
'
' DESCRIPTION:
' SHA-256 function
'*******************************************************************************
Private Function Maj(ByVal x As Long, _
                     ByVal y As Long, _
                     ByVal z As Long) As Long
    Maj = ((x And y) Xor (x And z) Xor (y And z))
End Function

'*******************************************************************************
' S (FUNCTION)
'
' DESCRIPTION:
' SHA-256 function (rotate right)
'*******************************************************************************
Private Function S(ByVal x As Long, _
                   ByVal n As Long) As Long
    S = (RShift(x, (n And m_lOnBits(4))) Or LShift(x, (32 - (n And m_lOnBits(4)))))
End Function

'*******************************************************************************
' R (FUNCTION)
'
' DESCRIPTION:
' SHA-256 function (just a right shift)
'*******************************************************************************
Private Function R(ByVal x As Long, _
                   ByVal n As Long) As Long
    R = RShift(x, CInt(n And m_lOnBits(4)))
End Function

'*******************************************************************************
' Sigma0 (FUNCTION)
'
' DESCRIPTION:
' SHA-256 function
'*******************************************************************************
Private Function Sigma0(ByVal x As Long) As Long
    Sigma0 = (S(x, 2) Xor S(x, 13) Xor S(x, 22))
End Function

'*******************************************************************************
' Sigma1 (FUNCTION)
'
' DESCRIPTION:
' SHA-256 function
'*******************************************************************************
Private Function Sigma1(ByVal x As Long) As Long
    Sigma1 = (S(x, 6) Xor S(x, 11) Xor S(x, 25))
End Function

'*******************************************************************************
' Gamma0 (FUNCTION)
'
' DESCRIPTION:
' SHA-256 function
'*******************************************************************************
Private Function Gamma0(ByVal x As Long) As Long
    Gamma0 = (S(x, 7) Xor S(x, 18) Xor R(x, 3))
End Function

'*******************************************************************************
' Gamma1 (FUNCTION)
'
' DESCRIPTION:
' SHA-256 function
'*******************************************************************************
Private Function Gamma1(ByVal x As Long) As Long
    Gamma1 = (S(x, 17) Xor S(x, 19) Xor R(x, 10))
End Function

'*******************************************************************************
' 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
    
    ' Initial hash values
    HASH(0) = &H6A09E667
    HASH(1) = &HBB67AE85
    HASH(2) = &H3C6EF372
    HASH(3) = &HA54FF53A
    HASH(4) = &H510E527F
    HASH(5) = &H9B05688C
    HASH(6) = &H1F83D9AB
    HASH(7) = &H5BE0CD19
    
    ' Preprocessing. Append padding bits and length and convert to words
    M = ConvertToWordArray(sMessage)
    
    ' Main loop
    For i = 0 To UBound(M) Step 16
        a = HASH(0)
        b = HASH(1)
        c = HASH(2)
        d = HASH(3)
        e = HASH(4)
        f = HASH(5)
        g = HASH(6)
        h = HASH(7)
        
        For j = 0 To 63
            If j < 16 Then
                W(j) = M(j + i)
            Else
                W(j) = AddUnsigned(AddUnsigned(AddUnsigned(Gamma1(W(j - 2)), _
                    W(j - 7)), Gamma0(W(j - 15))), W(j - 16))
            End If
                
            T1 = AddUnsigned(AddUnsigned(AddUnsigned(AddUnsigned(h, Sigma1(e)), _
                Ch(e, f, g)), K(j)), W(j))
            T2 = AddUnsigned(Sigma0(a), Maj(a, b, c))
            
            h = g
            g = f
            f = e
            e = AddUnsigned(d, T1)
            d = c
            c = b
            b = a
            a = AddUnsigned(T1, T2)
        Next
        
        HASH(0) = AddUnsigned(a, HASH(0))
        HASH(1) = AddUnsigned(b, HASH(1))
        HASH(2) = AddUnsigned(c, HASH(2))
        HASH(3) = AddUnsigned(d, HASH(3))
        HASH(4) = AddUnsigned(e, HASH(4))
        HASH(5) = AddUnsigned(f, HASH(5))
        HASH(6) = AddUnsigned(g, HASH(6))
        HASH(7) = AddUnsigned(h, HASH(7))
    Next
    
    ' Output the 256 bit digest
    SHA256 = LCase(Right("00000000" & Hex(HASH(0)), 8) & _
        Right("00000000" & Hex(HASH(1)), 8) & _
        Right("00000000" & Hex(HASH(2)), 8) & _
        Right("00000000" & Hex(HASH(3)), 8) & _
        Right("00000000" & Hex(HASH(4)), 8) & _
        Right("00000000" & Hex(HASH(5)), 8) & _
        Right("00000000" & Hex(HASH(6)), 8) & _
        Right("00000000" & Hex(HASH(7)), 8))
End Function