filestream.cls

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

        If .LoDWord = INVALID_FILE_SIZE Then
            If Err.LastDllError <> NO_ERROR Then IOError Err.LastDllError
        End If
    End With
    Length = 10000@ * AsCurr(Size)
End Property

''
' Returns the current position within the stream.
'
' @return The current position within the stream.
' @remarks The current position is where the next byte is read from
' or written to. Once a byte has been read or written, the position
' is advanced byte 1 byte.
'
Public Property Get Position() As Currency
    Position = mFilePosition
End Property

''
' Sets the current position within the stream to be read from or written to.
'
' @param RHS The new position in the stream.
' @remarks The position is an absolute byte position from the beginning of
' the file. If the new position is negative an exception is thrown. If the
' FileStream is opened in Append mode, then the position cannot be set to
' data within the original file.
'
Public Property Let Position(ByVal RHS As Currency)
    Call SeekPosition(RHS, SeekOrigin.FromBeginning)
End Property

''
' Moves the file pointer to a new position relative to a specified reference.
'
' @param Offset The number of bytes to move from the reference point. The value can be negative to move backwards.
' @param Origin The reference point to begin moving the file pointer from.
' @return The new position in the file stream.
'
Public Function SeekPosition(ByVal Offset As Currency, ByVal Origin As SeekOrigin) As Currency
    Call VerifyCanSeek
    Call VerifyIsOpen
    
    Offset = Int(Offset)
    
    Dim NewPosition As Currency
    Select Case Origin
        Case FromBeginning:     NewPosition = Offset
        Case FromCurrent:       NewPosition = mFilePosition + Offset
        Case FromEnd:           NewPosition = Length + Offset
    End Select
    
    If NewPosition < mMinPosition Then
        If mMinPosition = 0@ Then
            Throw Cor.NewArgumentException("Cannot seek before beginning of file", "Offset")
        Else
            Throw Cor.NewIOException("Seeking to a position prior to append-start position may cause data to be overwritten.")
        End If
    End If
    
    If mCanWrite Then Call Flush
    Select Case NewPosition
        Case mBufferOffset To mBufferOffset + mBytesBuffered - 1
            ' in same buffer works only for reading
            mReadPosition = NewPosition - mBufferOffset
            mFilePosition = NewPosition
        Case Else
            mFilePosition = InternalSeek(Offset, Origin)
            mBufferOffset = mFilePosition
            mBytesBuffered = 0
    End Select
    SeekPosition = mFilePosition
End Function

''
' Sets the length of the stream to the specified length.
'
' @param Value The length of the new file in bytes.
' @remarks <p>If the new value is less than the origin file, then the file will
' be truncated. If the new value is larger than the original, then the newly
' exposed bytes are of undefined value.</p>
' <p>The stream must have Seek and Write support</p>
'
Public Sub SetLength(ByVal Value As Currency)
    Call VerifyCanSeek
    Call VerifyCanWrite
    Call VerifyIsOpen
    
    Value = Int(Value)
    If Value < mMinPosition Then
        If mMinPosition = 0@ Then
            Throw Cor.NewArgumentOutOfRangeException("Cannot set the length to a negative value.", "Value", Value)
        Else
            Throw Cor.NewIOException("Setting the length to a position prior to the append-start postion is not permitted.")
        End If
    End If

    Call Flush
    mBytesBuffered = 0
    
    Call InternalSeek(Value, FromBeginning)
    If SetEndOfFile(mHandle) = BOOL_FALSE Then IOError Err.LastDllError
End Sub

''
' Returns the next byte in the file stream starting at the current file position.
'
' @return The byte value at the current file position.
' @remarks If the file position is passed the end of the stream, then -1 is returned.
'
Public Function ReadByte() As Long
    Call VerifyCanRead
    Call VerifyIsOpen

    If mCanWrite Then Call Flush

    If Position >= Length Then
        ReadByte = -1
        Exit Function
    End If

    If (mBytesBuffered = 0) Or (mReadPosition = mBytesBuffered) Then Call FillBuffer
    
    ReadByte = mBuffer(mReadPosition)
    mReadPosition = mReadPosition + 1
    mFilePosition = mFilePosition + 1
End Function

''
' Reads a specified number of bytes into the given array.
'
' @param Bytes 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.
' @return The number of byte actually read from the stream.
'
Public Function ReadBlock(ByRef Bytes() As Byte, ByVal Offset As Long, ByVal Count As Long) As Long
    Call VerifyCanRead
    Call VerifyIsOpen
    
    Dim Result As Long
    Result = VerifyArrayRange(SAPtr(Bytes), Offset, Count)
    If Result <> NO_ERROR Then Call ThrowArrayRangeException(Result, "Bytes", Offset, "Offset", Count, "Count")
    
    If mCanWrite Then Call Flush
    If Count = 0 Then Exit Function
    
    If mCanSeek Then
        If mFilePosition > Length Then Exit Function
    End If
    
    If (mBytesBuffered = 0) Or (mReadPosition = mBytesBuffered) Then Call FillBuffer
    If mBytesBuffered = 0 Then Exit Function
    
    Dim Available As Long
    Available = mBytesBuffered - mReadPosition
    
    If Count > Available Then
        Call CopyMemory(Bytes(Offset), mBuffer(mReadPosition), Available)
        
        ' Read the rest of the requested amount of data from the file.
        If ReadFile(mHandle, Bytes(Offset + Available), Count - Available, Count, ByVal 0&) = BOOL_FALSE Then
            If mHandle <> ERROR_BROKEN_PIPE Then IOError Err.LastDllError
        End If
        
        Count = Count + Available
        mBytesBuffered = 0
    Else
        ' All of the data was already cached in the buffer.
        Call CopyMemory(Bytes(Offset), mBuffer(mReadPosition), Count)
    End If
    mReadPosition = mReadPosition + Count
    mFilePosition = mFilePosition + Count
    ReadBlock = Count
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
    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 a single byte to the stream.
'
' @param Value The value to be written to the stream.
' @remarks The value is written to the underlying buffer. Once the buffer is full, it is
' then flushed to the underlying stream and emptied to be reused.
'
Public Sub WriteByte(ByVal Value As Byte)
    Call VerifyCanWrite
    Call VerifyIsOpen
    
    If mBytesBuffered > 0 Then Call InternalSeek(mFilePosition, FromBeginning)
    If mWritePosition = mBufferSize Then Call Flush
    If cArray.IsNull(mBuffer) Then ReDim mBuffer(0 To mBufferSize - 1)
    mBuffer(mWritePosition) = Value
    mWritePosition = mWritePosition + 1
    mFilePosition = mFilePosition + 1
End Sub

''
' Writes an array of bytes to the stream.
'
' @param Bytes The source array to write to the stream.
' @param Offset The index of the first byte in <i>Buffer</i> to be written to the stream.
' @param Count The number of bytes to write from the array.
' @remarks The data to be written is buffered if there is enough room, otherwise,
' any data in the buffer is written to the stream, followed by the data in <i>Buffer</i>.
'
Public Sub WriteBlock(ByRef Bytes() As Byte, ByVal Offset As Long, ByVal Count As Long)
    Call VerifyCanWrite
    Call VerifyIsOpen
    
    Dim Result As Long
    Result = VerifyArrayRange(SAPtr(Bytes), Offset, Count)
    If Result <> NO_ERROR Then Call ThrowArrayRangeException(Result, "Bytes", Offset, "Offset", Count, "Count")
    
    If Count = 0 Then Exit Sub
    If cArray.IsNull(mBuffer) Then ReDim mBuffer(0 To mBufferSize - 1)
    
    If mBytesBuffered > 0 Then Call InternalSeek(mFilePosition, FromBeginning)
    
    ' If we can't fit the data in the remaining available
    ' space in the buffer, then flush the buffer.
    If Count > mBufferSize - mWritePosition Then Call Flush
    
    ' If more bytes are to be written than can be held
    ' in the buffer, then just write it all out to the file.
    If Count > mBufferSize Then
        Dim BytesWritten As Long
        If WriteFile(mHandle, Bytes(Offset), Count, BytesWritten, ByVal 0&) = BOOL_FALSE Then IOError Err.LastDllError
        Count = BytesWritten
        mWritePosition = 0
    Else
        ' Cache it to the local buffer.
        Call CopyMemory(mBuffer(mWritePosition), Bytes(Offset), Count)
        mWritePosition = mWritePosition + Count
    End If
    mFilePosition = mFilePosition + Count
End Sub

''
' Begins an asynchronous buffer write. Currently the FileStream 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.
' @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")