ASP的DES加密解密
web ASP 2018-05-18 2214 0
关于本站

“最难不过坚持”

本人承接扒站仿站,php网站维护,病毒查杀,网站编辑,网站改版,html制作

有需要网站维护,改版,病毒查杀,网站编辑,网站备案,html制作等相关的工作可以联系我。
本人有多年相关工作经验,也可提供免费咨询,交个朋友。
有需要探讨问题的朋友,也可以加我微信,共同探讨!
微信:15011482830 QQ:408917339

7440204 2655 39
最新评论
https://jueru.net/
评 留言
:weixiao:
评 留言
:shuijiao: :weiqu: :zhenbang: :leng:
评 留言
:yiwen: :yiwen: :yiwen: :yiwen:
评 EasySass: could not generate CSS file. See Output panel for details.
这个业务逻辑多少都有点奇怪了,阅读浏览次数增值在新闻详情页的控制器方法里setInc,这怎么还写进模型事件里了。如果非要用onAfterRead也可以,把新闻文章的内容单独分出来一个news_content表,然后把它和news做关联,然后给news_content表的onAfterRead事件做增值处理,这样点进新闻页内查询到文章内容时才会触发它。
评 TP6模型事件-查询后onAfterRead不好用
文章标签更多
ThinkPHP (254)
Mysql (58)
DedeCms (33)
jQuery (67)
证件照 (1)
setInc (4)
setDec (4)
onclick (5)
打开边栏(ESC) 关闭边栏(ESC)

了解了des加密,网上搜了两篇文章,其中一篇测试有问题,不知识哪出了问题,网址如下

https://blog.csdn.net/why_aircraft/article/details/5634216

另一篇测试没问题,复制过来,下面是原文

=============================================

前两天学到对称密码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
%>
<%
'加密:
key = "F7F741E99D0137"
data = "Qiuyi Studio,OK!"
Set DesCrypt = New Cls_DES
Response.Write(DesCrypt.DES(data,key,0) & "<br />")
Set DesCrypt = Nothing
'结果:9E9E1DC1CF117A936DCA399A26C47946

'解密:
key = "F7F741E99D0137"
data = "9E9E1DC1CF117A936DCA399A26C47946"
Set DesCrypt = New Cls_DES
Response.Write(DesCrypt.DES(data,key,1) & "<br />")
Set DesCrypt = Nothing
'结果:Qiuyi Studio,OK! 
%>
<%  
'rem 用法示例  
key = "abcd1234567890" '密钥是14位十六进制数(0—9,A,B,C,D,E,F)  
data = "Hello word!"  
Set DesCrypt = New Cls_DES  
Response.Write("原 字 符:" & data & "<br />")  
  
data_d = DesCrypt.DES(data,key,0) '加密  
Response.Write("加密结果:" & data_d & "<br />")  
  
data_e = DesCrypt.DES(data_d,key,1) '解密  
Response.Write("解密结果:" & data_e & "<br />")  
  
Set DesCrypt = Nothing  
%>
使用说明:
    本程序只对ASCII码在000—127范围的字符加密,如果不是这个范围的,加密会出错或者不正确。即在正常在键盘上输入的字符都可以加密(非中文)。因为程序中我使用了ASCII码为013的字符(回车符)作为分组填充字符,所以要加密的字符串记得末尾不能有回车符(回车符和换行符是不同的字符)。

    密钥和加密后的字符串都用十六进制数,需要加密的字符串就是原明文字符串。密钥是14位十六进制数(0—9,A,B,C,D,E,F)。

版权声明:本篇文章来源于网络。 来源链接

相关推荐
asp的Base64加密解密函数
ASP | 2018-07-19 17708
<% OPTION EXPLICIT const BASE_64_MAP_INIT = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" dim newline dim Base64EncMap(63) dim Base64DecMap(127) '...
请问这个函数是什么意思 CreateObject("MSXML2.XMLHTTP")
ASP | 2018-03-08 5779
private Function getHTTPPage(url) On Error Resume Next Dim http Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", url, False http.send If http.readyState ...
评论:0条
评论加载中...
发表评论