source: trunk/Include/Classes/System/IO/FileStream.ab@ 431

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
    
    offset As QWord 'オーバーラップドIO用

Public
    /* コンストラクタ.NETと同じように実装は難しい、一先ず動くものを実装したが変更が必要だと思う */
    Sub FileStream(path As String, mode As FileMode, access As FileAccess, share As FileShare, options As FileOptions)
        Dim ac As DWord
        Dim mo As DWord
        Dim sh As DWord
        Dim op As DWord

        Select Case access
            Case FileAccess.Read
                ac=GENERIC_READ
            Case FileAccess.ReadWrite
                ac=GENERIC_READ or GENERIC_WRITE
            Case FileAccess.Write
                ac=GENERIC_WRITE
        End Select

        Select Case share
            Case FileShare.DeleteFile
                sh=FILE_SHARE_DELETE
            Case FileShare.None
                sh=0
            Case FileShare.Read
                sh=FILE_SHARE_READ
            Case FileShare.ReadWrite
                sh=FILE_SHARE_READ or FILE_SHARE_WRITE
            Case FileShare.Write
                sh=FILE_SHARE_WRITE
        End Select

        Select Case mode
            Case FileMode.Append
                mo=OPEN_ALWAYS
            Case FileMode.Create
                mo=CREATE_ALWAYS
            Case FileMode.CreateNew
                mo=CREATE_NEW
            Case FileMode.Open
                mo=OPEN_EXISTING
            Case FileMode.OpenOrCreate
                mo=OPEN_ALWAYS
            Case FileMode.Truncate
                mo=TRUNCATE_EXISTING
        End Select

        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
            Beep(220,500)
            Exit Sub
        End If

        This.filePath = path
        This.fileMode = mo
        This.fileAccess = ac
        This.fileShare = sh
        This.fileOptions = op
        This.offset = 0
    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
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

    /*Handle*/

    /*!
    @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 Sub Dispose(disposing As Boolean)
        Flush()
        CloseHandle(InterlockedExchangePointer(VarPtr(This.handle),NULL))
    End Sub

    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 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