订阅本栏目 RSS您所在的位置: 深山工作室 > ASP > 正文

RSA加密解密插件

2022/6/3 15:55:10 字体: 浏览 40



<%
''........................................
'' RSA插件
'' author Flc 2021-02-02
'' Version v1.0
''........................................


    Public Publickey, Privatekey
    Private SB, Rsa
    Private s_B, s_R, s_U

    Private Sub Class_Initialize()
        Set SB = App.Str.StringBuilder()
        Set Rsa = Server.CreateObject("System.Security.Cryptography.RSACryptoServiceProvider")
        s_B = 0
        s_R = 0
        s_U = 0
    End Sub

    Private Sub Class_Terminate()
        Rsa.Clear()
        Set Rsa = Nothing
        Set SB = Nothing
    End Sub

    ''前置简写,base64不进行编码转换
    Public Function B()
        s_B = 1 : Set B = Me
    End Function

    ''前置简写,xml转pem 私匙pkcs8转换
    Public Function R()
        s_R = 1 : Set R = Me
    End Function

    ''前置简写,xml转pem 公匙转换
    Public Function U()
        s_U = 1 : Set U = Me
    End Function

    ''Rsa密匙初始化
    Public Sub Rsakey()
        With Rsa
            Publickey = .ToXmlString(False)    'xml格式
            Privatekey = .ToXmlString(True)    'xml格式
            'App.Fso.CreateFile RsaFile & "Rsa-Publickey.xml", Publickey
            'App.Fso.CreateFile RsaFile & "Rsa-Privatekey.xml", Privatekey
        End With
    End Sub

    ''密匙pem格式转xml格式
    ''Ascii 密匙
    Public Function Xml(ByVal Ascii)
        Dim Header, Footer, Kind
        If Ascii = "" Then Xml = "" : Exit Function
        If Instr(Ascii, "BEGIN") > 0 And Instr(Ascii, "END") > 0 Then
            If Instr(Ascii, "PUBLIC") Then
                Header = "-----BEGIN PUBLIC KEY-----"
                Footer = "-----END PUBLIC KEY-----"
            ElseIf Instr(Ascii, "RSA PRIVATE") Then
                Header = "-----BEGIN RSA PRIVATE KEY-----"
                Footer = "-----END RSA PRIVATE KEY-----"
            Else
                Header = "-----BEGIN PRIVATE KEY-----"
                Footer = "-----END PRIVATE KEY-----"
            End If
            Dim P0, P1
            P0 = Instr( 1, Ascii, Header, vbTextCompare) + Len(Header)
            P1 = Instr(P0, Ascii, Footer, vbTextCompare)
            Ascii = Mid(Ascii, P0, (P1 - P0))
        End If
        Kind = App.IIF(Len(Ascii) > 800, 1, 0)
        Xml = Encryption(App.Crypt.H.Base64Decode(Ascii), Kind)
    End Function

    ''密匙xml格式转pem格式
    ''Ascii 密匙
    Public Function Pem(ByVal Str)
        Dim I, Filter, Data : Data = Empty : I = 0
        If s_U = 0 Then
            ''pkcs1 私匙
            Filter = "RSA PRIVATE"
            Str = Node(Str, 1)
            Str = B.KeyLength("020100" & Str, "30")
            ''pkcs8 私匙
            If s_R = 1 Then
                Filter = "PRIVATE"
                Str = B.KeyLength(Str, "04")
                Str = B.KeyLength("020100300d06092a864886f70d0101010500" & Str, "30")
                s_R = 0
            End if
        Else
            ''公匙
            Filter = "PUBLIC"
            Str = Node(Str, 0)
            Str = B.KeyLength(Str, "0030")
            Str = B.KeyLength(Str, "03")
            Str = B.KeyLength("300d06092a864886f70d0101010500" & Str, "30")
            s_U = 0
        End If
        Data = App.Crypt.H.Base64Encode(Str)
        SB.Append "-----BEGIN " & Filter & " KEY-----" & VbCrlf
        While I < Len(Data) / 64
            SB.Append Mid(Data, I * 64 + 1, 64) & vbCrlf
            I = I + 1
        Wend
        SB.Append "-----END " & Filter & " KEY-----"
        Pem = SB.ToString
        SB.Clear
    End Function

    ''RSA XML节点转换
    Private Function Node(ByVal Str, ByVal Ascii)
        Dim N, E, P, D, DP, DQ, InverseQ, Q, Xml
        App.Xml.Load Str
        If Ascii = 1 Then
            N = KeyLength(App.Xml("Modulus").Text, "02")
            E = KeyLength(App.Xml("Exponent").Text, "02")
            P = KeyLength(App.Xml("P").Text, "02")
            Q = KeyLength(App.Xml("Q").Text, "02")
            DP = KeyLength(App.Xml("DP").Text, "02")
            DQ = KeyLength(App.Xml("DQ").Text, "02")
            InverseQ = KeyLength(App.Xml("InverseQ").Text, "02")
            D = KeyLength(App.Xml("D").Text, "02")
            Node = Join(Array(N, E, D, P, Q, DP, DQ, InverseQ), "")
        Else
            N = KeyLength(App.Xml("Modulus").Text, "02")
            E = KeyLength(App.Xml("Exponent").Text, "02")
            Node = N & E
        End If
        App.Xml.Close
    End Function

    ''拼接数据长度计算
    Public Function KeyLength(ByVal Str, ByVal Ascii)
        If s_B = 0 Then Str = App.Crypt.H.Base64Decode(Str)
        If CLng("&H" & Mid(Str, 1, 2)) >= 128 Then Str = "00" & Str
        Dim Obj : Obj = Hex(Cint(Len(Str) / 2))
        If Len(Obj) > 2 Then
            KeyLength = Join(Array(Ascii, App.IIF(Len(Obj) = "3", "820", "82"), Obj, Str), "")
        Else
            If CLng("&H" & Obj) < 128 Then
                KeyLength = Join(Array(Ascii, App.IIF(Len(Obj) = "1", "0", ""), Obj, Str), "")
            Else
                KeyLength = Join(Array(Ascii, App.IIF(Len(Obj) = "1", "810", "81"), Obj, Str), "")
            End if
        End If
        s_B = 0
    End Function

    ''pem转xml节点分析
    ''目前只支持[1024bit],[2048bit]位数pem密匙转换
    Private Function Encryption(ByVal Str, ByVal Format)
        Dim Text, Obj, Entry
        Dim N, E, D, P, Q, DP, DQ, Inverseq
        If Left(Migration(Str, 2), 2) = "30" Then
            If CLng("&H" & Leng(Str)) = Len(Str) / 2 Then
                If Format = 1 Then
                    If Left(Migration(Str, 2), 2) = "02" Then Text = Migration(Str, 4)
                End If
                Select Case Left(Migration(Str, 2), 2)
                    Case "30"
                        Text = CLng("&H" & Left(Migration(Str, 2), 2))
                        Obj = Left(Migration(Str, 2), 2)
                        ''OBJECT_IDENTIFIER版本号,未输出
                        If Obj = "06" Then
                            Text = Left(Migration(Str, 2), 2)
                            Text = Migration(Str, CLng("&H" & Text) * 2)
                        End If
                        ''UNLL
                        If Left(Migration(Str, 2), 2) = "05" And Left(Migration(Str, 2), 2) = "00" Then
                            Obj = Left(Migration(Str, 2), 2) : Text = Leng(Str)
                            ''2048密匙下多出一位
                            If Left(Str, 2) = "00" Then Text = Migration(Str, 2)
                        End If
                        If Left(Migration(Str, 2), 2) = "30" Then
                            Text = Leng(Str)
                            If Format = 1 Then
                                If Left(Migration(Str, 2), 2) = "02" Then Text = Leng(Str)
                                If Text <> "00" Then
                                    ''Encryption = "{""code"": 1001, ""msg"": ""密匙错误,请检查!"", ""data"": """"}"
                                    App.Console "密匙 ["& App.IIf(Format = 1, "Privatekey", "Publickey") &"] 格式错误"
                                    App.Error.FunctionName = "Rsa.Encryption"
                                    App.Error.Detail = App.IIf(Format = 1, "Privatekey", "Publickey")
                                    App.Error.Raise "error-crypt-rsa"
                                    'Exit Function
                                End If
                            End If
                            If Left(Migration(Str, 2), 2) = "02" Then N = Identifier(Str)
                        End If
                    Case "02"
                        N = Identifier(Str)
                        If  N = "" Then Text = Migration(Str, 2) : N = Identifier(Str)
                    Case Else
                        App.Console "密匙 ["& App.IIf(Format = 1, "Privatekey", "Publickey") &"] 格式错误"
                        App.Error.FunctionName = "Rsa.Encryption"
                        App.Error.Detail = App.IIf(Format = 1, "Privatekey", "Publickey")
                        App.Error.Raise "error-crypt-rsa"
                End Select
                If Left(Migration(Str, 2), 2) = "02" Then E = Identifier(Str)
                If Format = 1 Then
                    If Left(Migration(Str, 2), 2) = "02" Then D = Identifier(Str)
                    If Left(Migration(Str, 2), 2) = "02" Then P = Identifier(Str)
                    If Left(Migration(Str, 2), 2) = "02" Then Q = Identifier(Str)
                    If Left(Migration(Str, 2), 2) = "02" Then DP = Identifier(Str)
                    If Left(Migration(Str, 2), 2) = "02" Then DQ = Identifier(Str)
                    If Left(Migration(Str, 2), 2) = "02" Then Inverseq = Identifier(Str)
                    Encryption = Join(Array("<RSAKeyValue><Modulus>", N, "</Modulus><Exponent>", E, "</Exponent><P>", P, "</P><Q>", Q, "</Q><DP>", DP, "</DP><DQ>", DQ, "</DQ><InverseQ>", Inverseq, "</InverseQ><D>", D, "</D></RSAKeyValue>"), "")
                Else
                    Encryption = Join(Array("<RSAKeyValue><Modulus>", N, "</Modulus><Exponent>", E, "</Exponent></RSAKeyValue>"), "")
                End If
            End If
        Else
            App.Console "密匙 ["& App.IIf(Format = 1, "Privatekey", "Publickey") &"] 格式错误"
            App.Error.FunctionName = "Rsa.Encryption"
            App.Error.Detail = App.IIf(Format = 1, "Privatekey", "Publickey")
            App.Error.Raise "error-crypt-rsa"
        End If
    End Function

    ''节点数据提取
    Private Function Identifier(ByRef Str)
        Dim Text
        If Left(Str, 2) = "81" Or Left(Str, 2) = "82" Then
            Text = Leng(Str)
        Else
            Text = Left(Migration(Str, 2), 2)
        End If
        Text = CLng("&H" & Text) * 2
        Text = Left(Migration(Str, Text), Text)
        If Left(Text, 2) = "00" Then Text = Right(Text, Len(Text) - 2)
        Identifier = App.Crypt.B.Base64Encode(App.Crypt.D.Base(Text))
    End Function

    ''节点长度
    Private Function Leng(ByRef Str)
        Dim I, Lo, Text : I = 1
        Text = Left(Migration(Str, 2), 2)
        Lo = CLng("&H" & Text)
        If Lo >= 128 Then I = I - 1 + (Lo - 128)
        Leng = Left(Migration(Str, I * 2), I * 2)
    End Function

    ''数据偏移
    Private Function Migration(ByRef Str, ByVal Length)
        Migration = Str
        Str = Right(Str, Len(Str) - Length)
    End Function

    ''rsa签名 私匙签名
    ''4.5以上版本需改.SignHash_2, 以下为SignHash
    ''Hash 加密内容
    ''Length sha1 or sha256
    Public Function Sign(ByVal Hash, ByVal Length)
        With Rsa
            .FromXmlString(Privatekey)
            Hash = App.Crypt.Middleware(Hash, "System.Security.Cryptography." & UCase(Length) & "Managed", "")
            Sign = App.Crypt.B.Base64Encode(.SignHash_2(App.Crypt.D.Base(Hash), Length))
        End With
    End Function

    ''rsa验证 公匙验证
    ''4.5以上版本需改.VerifyHash_2, 以下为.VerifyHash
    ''Hash 加密内容
    ''Signature 签名内容
    ''Length sha1 or sha256
    Public Function Verify(ByVal Hash, ByVal Signature, ByVal Length)
        With Rsa
            .FromXmlString(Publickey)
            Hash = App.Crypt.Middleware(Hash, "System.Security.Cryptography." & UCase(Length) & "Managed", "")
            Verify = .VerifyHash_2(App.Crypt.D.Base(Hash), Length, App.Crypt.B.Base64Decode(Signature))
        End With
    End Function

    ''Rsa加密 公匙加密
    ''需要.net framework4.5版本库的支持,系统最低要求win7,win2008
    ''4.5以上版本需改.Encrypt_2
    ''Str 加密内容
    Public Function Encrypt(ByVal Str)
        Dim I, MAX_ENCRYPT_BLOCK : I = 0
        With Rsa
            .FromXmlString(Publickey)
            MAX_ENCRYPT_BLOCK = (.KeySize / 8 - 11) * 2
            'Str = App.Crypt.Base(App.Str.ToByte(Server.UrlEncode(Str)))
            Str = App.Crypt.Base(App.Str.ToByte(Str))
            While I < Len(Str) / MAX_ENCRYPT_BLOCK
                ''如果为 true OAEP 填充, 为 false PKCS#1 v1.5 填充。
                SB.Append App.Crypt.Base(.Encrypt_2(App.Crypt.D.Base(Mid(Str, I * MAX_ENCRYPT_BLOCK + 1, MAX_ENCRYPT_BLOCK)), False))
                I = I + 1
            Wend
            Encrypt = App.Crypt.B.Base64Encode(App.Crypt.D.Base(SB.ToString))
            'RsaEncrypt = SB.ToString
            SB.Clear
        End With
    End Function

    ''Rsa解密 私匙解密
    ''需要.net framework4.5版本库的支持,系统最低要求win7,win2008
    ''4.5以上版本需改.Decrypt_2
    ''Str 解密内容
    Public Function Decrypt(ByVal Str)
        Dim I, MAX_ENCRYPT_BLOCK : I = 0
        With Rsa
            .FromXmlString(Privatekey)
            MAX_ENCRYPT_BLOCK = .KeySize / 8 * 2
            Str = App.Crypt.H.Base64Decode(Str)
            While I < Len(Str) / MAX_ENCRYPT_BLOCK
                SB.Append App.Str.ToString(.Decrypt_2(App.Crypt.D.Base(Mid(Str, I * MAX_ENCRYPT_BLOCK + 1, MAX_ENCRYPT_BLOCK)), False))
                I = I + 1
            Wend
            'Decrypt = App.UrlDecode(SB.ToString)
            Decrypt = SB.ToString
            SB.Clear
        End With
    End Function

%>

相关阅读
ASP.NET中文乱码问题的解决。
asp获取汉字拼音的第一个字母
告诉你一些GOOGLE搜索你不知道的东西
GOOGLE百度破解,网站优化SEO最终详解
深山旅行社网站管理系统 v1.6
Html中的Frame详解
关于SQL2008 “不允许保存更改。您所做的更改要求删除并重新创建以下表。您对无法重新创建的标进行了更改或者启用了‘阻止保存要求重新创建表的更改’” 解决方案
一个非常实用的当你在关闭任何窗口时都作出提示[推荐]
共有0条关于《RSA加密解密插件》的评论
发表评论
正在加载评论......
返回顶部发表评论
呢 称:
表 情:
内 容:
评论内容:不能超过 1000 字,需审核,请自觉遵守互联网相关政策法规。
验证码: 验证码 
网友评论声明,请自觉遵守互联网相关政策法规。

您发布的评论即表示同意遵守以下条款:
一、不得利用本站危害国家安全、泄露国家秘密,不得侵犯国家、社会、集体和公民的合法权益;
二、不得发布国家法律、法规明令禁止的内容;互相尊重,对自己在本站的言论和行为负责;
三、本站对您所发布内容拥有处置权。

更多信息>>栏目类别选择
百度小程序开发
微信小程序开发
微信公众号开发
uni-app
asp函数库
ASP
DIV+CSS
HTML
更多>>同类信息
iis点开后任务栏上有显示,但是窗口看不到的解决办法
RSA加密解密插件
微软Encoder加密解密函数
asp无限级调用分类显示
实现iis6与iis7环境下支持mp4视频随意拖动、预览播放、边下载边播放
做好的网站把http改成https申请SSL域名证书
更多>>最新添加文章
阿里云短信验证码签名不合法isv.SMS_SIGNATURE_ILLEGAL
iis点开后任务栏上有显示,但是窗口看不到的解决办法
facebook广告推广设定像素标准事件的值和币种等说明
iframe里阻止_blank弹出新窗口的方法
jquery实现下拉加载更多
静态网站利用微信URL Scheme生成的ticket从浏览器h5跳到微信小程序完整代码
RSA加密解密插件
微软Encoder加密解密函数
更多>>随机抽取信息
360500怎么样?啥时候能帮我的工资给我。
div span 之间不同的用法
总结一些DIV+CSS制作网页时容易犯的错误
扬子国际
asp版图形验证码,可自定义点阵信息,支持字符扭曲、倾斜、倾斜
uni-app自定义loading组件