ASP的DES加密解密

ASP的DES加密解密

2007-05-18 09:49

原文： http://hi.baidu.com/myfav/blog/item/3ebc58828edd79a30cf4d290.html

前两天学到对称密码DES算法，然后就自己亲手写了个实现程序出来，好多地方用得着呐。这里是用ASP实现，当然也就是可以移到VB啦。懂得怎样写后写成什么语言都行啦，只要懂得那门语言。如果有朋友想知道具体DES算法过程是怎样的，可以到网上查找。 （这两天又把它改进了一下，加密字符串并且使用十六进制，这样加密后的字符串会短些~~~      —— 2007年5月2日） <% Class Cls_DES      Private IPRule, CPRule, EPRule, PRule, SBox(7), PCRule(1), MvRule      Private K(16), L(16), R(16)      Private FillCode, DesStatus           Private Sub Class_Initialize()          DesStatus = -1          FillCode = "0001101"          IPRule = "58,50,42,34,26,18,10,2," &_              "60,52,44,36,28,20,12,4," &_              "62,54,46,38,30,22,14,6," &_              "64,56,48,40,32,24,16,8," &_              "57,49,41,33,25,17, 9,1," &_              "59,51,43,35,27,19,11,3," &_              "61,53,45,37,29,21,13,5," &_              "63,55,47,39,31,23,15,7,"          CPRule = "40, 8,48,16,56,24,64,32," &_              "39, 7,47,15,55,23,63,31," &_              "38, 6,46,14,54,22,62,30," &_              "37, 5,45,13,53,21,61,29," &_              "36, 4,44,12,52,20,60,28," &_              "35, 3,43,11,51,19,59,27," &_              "34, 2,42,10,50,18,58,26," &_              "33, 1,41, 9,49,17,57,25,"          EPRule = "32, 1, 2, 3, 4, 5," &_              " 4, 5, 6, 7, 8, 9," &_              " 8, 9,10,11,12,13," &_              "12,13,14,15,16,17," &_              "16,17,18,19,20,21," &_              "20,21,22,23,24,25," &_              "24,25,26,27,28,29," &_              "28,29,30,31,32, 1,"          PRule = "16, 7,20,21,29,12,28,17," &_              " 1,15,23,26, 5,18,31,10," &_              " 2, 8,24,14,32,27, 3, 9," &_              "19,13,30, 6,22,11, 4,25,"          SBox(0) = "14, 4,13, 1, 2,15,11, 8, 3,10, 6,12, 5, 9, 0, 7," &_              " 0,15, 7, 4,14, 2,13, 1,10, 6,12,11, 9, 5, 3, 8," &_              " 4, 1,14, 8,13, 6, 2,11,15,12, 9, 7, 3,10, 5, 0," &_              "15,12, 8, 2, 4, 9, 1, 7, 5,11, 3,14,10, 0, 6,13,"          SBox(1) = "15, 1, 8,14, 6,11, 3, 4, 9, 7, 2,13,12, 0, 5,10," &_              " 3,13, 4, 7,15, 2, 8,14,12, 0, 1,10, 6, 9,11, 5," &_              " 0,14, 7,11,10, 4,13, 1, 5, 8,12, 6, 9, 3, 2,15," &_              "13, 8,10, 1, 3,15, 4, 2,11, 6, 7,12, 0, 5,14, 9,"          SBox(2) = "10, 0, 9,14, 6, 3,15, 5, 1,13,12, 7,11, 4, 2, 8," &_              "13, 7, 0, 9, 3, 4, 6,10, 2, 8, 5,14,12,11,15, 1," &_              "13, 6, 4, 9, 8,15, 3, 0,11, 1, 2,12, 5,10,14, 7," &_              " 1,10,13, 0, 6, 9, 8, 7, 4,15,14, 3,11, 5, 2,12,"          SBox(3) = " 7,13,14, 3, 0, 6, 9,10, 1, 2, 8, 5,11,12, 4,15," &_              "13, 8,11, 5, 6,15, 0, 3, 4, 7, 2,12, 1,10,14, 9," &_              "10, 6, 9, 0,12,11, 7,13,15, 1, 3,14, 5, 2, 8, 4," &_              " 3,15, 0, 6,10, 1,13, 8, 9, 4, 5,11,12, 7, 2,14,"          SBox(4) = " 2,12, 4, 1, 7,10,11, 6, 8, 5, 3,15,13, 0,14, 9," &_              "14,11, 2,12, 4, 7,13, 1, 5, 0,15,10, 3, 9, 8, 6," &_              " 4, 2, 1,11,10,13, 7, 8,15, 9,12, 5, 6, 3, 0,14," &_              "11, 8,12, 7, 1,14, 2,13, 6,15, 0, 9,10, 4, 5, 3,"          SBox(5) = "12, 1,10,15, 9, 2, 6, 8, 0,13, 3, 4,14, 7, 5,11," &_              "10,15, 4, 2, 7,12, 9, 5, 6, 1,13,14, 0,11, 3, 8," &_              " 9,14,15, 5, 2, 8,12, 3, 7, 0, 4,10, 1,13,11, 6," &_              " 4, 3, 2,12, 9, 5,15,10,11,14, 1, 7, 6, 0, 8,13,"          SBox(6) = " 4,11, 2,14,15, 0, 8,13, 3,12, 9, 7, 5,10, 6, 1," &_              "13, 0,11, 7, 4, 9, 1,10,14, 3, 5,12, 2,15, 8, 6," &_              " 1, 4,11,13,12, 3, 7,14,10,15, 6, 8, 0, 5, 9, 2," &_              " 6,11,13, 8, 1, 4,10, 7, 9, 5, 0,15,14, 2, 3,12,"          SBox(7) = "13, 2, 8, 4, 6,15,11, 1,10, 9, 3,14, 5, 0,12, 7," &_              " 1,15,13, 8,10, 3, 7, 4,12, 5, 6,11, 0,14, 9, 2," &_              " 7,11, 4, 1, 9,12,14, 2, 0, 6,10,13,15, 3, 5, 8," &_              " 2, 1,14, 7, 4,10, 8,13,15,12, 9, 0, 3, 5, 6,11,"          PCRule(0) = "57,49,41,33,25,17, 9," &_              " 1,58,50,42,34,26,18," &_              "10, 2,59,51,43,35,27," &_              "19,11, 3,60,52,44,36," &_              "63,55,47,39,31,23,15," &_              " 7,62,54,46,38,30,22," &_              "14, 6,61,53,45,37,29," &_              "21,13, 5,28,20,12, 4,"          PCRule(1) = "14,17,11,24, 1, 5, 3,28," &_              "15, 6,21,10,23,19,12, 4," &_              "26, 8,16, 7,27,20,13, 2," &_              "41,52,31,37,47,55,30,40," &_              "51,45,33,48,44,49,39,56," &_              "34,53,46,42,50,36,29,32,"          MvRule = "1,1,2,2,2,2,2,2,1,2,2,2,2,2,2,1"      End Sub           Private Function Permute(ByVal Rule, ByVal Text)          Dim P_Rule, Num, PText          PText = ""          P_Rule = Split(Rule, ",")          For Each Num In P_Rule              Num = Trim(Num) & ""              If Num <> "" Then                  Num = CLng(Num)                  PText = PText & Mid(Text, Num, 1)              End If          Next          Erase P_Rule          Permute = PText      End Function           Private Function CreateKey()          Dim IPKey, C(16), D(16), i, Mv_Rule, MvLen          IPKey = Permute(PCRule(0), K(0))          C(0) = Left(IPKey, 28)          D(0) = Right(IPKey, 28)          Mv_Rule = Split(MvRule, ",")          For i = 1 To 16              MvLen = CLng(Trim(Mv_Rule(i - 1)))              C(i) = Right(C(i -1), Len(C(i -1)) - MvLen) & Left(C(i -1), MvLen)              D(i) = Right(D(i -1), Len(D(i -1)) - MvLen) & Left(D(i -1), MvLen)              K(i) = Permute(PCRule(1), C(i) & D(i))          Next      End Function      Private Function IP(ByVal Text)          Dim IPText          IPText = Permute(IPRule, Text)          L(0) = Left(IPText, 32)          R(0) = Right(IPText, 32)          IP = IPText      End Function           Private Function IterativeLR()          Dim i          For i = 1 To 16              L(i) = R(i - 1)              R(i) = B_XOR(L(i - 1), F(R(i - 1), K(i)))          Next      End Function           Private Function F(ByVal RText, ByVal Keys)          Dim EPText, XORText, Result, SKey(7), i, x, y          Result = ""          EPText = Permute(EPRule, RText)          XORText = B_XOR(EPText, Keys)          For i = 1 To Len(XORText) / 6              SKey(i - 1) = Mid(XORText, (i - 1) * 6 + 1, 6)              x = BinaryToDecimal(Left(SKey(i - 1), 1) & Right(SKey(i - 1), 1))              y = BinaryToDecimal(Mid(SKey(i - 1), 2, 4))              SKey(i - 1) = DecimalToBinary(Trim(Split(SBox(i -1), ",")(x * 16 + y)))              If Len(SKey(i - 1)) < 4 Then                  Select Case (4 - Len(SKey(i - 1)))                      Case 1                          SKey(i - 1) = "0" & SKey(i - 1)                      Case 2                          SKey(i - 1) = "00" & SKey(i - 1)                      Case 3                          SKey(i - 1) = "000" & SKey(i - 1)                  End Select              End If              Result = Result & SKey(i - 1)          Next          Result = Permute(PRule, Result)          F = Result      End Function           Private Function B_XOR(ByVal Expression1, ByVal Expression2)          Dim E, K, i, XORText          XORText = ""          E = Trim(Expression1) & ""          K = Trim(Expression2) & ""          For i = 1 To Len(K)              XORText = XORText & CStr(CInt(Mid(E, i, 1)) Xor CInt(Mid(K, i, 1)))          Next          B_XOR = XORText      End Function           Private Function BinaryToDecimal(ByVal binNum)          Dim Binary, Decimal, i, Length          Decimal = 0          Binary = Trim(binNum) & ""          If Binary <> "" Then              While Left(Binary, 1) = "0"                  Binary = Right(Binary, Len(Binary) - 1)              Wend              Length = Len(Binary)              For i = 1 To Length                  Decimal = Decimal + CInt(Mid(Binary, i, 1)) * 2^(Length - i)              Next          End If          BinaryToDecimal = Decimal      End Function           Private Function DecimalToBinary(ByVal decNum)          Dim Decimal, Binary, division          Binary = ""          Decimal = Trim(decNum) & ""          If Decimal <> "" Then              Decimal = CLng(Decimal)              While Decimal > 1                  Binary = Binary & CStr(Decimal Mod 2)                  Decimal = Decimal / 2              Wend              Binary = StrReverse(Binary & Decimal)          End If          DecimalToBinary = Binary      End Function  Private Function StrToBinary(ByVal Str)          Dim Data, Binary, Text, TextLen, i          Text = ""          Data = Str          For i = 1 To Len(Data)              Binary = CStr(DecimalToBinary(Asc(Mid(Data, i, 1))))              If Len(Binary) < 7 Then                  Select Case (7 - Len(Binary))                      Case 1                          Binary = "0" & Binary                      Case 2                          Binary = "00" & Binary                      Case 3                          Binary = "000" & Binary                      Case 4                          Binary = "0000" & Binary                      Case 5                          Binary = "00000" & Binary                      Case 6                          Binary = "000000" & Binary                  End Select              End If              Text = Text & Binary          Next          TextLen = Len(Text)          If TextLen >= 63 Then              If (TextLen Mod 63) <> 0 Then                  For i = 1 To ((TextLen - TextLen Mod 63) / 7)                      Text = Text & FillCode                  Next              End If          Else              For i = 1 To ((63 - TextLen) / 7)                  Text = Text & FillCode              Next          End If          Binary = Text          Text = ""          For i = 0 To (Len(Binary) / 63 - 1)              Text = Text & Mid(Binary, i * 63 + 1, 63) & "0"          Next          StrToBinary = Text      End Function           Private Function BinaryToStr(ByVal binNum)          Dim Text, binText, Length, Group, i, j          Text = ""          binText = Trim(binNum) & ""          If binText <> "" Then              Length = Len(binText) / 64 - 1              ReDim Group(Length)              For i = 0 To Length                  Group(i) = Left(Mid(binText, i * 64 + 1, 64), 63)              Next              While Right(Group(Length), 7) = FillCode                  Group(Length) = Left(Group(Length), Len(Group(Length)) - 7)              Wend              For i = 0 To Length                  For j = 1 To Len(Group(i)) / 7                      Text = Text & Chr(BinaryToDecimal(Mid(Group(i), (j - 1) * 7 + 1, 7)))                  Next              Next              Erase Group          End If          BinaryToStr = Text      End Function           Private Function BinaryToHex(ByVal binNum)          Dim binText, Text, Length, FillLen, Temp, i          Text = ""          binText = Trim(binNum) & ""          If binText <> "" Then              Length = Len(binText)              If Length >= 4 Then                  FillLen = Length Mod 4              Else                  FillLen = 4 - Length              End If              Select Case FillLen                  Case 1                      binText = "0" & binText                  Case 2                      binText = "00" & binText                  Case 3                      binText = "000" & binText              End Select              For i = 0 To (Len(binText) / 4 - 1)                  Temp = Mid(binText, i * 4 + 1, 4)                  Select Case Temp                      Case "0000"                          Text = Text & "0"                      Case "0001"                          Text = Text & "1"                      Case "0010"                          Text = Text & "2"                      Case "0011"                          Text = Text & "3"                      Case "0100"                          Text = Text & "4"                      Case "0101"                          Text = Text & "5"                      Case "0110"                          Text = Text & "6"                      Case "0111"                          Text = Text & "7"                      Case "1000"                          Text = Text & "8"                      Case "1001"                          Text = Text & "9"                      Case "1010"                          Text = Text & "A"                      Case "1011"                          Text = Text & "B"                      Case "1100"                          Text = Text & "C"                      Case "1101"                          Text = Text & "D"                      Case "1110"                          Text = Text & "E"                      Case "1111"                          Text = Text & "F"                  End Select              Next          End If          BinaryToHex = Text      End Function           Private Function HexToBinary(ByVal hexNum)          Dim hexText, Text, Temp, i          Text = ""          hexText = Trim(hexNum) & ""          For i = 1 To Len(hexText)              Temp = UCase(Mid(hexText, i, 1))              Select Case Temp                  Case "0"                      Text = Text & "0000"                  Case "1"                      Text = Text & "0001"                  Case "2"                      Text = Text & "0010"                  Case "3"                      Text = Text & "0011"                  Case "4"                      Text = Text & "0100"                  Case "5"                      Text = Text & "0101"                  Case "6"                      Text = Text & "0110"                  Case "7"                      Text = Text & "0111"                  Case "8"                      Text = Text & "1000"                  Case "9"                      Text = Text & "1001"                  Case "A"                      Text = Text & "1010"                  Case "B"                      Text = Text & "1011"                  Case "C"                      Text = Text & "1100"                  Case "D"                      Text = Text & "1101"                  Case "E"                      Text = Text & "1110"                  Case "F"                      Text = Text & "1111"              End Select          Next          HexToBinary = Text      End Function           Private Function KeyReverse()          Dim Temp, i          For i = 1 To 8              Temp = K(i)              K(i) = K(16 - i + 1)              K(16 - i + 1) = Temp          Next      End Function           Public Function DES(ByVal Data, ByVal Keys, ByVal Work)          Dim Text, i, Group, GroupLen          Text = Data          K(0) = HexToBinary(Keys)          If Work = 0 Then              Text = StrToBinary(Text)          Else              Text = HexToBinary(Text)          End If          GroupLen = Len(Text) / 64 - 1          ReDim Group(GroupLen)          For i = 0 To GroupLen              Group(i) = Mid(Text, i * 64 + 1, 64)          Next          Text = ""          CreateKey()          For i = 0 To GroupLen              IP(Group(i))              If Work <> 0 And DesStatus <> 1 Then                  KeyReverse()                  DesStatus = 1              ElseIf Work = 0 And DesStatus = 1 Then                  KeyReverse()                  DesStatus = 0              End If              IterativeLR()              Text = Text & Permute(CPRule, R(16) & L(16))          Next          Erase Group          If Work = 0 Then              Text = BinaryToHex(Text)          Else              Text = BinaryToStr(Text)          End If          DES = Text      End Function End Class %> 使用说明：      本程序只对ASCII码在000—127范围的字符加密，如果不是这个范围的，加密会出错或者不正确。即在正常在键盘上输入的字符都可以加密（非中文）。因为程序中我使用了ASCII码为013的字符（回车符）作为分组填充字符，所以要加密的字符串记得末尾不能有回车符（回车符和换行符是不同的字符）。      密钥和加密后的字符串都用十六进制数，需要加密的字符串就是原明文字符串。密钥是14位十六进制数（0—9,A,B,C,D,E,F）。下面是加密解密例子： 加密： key = "F7F741E99D0137" data = "Qiuyi Studio,OK!" Set DesCrypt = New Cls_DES Response.Write(DesCrypt.DES(data,key,0)) Set DesCrypt = Nothing 结果：9E9E1DC1CF117A936DCA399A26C47946 解密： key = "F7F741E99D0137" data = "9E9E1DC1CF117A936DCA399A26C47946" Set DesCrypt = New Cls_DES Response.Write(DesCrypt.DES(data,key,1)) Set DesCrypt = Nothing 结果：Qiuyi Studio,OK!