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
%>
Leave a Reply