DDR爱好者之家 Design By 杰米
在asp中通过vbs类实现rsa加密与解密,建议入精华

本文章有两文件组成
test.asp 测试演示文件
clsrsa.asp 实现rsa加密与解密的vbs类文件
下面是代码:

1. test.asp 

复制代码 代码如下:
<% 
rem 文章标题:在asp中通过vbs类实现rsa加密与解密 
rem 收集整理:yanek 
rem 联系:aspboy@263.net 

%> 
<%Option Explicit%> 
<!--#INCLUDE FILE="clsRSA.asp"--> 
<% 

Dim LngKeyE 
Dim LngKeyD 
Dim LngKeyN 
Dim StrMessage 
Dim ObjRSA 
If Not Request.Form = "" Then 

    LngKeyE = Request.Form("KeyE") 
    LngKeyD = Request.Form("KeyD") 
    LngKeyN = Request.Form("KeyN") 
    StrMessage = Request.Form("Message") 

    Set ObjRSA = New clsRSA 

    Select Case Request.Form("Action") 
        Case "Generate Keys" 
            Call ObjRSA.GenKey() 
            LngKeyE = ObjRSA.PublicKey 
            LngKeyD = ObjRSA.PrivateKey 
            LngKeyN = ObjRSA.Modulus 
        Case "Encrypt" 
            ObjRSA.PublicKey = LngKeyE 
            ObjRSA.Modulus = LngKeyN 
            StrMessage = ObjRSA.Encode(StrMessage) 
        Case "Decrypt" 
            ObjRSA.PrivateKey = LngKeyD 
            ObjRSA.Modulus = LngKeyN 
            StrMessage = ObjRSA.Decode(StrMessage) 
    End Select 

    Set ObjRSA = Nothing 

End If 
%> 
<HTML> 
    <HEAD> 
        <TITLE>RSA Cipher Demonstration</TITLE> 
    </HEAD> 
    <BODY> 
        <H1>RSA Cipher Demonstration</H1> 
        <P> 
            You will first need to generate your public/privage key-pair 
            before you can encrypt/decrypt messages. 
        </P> 
        <FORM method="post"> 
            <TABLE> 
                <TR> 
                    <TD>Public Key</TD> 
                    <TD><INPUT name="KeyE" value="<%=Server.HTMLEncode(LngKeyE)%>"></TD> 
                    <TD rowspan="3"> 
                        <INPUT type="Submit" name="Action" value="Generate Keys"> 
                    </TD> 
                </TR> 
                <TR> 
                    <TD>Private Key</TD> 
                    <TD><INPUT name="KeyD" value="<%=Server.HTMLEncode(LngKeyD)%>"></TD> 
                </TR> 
                <TR> 
                    <TD>Modulus</TD> 
                    <TD><INPUT name="KeyN" value="<%=Server.HTMLEncode(LngKeyN)%>"></TD> 
                </TR> 
                <TR> 
                    <TD colspan="3"> 
                        Test Message:<BR> 
                        <TEXTAREA name="Message" cols="50" rows="7"><%=Server.HTMLEncode(StrMessage)%></TEXTAREA> 
                    </TD> 
                </TR> 
                <TR> 
                    <TD align="right" colspan="3"> 
                        <INPUT type="Submit" name="Action" value="Encrypt"> 
                        <INPUT type="Submit" name="Action" value="Decrypt"> 
                    </TD> 
                </TR> 
            </TABLE> 
        </FORM> 
            </BODY> 
</HTML> 
    


clsrsa.asp  

复制代码 代码如下:
<% 
rem 实现rsa加密与解密的vbs类文件 
rem 文章标题:在asp中通过vbs类实现rsa加密与解密 
rem 收集整理:yanek 
rem 联系:aspboy@263.net 

' RSA Encryption Class 

' .PrivateKey 
'        Your personal private key.  Keep this hidden. 

' .PublicKey 
'        Key for others to encrypt data with. 

' .Modulus 
'        Used with both public and private keys when encrypting 
'        and decrypting data. 

' .GenKey() 
'        Creates Public/Private key set and Modulus 

' .Crypt(pLngMessage, pLngKey)   
'        Encrypts/Decrypts message and returns  
'        as a string. 

' .Encode(pStrMessage) 
'        Encrypts message and returns in double-hex format 

' .Decode(pStrMessage) 
'        Decrypts message from double-hex format and returns a string 

Class clsRSA 

    Public PrivateKey 
    Public PublicKey 
    Public Modulus 

    Public Sub GenKey() 
        Dim lLngPhi 
        Dim q 
        Dim p 

        Randomize 

        Do 
            Do 

                ' 2 random primary numbers (0 to 1000) 
                Do 
                    p = Rnd * 1000 \ 1 
                Loop While Not IsPrime(p) 

                Do 
                    q = Rnd * 1000 \ 1 
                Loop While Not IsPrime(q) 

                 
                ' n = product of 2 primes 
                Modulus = p * q \ 1 

                ' random decryptor (2 to n) 
                PrivateKey = Rnd * (Modulus - 2) \ 1 + 2 

                lLngPhi = (p - 1) * (q - 1) \ 1 
                PublicKey = Euler(lLngPhi, PrivateKey) 

            Loop While PublicKey = 0 Or PublicKey = 1 

        ' Loop if we can't crypt/decrypt a byte     
        Loop While Not TestCrypt(255) 

    End Sub 

    Private Function TestCrypt(ByRef pBytData) 
        Dim lStrCrypted 
        lStrCrypted = Crypt(pBytData, PublicKey) 
        TestCrypt = Crypt(lStrCrypted, PrivateKey) = pBytData 
    End Function 

    Private Function Euler(ByRef pLngPHI, ByRef pLngKey) 

        Dim lLngR(3) 
        Dim lLngP(3) 
        Dim lLngQ(3) 

        Dim lLngCounter 
        Dim lLngResult 

        Euler = 0 

        lLngR(1) = pLngPHI: lLngR(0) = pLngKey 
        lLngP(1) = 0: lLngP(0) = 1 
        lLngQ(1) = 2: lLngQ(0) = 0 

        lLngCounter = -1 

        Do Until lLngR(0) = 0 

            lLngR(2) = lLngR(1): lLngR(1) = lLngR(0) 
            lLngP(2) = lLngP(1): lLngP(1) = lLngP(0) 
            lLngQ(2) = lLngQ(1): lLngQ(1) = lLngQ(0) 

            lLngCounter = lLngCounter + 1 

            lLngR(0) = lLngR(2) Mod lLngR(1) 
            lLngP(0) = ((lLngR(2)\lLngR(1)) * lLngP(1)) + lLngP(2) 
            lLngQ(0) = ((lLngR(2)\lLngR(1)) * lLngQ(1)) + lLngQ(2) 

        Loop 

        lLngResult = (pLngKey * lLngP(1)) - (pLngPHI * lLngQ(1)) 

        If lLngResult > 0 Then 
            Euler = lLngP(1) 
        Else 
            Euler = Abs(lLngP(1)) + pLngPHI 
        End If 

    End Function 

    Public Function Crypt(pLngMessage, pLngKey) 
        On Error Resume Next 
        Dim lLngMod 
        Dim lLngResult 
        Dim lLngIndex 
        If pLngKey Mod 2 = 0 Then 
            lLngResult = 1 
            For lLngIndex = 1 To pLngKey / 2 
                lLngMod = (pLngMessage ^ 2) Mod Modulus 
                ' Mod may error on key generation 
                lLngResult = (lLngMod * lLngResult) Mod Modulus  
                If Err Then Exit Function 
            Next 
        Else 
            lLngResult = pLngMessage 
            For lLngIndex = 1 To pLngKey / 2 
                lLngMod = (pLngMessage ^ 2) Mod Modulus 
                On Error Resume Next 
                ' Mod may error on key generation 
                lLngResult = (lLngMod * lLngResult) Mod Modulus 
                If Err Then Exit Function 
            Next 
        End If 
        Crypt = lLngResult 
    End Function 

    Private Function IsPrime(ByRef pLngNumber) 
        Dim lLngSquare 
        Dim lLngIndex 
        IsPrime = False 
        If pLngNumber < 2 Then Exit Function 
        If pLngNumber Mod 2 = 0 Then Exit Function 
        lLngSquare = Sqr(pLngNumber) 
        For lLngIndex = 3 To lLngSquare Step 2 
            If pLngNumber Mod lLngIndex = 0 Then Exit Function 
        Next 
        IsPrime = True 
    End Function 

    Public Function Encode(ByVal pStrMessage) 
        Dim lLngIndex 
        Dim lLngMaxIndex 
        Dim lBytAscii 
        Dim lLngEncrypted 
        lLngMaxIndex = Len(pStrMessage) 
        If lLngMaxIndex = 0 Then Exit Function 
        For lLngIndex = 1 To lLngMaxIndex 
            lBytAscii = Asc(Mid(pStrMessage, lLngIndex, 1)) 
            lLngEncrypted = Crypt(lBytAscii, PublicKey) 
            Encode = Encode & NumberToHex(lLngEncrypted, 4) 
        Next 
    End Function 

    Public Function Decode(ByVal pStrMessage) 
        Dim lBytAscii 
        Dim lLngIndex 
        Dim lLngMaxIndex 
        Dim lLngEncryptedData 
        Decode = "" 
        lLngMaxIndex = Len(pStrMessage) 
        For lLngIndex = 1 To lLngMaxIndex Step 4 
            lLngEncryptedData = HexToNumber(Mid(pStrMessage, lLngIndex, 4)) 
            lBytAscii = Crypt(lLngEncryptedData, PrivateKey) 
            Decode = Decode & Chr(lBytAscii) 
        Next 
    End Function 

    Private Function NumberToHex(ByRef pLngNumber, ByRef pLngLength) 
        NumberToHex = Right(String(pLngLength, "0") & Hex(pLngNumber), pLngLength) 
    End Function 

    Private Function HexToNumber(ByRef pStrHex) 
        HexToNumber = CLng("&h" & pStrHex) 
    End Function 

End Class 
%> 
演示地址:http://www.cnaspol.com/myrsa/test.asp
DDR爱好者之家 Design By 杰米
广告合作:本站广告合作请联系QQ:858582 申请时备注:广告合作(否则不回)
免责声明:本站资源来自互联网收集,仅供用于学习和交流,请遵循相关法律法规,本站一切资源不代表本站立场,如有侵权、后门、不妥请联系本站删除!
DDR爱好者之家 Design By 杰米