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

在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