source: trunk/ab5.0/ablib/src/Classes/System/IO/FileStreamImpl.ab@ 668

'Classes/System/IO/FileStreamImpl.ab

Namespace System
Namespace IO
Namespace Detail

Sub ThrowIfFilePointerFunctionFailed(dwLow As DWord)
    If dwLow = INVALID_FILE_SIZE Then
        Dim error = GetLastError()
        If error <> NO_ERROR Then
            Detail.ThrowWinIOException("FileStream: Failed to position or file size function.", error)
        End If
    End If
End Sub

/*!
@brief シーク系関数の集合
@date 2008/08/21
@auther Egtra
*/
Class SeekFunctions
Public
    Abstract Function CanSeek() As Boolean
    Abstract Function Seek(s As FileStream, offset As Int64, origin As SeekOrigin) As Int64
    Abstract Sub Position(s As FileStream, value As QWord)
    Abstract Function Position(s As FileStream) As QWord
    Abstract Function Length(s As FileStream) As QWord
    Abstract Sub SetLength(s As FileStream, value As QWord)
End Class

/*!
@brief シークできない実装
@date 2008/08/21
@auther Egtra
*/
Class Unseekable
    Inherits SeekFunctions
Public
    Override Function CanSeek() As Boolean
        Return False
    End Function
    Override Function Seek(s As FileStream, offset As Int64, origin As SeekOrigin) As Int64
        Throw New NotSupportedException("FileStream.Seek")
    End Function
    Override Sub Position(s As FileStream, vvalue As QWord)
        Throw New NotSupportedException("FileStream.Position")
    End Sub
    Override Function Position(s As FileStream) As QWord
        Throw New NotSupportedException("FileStream.Position")
    End Function
    Override Function Length(s As FileStream) As QWord
        Throw New NotSupportedException("FileStream.Length")
    End Function
    Override Sub SetLength(s As FileStream, value As QWord)
        Throw New NotSupportedException("FileStream.SetLength")
    End Sub
End Class

/*!
@brief シークできる実装
@date 2008/08/21
@auther Egtra
*/
Class Seekable
    Inherits SeekFunctions
Public
    Override Function CanSeek() As Boolean
        Return True
    End Function
    Override Function Seek(s As FileStream, offset As Int64, origin As SeekOrigin) As Int64
        Dim seek = VarPtr(offset) As *LARGE_INTEGER
        Dim ret = SetFilePointer(s.Handle, seek->LowPart As Long, VarPtr(seek->HighPart), origin As DWord)
        If ret = INVALID_SET_FILE_POINTER Then
            Dim error = GetLastError()
            If error = ERROR_NEGATIVE_SEEK Then
                Throw New ArgumentException("FileStream.Seek: Cannot seek to negative offset.")
            ElseIf error <> NO_ERROR Then
                Detail.ThrowWinIOException("FileStream.Seek: Failed to seek.", error)
            End If
        End If
        seek->LowPart = ret
        Seek = offset
    End Function
    Override Sub Position(s As FileStream, value As QWord)
        Dim position = VarPtr(value) As *LARGE_INTEGER
        With position[0]
            Dim ret = SetFilePointer(s.Handle, .LowPart As Long, VarPtr(.HighPart), FILE_BEGIN)
            ThrowIfFilePointerFunctionFailed(ret)
        End With
    End Sub
    Override Function Position(s As FileStream) As QWord
        Dim position = VarPtr(Position) As *LARGE_INTEGER
        With position[0]
            .LowPart = SetFilePointer(s.Handle, .LowPart As Long, VarPtr(.HighPart), FILE_CURRENT)
            ThrowIfFilePointerFunctionFailed(.LowPart)
        End With
    End Function
    Override Function Length(s As FileStream) As QWord
        Dim length = VarPtr(Length) As *ULARGE_INTEGER
        length->LowPart = GetFileSize(s.Handle, VarPtr(length->HighPart))
        ThrowIfFilePointerFunctionFailed(length->LowPart)
    End Function
    Override Sub SetLength(s As FileStream, value As QWord)
        If s.CanWrite() Then
            Dim current = s.Position()
            Position(s, value)
            Dim ret = SetEndOfFile(s.Handle)
            If ret = FALSE Then
                Detail.ThrowWinLastErrorIOException("FileStream.SetLength failed")
            End If
            Position(s, current)
        End If
    End Sub
End Class

/*!
@brief シークできる実装（重複IO用）
@date 2008/08/21
@auther Egtra
*/
Class OverlappedSeekable
    Inherits Seekable
Public
    Override Function Seek(s As FileStream, offset As Int64, origin As SeekOrigin) As Int64
        Seek = Super.Seek(s, offset, origin)
        offset = Position(s)
    End Function
    Override Sub Position(s As FileStream, value As QWord)
        Super.Position(s, value)
        offset = value
    End Sub
    Override Function Position(s As FileStream) As QWord
        Position = offset
    End Function
Private
    offset As QWord
End Class

'---------------------------------------

/*!
@brief 読み取り関数の集合
@date 2008/08/21
@auther Egtra
*/
Class ReadFunctions
Public
    Abstract Function CanRead() As Boolean
    Abstract Function Read(s As FileStream, buffer As *Byte, offset As Long, count As Long) As Long
    Abstract Function BeginRead(s As FileStream, buffer As *Byte, offset As Long, count As Long, callback As AsyncCallback, state As Object) As System.IAsyncResult
    Abstract Function EndRead(s As FileStream, asyncResult As System.IAsyncResult) As Long
End Class

/*!
@brief 読み取りできない実装
@date 2008/08/21
@auther Egtra
*/
Class Unreadable
    Inherits ReadFunctions
Public
    Override Function CanRead() As Boolean
        Return False
    End Function

    Override Function Read(s As FileStream, buffer As *Byte, offset As Long, count As Long) As Long
        Throw New NotSupportedException("FileStream.Read")
    End Function

    Override Function BeginRead(s As FileStream, buffer As *Byte, offset As Long, count As Long, callback As AsyncCallback, state As Object) As System.IAsyncResult
        Throw New NotSupportedException("FileStream.BeginRead")
    End Function

    Override Function EndRead(s As FileStream, asyncResult As System.IAsyncResult) As Long
        Throw New NotSupportedException("FileStream.EndRead")
    End Function
End Class

/*!
@brief 読み取りできる実装
@date 2008/08/21
@auther Egtra
*/
Class Readable
    Inherits ReadFunctions
Public
    Override Function CanRead() As Boolean
        Return True
    End Function
    Override Function Read(s As FileStream, buffer As *Byte, offset As Long, count As Long) As Long
        Dim readBytes As DWord
        Dim ret = ReadFile(s.Handle, VarPtr(buffer[offset]), count As DWord, VarPtr(readBytes), ByVal NULL)
        If ret = FALSE Then
            Detail.ThrowWinLastErrorIOException("FileStream.Read: Failed to read.")
        End If
        Read = readBytes As Long
    End Function

    Override Function BeginRead(s As FileStream, buffer As *Byte, offset As Long, count As Long, callback As AsyncCallback, state As Object) As System.IAsyncResult
        BeginRead = ThreadPoolIo(ToMBStr("ReadFile"), s, buffer, offset, count, callback, state)
    End Function

    Override Function EndRead(s As FileStream, asyncResult As System.IAsyncResult) As Long
        Dim ar = asyncResult As Detail.IAsyncStreamResult
        EndRead = ar.WaitAndGetResult
    End Function
End Class

/*!
@brief 読み取りできる実装（重複IO用）
@date 2008/08/21
@auther Egtra
*/
Class OverlappedReadable
    Inherits Readable
Public
    Override Function Read(s As FileStream, buffer As *Byte, offset As Long, count As Long) As Long
        Read = EndRead(s, BeginRead(s, buffer, offset, count, Nothing, Nothing))
    End Function

    Override Function BeginRead(s As FileStream, buffer As *Byte, offset As Long, count As Long, callback As AsyncCallback, state As Object) As System.IAsyncResult
        BeginRead = BeginOverlappedIo(ToMBStr("ReadFile"), s, buffer, offset, count, callback, state)
        If s.CanSeek Then
            s.Seek(count, SeekOrigin.Current)
        End If
    End Function
End Class

'---------------------------------------

/*!
@brief 書き込み関数の集合
@date 2008/08/21
@auther Egtra
*/
Class WriteFunctions
Public
    Abstract Function CanWrite() As Boolean
    Abstract Sub Write(s As FileStream, buffer As *Byte, offset As Long, count As Long)
    Abstract Function BeginWrite(s As FileStream, buffer As *Byte, offset As Long, count As Long, callback As AsyncCallback, state As Object) As System.IAsyncResult
    Abstract Sub EndWrite(s As FileStream, asyncResult As System.IAsyncResult)
End Class

/*!
@brief 書き込みできない実装
@date 2008/08/21
@auther Egtra
*/
Class Unwritable
    Inherits WriteFunctions
Public
    Override Function CanWrite() As Boolean
        Return False
    End Function

    Override Sub Write(s As FileStream, buffer As *Byte, offset As Long, count As Long)
        Throw New NotSupportedException("FileStream.Write")
    End Sub

    Override Function BeginWrite(s As FileStream, buffer As *Byte, offset As Long, count As Long, callback As AsyncCallback, state As Object) As System.IAsyncResult
        Throw New NotSupportedException("FileStream.BeginWrite")
    End Function

    Override Sub EndWrite(s As FileStream, asyncResult As System.IAsyncResult)
        Throw New NotSupportedException("FileStream.EndWrite")
    End Sub
End Class

/*!
@brief 書き込みできる実装
@date 2008/08/21
@auther Egtra
*/
Class Writable
    Inherits WriteFunctions
Public
    Override Function CanWrite() As Boolean
        Return True
    End Function

    Override Sub Write(s As FileStream, buffer As *Byte, offset As Long, count As Long)
        Dim readBytes As DWord
        Dim ret = WriteFile(s.Handle, VarPtr(buffer[offset]), count As DWord, VarPtr(readBytes), ByVal NULL)
        If ret = FALSE Then
            Detail.ThrowWinLastErrorIOException("FileStream.Write: Failed to write.")
        End If
    End Sub

    Override Function BeginWrite(s As FileStream, buffer As *Byte, offset As Long, count As Long, callback As AsyncCallback, state As Object) As System.IAsyncResult
        BeginWrite = ThreadPoolIo(ToMBStr("WriteFile"), s, buffer, offset, count, callback, state)
    End Function

    Override Sub EndWrite(s As FileStream, asyncResult As System.IAsyncResult)
        Dim ar = asyncResult As Detail.IAsyncStreamResult
        ar.WaitAndGetResult()
    End Sub
End Class

/*!
@brief 書き込みできる実装（重複IO用）
@date 2008/08/21
@auther Egtra
*/
Class OverlappedWritable
    Inherits Writable
Public
    Override Sub Write(s As FileStream, buffer As *Byte, offset As Long, count As Long)
        EndWrite(s, BeginWrite(s, buffer, offset, count, Nothing, Nothing))
    End Sub

    Override Function BeginWrite(s As FileStream, buffer As *Byte, offset As Long, count As Long, callback As AsyncCallback, state As Object) As System.IAsyncResult
        BeginWrite = BeginOverlappedIo(ToMBStr("WriteFile"), s, buffer, offset, count, callback, state)
        If s.CanSeek Then
            s.Seek(count, SeekOrigin.Current)
        End If
    End Function
End Class

'---------------------------------------

/*!
@brief 重複IO実行開始
@param[in] fn "ReadFile"か"WriteFile"または引数に互換性のあるkernel32の関数名
@param[in] s 対象のストリーム
@param[in,out] buffer 入出力先
@param[in] offset buffer内で入出力を開始する位置
@param[in] count 読み書きするバイト数
@param[in] callback 完了したときに呼ばれるデリゲート
@param[in] state IAsyncResultへの追加引数
@return EndRead/Writeへの引き換えとなるIAsyncResult
@date 2008/08/21
@auther Egtra
*/
Function BeginOverlappedIo(fn As PCSTR, s As FileStream, buffer As *Byte, offset As Long, count As Long, callback As AsyncCallback, state As Object) As Detail.AsyncStreamResult
    Dim ioFile = GetProcAddress(GetModuleHandle("kernel32.dll"), fn) As Detail.PIOFile
    BeginOverlappedIo = New Detail.AsyncStreamResult(s.Handle, state)
    Dim pov = BeginOverlappedIo.PtrToOverlapped
    Dim position = s.Position
    pov->Offset = LODWORD(position)
    pov->OffsetHigh = HIDWORD(position)
    position += count
    If ioFile(s.Handle, buffer + offset, count, 0, pov) Then
        BeginOverlappedIo.SetCompletedSynchronously()
    Else
        Dim lastError = GetLastError()
        If lastError = ERROR_IO_PENDING Then
            If Not ActiveBasic.IsNothing(callback) Then
                Dim d = New Detail.CallbackData
                d.Callback = callback
                d.Result = BeginOverlappedIo
                Threading.ThreadPool.RegisterWaitForSingleObject(BeginOverlappedIo.AsyncWaitHandle, AddressOf(CallAsyncCallbackB), d)
            End If
            Exit Function
        ElseIf lastError = ERROR_HANDLE_EOF Then
            BeginOverlappedIo.SetCompletedSynchronously()
            BeginOverlappedIo.Handle = 0
            BeginOverlappedIo.Result = 0
        Else
            Detail.ThrowWinIOException("AsyncFileStream", lastError)
        End If
    End If
    If Not ActiveBasic.IsNothing(callback) Then
        Dim d = New Detail.CallbackData
        d.Callback = callback
        d.Result = BeginOverlappedIo
        Threading.ThreadPool.QueueUserWorkItem(AddressOf(CallAsyncCallback), d)
    End If
End Function

/*!
@brief BeginOverlappedIoのコールバック補助
@return EndRead/Writeへの引き換えとなるIAsyncResult
@date 2008/08/21
@auther Egtra
*/
Sub CallAsyncCallbackB(o As Object, b As Boolean)
    CallAsyncCallback(o)
End Sub

/*!
@brief BeginOverlappedIoのコールバック補助
@return EndRead/Writeへの引き換えとなるIAsyncResult
@date 2008/08/21
@auther Egtra
*/
Sub CallAsyncCallback(o As Object)
    Dim d = o As Detail.CallbackData
    Dim c = d.Callback
    c(d.Result)
End Sub

/*!
@brief Stream用IAsyncResult拡張
@date 2008/08/21
@auther Egtra
*/
Interface IAsyncStreamResult
    Inherits IAsyncResult
    /*!
    @brief 入出力完了まで待機する
    @return 読み書きしたバイト数
    */
    Function WaitAndGetResult() As DWord
End Interface

/*!
@brief IAsyncStreamResult実装用基底クラス
@date 2008/08/21
@auther Egtra
2つの派生クラス、AsyncStreamResultとThreadPoolIoResultの共通部分
*/
Class AsyncStreamResultImplBase
    Implements IAsyncStreamResult
Protected
    Sub AsyncStreamResultImplBase(state As Object)
        Imports System.Threading
        wait = New EventWaitHandle(False, EventResetMode.ManualReset)
        s = state
    End Sub
Public
    Virtual Function AsyncWaitHandle() As Threading.WaitHandle
        AsyncWaitHandle = wait
    End Function

    Virtual Function CompletedSynchronously() As Boolean
    End Function

    Virtual Function IsCompleted() As Boolean
        IsCompleted = AsyncWaitHandle.WaitOne(0)
    End Function

    Virtual Function AsyncState() As Object
        AsyncState = s
    End Function

    Virtual Function WaitAndGetResult() As DWord
    End Function

    Function AsyncEventWaitHandle() As Threading.EventWaitHandle
        AsyncEventWaitHandle = wait
    End Function
Private
    wait As Threading.EventWaitHandle
    s As Object
End Class

/*!
@brief 重複IO用IAsyncStreamResult実装
@date 2008/08/21
@auther Egtra
*/
Class AsyncStreamResult
    Inherits AsyncStreamResultImplBase
Public
    Sub AsyncStreamResult(handle As HANDLE, state As Object)
        AsyncStreamResultImplBase(state)
        h = handle
        cs = False
        overlapped.hEvent = AsyncWaitHandle.Handle
    End Sub

    Override Function CompletedSynchronously() As Boolean
        CompletedSynchronously = cs
    End Function

    Sub SetCompletedSynchronously()
        cs = True
        wait.Set()
    End Sub

    Override Function WaitAndGetResult() As DWord
        If h <> 0 Then
            If GetOverlappedResult(h, overlapped, result, TRUE) = FALSE Then
                Detail.ThrowWinLastErrorIOException("FileStream.EndRead/Write")
            End If
            h = 0
        End If
        WaitAndGetResult = result
    End Function

    Function PtrToOverlapped() As *OVERLAPPED
        PtrToOverlapped = VarPtr(overlapped)
    End Function

    Sub Handle(handle As HANDLE)
        h = handle
    End Sub

    '同期IO用
    Sub Result(res As DWord)
        result = res
    End Sub
Private
    overlapped As OVERLAPPED
    h As HANDLE
    result As DWord
    cs As Boolean
End Class

/*!
@brief ThreadPoolIo用IAsyncStreamResult実装
@date 2008/08/21
@auther Egtra
ThreadPoolIo関数も参照
*/
Class ThreadPoolIoResult
    Inherits AsyncStreamResultImplBase
Public
    Sub ThreadPoolIoResult(state As Object)
        AsyncStreamResultImplBase(state)
    End Sub

    Override Function CompletedSynchronously() As Boolean
        CompletedSynchronously = False
    End Function

    Override Function WaitAndGetResult() As DWord
        AsyncWaitHandle.WaitOne()
        If Not ActiveBasic.IsNothing(ex) Then
            Throw ex
        End If
        WaitAndGetResult = Result
    End Function

    Sub SetException(e As Exception)
        ex = e
    End Sub

    Result As DWord
Private
    ex As Exception
End Class

/*!
@brief Stream用同期IAsyncStreamResult実装
@date 2008/08/21
@auther Egtra
StreamでのBeginRead/Writeの実装は、常にBegin内部で同期的に処理するというもの。これはそれ用の実装。
*/
Class SyncStreamResultImpl
    Implements IAsyncStreamResult
Public
    Sub SyncStreamResultImpl(result As DWord, state As Object)
        Imports System.Threading
        wait = New EventWaitHandle(False, EventResetMode.ManualReset)
        s = state
    End Sub

    Virtual Function AsyncWaitHandle() As Threading.WaitHandle
        Imports System.Threading
        If ActiveBasic.IsNothing(wait) Then
            wait = New EventWaitHandle(True, EventResetMode.ManualReset)
        End If
        AsyncWaitHandle = wait
    End Function

    Virtual Function CompletedSynchronously() As Boolean
        CompletedSynchronously = True
    End Function

    Virtual Function IsCompleted() As Boolean
        IsCompleted = True
    End Function

    Virtual Function AsyncState() As Object
        AsyncState = s
    End Function

    Virtual Function WaitAndGetResult() As DWord
        WaitAndGetResult = res
    End Function

    Function AsyncEventWaitHandle() As Threading.EventWaitHandle
        AsyncEventWaitHandle = wait
    End Function
Private
    s As Object
    res As DWord

    Static wait = Nothing As Threading.EventWaitHandle
End Class

/*!
@brief ReadFile/WriteFileのプロトタイプに一致する関数へのポインタ
@date 2008/08/21
@auther Egtra
*/
TypeDef PIOFile = *Function(h As HANDLE, buf As VoidPtr, bytes As DWord, result As *DWord, ov As *OVERLAPPED) As BOOL

/*!
@brief BeginOverlappedIoとCallAsyncCallbackとの間で受け渡されるデータの集まり
@date 2008/08/21
@auther Egtra
*/
Class CallbackData
Public
    Callback As AsyncCallback
    Result As IAsyncResult
End Class

'---------------------------------------

/*!
@brief スレッドプールによる非同期IO
@date 2008/08/21
@param[in] fn "ReadFile"か"WriteFile"または引数に互換性のあるkernel32の関数名
@param[in] s 対象のストリーム
@param[in,out] buffer 入出力先
@param[in] offset buffer内で入出力を開始する位置
@param[in] count 読み書きするバイト数
@param[in] callback 完了したときに呼ばれるデリゲート
@param[in] state IAsyncResultへの追加引数
@return EndRead/Writeへの引き換えとなるIAsyncResult
@auther Egtra
OVERLAPPED指定無しで開いたファイルの非同期関数用
*/
Function ThreadPoolIo(ioType As PCSTR, s As FileStream, buffer As *Byte, offset As Long, count As Long, callback As AsyncCallback, state As Object) As System.IAsyncResult
    Dim result = New ThreadPoolIoResult(state)
    ThreadPoolIo = result
    Dim d = New ThreadPoolIoData
    With d
        .IoType = ioType
        .Handle = s.Handle
        .Result = result
        .Buffer = buffer + offset
        .Size = count As DWord
    End With
    Threading.ThreadPool.QueueUserWorkItem(AddressOf(ThreadIo), d)
End Function

/*!
@brief ThreadPoolIo補助で実際に入出力関数を呼ぶ
@date 2008/08/21
@auther Egtra
*/
Sub ThreadIo(o As Object)
    Dim d = o As ThreadPoolIoData
    With d
        Dim ioFile = GetProcAddress(GetModuleHandle("kernel32.dll"), .IoType) As Detail.PIOFile
        If ioFile(.Handle, .Buffer, .Size, VarPtr(.Result.Result), 0) = FALSE Then
            .Result.SetException(Detail.GetWinLastErrorIOException("FileStream.BeginRead/Write"))
        End If
        d.Result.AsyncEventWaitHandle.Set()
        If Not ActiveBasic.IsNothing(.Callback) Then
            Dim c = .Callback
            c(.Result)
        End If
    End With
End Sub

/*!
@brief ThreadPoolIoとThreadIoとの間で受け渡すデータの集まり
@date 2008/08/21
@auther Egtra
*/
Class ThreadPoolIoData
Public
    IoType As PCSTR
    Handle As HANDLE
    Result As ThreadPoolIoResult
    Callback As AsyncCallback
    Buffer As *Byte
    Size As DWord
End Class

End Namespace
End Namespace
End Namespace