技术资料 > ASP技术 > 安全加密 : 在asp中通过vbs类实现rsa加密与解密

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

March 25,2004

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

1. test.asp

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

%>
<%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 联系:[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

      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