filestream.cls

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

    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

''
' Writes any data that may be in the write buffer to the underlying stream.
'
Public Sub Flush()
    Call VerifyCanWrite
    Call VerifyIsOpen
    
    Dim BytesWritten As Long
    If mWritePosition > 0 Then
        If WriteFile(mHandle, mBuffer(0), mWritePosition, BytesWritten, ByVal 0&) = BOOL_FALSE Then IOError Err.LastDllError
        mWritePosition = 0
        mBytesBuffered = 0
        mBufferOffset = mBufferOffset + BytesWritten
    End If
End Sub

''
' Closes the current stream, flushing any data that may need to be written to the stream.
'
' @remarks If the stream was created around a handle and the stream was given ownership
' of the handle, then the handle will also be closed with the stream. Otherwise, only
' the stream will be closed, leaving the handle in its original state.
'
Public Sub CloseStream()
    If mIsOpen Then
        If mCanWrite Then Call Flush
        If mOwnsHandle Then Call CloseHandle(mHandle)
        mIsOpen = False
    End If
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
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Friend Sub Init(ByVal sPath As String, ByVal Mode As FileMode, ByVal Access As FileAccess, ByVal Share As FileShare, ByVal BufferSize As Long, ByVal UseAsync As Boolean)
    sPath = cString.Trim(sPath)
    If Len(sPath) = 0 Then _
        Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_EmptyPath), "sPath")
    If BufferSize <= 0 Then _
        Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_NeedPosNum), "BufferSize", BufferSize)
        
    Dim AppendMode As Boolean
    If Mode = FileMode.Append Then
        If Access = CONSIDERED_MISSING Then
            Access = WriteAccess
        ElseIf Access And ReadAccess Then
            Throw Cor.NewArgumentException("Append mode cannot be used in combination with read access.")
        End If
        AppendMode = True
        Mode = FileMode.OpenOrCreate
    End If
    If Access = CONSIDERED_MISSING Then Access = ReadWriteAccess
    
    Call Path.VerifyPath(sPath)
    
    Dim Atts As Long
    Atts = FILE_ATTRIBUTE_NORMAL
    
    If UseAsync And Environment.IsNT Then
        Atts = Atts Or FILE_FLAG_OVERLAPPED
        mIsAsync = True
    End If
    
    mHandle = API.CreateFile(sPath, Access, Share, 0, Mode, Atts, 0)
    If mHandle = INVALID_HANDLE Then IOError Err.LastDllError, sPath
    
    mName = Path.GetFileName(sPath)
    mCanWrite = (Access And FileAccess.WriteAccess) <> 0
    mCanRead = ((Access And FileAccess.ReadAccess) <> 0) And (Mode <> Truncate)
    mCanSeek = (GetFileType(mHandle) = FILE_TYPE_DISK)
    mOwnsHandle = True
    mIsOpen = True
    
    If AppendMode And mCanSeek Then
        mMinPosition = InternalSeek(0@, FromEnd)
        mFilePosition = mMinPosition
        mBufferOffset = mMinPosition
    End If
    
    If BufferSize < MIN_BUFFERSIZE Then BufferSize = MIN_BUFFERSIZE
    mBufferSize = BufferSize
End Sub

Friend Sub InitFromHandle(ByVal Handle As Long, ByVal Access As FileAccess, ByVal OwnsHandle As Boolean, ByVal BufferSize As Long)
    If Handle = INVALID_HANDLE Then _
        Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_InvalidHandle))
    If BufferSize < 0 Then _
        Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_NeedPosNum), "BufferSize", BufferSize)
    
    mOwnsHandle = OwnsHandle
    mHandle = Handle
    mBufferSize = BufferSize
    mCanSeek = (GetFileType(Handle) = FILE_TYPE_DISK)
    mCanWrite = (Access And WriteAccess) <> 0
    mCanRead = (Access And ReadAccess) <> 0
    mIsOpen = True
    
    If mCanSeek Then
        mFilePosition = InternalSeek(0@, FromCurrent)
        If mFilePosition > Length Then
            mFilePosition = InternalSeek(0@, FromEnd)
        End If
    End If
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Private Helpers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub VerifyCanSeek()
    If Not mCanSeek Then Throw Cor.NewNotSupportedException("The file stream does not support seek methods.")
End Sub

Private Sub VerifyIsOpen()
    If Not mIsOpen Then Throw Cor.NewObjectDisposedException("FileStream", "The file stream is closed.")
End Sub

Private Sub VerifyCanWrite()
    If Not mCanWrite Then Throw Cor.NewNotSupportedException("The file stream does not support writing.")
End Sub

Private Sub VerifyCanRead()
    If Not mCanRead Then Throw Cor.NewNotSupportedException("The file stream does not support reading.")
End Sub

Private Sub FillBuffer()
    mBufferOffset = mFilePosition
    mReadPosition = 0
    mWritePosition = 0
    
    If SAPtr(mBuffer) = vbNullPtr Then ReDim mBuffer(0 To mBufferSize - 1)
    
    If ReadFile(mHandle, mBuffer(0), mBufferSize, mBytesBuffered, ByVal 0&) = BOOL_FALSE Then
        If mHandle <> ERROR_BROKEN_PIPE Then IOError Err.LastDllError
    End If
End Sub

Private Function InternalSeek(ByVal Offset As Currency, ByVal Origin As SeekOrigin) As Currency
    With AsDLong(0.0001@ * Offset)
        .LoDWord = SetFilePointer(mHandle, .LoDWord, .HiDWord, Origin)
        ' in order to catch an error we check the return value against
        ' INVALID_SET_FILE_POINTER (&HFFFFFFFF). Even though it is a value
        ' of -1, the value must be treated as unsigned, so its negative
        ' values are = 2gig to 4gig positive values, which works with the
        ' 64bit positioning. So, if we get the -1, we need to check for
        ' an actual error using Err.LastDllError.
        If .LoDWord = INVALID_SET_FILE_POINTER Then
            Dim e As Long
            e = Err.LastDllError
            If e <> NO_ERROR Then IOError e
        End If
        InternalSeek = 10000@ * AsCurr(.LoDWord)
    End With
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
    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