cryptostream.cls

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

' @param State User data that can be carried within the IAsyncResult object return.
' @return An IAsyncResult object used to identify the corrisponding EndBread and report
' information about the buffer read.
'
Public Function BeginWrite(ByRef Buffer() As Byte, ByVal Offset As Long, ByVal Count As Long, Optional ByVal Callback As AsyncCallback, Optional ByVal State As Variant) As IAsyncResult
    Dim Ret As StreamAsyncResult
    
    Set Ret = Cor.NewStreamAsyncResult(State)
    On Error GoTo errTrap:
    With Ret
        .CompletedSynchronously = True
        .IsCompleted = True
    End With
    Call WriteBlock(Buffer, Offset, Count)
    
    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 BeginWrite = Ret
End Function

''
' Signifies the end of an asynchronous write to the stream.
'
' @param AsyncResult The IAsyncResult returned from the BeginWrite function.
'
Public Sub EndWrite(ByVal AsyncResult As IAsyncResult)
    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 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
End Sub

''
' Returns a boolean indicating if the value and this object
' instance are the same instance.
'
' @param value The value to test equality on.
' @return Boolean indicating equality.
' @see IObject
'
Public Function Equals(ByRef Value As Variant) As Boolean
    Equals = Object.Equals(Me, Value)
End Function

''
' Returns a psuedo-unique number used to help identify this
' object in memory. The current method is to return the value
' obtained from ObjPtr. If a different method needs to be impelmented
' then change the method here in this function.
'
' An override might be necessary if the hashcode should be
' derived from a value contained within the class.
'
Public Function GetHashCode() As Long
    GetHashCode = ObjPtr(CUnk(Me))
End Function

''
' Returns a string representation of this object instance.
' The default method simply returns the application name
' and class name in which this class resides.
'
' A Person class may return the person's name instead.
'
Public Function ToString() As String
    ToString = Object.ToString(Me, App)
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Friend Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Friend Sub Init(ByVal Stream As Stream, ByVal Transform As ICryptoTransform, ByVal Mode As CryptoStreamMode)
    If Stream Is Nothing Then _
        Throw Cor.NewArgumentNullException(Environment.GetResourceString(ArgumentNull_Stream), "Stream")
    If Transform Is Nothing Then _
        Throw Cor.NewArgumentNullException("Transform cannot be nothing.", "Transform")
    
    Select Case Mode
        Case CryptoStreamMode.ReadMode
            If Not Stream.CanRead Then _
                Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_StreamNotReadable), "Stream")
                
        Case CryptoStreamMode.WriteMode
            If Not Stream.CanWrite Then _
                Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_StreamNotWritable), "Stream")
                
        Case Else
            Throw Cor.NewArgumentException("Invalid mode.", "mode")
    End Select
    
    Set mStream = Stream
    Set mTransform = Transform
    mMode = Mode
    
    mOutputBlockSize = mTransform.OutputBlockSize
    mInputBlockSize = mTransform.InputBlockSize
    
    Call InitBuffers
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Private Helpers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub InitBuffers()
    ReDim mInputBuffer(0 To mInputBlockSize - 1)
    ReDim mOutputBuffer(0 To mOutputBlockSize - 1)
End Sub

''
' This is used when reading from the Stream.
' We like to have a full buffer to read from for small reads.
'
Private Function FillBuffer() As Boolean
    Do
        ' We need to read a full block of bytes in at one time. The Stream
        ' being read from must have an exact multiple of mInputBlockSize bytes
        ' to read or it will eventually fail.
        Dim BytesRead As Long
        BytesRead = mStream.ReadBlock(mInputBuffer, 0, mInputBlockSize)
        
        ' If we did that, then we can assume we are not at the end of the Stream.
        If BytesRead > 0 Then
            ' So just transform the whole buffer to our output buffer.
            mBytesBuffered = mTransform.TransformBlock(mInputBuffer, 0, BytesRead, mOutputBuffer, 0)
        Else
            ' We didn't have any bytes, so we assume the end of the stream was reached.
            ' Using the TransformFinalBlock will strip away the padding from what we
            ' have left in our input buffer.
            mOutputBuffer = mTransform.TransformFinalBlock(mInputBuffer, 0, mBytesBuffered)
            mBytesBuffered = cArray.GetLength(mOutputBuffer)
            Exit Do
        End If
    Loop While mBytesBuffered = 0
    
    mOutputIndex = 0
    FillBuffer = (mBytesBuffered > 0)
End Function

''
' This is used when writing to the Stream. It handles the small internal buffer we have.
' This will get the mInputBuffer transformed and written to the Stream.
' This assumes that the buffer is full.
'
Private Sub FlushBuffer()
    Dim TotalBytesTransformed As Long
    TotalBytesTransformed = mTransform.TransformBlock(mInputBuffer, 0, mInputBlockSize, mOutputBuffer, 0)
    
    ' Write it out. It's possible nothing was actually transformed. However, we will just
    ' rely on the Stream object to optimize for a count of zero bytes to write.
    Call mStream.WriteBlock(mOutputBuffer, 0, TotalBytesTransformed)
    
    mBytesBuffered = 0
    mInputIndex = 0
End Sub

''
' This will fill the internal mInputBuffer with as much as possible
' and flush (Transform) it if it was filled.
'
Private Sub WriteToBuffer(ByRef Buffer() As Byte, ByRef Offset As Long, ByRef Count As Long)
    ' Determine how many bytes are needed to fill the buffer. The buffer should
    ' never be full already, so the best we can do is fill it.
    Dim AmountToCopy As Long
    AmountToCopy = MathExt.Min(mInputBlockSize - mBytesBuffered, Count)
    
    ' Don't need to waste our time if there is nothing to do.
    If AmountToCopy = 0 Then Exit Sub
    
    ' Fill our buffer with as much as possible. We still may not have filled it.
    Call CopyMemory(mInputBuffer(mInputIndex), Buffer(Offset), AmountToCopy)
    
    ' And we update everyone according to how much we moved.
    mBytesBuffered = mBytesBuffered + AmountToCopy
    mInputIndex = mInputIndex + AmountToCopy
    Offset = Offset + AmountToCopy
    Count = Count - AmountToCopy
    
    ' And if we did fill the buffer, get it transformed and written to the Stream.
    If mBytesBuffered = mInputBlockSize Then Call FlushBuffer
End Sub

''
' This will write as large a single block of bytes as possible
'
' @param InputBuffer The bytes to be encrypted and written to the Stream.
' @param InputOffset The starting position in InputBuffer to begin encrypting. This is passed ByRef
' to reflect any updates of the position to the calling code.
' @param InputCount The number of bytes to be processed. This is passed ByRef to reflect any updates of the
' count to the calling code.
'
Private Sub WriteMultiBlock(ByRef InputBuffer() As Byte, ByRef InputOffset As Long, ByRef InputCount As Long)
    ' If we have bytes buffered then we need to fill that buffer and flush
    ' it before we do our multiblock transformation.
    If mBytesBuffered > 0 Then Call WriteToBuffer(InputBuffer, InputOffset, InputCount)
    
    ' If there isn't even enough bytes to fill a block, then how can we do multiblock?
    ' InputCount can be modified in the WriteToBuffer call.
    If InputCount <= mInputBlockSize Then Exit Sub
    
    ' How many blocks will we be doing at once?
    Dim TotalBytes As Long
    TotalBytes = (InputCount \ mOutputBlockSize) * mInputBlockSize
        
    Dim OutputBuffer() As Byte
    ReDim OutputBuffer(0 To TotalBytes - 1)
    
    ' apply the cipher to the big array of bytes.
    Dim TotalBytesTransformed As Long
    TotalBytesTransformed = mTransform.TransformBlock(InputBuffer, InputOffset, TotalBytes, OutputBuffer, 0)
    
    ' If anything was transformed, then write it out to the Stream.
    If TotalBytesTransformed > 0 Then
        Call mStream.WriteBlock(OutputBuffer, 0, TotalBytesTransformed)
        InputOffset = InputOffset + TotalBytes
        InputCount = InputCount - TotalBytes
    End If
End Sub

Private Function ReadBufferedBytes(ByRef Buffer() As Byte, ByRef Offset As Long, ByRef Count As Long) As Long
    ' If nothing is buffered, we can't read from it
    ' and return what it contains.
    If mBytesBuffered = 0 Then Exit Function
    
    Dim AmountToCopy As Long
    
    ' Only copy what we want or what we already have, which
    ' ever is the smaller value.
    AmountToCopy = MathExt.Min(mBytesBuffered, Count)
    
    ' Make sure there is room in the return buffer.
    If (Offset + AmountToCopy - 1) > UBound(Buffer) Then _
        Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_SmallConversionBuffer), "Buffer")
    
    ' Copy the data to the return buffer and update all the counters.
    Call CopyMemory(Buffer(Offset), mOutputBuffer(mOutputIndex), AmountToCopy)
    Offset = Offset + AmountToCopy
    Count = Count - AmountToCopy
    mBytesBuffered = mBytesBuffered - AmountToCopy
    mOutputIndex = mOutputIndex + AmountToCopy
    ReadBufferedBytes = AmountToCopy
End Function

Private Function ReadMultiBlock(ByRef Buffer() As Byte, ByRef Offset As Long, ByRef Count As Long) As Long
    ' If less than atleast 1 full block is requested, then
    ' we can't perform a mutli-block read, so exit.
    If Count < mOutputBlockSize Then Exit Function
    
    Dim Result As Long
    
    ' Calculate how many full output blocks we want, then determine
    ' how many input blocks in bytes it will take to get it.
    Dim TotalBytes As Long
    TotalBytes = (Count \ mOutputBlockSize) * mInputBlockSize
    
    Dim InputBuffer() As Byte
    ReDim InputBuffer(0 To TotalBytes - 1)
    
    Dim BytesRead As Long
    BytesRead = mStream.ReadBlock(InputBuffer, 0, TotalBytes)
    
    If BytesRead = 0 Then Exit Function
    
    Dim TotalBytesTransformed As Long
    TotalBytesTransformed = mTransform.TransformBlock(InputBuffer, 0, BytesRead, Buffer, Offset)
    
    Offset = Offset + TotalBytesTransformed
    Count = Count - TotalBytesTransformed
    Result = Result + TotalBytesTransformed
    
    ReadMultiBlock = Result
End Function


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


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   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


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Stream Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function Stream_BeginRead(Buffer() As Byte, ByVal Offset As Long, ByVal Count As Long, Optional ByVal Callback As AsyncCallback, Optional ByVal State As Variant) As IAsyncResult
    Stream_BeginRead = BeginRead(Buffer, Offset, Count, Callback, State)
End Function

Private Function Stream_BeginWrite(Buffer() As Byte, ByVal Offset As Long, ByVal Count As Long, Optional ByVal Callback As AsyncCallback, Optional ByVal State As Variant) As IAsyncResult
    Call BeginWrite(Buffer, Offset, Count, Callback, State)
End Function

Private Property Get Stream_CanRead() As Boolean
    Stream_CanRead = CanRead
End Property

Private Property Get Stream_CanSeek() As Boolean
    Stream_CanSeek = CanSeek
End Property

Private Property Get Stream_CanTimeout() As Boolean
    Stream_CanTimeout = CanTimeout
End Property

Private Property Get Stream_CanWrite() As Boolean
    Stream_CanWrite = CanWrite
End Property

Private Sub Stream_CloseStream()
    Call CloseStream
End Sub

Private Function Stream_EndRead(ByVal AsyncResult As IAsyncResult) As Long
    Stream_EndRead = EndRead(AsyncResult)
End Function

Private Sub Stream_EndWrite(ByVal AsyncResult As IAsyncResult)
    Call EndWrite(AsyncResult)
End Sub

Private Function Stream_Equals(Value As Variant) As Boolean
    Stream_Equals = Equals(Value)
End Function

Private Sub Stream_Flush()
    Call Flush
End Sub

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

Private Property Get Stream_Length() As Currency
    Stream_Length = Length
End Property

Private Property Let Stream_Position(ByVal RHS As Currency)
    Position = RHS
End Property

Private Property Get Stream_Position() As Currency
    Stream_Position = Position
End Property

Private Function Stream_ReadBlock(Buffer() As Byte, ByVal Offset As Long, ByVal Count As Long) As Long
    Stream_ReadBlock = ReadBlock(Buffer, Offset, Count)
End Function

Private Function Stream_ReadByte() As Long
    Stream_ReadByte = ReadByte
End Function

Private Property Let Stream_ReadTimeout(ByVal RHS As Long)
    ReadTimeout = RHS
End Property

Private Property Get Stream_ReadTimeout() As Long
    Stream_ReadTimeout = ReadTimeout
End Property

Private Function Stream_SeekPosition(ByVal Offset As Currency, ByVal Origin As SeekOrigin) As Currency
    Stream_SeekPosition = SeekPosition(Offset, Origin)
End Function

Private Sub Stream_SetLength(ByVal Value As Currency)
    Call SetLength(Value)
End Sub

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

Private Sub Stream_WriteBlock(Buffer() As Byte, ByVal Offset As Long, ByVal Count As Long)
    Call WriteBlock(Buffer, Offset, Count)
End Sub

Private Sub Stream_WriteByte(ByVal Value As Byte)
    Call WriteByte(Value)
End Sub

Private Property Let Stream_WriteTimeout(ByVal RHS As Long)
    WriteTimeout = RHS
End Property

Private Property Get Stream_WriteTimeout() As Long
    Stream_WriteTimeout = WriteTimeout
End Property