cryptostream.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 = "CryptoStream"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
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: CryptoStream
'

''
' Provides a streaming mechanism for ciphering data.
'
' @remarks A <b>CryptoStream</b> can be written to or read from in the same manner
' as other stream objects. A <b>CryptoStream</b> is designed to be used in a daisy-chain
' fashion, allowing for multiple transformations to be applied as a single process.
' <p>By supplying another <b>Stream</b> object to the <b>Cor.NewCryptoStream</b> function,
' an automatic daisy-chaining of the two streams is created. The <b>Stream</b> does not
' have to be another <b>CryptoStream</b> object. It can be any object implementing the
' <b>Stream</b> interface.
'
' @see Constructors
'
Option Explicit
Implements IObject
Implements Stream



''
' Specifies modes for a CryptoStream.
'
' @param ReadMode Sets the CryptoStream to a reading mode.
' @param WriteMode Sets the CryptoStream to a writing mode.
'
Public Enum CryptoStreamMode
    ReadMode = 0
    WriteMode = 1
End Enum

Private mMode               As CryptoStreamMode
Private mStream             As Stream
Private mTransform          As ICryptoTransform
Private mInputBuffer()      As Byte
Private mOutputBuffer()     As Byte
Private mInputIndex         As Long
Private mOutputIndex        As Long
Private mBytesBuffered      As Long
Private mFinalTransformed   As Boolean
Private mOutputBlockSize    As Long
Private mInputBlockSize     As Long



''
' Returns if the Stream can be read from.
'
' @return Returns True if the Stream supports reading, False otherwise.
' @remarks A CryptoStream object supports only reading or writing, not both simultaneously.
'
Public Property Get CanRead() As Boolean
    CanRead = (mMode = ReadMode)
End Property

''
' Returns if the Stream can seek.
'
' @return Always returns False.
'
Public Property Get CanSeek() As Boolean
    CanSeek = False
End Property

''
' Returns if the Stream can be written to.
'
' @return Returns True if the Stream supports writing, False otherwise.
' @remarks A CryptoStream object supports only ready or writing, not both simultaneously.
'
Public Property Get CanWrite() As Boolean
    CanWrite = (mMode = WriteMode)
End Property

''
' Returns the current position withing the Stream.
'
' @return The current position.
' @remarks Always throws a NotSupportedException exception.
'
Public Property Get Position() As Currency
    Throw Cor.NewNotSupportedException("Seeking is not supported.")
End Property

''
' Sets the current position within the Stream.
'
' @param RHS The new position.
' @remarks Always throws a NotSupportedException exception.
'
Public Property Let Position(ByVal RHS As Currency)
    Throw Cor.NewNotSupportedException("Seeking is not supported.")
End Property

''
' Returns the length of the current Stream.
'
' @return The length of the Stream.
' @remarks Always throws a NotSupportedException exception.
'
Public Property Get Length() As Currency
    Throw Cor.NewNotSupportedException("Seeking is not supported.")
End Property

''
' Sets the length of the current Stream.
'
' @param Value The new length of the Stream.
' @remarks Always throws a NotSupportedException exception.
'
Public Sub SetLength(ByVal Value As Currency)
    Throw Cor.NewNotSupportedException("Seeking is not supported.")
End Sub

''
' Seeks a new position within the Stream.
'
' @param Offset The number of bytes to move.
' @param Origin The starting position in the stream to move from.
' @return The new position in the Stream.
' @remarks Always throws a NotSupportedException exception.
'
Public Function SeekPosition(ByVal Offset As Currency, ByVal Origin As SeekOrigin) As Currency
    Throw Cor.NewNotSupportedException("Seeking is not supported.")
End Function

''
' Returns if the Stream can timeout.
'
' @returns Returns True if the Stream can timeout, False otherwise.
'
Public Property Get CanTimeout() As Boolean
    CanTimeout = mStream.CanTimeout
End Property

''
' Returns the amount of time must pass before a Read timeout occurs.
'
' @return Returns the timeout period in milliseconds.
'
Public Property Get ReadTimeout() As Long
    ReadTimeout = mStream.ReadTimeout
End Property

''
' Sets the timeout period for Read operations.
'
' @param RHS The timeout period in milliseconds.
'
Public Property Let ReadTimeout(ByVal RHS As Long)
    mStream.ReadTimeout = RHS
End Property

''
' Returns the timeout period for a write operation.
'
' @return The timeout period in milliseconds.
'
Public Property Get WriteTimeout() As Long
    WriteTimeout = mStream.WriteTimeout
End Property

''
' Sets the timeout period for a write operation.
'
' @param RHS The timeout period in milliseconds.
'
Public Property Let WriteTimeout(ByVal RHS As Long)
    mStream.WriteTimeout = RHS
End Property

''
' Closes the underlying Stream.
'
Public Sub CloseStream()
    If Me.CanWrite And (Not mFinalTransformed) Then Call FlushFinalBlock
    Call mStream.CloseStream
    Erase mInputBuffer
    Erase mOutputBuffer
End Sub

''
' Flushes the buffers of the underlying Stream.
'
' @remarks This does not flush the buffers within the CryptoStream. Call FlushFinalBlock
' to flush the remaining data to the underlying stream.
'
Public Sub Flush()
    Call mStream.Flush
End Sub

''
' Flushes the remaining data to the underlying stream.
'
' @remarks This can only be called once.
'
Public Sub FlushFinalBlock()
    If Not CanWrite Then _
        Throw Cor.NewNotSupportedException("Stream does not support writing.")
    If mFinalTransformed Then _
        Throw Cor.NewNotSupportedException("Cannot call FlushFinalBlock twice.")
    
    mOutputBuffer = mTransform.TransformFinalBlock(mInputBuffer, 0, mBytesBuffered)
    Call mStream.WriteBlock(mOutputBuffer, 0, cArray.GetLength(mOutputBuffer))
    
    If TypeOf mStream Is CryptoStream Then
        Dim cs As CryptoStream
        Set cs = mStream
        Call cs.FlushFinalBlock
    End If
    
    Call Flush
    Call InitBuffers
    mFinalTransformed = True
End Sub

''
' Reads a requested amount of data from the stream.
'
' @param Buffer The byte array that will receive the requested data.
' @param Offset The starting index within <i>Buffer</i> to begin writing data.
' @param Count The number of bytes to read.
' @return The actual number of bytes read.
' @remarks The number of bytes read may be less than the actual number of bytes requested.
'
Public Function ReadBlock(ByRef Buffer() As Byte, ByVal Offset As Long, ByVal Count As Long) As Long
    If Not CanRead Then _
        Throw Cor.NewNotSupportedException("The Stream does not support reading.")
    If cArray.IsNull(Buffer) Then _
        Throw Cor.NewArgumentNullException(Environment.GetResourceString(ArgumentNull_Array), "Buffer")
    If Offset < LBound(Buffer) Then _
        Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_LBound), "Offset", Offset)
    If Count < 0 Then _
        Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_NeedNonNegNum), "Count", Count)
    
    Dim BytesRead  As Long
    
    ' Just grab anything that might already be buffered.
    BytesRead = ReadBufferedBytes(Buffer, Offset, Count)
    
    ' Take advantage of transforming multiple blocks if possible.
    If mTransform.CanTransformMultipleBlocks Then
        BytesRead = BytesRead + ReadMultiBlock(Buffer, Offset, Count)
    End If
    
    ' Fill in the end of the requested amount a little at a time.
    Do While Count > 0
        If mBytesBuffered = 0 Then
            If Not FillBuffer Then Exit Do
        End If
        
        BytesRead = BytesRead + ReadBufferedBytes(Buffer, Offset, Count)
    Loop
    
    ReadBlock = BytesRead
End Function

''
' Reads a single byte from the Stream.
'
' @return Returns the byte data or -1 if the end of the stream was reached.
'
Public Function ReadByte() As Long
    If Not CanRead Then _
        Throw Cor.NewNotSupportedException("The Stream does not support reading.")
    
    If mBytesBuffered = 0 Then
        If Not FillBuffer Then
            ReadByte = -1
            Exit Function
        End If
    End If
    
    ReadByte = mOutputBuffer(mOutputIndex)
    mOutputIndex = mOutputIndex + 1
    mBytesBuffered = mBytesBuffered - 1
End Function

''
' Begins an Asynchronous read operation (currently is only synchronous)
'
' @param Buffer The array to store the bytes that are read from the stream.
' @param Offset The index in <i>Buffer</i> to begin storing bytes.
' @param Count The number of bytes to be read from the stream.
' @param Callback An object that is called when the read operation is complete.
' @param State user-defined data to be kept with the <i>Callback</i> object for later retrieval.
' @return An IAsyncResult object used to identify the corrisponding Endread and report
' information about the buffer read.
'
Public Function BeginRead(ByRef Buffer() As Byte, ByVal Offset As Long, ByVal Count As Long, Optional ByVal Callback As AsyncCallback, Optional ByVal State As Variant) As IAsyncResult
    If Not CanRead Then _
        Throw Cor.NewNotSupportedException("The Stream does not support reading.")
    
    Dim Ret As StreamAsyncResult
    Set Ret = Cor.NewStreamAsyncResult(State)
    
    On Error GoTo errTrap
    With Ret
        .BytesRead = ReadBlock(Buffer, Offset, Count)
        .IsCompleted = True
        .IsReadType = True
    End With

    If Not Callback Is Nothing Then Call Callback.Execute(Ret)

errTrap:
    Dim Ex As Exception
    If Catch(Ex, Err) Then Set Ret.Exception = Ex
    Set BeginRead = Ret
End Function

''
' Signifies the end of an asynchronous read from the stream.
'
' @param AsyncResult The IAsyncResult object returned from the BeginRead function.
' @return The number of bytes read from the stream in to <i>Buffer</i> in the BeginRead method.
'
Public Function EndRead(ByVal AsyncResult As IAsyncResult) As Long
    If AsyncResult Is Nothing Then _
        Throw Cor.NewArgumentNullException("AsyncResult object is required.", "AsyncResult")
    If Not TypeOf AsyncResult Is StreamAsyncResult Then _
        Throw Cor.NewArgumentException("AsyncResult object is not part of this stream.", "AsyncResult")
    
    Dim Result As StreamAsyncResult
    Set Result = AsyncResult
    If Not Result.IsReadType Then _
        Throw Cor.NewArgumentException("AsyncResult object is not part of this stream.", "AsyncResult")
    If Result.EndCalled Then _
        Throw Cor.NewInvalidOperationException("The EndRead has already been called.")
    
    If Not Result.Exception Is Nothing Then Throw Result.Exception
    
    EndRead = Result.BytesRead
End Function

''
' Writes an array of bytes to the Stream.
'
' @param Buffer The array of bytes to be written to the Stream.
' @param Offset The index within <i>Buffer</i> to begin writing from.
' @param Count The number of bytes to be written.
' @param The bytes are transformed using the supplied ICryptoTransform before
' being written to the underlying stream.
'
Public Sub WriteBlock(ByRef Buffer() As Byte, ByVal Offset As Long, ByVal Count As Long)
    If Not CanWrite Then _
        Throw Cor.NewNotSupportedException("Stream does not support writing.")
    
    Dim Result As Long
    Result = VerifyArrayRange(SAPtr(Buffer), Offset, Count)
    If Result <> NO_ERROR Then Call ThrowArrayRangeException(Result, "Buffer", Offset, "Offset", Count, "Count", False)
    
    If (Count > mInputBlockSize) And mTransform.CanTransformMultipleBlocks Then
        Call WriteMultiBlock(Buffer, Offset, Count)
    End If
    
    Do While Count > 0
        Call WriteToBuffer(Buffer, Offset, Count)
    Loop
End Sub

''
' Writes a single byte to the Stream.
'
' @param Value The byte to be written to the stream.
'
Public Sub WriteByte(ByVal Value As Byte)
    If Not CanWrite Then _
        Throw Cor.NewNotSupportedException("Stream does not support writing.")
    
    mInputBuffer(mInputIndex) = Value
    mInputIndex = mInputIndex + 1
    mBytesBuffered = mBytesBuffered + 1
    
    If mBytesBuffered = mInputBlockSize Then Call FlushBuffer
End Sub

''
' Begins an asynchronous buffer write. Currently the CryptoStream class does not
' support asynchronous buffer writing.
'
' @param Buffer The source array to copy the bytes from into the stream.
' @param Offset The starting index in the source <i>Buffer</i> to begin copying from.
' @param Count The maximum number of bytes to be copied into the stream.
' @param Callback A user supplied object to be notified of the finish of the writing.