Namespace System Namespace IO /* ほんとはmiscに入れるかかファイルを分けたほうがいいかもしれないが一先ず実装 */ Enum FileOptions None = 0 Asynchronous = FILE_FLAG_OVERLAPPED DeleteOnClose = FILE_FLAG_DELETE_ON_CLOSE Encrypted = FILE_ATTRIBUTE_ENCRYPTED RandomAccess = FILE_FLAG_RANDOM_ACCESS SequentialScan = FILE_FLAG_SEQUENTIAL_SCAN WriteThrough = FILE_FLAG_WRITE_THROUGH End Enum Class FileStream Inherits Stream handle As HANDLE /* ファイルハンドルからこれらを取得できれば、これらは入らないが 今のところは不明なので自前で実装するしかない */ filePath As String fileMode As DWord fileAccess As DWord fileShare As DWord fileOptions As DWord ownsHandle As Boolean offset As QWord 'オーバーラップドIO用 Public /* コンストラクタ.NETと同じように実装は難しい、一先ず動くものを実装したが変更が必要だと思う */ Sub FileStream(path As String, mode As FileMode, access As FileAccess, share As FileShare, options As FileOptions) If ActiveBasic.IsNothing(path) Then Throw New ArgumentNullException("path") ElseIf path.Length = 0 Then Throw New ArgumentException End If Dim ac = access As DWord Dim sh = share As DWord Dim mo = mode As DWord Dim op = options As DWord ' If (Environment.OSVersion.Platform As DWord) <> (PlatformID.Win32NT As DWord) Then 'ToDo: なぜかアクセス違反になる op And= Not FILE_FLAG_OVERLAPPED ' End If This.handle=CreateFile(ToTCStr(path),ac,sh,ByVal NULL,mo,op,0) If This.handle=INVALID_HANDLE_VALUE Then 'エラー処理 'Throw ArgumentException 'Throw IOException 'Throw System.IO.FileNotFoundException This.handle=0 Detail.ThrowWinLastErrorIOException("Failed to open/create file.") Exit Sub End If This.filePath = path This.fileMode = mo This.fileAccess = ac This.fileShare = sh This.fileOptions = op This.offset = 0 This.ownsHandle = True If FileMode.Append = This.fileMode Then Seek(0, SeekOrigin.End) End If End Sub Sub FileStream(path As String, mode As FileMode, access As FileAccess, share As FileShare) This.FileStream(path,mode,access,share,FileOptions.None) End Sub Sub FileStream(path As String, mode As FileMode, access As FileAccess) This.FileStream(path,mode,access,FileShare.None,FileOptions.None) End Sub Sub FileStream(path As String, mode As FileMode) Dim access As FileAccess Select Case mode Case FileMode.Append access=FileAccess.Write Case FileMode.Create access=FileAccess.ReadWrite Case FileMode.CreateNew access=FileAccess.ReadWrite Case FileMode.Open access=FileAccess.ReadWrite Case FileMode.OpenOrCreate access=FileAccess.ReadWrite Case FileMode.Truncate access=FileAccess.Write End Select This.FileStream(path,mode,access,FileShare.None,FileOptions.None) End Sub /* @date 2008/02/26 @auther Egtra '不要になったら削除すること */ Sub FileStream(h As HANDLE, access As FileAccess, owns As Boolean) handle = h fileAccess = access As DWord ownsHandle = owns End Sub Public /*! @brief ファイルが読み込みに対応しているかを返す */ Override Function CanRead() As Boolean If This.fileAccess And GENERIC_READ Then Return True Else Return False End If End Function /*! @brief ファイルがシークに対応しているかを返す */ Override Function CanSeek() As Boolean If GetFileType(This.handle)=FILE_TYPE_DISK Then Return True Else Return False End If End Function ' Override Function CanTimeout() As Boolean ' /* ファイルがタイムアウトに対応しているかを返す */ ' Return False /*今のところ対応していないのでFalse*/ ' End Function*/ /*! @brief ファイルが書き込みに対応しているかを返す */ Override Function CanWrite() As Boolean If This.fileAccess And GENERIC_WRITE Then Return True Else Return False End If End Function Function Handle() As HANDLE Return handle End Function /*! @brief ファイルが非同期操作に対応しているかを返す */ Function IsAsync() As Boolean If This.fileOptions And FILE_FLAG_OVERLAPPED /*FileOptions.Asynchronous*/ Then Return True Else Return False End If End Function Override Function Length() As Int64 disposedCheck() If This.CanSeek() Then Dim length = VarPtr(Length) As *ULARGE_INTEGER length->LowPart = GetFileSize(This.handle, VarPtr(length->HighPart)) If LODWORD(Length) = INVALID_FILE_SIZE Then Dim error = GetLastError() If error <> NO_ERROR Then ' Detail.ThrowWinIOException("FileStream.Read: Failed to read.", error) End If End If If Length < 0 Then Debug 'Throw OverflowException End If End If End Function Function Name() As String Return This.filePath End Function Override Sub Position(value As Int64) disposedCheck() If This.CanSeek() Then If This.IsAsync() Then offset = value As QWord Else Dim position As LARGE_INTEGER position.LowPart=LODWORD(value) position.HighPart=HIDWORD(value) SetFilePointer(This.handle,position.LowPart,VarPtr(position.HighPart) As *DWord,FILE_BEGIN) End If End If End Sub Override Function Position() As Int64 disposedCheck() If This.CanSeek() Then If This.IsAsync() Then Return offset As Int64 Else Dim position As LARGE_INTEGER ZeroMemory(VarPtr(position),SizeOf(LARGE_INTEGER)) position.LowPart=SetFilePointer(This.handle,position.LowPart,VarPtr(position.HighPart) As *DWord,FILE_CURRENT) Return MAKEQWORD(position.LowPart,position.HighPart) As Int64 End If End If End Function /* Override Sub ReadTimeout(value As Long) 'TODO End Sub Override Function ReadTimeout() As Long 'TODO End Function*/ /* Safe〜Handle系の実装は要相談!! */ /* Function SafeFileHandle() As SafeFileHandle End Function*/ Override Sub WriteTimeout(value As Long) 'TODO End Sub Override Function WriteTimeout() As Long 'TODO End Function Public Override Function BeginRead(buffer As *Byte, offset As Long, count As Long, callback As AsyncCallback, state As Object) As System.IAsyncResult If This.IsAsync() Then Else Read(buffer,offset,count) End If End Function Override Function BeginWrite(buffer As *Byte, offset As Long, count As Long, callback As AsyncCallback, state As Object) As System.IAsyncResult If This.IsAsync() Then Else Write(buffer,offset,count) End If End Function /* CreateObjRef*/ Override Function EndRead(asyncResult As System.IAsyncResult) As Long 'TODO End Function Override Sub EndWrite(asyncResult As System.IAsyncResult) 'TODO End Sub /* Equals*/ Override Sub Flush() disposedCheck() Dim ret = FlushFileBuffers(This.handle) If ret = FALSE Then ' Detail.ThrowWinLastErrorIOException("FileStream.Read: Failed to read.") End If End Sub /* Function GetAccessControl() As FileSecurity FileSecurityの実装がまだできてない。 End Function*/ /* GetLifetimeService*/ /* Override Function GetType() As TypeInfo Return Super.GetType() End Function*/ /* InitializeLifetimeService*/ Sub Lock(position As Int64, length As Int64) disposedCheck() If position < 0 Then Throw New ArgumentOutOfRangeException("FileStream.Lock: An argument is negative value.", New System.Int64(position), "position") ElseIf length < 0 Then Throw New ArgumentOutOfRangeException("FileStream.Lock: An argument is negative value.", New System.Int64(length), "length") End If LockFile(handle, LODWORD(position As QWord), HIDWORD(position As QWord), LODWORD(length As QWord), HIDWORD(length As QWord)) End Sub Override Function Read(buffer As *Byte, offset As Long, count As Long) As Long disposedCheck() If buffer = 0 Then Throw New ArgumentNullException("FileStream.Read: An argument is null value.", "buffer") ElseIf Not This.CanRead() Then Throw New NotSupportedException("FileStream.Read: This stream is not readable.") End If Dim ret As BOOL Dim readBytes As DWord If This.IsAsync() Then Dim overlapped As OVERLAPPED SetQWord(VarPtr(overlapped.Offset), offset) overlapped.hEvent = CreateEvent(0, TRUE, FALSE, 0) If overlapped.hEvent = 0 Then Throw New OutOfMemoryException("FileStream.Read: Failed to create an event object.") End If Try ret = ReadFile(This.handle, VarPtr(buffer[offset]), count, 0, overlapped) If ret = FALSE Then Dim error = GetLastError() If error <> ERROR_IO_PENDING Then Detail.ThrowWinIOException("FileStream.Read: Failed to read.", error) End If End If ret = GetOverlappedResult(This.handle, overlapped, readBytes, TRUE) If ret = FALSE Then Detail.ThrowWinLastErrorIOException("FileStream.Read: Failed to read.") End If offset += Read Finally CloseHandle(overlapped.hEvent) End Try Else ret = ReadFile(This.handle,VarPtr(buffer[offset]),count,VarPtr(readBytes),ByVal NULL) If ret = FALSE Then Detail.ThrowWinLastErrorIOException("FileStream.Read: Failed to read.") End If End If Read = readBytes As Long End Function /*! @brief ストリームの現在位置を移動させる。 @param[in] offset originからの移動量 @param[in] origin 移動の基準位置 @return 移動後の新しい現在位置 @exception DisposedException 既にストリームが閉じられている場合 @exception ArgumentException 移動後の位置が負の位置(ファイル先頭より手前)になる場合 @exception IOException その他エラーが発生した場合 */ Override Function Seek(offset As Int64, origin As SeekOrigin) As Int64 disposedCheck() If This.CanSeek() Then If This.IsAsync() Then Select Case origin Case SeekOrigin.Begin This.offset = offset Case SeekOrigin.Current This.offset += offset Case SeekOrigin.End This.offset = This.Length + offset End Select Seek = This.offset As Int64 If Seek < 0 Then ' Throw ArgumentException("FileStream.Seek: Cannot seek to negative offset.") End If Else Dim seek = VarPtr(offset) As *ULARGE_INTEGER Dim ret = SetFilePointer(This.handle, seek->LowPart, VarPtr(seek->HighPart), origin As DWord) If ret = INVALID_SET_FILE_POINTER Then Dim error = GetLastError() If error = ERROR_NEGATIVE_SEEK Then ' Throw ArgumentException("FileStream.Seek: Cannot seek to negative offset.") ElseIf error <> NO_ERROR Then ' Throw Detail.ThrowWinIOException("FileStream.Seek: Failed to seek.", error) End If End If seek->LowPart = ret Seek = offset End If End If End Function /* Sub SetAccessControl(fileSecurity As FileSecurity) FileSecurityの実装がまだできてない。 End Sub*/ Override Sub SetLength(value As Int64) disposedCheck() If This.CanWrite() and This.CanSeek() Then If This.IsAsync() Then Else Dim current = This.Position() This.Position(value) Dim ret = SetEndOfFile(This.handle) If ret = FALSE Then Detail.ThrowWinLastErrorIOException("FileStream.Read: Failed to read.") End If Position = current End If End If End Sub /* Synchronized*/ Override Function ToString() As String Return This.Name() End Function Sub Unlock(position As Int64, length As Int64) disposedCheck() If position < 0 Then Throw New ArgumentOutOfRangeException("FileStream.Lock: An argument is negative value.", New System.Int64(position), "position") ElseIf length < 0 Then Throw New ArgumentOutOfRangeException("FileStream.Lock: An argument is negative value.", New System.Int64(length), "length") End If Dim ret = UnlockFile(handle, LODWORD(position As QWord), HIDWORD(position As QWord), LODWORD(length As QWord), HIDWORD(length As QWord)) If ret = FALSE Then Detail.ThrowWinLastErrorIOException("FileStream.Read: Failed to read.") End If End Sub Override Sub Write(buffer As *Byte, offset As Long, count As Long) disposedCheck() If This.CanWrite() Then Dim writeBytes As DWord If This.IsAsync() Then Dim overlapped As OVERLAPPED SetQWord(VarPtr(overlapped.Offset), offset) overlapped.hEvent = CreateEvent(0, TRUE, FALSE, 0) Dim ret = WriteFile(This.handle, VarPtr(buffer[offset]), count, 0, overlapped) If ret <> FALSE Or GetLastError() = ERROR_IO_PENDING Then GetOverlappedResult(This.handle, overlapped, writeBytes, TRUE) End If offset += writeBytes CloseHandle(overlapped.hEvent) Else WriteFile(This.handle, VarPtr(buffer[offset]), count, VarPtr(writeBytes), ByVal NULL) End If End If End Sub Protected Override Sub Dispose(disposing As Boolean) If handle <> 0 Then Flush() CloseHandle(InterlockedExchangePointer(ByVal VarPtr(handle), NULL)) End If End Sub Override Function CreateWaitHandle() As System.Threading.WaitHandle Return New System.Threading.AutoResetEvent(False) End Function Private Sub disposedCheck() If handle = 0 Then ' Throw ObjectDisposedException("FileStream: This stream has closed.") End If End Sub End Class End Namespace End Namespace