訂閱本欄目 RSS您所在的位置: 深山工作室 > ASP > 正文

RSA加密解密插件

2022/6/3 15:55:10 字體: 瀏覽 586



<%
''........................................
'' 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

%>

相關閱讀
中國簽證行業領導者--91出國簽證網
動態返回selected選擇框的代碼說明
麗江云杉旅行網
asp漢字轉換為拼音
asp利用XMLHTTP獲取xml數據方法
深山工作室
uni-app操作json數組
asp數組隨機排序
共有0條關于《RSA加密解密插件》的評論
發表評論
正在加載評論......
返回頂部發表評論
呢 稱:
表 情:
內 容:
評論內容:不能超過 1000 字,需審核,請自覺遵守互聯網相關政策法規。
驗證碼: 驗證碼 
網友評論聲明,請自覺遵守互聯網相關政策法規。

您發布的評論即表示同意遵守以下條款:
一、不得利用本站危害國家安全、泄露國家秘密,不得侵犯國家、社會、集體和公民的合法權益;
二、不得發布國家法律、法規明令禁止的內容;互相尊重,對自己在本站的言論和行為負責;
三、本站對您所發布內容擁有處置權。

更多信息>>欄目類別選擇
百度小程序開發
微信小程序開發
微信公眾號開發
uni-app
asp函數庫
ASP
DIV+CSS
HTML
python
更多>>同類信息
ASP中Utf-8與Gb2312編碼轉換亂碼問題的解決方法頁面編碼聲明
asp顯示隨機密碼
通過阿里云服務接口獲得ip地址詳細信息
iis點開后任務欄上有顯示,但是窗口看不到的解決辦法
RSA加密解密插件
微軟Encoder加密解密函數
更多>>最新添加文章
python里面requests.post返回的res.text還有其它的嗎
aliyun阿里云續費域名優惠口令(注冊、續費都可以使用)
windows7環境下安裝配置jdk
python對微信操作要用到這兩個庫wxpy與itchat
ASP中Utf-8與Gb2312編碼轉換亂碼問題的解決方法頁面編碼聲明
DW設置之后更好用 DreamweaverCS編輯GB2312與UTF-8文件在代碼視圖中點擊鼠標錯位問題的解決辦法
解決國內 github.com 打不開的準確方法
8種Python字符串拼接的方法,你知道幾種
更多>>隨機抽取信息
JS代碼判斷集錦(之二)
安卓版微信中播放視頻不自動全屏
地瓜坊
html表單里面的label詳細
Shopify 店鋪被封原因與防范及如何解封辦法
利用javascript高亮關鍵詞系列
91超碰caoporen国产香蕉|亚洲天堂在线免费|国产成人片在线观看|日本午夜免a费看大片中文|香蕉国产在线观看免费