'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