ASP实现SHA1算法,我的第一个和加解密有关的类.

sha140

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
<%
'加密解密类
'类方法 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
%>

Leave a Reply

Your email address will not be published.

Time limit is exhausted. Please reload the CAPTCHA.

Proudly powered by WordPress   Premium Style Theme by www.gopiplus.com
渝公网安渝公网安备 50010702500270号 渝ICP备09056628号-7