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

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