Attribute VB_Name = "modSHA1"
Public Function BSHA1(ByVal S As String, _
                      Optional ByVal bRE As Boolean = False, _
                      Optional ByVal bStandard As Boolean = False) As String
    
    Dim B(21)       As Long 'hash buffer
    Dim i           As Long
    
    '//Init the seeds
    B(0) = &H67452301
    B(1) = &HEFCDAB89
    B(2) = &H98BADCFE
    B(3) = &H10325476
    B(4) = &HC3D2E1F0
    
    '//Update the string buffer (to be hashed)
    Call SHA1Update(bRE, bStandard, B(), S)
    
    '//Reverse endian if needed
    If bRE Then
        For i = 0 To 4
            B(i) = htonl(B(i))
        Next i
    End If
    
    '//Return the broken SHA1 hash
    BSHA1 = String(20, 0)
    Call CopyMemory(ByVal BSHA1, B(0), 20)
End Function
Private Sub SHA1Update(ByVal bRE As Boolean, _
                       ByVal bS As Boolean, _
                       ByRef B() As Long, _
                       ByVal S As String)
    Dim i       As Long
    Dim A       As String
    If bS Then
        '//Standard SHA1 padding
        A = Chr$(128) & String$((128 - (Len(S) Mod 64) - 9) Mod 64, 0)
        If bRE Then
            S = S & A & String$(4, 0) & StrReverse(MakeDWORD((Len(S) * 8)))
        Else
            S = S & A & MakeDWORD((Len(S) * 8)) & String$(4, 0)
        End If
    Else
        If ((Len(S) Mod 64) <> 0) Then
            '//buffer the string so its divisible by 64 (0x40)
            S = S & String(64 - (Len(S) Mod 64), 0)
        End If
    End If
    For i = 1 To Len(S) Step 64
        '//copy chunk of the string into the long array to be hashed
        Call CopyMemory(B(5), ByVal Mid$(S, i, 64), 64)
        '//transform
        Call SHA1Transform(bRE, bS, B)
    Next i
End Sub
Private Sub SHA1Transform(ByVal bRE As Boolean, ByVal bS As Boolean, ByRef p() As Long)
    Dim hB(80) As Long
    Dim A      As Long
    Dim B      As Long
    Dim C      As Long
    Dim D      As Long
    Dim E      As Long
    Dim G      As Long
    Dim i      As Long
    If bRE Then 'reverse endian
        For i = 0 To 15: hB(i) = htonl(p(i + 5)): Next i
    Else
        For i = 0 To 15: hB(i) = p(i + 5): Next i
    End If
    If bS Then 'standard SHA1
        For i = 16 To 79
            hB(i) = LSC((hB(i - 16) Xor hB(i - 8) Xor hB(i - 14) Xor hB(i - 3)), 1)
        Next i
    Else
        For i = 16 To 79
            hB(i) = LSC(1, (hB(i - 16) Xor hB(i - 8) Xor hB(i - 14) Xor hB(i - 3)) And 31)
        Next i
    End If
    A = p(0)
    B = p(1)
    C = p(2)
    D = p(3)
    E = p(4)
    For i = 0 To 19
        G = Add(Add(Add(Add(hB(i), E), LSC(A, 5)), ((B And C) Or ((Not B) And D))), &H5A827999)
        E = D: D = C: C = LSC(B, 30): B = A: A = G
    Next i
    For i = 20 To 39
        G = Add(Add(Add(Add(hB(i), E), LSC(A, 5)), (D Xor C Xor B)), &H6ED9EBA1)
        E = D: D = C: C = LSC(B, 30): B = A: A = G
    Next i
    For i = 40 To 59
        G = Add(Add(Add(Add(hB(i), E), LSC(A, 5)), (C And B) Or (D And C) Or (D And B)), &H8F1BBCDC)
        E = D: D = C: C = LSC(B, 30): B = A: A = G
    Next i
    For i = 60 To 79
        G = Add(Add(Add(Add(hB(i), E), LSC(A, 5)), (D Xor C Xor B)), &HCA62C1D6)
        E = D: D = C: C = LSC(B, 30): B = A: A = G
    Next i
    p(0) = Add(p(0), A)
    p(1) = Add(p(1), B)
    p(2) = Add(p(2), C)
    p(3) = Add(p(3), D)
    p(4) = Add(p(4), E)
End Sub
'~~~~~~ Extra functions ~~~~~~~
Private Function LSC(ByVal N As Long, ByVal S As Long) As Long
    'left shift circle
    LSC = (LS(N, S) Or RS(N, (32 - S)))
End Function
Private Function RS(ByVal N As Long, ByVal S As Long) As Long
    'right shift bits
    If (S < 0) Or (S > 31) Then
        RS = 0
    ElseIf (S = 0) Then
        RS = N
    Else
        If ((N And &H80000000) = &H80000000) Then
            N = (N And &H7FFFFFFF)
            If (S = 31) Then 'stop over flow when shifting 31bits
                N = N / 2147483648#
            Else
                N = N \ (2 ^ S)
            End If
            RS = N Or (2 ^ (31 - S))
        Else
           RS = Int(CDbl(N) / CDbl(2 ^ S))
        End If
    End If
End Function
Private Function LS(ByVal N As Long, ByVal S As Long) As Long
    'left shift bits
    If (S < 0) Or (S > 31) Then
        LS = 0
    ElseIf S = 0 Then
        LS = N
    Else
        N = N And (2 ^ (32 - S) - 1)
        LS = WDbl(CDbl(N) * CDbl(WDbl(2 ^ S)))
    End If
End Function
Private Function WDbl(ByVal N As Double) As Long
    'wrap a double back to a long
    If N > &H7FFFFFFF Then
        N = N - 4294967296#
    ElseIf N < &H80000000 Then
        N = N + 4294967296#
    End If
    WDbl = N
End Function
Private Function Add(ByVal N1 As Long, ByVal N2 As Long, Optional ByVal D As Double) As Long
    'add 2 longs to a double, then wrap round
    D = N1
    D = D + N2
    Add = WDbl(D)
End Function
Private Function MakeDWORD(ByVal lngValue As Long) As String
    MakeDWORD = String(4, vbNullChar)
    Call CopyMemory(ByVal MakeDWORD, lngValue, 4)
End Function

