cryptoapitransform.cls

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

        If (mPadding <> PaddingMode.None) And (mPadding <> PaddingMode.Zeros) Then
            mKeepLastBlock = True
            ReDim mLastBlock(0 To mBlockSize - 1)
        End If
    End With

    mIsEncrypting = IsEncrypting
End Sub



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Private Helpers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''
' The way we handle custom padding is to pad the block ourselves then let the CryptoAPI
' add one additional padded block. Afterwards, we strip that additional block off.
'
Private Function EncryptFinalBlock(ByRef InputBuffer() As Byte, ByVal InputOffset As Long, ByVal InputCount As Long) As Byte()
    Dim FullBlocks As Long
    FullBlocks = InputCount \ mBlockSize

    ' If we have a number of bytes to encrypt equal to a multiple of mBlockSize then
    ' we will have zero remaining bytes. Any padding will create a new full block instead
    ' of just filling in the last partial block.
    Dim RemainingBytes As Long
    RemainingBytes = InputCount - (FullBlocks * mBlockSize)

    If (mPadding = PaddingMode.None) And (RemainingBytes <> 0) Then _
        Throw Cor.NewCryptographicException("Length of data to be encrypted is incorrect.")

    ' We need enough bytes to hold all the full blocks, 1 padded block produced by us
    ' and 1 padded block that the CryptoAPI must create.
    Dim TotalBytes As Long
    TotalBytes = (FullBlocks + 2) * mBlockSize

    Dim OutputBuffer() As Byte
    ReDim OutputBuffer(0 To TotalBytes - 1)

    ' We have to copy the data to be encrypted to our output buffer because CryptoAPI
    ' puts the encrypted data back into the working array.
    If InputCount > 0 Then Call CopyMemory(OutputBuffer(0), InputBuffer(InputOffset), InputCount)

    ' We subtract the number of padding bytes that were not added.
    TotalBytes = TotalBytes - CryptoHelper.PadBlock(OutputBuffer, FullBlocks * mBlockSize + RemainingBytes, mPadding, mBlockSize - RemainingBytes, mBlockSize)

    Dim Size As Long
    Size = TotalBytes - mBlockSize ' We don't want to include the CryptoAPI padding block as part of the data to encrypt.
    If CryptEncrypt(mCipherKey, 0, True, 0, OutputBuffer(0), Size, TotalBytes) = 0 Then _
        Throw Cor.NewCryptographicException("Encryption failed: " & GetErrorMessage(Err.LastDllError))

    ' Size will be set to the total bytes encrypted, including the additional block of padding.
    ' We don't want that additional block of padding from the CryptoAPI since we've added our own,
    ' so we will just strip of the last block of bytes.
    Dim NewSize As Long
    NewSize = Size - mBlockSize
    If NewSize > 0 Then
        ReDim Preserve OutputBuffer(0 To NewSize - 1)
    Else
        OutputBuffer = Cor.NewBytes()
    End If

    Call Reset
    EncryptFinalBlock = OutputBuffer
End Function

Private Function EncryptBlock(ByRef InputBuffer() As Byte, ByVal InputOffset As Long, ByVal InputCount As Long, ByRef OutputBuffer() As Byte, ByVal OutputOffset As Long) As Long
    ' Since the cipher changes the data within the same array, we need to copy the
    ' plain text data to the output buffer and let the cipher work on that buffer.
    Call CopyMemory(OutputBuffer(OutputOffset), InputBuffer(InputOffset), InputCount)

    If CryptEncrypt(mCipherKey, 0, False, 0, OutputBuffer(OutputOffset), InputCount, InputCount) = BOOL_FALSE Then _
        Throw Cor.NewCryptographicException("Failed to encrypt data. " & GetErrorMessage(Err.LastDllError))

    EncryptBlock = InputCount
End Function

''
' This function is usually called repeatedly. The last block may be buffered and not processed
' on the same call. It may be processed during the next call or the call to TransformFinalBlock.
'
Private Function DecryptBlock(ByRef InputBuffer() As Byte, ByVal InputOffset As Long, ByVal InputCount As Long, ByRef OutputBuffer() As Byte, ByVal OutputOffset As Long) As Long
    Dim NextOutputOffset As Long
    NextOutputOffset = OutputOffset

    ' Start out attempting to process the original requested number of bytes.
    Dim TotalBytes As Long
    TotalBytes = InputCount

    ' If we buffered the last block from the previous call, then we now need to
    ' include it in this decryption process as the first block of the InputBuffer.
    If mHasLastBlock Then
        Call CopyMemory(OutputBuffer(NextOutputOffset), mLastBlock(0), mBlockSize)
        NextOutputOffset = NextOutputOffset + mBlockSize
        TotalBytes = TotalBytes + mBlockSize
        mHasLastBlock = False
    End If

    ' If we are still needing to keep the last block after each call, then we need
    ' to copy it now and not include it in the current operation by decrementing the
    ' number of bytes to be processed.
    If mKeepLastBlock Then
        TotalBytes = TotalBytes - mBlockSize
        InputCount = InputCount - mBlockSize
        Call CopyMemory(mLastBlock(0), InputBuffer(InputOffset + InputCount), mBlockSize)
        mHasLastBlock = True
    End If

    ' If there is anything left in the InputBuffer to process we need to copy it to the
    ' output buffer which the decryption routine will work on.
    If InputCount > 0 Then Call CopyMemory(OutputBuffer(NextOutputOffset), InputBuffer(InputOffset), InputCount)

    ' Have the decryption routine work on the bytes in the output buffer. The decrypted bytes
    ' will be placed back into the same buffer.
    If CryptDecrypt(mCipherKey, 0, False, 0, OutputBuffer(OutputOffset), TotalBytes) = BOOL_FALSE Then _
        Throw Cor.NewCryptographicException("Could not decrypt data. " & GetErrorMessage(Err.LastDllError))

    ' Return how many bytes we actually decrypted.
    DecryptBlock = TotalBytes
End Function

Private Function DecryptFinalBlock(ByRef InputBuffer() As Byte, ByVal InputOffset As Long, ByVal InputCount As Long) As Byte()
    If (InputCount Mod mBlockSize) <> 0 Then _
        Throw Cor.NewCryptographicException("Invalid data length.")

    Dim TotalBytes As Long
    TotalBytes = InputCount

    ' If we kept the last block from the previous decrypt call then we need
    ' to include it in this final decryption call, so up the total bytes to process.
    If mHasLastBlock Then
        TotalBytes = TotalBytes + mBlockSize
    End If

    ' If we still don't have anything to process (no previous block and nothing in this block)
    ' then simply reset everything and return an empty byte array representing the final block.
    If TotalBytes = 0 Then
        Call Reset
        DecryptFinalBlock = Cor.NewBytes
        Exit Function
    End If

    ' Allocate the buffer that all the work will be performed on.
    Dim OutputBuffer() As Byte
    ReDim OutputBuffer(0 To TotalBytes - 1)

    ' If we kept the last block from the previous decrypt call then we need
    ' to now copy that block into the working buffer.
    Dim OutputOffset As Long
    If mHasLastBlock Then
        Call CopyMemory(OutputBuffer(0), mLastBlock(0), mBlockSize)
        OutputOffset = mBlockSize
        mHasLastBlock = False
    End If

    ' If there is something in the InputBuffer to be processed, then
    ' add it to the working buffer, too.
    If InputCount > 0 Then Call CopyMemory(OutputBuffer(OutputOffset), InputBuffer(InputOffset), InputCount)

    ' Decrypt the working buffer. We don't tell the CryptDecrypt method that this is the
    ' final block because we don't want the CryptoAPI to deal with any padding. We will
    ' deal with that next ourselves so we can support different padding types.
    If CryptDecrypt(mCipherKey, 0, False, 0, OutputBuffer(0), TotalBytes) = BOOL_FALSE Then _
        Throw Cor.NewCryptographicException("Could not decrypt data. " & GetErrorMessage(Err.LastDllError))

    ' Remove the padding based on the type of padding expected.
    Dim DepadCount As Long
    DepadCount = CryptoHelper.DepadBlock(OutputBuffer, mPadding, mBlockSize)

    ' Calculate how many plain text bytes we really have.
    Dim NewSize As Long
    NewSize = TotalBytes - DepadCount
    If NewSize > 0 Then
        ' Chop of the end padding bytes now. This is pretty efficient
        ' because the data is not actually moved since we are shrinking the array.
        ReDim Preserve OutputBuffer(0 To NewSize - 1)
    Else
        ' Nothing is left, so return an empty array.
        OutputBuffer = Cor.NewBytes
    End If

    Call Reset
    DecryptFinalBlock = OutputBuffer
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Class Events
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Class_Terminate()
    Call Clear
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   ICryptoTransform Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Property Get ICryptoTransform_CanReuseTransform() As Boolean
    ICryptoTransform_CanReuseTransform = CanReuseTransform
End Property

Private Property Get ICryptoTransform_CanTransformMultipleBlocks() As Boolean
    ICryptoTransform_CanTransformMultipleBlocks = CanTransformMultipleBlocks
End Property

Private Property Get ICryptoTransform_InputBlockSize() As Long
    ICryptoTransform_InputBlockSize = InputBlockSize
End Property

Private Property Get ICryptoTransform_OutputBlockSize() As Long
    ICryptoTransform_OutputBlockSize = OutputBlockSize
End Property

Private Function ICryptoTransform_TransformBlock(InputBuffer() As Byte, ByVal InputOffset As Long, ByVal InputCount As Long, OutputBuffer() As Byte, ByVal OutputOffset As Long) As Long
    ICryptoTransform_TransformBlock = TransformBlock(InputBuffer, InputOffset, InputCount, OutputBuffer, OutputOffset)
End Function

Private Function ICryptoTransform_TransformFinalBlock(InputBuffer() As Byte, ByVal InputOffset As Long, ByVal InputCount As Long) As Byte()
    ICryptoTransform_TransformFinalBlock = TransformFinalBlock(InputBuffer, InputOffset, InputCount)
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   IObject Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function IObject_Equals(Value As Variant) As Boolean
    IObject_Equals = Equals(Value)
End Function

Private Function IObject_GetHashcode() As Long
    IObject_GetHashcode = GetHashCode
End Function

Private Function IObject_ToString() As String
    IObject_ToString = ToString
End Function