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

发表于:2007-06-30来源:作者:点击数: 标签:
在asp中通过 vb s类实现rsa加密与解密,建议入精华 本文章有两文件组成 test.asp 测试 演示文件 clsrsa.asp 实现rsa加密与解密的vbs类文件 下面是代码: 1. test.asp % rem 文章标题:在asp中通过vbs类实现rsa加密与解密 rem 收集整理:yanek rem 联系:aspboy@263
在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

原文转自:http://www.ltesting.net