rsacryptoserviceprovider.cls

这是一个在vb下实现的各种加密程序,可以实现一般的文本加密和文件加密,但是很多算法都是已经被人破解过的.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "RSACryptoServiceProvider"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'    CopyRight (c) 2006 Kelly Ethridge
'
'    This file is part of VBCorLib.
'
'    VBCorLib is free software; you can redistribute it and/or modify
'    it under the terms of the GNU Library General Public License as published by
'    the Free Software Foundation; either version 2.1 of the License, or
'    (at your option) any later version.
'
'    VBCorLib is distributed in the hope that it will be useful,
'    but WITHOUT ANY WARRANTY; without even the implied warranty of
'    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'    GNU Library General Public License for more details.
'
'    You should have received a copy of the GNU Library General Public License
'    along with Foobar; if not, write to the Free Software
'    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
'
'    Module: RSACryptoServiceProvider
'

''
' Provides RSA encryption services using the Windows Crypto API methods.
'
Option Explicit
Implements IObject
Implements AsymmetricAlgorithm
Implements RSA
Implements ICspAsymmetricAlgorithm

Private mProvider           As Long
Private mKey                As Long
Private mKeySize            As Long
Private mProviderName       As String
Private mProviderType       As Long
Private mKeyContainerName   As String
Private mKeyNumber          As Long
Private mPersistKeyInCsp    As Boolean
Private mFlags              As CspProviderFlags
Private mLegalKeySizes()    As KeySizes
Private mRandomlyGenerated  As Boolean
Private mPublicOnly         As Boolean
Private mIsDisposed         As Boolean




''
' Returns a CspKeyContainerInfo object containing information about this RSACryptoServiceProvider instance.
'
' @return A CspKeyContainerInfo object.
'
Public Property Get CspKeyContainerInfo() As CspKeyContainerInfo
    Call VerifyLoaded
    
    Dim Params As CspParameters
    Set Params = Cor.NewCspParameters(mProviderType, mProviderName, mKeyContainerName)
    Params.KeyNumber = mKeyNumber
    Params.Flags = mFlags
    
    Set CspKeyContainerInfo = Cor.NewCspKeyContainerInfo(Params)
    CspKeyContainerInfo.RandomlyGenerated = mRandomlyGenerated
    CspKeyContainerInfo.Accessible = True
End Property

''
' Returns the name of the key exchange algorithm this instance represents.
'
' @Return The name of the key exchange algorithm.
' @remarks When an RSACryptoServiceProvider is created as a key exchange instead
' of a signature service, this returns 'RSA-PKCS1-KeyEx', otherwise nothing is returned.
'
Public Property Get KeyExchangeAlgorithm() As String
    If mKeyNumber = AT_KEYEXCHANGE Then
        KeyExchangeAlgorithm = "RSA-PKCS1-KeyEx"
    End If
End Property

''
' Returns the RSA key size in bits.
'
' @return The key size in bits being used by this RSA instance.
' @remarks By default, the key size is 1024 for high encryption and 512 for base encryption providers.
'
Public Property Get KeySize() As Long
    KeySize = mKeySize
End Property

''
' Sets the key size.
'
' @param RHS The new key size.
' @remarks This property has no affect on the key size. To set the key size, use the
' Cor.NewRSACryptoServiceProvider constructor.
'
Public Property Let KeySize(ByVal RHS As Long)
    ' does nothing
End Property

''
' Returns an array of KeySizes objects defining the valid key sizes.
'
' @return An array of KeySizes objects.
' @remarks For high encryption systems, the legal key sizes go from 384 bits to 16384 bits
' in steps of 8 bits. For base encryption systems, the key sizes go from 384 bits to 512 bits
' in steps of 8 bits.
'
Public Property Get LegalKeySizes() As KeySizes()
    LegalKeySizes = mLegalKeySizes
End Property

''
' Returns if the current key will be stored in the current provider container.
'
' @return Returns True if the key will be stored, False otherwise.
' @remarks By default this is set to False. If a container is specified using the
' Cor.NewRSACryptoServiceProvider, then this will be set to True.<br>
' <br>A key is stored in the container to allow for each retrieval by any other
' service that knows where the key is. Only 1 key is stored in a container, therefore,
' if multiple providers share the same container, then the key may become invalid.
'
Public Property Get PersistKeyInCsp() As Boolean
    PersistKeyInCsp = mPersistKeyInCsp
End Property

''
' Sets if the current key will be stored in the current provider container.
'
' @param RHS Set to True to save the key on exit, False to have the key be deleted.
' @remarks By default this is set to False. If a container is specified using the
' Cor.NewRSACryptoServiceProvider, then this will be set to True.<br>
' <br>A key is stored in the container to allow for each retrieval by any other
' service that knows where the key is. Only 1 key is stored in a container, therefore,
' if multiple providers share the same container, then the key may become invalid.
'
Public Property Let PersistKeyInCsp(ByVal RHS As Boolean)
    mPersistKeyInCsp = RHS
End Property

''
' Returns if the key for this RSA instance is only the public half of the key pair.
'
' @return Returns True if only the public half of the key is present, False otherwise.
' @remarks RSA uses a private/public key pair to encrypt and decrypt. Only the public
' part is required to encrypt data. The private key is used to decrypt data.
'
Public Property Get PublicOnly() As Boolean
    Call VerifyLoaded
    PublicOnly = mPublicOnly
End Property

''
' Returns the signature algorithm.
'
' @return Always returns 'http://www.w3.org/2000/09/xmldsig#rsa-sha1'
'
Public Property Get SignatureAlgorithm() As String
    SignatureAlgorithm = "http://www.w3.org/2000/09/xmldsig#rsa-sha1"
End Property

''
' Releases any resources and disposes the RSA instance.
'
Public Sub Clear()
    Call CryptoAPI.DestroyKey(mKey)
    Call CryptoAPI.ReleaseContext(mProvider, Not mPersistKeyInCsp)
    
    mIsDisposed = True
End Sub

''
' Decrypts data using the private key in this RSA instance.
'
' @param Rgb The data to be decrypted.
' @param fOAEP A flag indicating if the data was padded using OAEP padding.
' @return Returns the decrypted data.
'
Public Function Decrypt(ByRef Rgb() As Byte, ByVal fOAEP As Boolean) As Byte()
    Call VerifyLoaded
    
    If cArray.IsNull(Rgb) Then _
        Throw Cor.NewArgumentNullException(Environment.GetResourceString(ArgumentNull_Array), "Rgb")
    
    Dim Flags As Long
    If fOAEP Then Flags = CRYPT_OAEP
    
    Dim Size As Long
    Size = cArray.GetLength(Rgb)
    
    ' We need to make a copy of the original array because we dont' want
    ' to alter its contents. Also, the copy is reversed in order to deal
    ' with .NET's Big-Endian form.
    Dim Ret() As Byte
    Ret = ReverseByteCopy(Rgb)
    
    If CryptDecrypt(mKey, 0, True, Flags, Ret(0), Size) = BOOL_FALSE Then _
        Throw Cor.NewCryptographicException(GetErrorMessage(Err.LastDllError))
    
    ReDim Preserve Ret(0 To Size - 1)
    Decrypt = Ret
End Function

''
' Decrypts the value.
'
' @param Rgb The value to be decrypted.
' @return The decrypted value.
' @remarks In .NET this would throw a NotSupportedException, however, it is
' supported in VBCorLib. This is equivalen to calling Decrypt(Data, False).
'
'
Public Function DecryptValue(ByRef Rgb() As Byte) As Byte()
    DecryptValue = Decrypt(Rgb, False)
End Function

''
' Encrypts data using the public key in this RSA instance.
'
' @param Rgb The data to be encrypted.
' @param fOAEP A flag indicating if OAEP padding should be used, otherwise PKCS#1 v1.5 padding is used.
'
Public Function Encrypt(ByRef Rgb() As Byte, ByVal fOAEP As Boolean) As Byte()
    Call VerifyLoaded
    
    If cArray.IsNull(Rgb) Then _
        Throw Cor.NewArgumentNullException(Environment.GetResourceString(ArgumentNull_Array), "Rgb")
    
    Dim Flags As Long
    If fOAEP Then Flags = CRYPT_OAEP
    
    Dim Size As Long
    Size = cArray.GetLength(Rgb)
    
    ' We copy the original array so we don't alter the
    ' original array during the encryption process.
    Dim Ret() As Byte
    ReDim Ret(0 To mKeySize \ 8 - 1)
    Call Buffer.BlockCopy(Rgb, 0, Ret, 0, Size)
    
    If CryptEncrypt(mKey, 0, True, Flags, Ret(0), Size, mKeySize \ 8) = BOOL_FALSE Then _
        Throw Cor.NewCryptographicException(GetErrorMessage(Err.LastDllError))
    
    ' This is to remain compatible with .NET's big-endian form.
    Encrypt = ReverseByteCopy(Ret)
End Function

''
' Encrypts a value.
'
' @param Rgb The value to be encrypted.
' @return The encrypted value.
' @remarks In .NET this would throw a NotSupportedException, however, it is
' supported in VBCorLib. This is equivalen to calling Encrypt(Data, False).
'
Public Function EncryptValue(ByRef Rgb() As Byte) As Byte()
    EncryptValue = Encrypt(Rgb, False)
End Function

''
' Exports the key information as a CryptoAPI PRIVATEKEYBLOB or PUBLICKEYBLOB structure.
'
' @param IncludePrivateParameters A flag indicating if only the public key should be exported
' or is both the public and private keys should be exported.
' @return An exported key blob structure.
'
Public Function ExportCspBlob(ByVal IncludePrivateParameters As Boolean) As Byte()
    Call VerifyLoaded
    
    Dim BlobType As Long
    BlobType = IIf(IncludePrivateParameters, PRIVATEKEYBLOB, PUBLICKEYBLOB)
    
    Dim Size As Long
    If CryptExportKey(mKey, 0, BlobType, 0, ByVal 0&, Size) = BOOL_FALSE Then _
        Throw Cor.NewCryptographicException(GetErrorMessage(Err.LastDllError))
    
    Dim Blob() As Byte
    ReDim Blob(0 To Size - 1)
    
    If CryptExportKey(mKey, 0, BlobType, 0, Blob(0), Size) = BOOL_FALSE Then _
        Throw Cor.NewCryptographicException(GetErrorMessage(Err.LastDllError))
    
    ExportCspBlob = Blob
End Function

''
' Exports the RSA algorithm parameters.
'
' @param IncludePrivateParameters A flag indicating if only the public key should be exported
' or is both the public and private keys should be exported.
' @return An RSAParameters object containing the parameters of the RSA algorithms.
'
Public Function ExportParameters(ByVal IncludePrivateParameters As Boolean) As RSAParameters
    Set ExportParameters = New RSAParameters
    Call ExportParameters.FromCspBlob(Me.ExportCspBlob(IncludePrivateParameters))
End Function

''
' Imports RSA parameters from an XML string.
'
' @param XmlString The string containing the XML formatted parameters.
'
Public Sub FromXmlString(ByVal XmlString As String)
    Dim Params As New RSAParameters
    Call Params.FromXmlString(XmlString)
    Call ImportParameters(Params)
End Sub

''
' Imports a CryptoAPI PRIVATEKEYBLOB or PUBLICKEYBLOB into the RSA provider.
'
' @param KeyBlob The blob key to be imported.
'
Public Sub ImportCspBlob(ByRef KeyBlob() As Byte)
    If cArray.IsNull(KeyBlob) Then _
        Throw Cor.NewArgumentNullException(Environment.GetResourceString(ArgumentNull_Array), "KeyBlob")
    
    Call VerifyLoaded(False)
    Call DeleteKey
    
    If CryptImportKey(mProvider, KeyBlob(LBound(KeyBlob)), cArray.GetLength(KeyBlob), 0, CRYPT_EXPORTABLE, mKey) = BOOL_FALSE Then _
        Throw Cor.NewCryptographicException(GetErrorMessage(Err.LastDllError))
    
    mPublicOnly = (KeyBlob(LBound(KeyBlob)) = PUBLICKEYBLOB)
End Sub

''
' Imports the RSA key parameters.
'
' @param Parameters The parameters to be imported as the new key.
'
Public Sub ImportParameters(ByVal Parameters As RSAParameters)
    If Parameters Is Nothing Then _
        Throw Cor.NewArgumentNullException("Parameters cannot be Nothing.", "Parameters")
    
    Call Me.ImportCspBlob(Parameters.ToCspBlob(mKeyNumber))
End Sub

''
' Signs data using the specified hash algorithm.
'
' @param InputStreamOrBuffer The data to be signed. This can be a <b>Stream</b> object or a Byte Array.
' @param hAlg The hash algorithm to use for signing. Only SHA1 and MD5 are supported.
' @param Offset The starting index of a Byte array input source. This is ignored for <b>Stream</b> input sources.
' @param Count The number of bytes of a Byte array input source to process. This is ignored for <b>Stream</b> input sources.
' @return The signature of the data.
' @remarks The hash algorithms can be specified either by the OID string, the hash name, or an actual instance of a hash
' object that implements either the <b>SHA1</b> or <b>MD5</b> interface.
' @see CryptoConfig
' @see SHA1
' @see MD5
' @see SHA1CryptoServiceProvider
' @see SHA1Manged
' @see MD5CryptoServiceProvider
'
Public Function SignData(ByRef InputStreamOrBuffer As Variant, ByVal hAlg As Variant, Optional ByRef Offset As Variant, Optional ByRef Count As Variant) As Byte()
    Dim HashObj As HashAlgorithm
    Set HashObj = GetHash(hAlg)
    
    SignData = SignHash(HashObj.ComputeHash(InputStreamOrBuffer, Offset, Count), GetOID(HashObj))
End Function

''
' Signs a hash using RSA AT_SIGNATURE.
'
' @param RgbHash The hash value to be signed.
' @param Str The type of hash value being signed.
' @return The signature for the hash data.
' @remarks Only SHA1 and MD5 hashes are supported.
' <p>The <i>Str</i> parameter can be "SHA", "SHA1", "MD5", or the OID.
' @see CryptoConfig
'
Public Function SignHash(ByRef RgbHash() As Byte, ByVal Str As String) As Byte()
    Dim Hash As Long
    Hash = SetHash(RgbHash, Str)

    Dim Size As Long
    If CryptSignHash(Hash, AT_SIGNATURE, vbNullString, 0, ByVal 0&, Size) = BOOL_FALSE Then _
        Throw Cor.NewCryptographicException(GetErrorMessage(Err.LastDllError))

    Dim Signature() As Byte
    ReDim Signature(0 To Size - 1)
    
    If CryptSignHash(Hash, AT_SIGNATURE, vbNullString, 0, Signature(0), Size) = BOOL_FALSE Then _
        Throw Cor.NewCryptographicException(GetErrorMessage(Err.LastDllError))
    
    Call CryptDestroyHash(Hash)
    
    SignHash = ReverseByteCopy(Signature)
    Exit Function

errTrap:
    If Hash <> vbNullPtr Then Call CryptDestroyHash(Hash)
    Call Throw
End Function

''
' Exports the RSA key to an Xml string.
'
' @param IncludePrivateParameters A flag indicating if the private portions of the key should be exported.
' @return An Xml representation of the RSA key.
'
Public Function ToXmlString(ByVal IncludePrivateParameters As Boolean) As String
    ToXmlString = Me.ExportParameters(IncludePrivateParameters).ToXmlString
End Function

''