dsacryptoserviceprovider.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 = "DSACryptoServiceProvider"
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: DSACryptoServiceProvider
'

''
' Provides a wrapper to access a DSA crypto service provider.
'
' @remarks This class is used to create signatures for data and hashes and provide
' verification of those signatures generated.
'
Option Explicit
Implements IObject
Implements AsymmetricAlgorithm
Implements DSA
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 DSACryptoServiceProvider 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
End Property

''
' Returns the name of the key exchange algorithm this instance represents.
'
' @Return The name of the key exchange algorithm.
' @remarks When an DSACryptoServiceProvider is created as a key exchange instead
' of a signature service, this returns 'DSA-PKCS1-KeyEx', otherwise nothing is returned.
'
Public Property Get KeyExchangeAlgorithm() As String
    ' return nothing
End Property

''
' Returns the DSA key size in bits.
'
' @return The key size in bits being used by this DSA 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.NewDSACryptoServiceProvider 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.NewDSACryptoServiceProvider, 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.NewDSACryptoServiceProvider, 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 DSA 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 DSA 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#DSA-sha1'
'
Public Property Get SignatureAlgorithm() As String
    SignatureAlgorithm = "http://www.w3.org/2000/09/xmldsig#dsa-sha1"
End Property

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

''
' 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 A 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 DSA key 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 DSAParameters object containing the parameters of the DSA algorithms.
'
Public Function ExportParameters(ByVal IncludePrivateParameters As Boolean) As DSAParameters
    Set ExportParameters = New DSAParameters
    
    If IncludePrivateParameters And (Not mPublicOnly) Then
        Call ExportParameters.FromCspBlob(Me.ExportCspBlob(False), Me.ExportCspBlob(True))
    Else
        Dim NullBytes() As Byte
        Call ExportParameters.FromCspBlob(Me.ExportCspBlob(False), NullBytes)
    End If
End Function

''
' Imports a DSA key in the form of an XML string.
'
' @param XmlString The XML string containing the key information.
'
Public Sub FromXmlString(ByVal XmlString As String)
    Dim Params As New DSAParameters
    Call Params.FromXmlString(XmlString)
    Call ImportParameters(Params)
End Sub

''
' Imports a CryptoAPI PRIVATEKEYBLOB or PUBLICKEYBLOB into the DSA 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
    
    mPublicOnly = (KeyBlob(LBound(KeyBlob)) = PUBLICKEYBLOB)
    
    If CryptImportKey(mProvider, KeyBlob(LBound(KeyBlob)), cArray.GetLength(KeyBlob), 0, IIf(mPublicOnly, 0, CRYPT_EXPORTABLE), mKey) = BOOL_FALSE Then _
        Throw Cor.NewCryptographicException(GetErrorMessage(Err.LastDllError))
End Sub

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

''
' Creates a signature for a Stream object or Byte array.
'
' @param InputStreamOrBuffer The input source to be signed. This can be any Stream object or Byte array.
' @param Offset The starting index of the Byte array to begin processing. This is only applied to a Byte array.
' @param Count The number of bytes to be processed. This is only applied to a Byte array.
' @return A byte array representing the signature for the data.
'
Public Function SignData(ByRef InputStreamOrBuffer As Variant, Optional ByRef Offset As Variant, Optional ByRef Count As Variant) As Byte()
    Dim HashObj As New SHA1CryptoServiceProvider
    SignData = SignHash(HashObj.ComputeHash(InputStreamOrBuffer, Offset, Count), "sha1")
End Function

''
' Creates a signature for a hash value.
'
' @param RgbHash The hash to create a signature for.
' @param Str The type of hash used to create the hash value.
' @return A byte array representing the signature for the hash value.
' @remarks Only SHA1 hash values are supported.
'
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)
    
    ' Reverse the sections to match the .NET implementation
    Call cArray.Reverse(Signature, 0, 20)
    Call cArray.Reverse(Signature, 20, 20)
    
    SignHash = Signature
    Exit Function

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

''
' Exports the DSA key as an XML string.
'
' @param IncludePrivateParameters A flag indicating if the private portions of the key should be exported as well.
' @return An XML string representation of the DSA key.
'
Public Function ToXmlString(ByVal IncludePrivateParameters As Boolean) As String
    Dim Params As DSAParameters
    Set Params = Me.ExportParameters(IncludePrivateParameters)
    ToXmlString = Params.ToXmlString
End Function

''
' Verifies the signature for the specified data.
'
' @param RgbData The data to verify the signature of.
' @param Signature The signature to be verified.
' @return Returns True if the signature if valid for the data, False otherwise.
'
Public Function VerifyData(ByRef RgbData() As Byte, ByRef Signature() As Byte) As Boolean
    If cArray.IsNull(RgbData) Then _
        Throw Cor.NewArgumentNullException(Environment.GetResourceString(ArgumentNull_Array), "Buffer")
    
    Dim HashObj As New SHA1CryptoServiceProvider
    VerifyData = VerifyHash(HashObj.ComputeHash(RgbData), "SHA1", Signature)
End Function

''
' Verifies the signature for the specified hash value.
'
' @param RgbHash The hash value to verify the signature of.
' @param Str The type of hash used to create the hash value.
' @param Signature The signature to be verified.
' @return Returns True if the signature is valid for the hash value, False otherwise.
' @remarks Only SHA1 hash values are supported.
'
Public Function VerifyHash(ByRef RgbHash() As Byte, ByVal Str As String, ByRef Signature() As Byte) As Boolean
    If cArray.IsNull(Signature) Then _
        Throw Cor.NewArgumentNullException(Environment.GetResourceString(ArgumentNull_Array), "Signature")
    
    Dim Hash As Long
    Hash = SetHash(RgbHash, Str)

    ' We need to reverse the two sections of the signature to deal with .NET's big-endian form.
    Dim RevSig() As Byte
    RevSig = Signature
    Call cArray.Reverse(RevSig, LBound(RevSig), 20)
    Call cArray.Reverse(RevSig, LBound(RevSig) + 20, 20)
    
    VerifyHash = CBool(CryptVerifySignature(Hash, RevSig(0), cArray.GetLength(RevSig), mKey, vbNullString, 0))
    Call CryptDestroyHash(Hash)
End Function

''
' Creates a new signature for the hash value.
'
' @param RgbHash The hash value to be signed.
' @return The hash value signature.
' @remarks Only SHA1 hash values are supported.