在asp中通过vbs类实现rsa加密与解密的代码

所属分类：网络编程 / ASP编程阅读数： 1292

收藏 0赞 0分享

在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  
%> 