memorystream.cls

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

''
' This has no purpose in a MemoryStream
'
Public Sub Flush()
    ' just here for consistency
End Sub

''
' Writes the underlying stream to another stream.
'
' @param Stream The stream to write the underlying stream to.
'
Public Sub WriteTo(ByVal Stream As Stream)
    Call VerifyBuffer
    Call VerifyOpen
    
    If Stream Is Nothing Then _
        Throw New ArgumentNullException
    Call Stream.WriteBlock(mBuffer, mIndex, mLength)
End Sub


''
' Returns a string representation of this object instance.
'
' @return String representing this instance.
Public Function ToString() As String
    ToString = Object.ToString(Me, App)
End Function

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

''
' Returns a pseudo-unique number identifying this instance.
'
' @return Pseudo-unique number identifying this instance.
Public Function GetHashCode() As Long
    GetHashCode = ObjPtr(CUnk(Me))
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Friend Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''
' Initializes the MemoryStream to a user-supplied byte array.
' This method should never be called directly. Only the constructors
' found in Constructors.cls should call this method.
Friend Sub Init(ByRef Buffer() As Byte, ByRef Index As Variant, ByRef Count As Variant, ByVal Writable As Boolean)
    Dim Result As Long
    Result = GetOptionalArrayRange(SAPtr(Buffer), Index, mIndex, Count, mCapacity)
    If Result <> NO_ERROR Then Call ThrowArrayRangeException(Result, "Buffer", mIndex, "Index", mCapacity, "Count", IsMissing(Index))
    
    mCanWrite = Writable
    mIsUserArray = True
    mLength = mCapacity
        
    SAPtr(mBuffer) = SAPtr(Buffer)
    Call LockArray
    mBufferSet = True
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Private Helpers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub LockArray()
    Call SafeArrayLock(GetArrayPointer(mBuffer, True))
End Sub

Private Sub UnlockArray()
    Call SafeArrayUnlock(GetArrayPointer(mBuffer, True))
End Sub

' verifies that the internal buffer has been allocated.
Private Sub VerifyBuffer()
    If Not mBufferSet Then
        ReDim mBuffer(0 To mCapacity - 1)
        mCanWrite = True
        mBufferSet = True
    End If
    
    ' We never try to change capacity of a user array.
    If Not mIsUserArray Then Call EnsureCapacity(mPosition + 1)
End Sub

Private Sub VerifyOpen()
    If mIsClosed Then Throw Cor.NewObjectDisposedException("MemoryStream", "Cannot perform action on a closed stream.")
End Sub

Private Sub VerifyWritable()
    If Not mCanWrite Then Throw Cor.NewNotSupportedException("Stream is ReadOnly.")
End Sub

' Ensures that the required capacity is met. If the capacity needs to
' be increased, an exception may be thrown by the Capacity property when set.
Private Sub EnsureCapacity(ByVal RequiredCapacity As Long)
    Dim NewCapacity As Long
    
    If RequiredCapacity <= mCapacity Then Exit Sub
    NewCapacity = mCapacity * 2
    If NewCapacity < RequiredCapacity Then NewCapacity = RequiredCapacity + DEF_CAPACITY
    Capacity = NewCapacity
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Class Events
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Class_Initialize()
    mCapacity = DEF_CAPACITY
    mCanWrite = True
End Sub

Private Sub Class_ReadProperties(PropBag As PropertyBag)
    With PropBag
        mBuffer = .ReadProperty("Buffer")
        mCanWrite = .ReadProperty("CanWrite")
        mPosition = .ReadProperty("Position")
        mCapacity = .ReadProperty("Capacity")
        mLength = .ReadProperty("Length")
        mIsClosed = .ReadProperty("IsClosed")
        mIndex = .ReadProperty("Index")
    End With
End Sub

Private Sub Class_Terminate()
    Call CloseStream
End Sub

Private Sub Class_WriteProperties(PropBag As PropertyBag)
    With PropBag
        Call .WriteProperty("Buffer", mBuffer)
        Call .WriteProperty("CanWrite", mCanWrite)
        Call .WriteProperty("Position", mPosition)
        Call .WriteProperty("Capacity", mCapacity)
        Call .WriteProperty("Length", mLength)
        Call .WriteProperty("IsClosed", mIsClosed)
        Call .WriteProperty("Index", mIndex)
    End With
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
    Set 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
    Set Stream_BeginWrite = 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