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

网络编程 2024/11/1 佚名

3 2 1

在asp中通过vbs类实现rsa加密与解密,建议入精华

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

1. test.asp

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

%>
<%Option Explicit%>

<%

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