<% 
rem 文章标题:在asp中通过vbs类实现rsa加密与解密 
rem 收集整理:yanek 
rem 联系:[email protected] 

%> 
 
 
<% 

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

RSA Cipher Demonstration

 
        

 
            You will first need to generate your public/privage key-pair 
            before you can encrypt/decrypt messages. 
        

 
         
            

 
                

 
                    

 
                    

 
                    

 
                

 
                

 
                    

 
                    

 
                

 
                

 
                    

 
                    

 
                

 
                

 
                     
                

 
                

 
                     
                

 
            

Public Key	<INPUT name="KeyE" value="”>
Private Key	<INPUT name="KeyD" value="”>
Modulus	<INPUT name="KeyN" value="”>
Test Message:

 
         
             
 

<% 
rem 实现rsa加密与解密的vbs类文件 
rem 文章标题:在asp中通过vbs类实现rsa加密与解密 
rem 收集整理:yanek 
rem 联系:[email protected] 

‘ 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 

        来源gaodai$ma#com搞$代*码网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 
%>