sha140

<%
'加密解密类
'类方法 SHA1 Byte_Data As String   sha1算法
Class CAMXAM_System_Encrypt_
    Private Array_Power,Array_Bits
    Private ClassName,ClassAuthor,ClassDate
    Private Sub Class_Initialize()
        ClassName = "加密类"
        ClassAuthor = "石卓林"
        ClassDate = "2006年3月23日"
    End Sub
    Private Function Create_Array() '初始化指数数组
        Dim Array_P(30),Array_B(30),Item
        For Item = 0 To 30 Step +1
            Array_P(Item) = Clng(2 ^ Item)
            Array_B(Item) = Clng((2 ^ (Item+1))-1)
        Next
            Array_Power = Array_P
            Array_Bits = Array_B
    End Function
    Private Function LeftShift(Value,Bits)'按位左移
        If Bits < 0 Or Bits > 31 Then
            Err.Raise 6
            Exit Function
        End If
        If Bits = 0 Then
            LeftShift = Value
            Exit Function
        End If
        If Bits = 31 Then
            If Value And 1 Then
                    LeftShift = &H80000000
            Else
                    LeftShift = 0
            End If
            Exit Function
        End If
            LeftShift = (Value And Array_Bits(31 - Bits)) * Array_Power(Bits)
        If Value And Array_Power(31 - Bits) Then
            LeftShift = ((Value And Array_Bits(30 - Bits)) * Array_Power(Bits)) Or &H80000000
        End If  
    End Function
    Private Function RightShift(Value,Bits)'按位右移
        If Bits < 0 Or Bits > 31 Then
            Err.Raise 6
            Exit Function
        End If
        If Bits = 0 Then
            RightShift = Value
            Exit Function
        End If
        If Bits = 31 Then
            If Value And &H80000000 Then
                RightShift = -1
            Else
                RightShift = 0
            End If
            Exit Function
        End If
            RightShift = (Value And &H7FFFFFFE) \ Array_Power(Bits)
        If Value And &H80000000 Then
            RightShift = Not((Not Value And &H7FFFFFFE) \ Array_Power(Bits) +1)-1
        End If
    End Function
    Private Function NoERightShift(Value,Bits)'无符号右移
        If Bits < 0 Or Bits > 31 Then
            Err.Raise 6
            Exit Function
        End If
        If Bits = 0 Then
            NoERightShift = Value
            Exit Function
        End If
        If Bits = 31 Then
            If Value And &H80000000 Then
                NoERightShift = 1
            Else
                NoERightShift = 0
            End If
            Exit Function
        End If
            NoERightShift = (Value And &H7FFFFFFE) \ Array_Power(Bits)
        If Value And &H80000000 Then
            NoERightShift = NoERightShift Or (&H40000000 \ Array_Power(Bits-1))
        End If
    End Function
    Private Function RotateLeft(Value,Bits)'转位
        RotateLeft = LeftShift(Value,Bits) Or NoERightShift(Value,(32 - Bits))
    End Function
    Private Function Byte_Array(Byte_Data)'填充和生成数组
        Dim Data_Length,String_Length,Array_Length,Array_Item,Max_Item,Lng_Asc
            String_Length = Len(Byte_Data)
            Data_Length = String_Length * 8
            Array_Length = (((String_Length + 8)\64)+1)*16 -1
        ReDim Data_Array(Array_Length)
        For Array_Item = 0 To Array_Length
            Data_Array(Array_Item) = &H00000000
        Next
        For Array_Item = 0 To String_Length-1
            Max_Item = (Array_Item)\4
            Lng_Asc = AscW(Mid(Byte_Data,Array_Item+1,1))
            Data_Array(Max_Item) = Data_Array(Max_Item) Or LeftShift(Lng_Asc,24-(Array_Item And 3)*8)
        Next
            Data_Array(String_Length\4) = Data_Array(String_Length\4) Or LeftShift(&H80,24-(Array_Item And 3)*8)
            Data_Array(Array_Length) = Data_Length
        Byte_Array = Data_Array
    End Function
    Private Function AddUnsigned(lX, lY)
        Dim lX4
        Dim lY4
        Dim lX8
        Dim lY8
        Dim lResult
    
        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
    private function sft(t,b,c,d)
        if t<20 Then
            sft = (b And c) Or ((Not b) And d)
            Exit Function
        End If
        if t<40 Then
            sft = b Xor c Xor d
            Exit Function
        End If
        if t<60 Then
            sft = (b And c) Or (b And d) Or (c And d)
            Exit Function
        End If
            sft = b Xor c Xor d
    End Function
    Private function skt(t)
        If t < 20 Then
            skt = Clng(1518500249)
        Else
            If t < 40 Then
                skt = Clng(1859775393)
            Else
                if t < 60 Then
                    skt = Clng(-1894007588)
                Else
                    skt = Clng(-899497514)
                End If
            End If
        End If
    End Function
    Private Function getHex(Lng_num)
        Dim Str
            Str = Hex(Lng_num)
        While Len(Str) < 8
            Str = 0 & Str
        Wend
        getHex = Str 
    End Function
    Public Function SHA1(Byte_Data)
        Dim x,W(79),a,b,c,d,e,i,j,aa,bb,cc,dd,ee,t
            Create_Array
            x = Byte_Array(Byte_Data)
            a = Clng(1732584193)
            b = Clng(-271733879)
            c = Clng(-1732584194)
            d = Clng(271733878)
            e = Clng(-1009589776)
        For i = 0 To UBound(x) Step +16
            aa = a
            bb = b
            cc = c
            dd = d
            ee = e
            For j = 0 To 79 Step +1
                If j < 16 Then
                    w(j) = x(i+j)
                Else
                    w(j) = RotateLeft(w(j-3) Xor w(j-8) Xor w(j-14) Xor w(j-16),1)
                End If
                t = AddUnsigned(AddUnsigned(RotateLeft(a,5),sft(j,b,c,d)),AddUnsigned(AddUnsigned(e,w(j)),skt(j)))
                e = d
                d = c
                c = RotateLeft(b,30)
                b = a
                a = t
            Next
            a = AddUnsigned(a,aa)
            b = AddUnsigned(b,bb)
            c = AddUnsigned(c,cc)
            d = AddUnsigned(d,dd)
            e = AddUnsigned(e,ee)
        Next
            SHA1 = Lcase(getHex(a) & getHex(b) & getHex(c) & getHex(d) & getHex(e))
    End Function
End Class
%>