source: trunk/ab5.0/ablib/src/Classes/System/IO/FileStream.ab @ 552

Last change on this file since 552 was 552, checked in by NoWest, 13 years ago

Handleメソッドを追加

File size: 12.9 KB
Line 
1Namespace System
2Namespace IO
3
4/* ほんとはmiscに入れるかかファイルを分けたほうがいいかもしれないが一先ず実装 */
5Enum FileOptions
6    None = 0
7    Asynchronous = FILE_FLAG_OVERLAPPED
8    DeleteOnClose = FILE_FLAG_DELETE_ON_CLOSE
9    Encrypted = FILE_ATTRIBUTE_ENCRYPTED
10    RandomAccess = FILE_FLAG_RANDOM_ACCESS
11    SequentialScan = FILE_FLAG_SEQUENTIAL_SCAN
12    WriteThrough = FILE_FLAG_WRITE_THROUGH
13End Enum
14
15Class FileStream
16    Inherits Stream
17
18    handle As HANDLE
19
20    /*
21    ファイルハンドルからこれらを取得できれば、これらは入らないが
22    今のところは不明なので自前で実装するしかない
23    */
24    filePath As String
25    fileMode As DWord
26    fileAccess As DWord
27    fileShare As DWord
28    fileOptions As DWord
29    ownsHandle As Boolean
30   
31    offset As QWord 'オーバーラップドIO用
32
33Public
34    /* コンストラクタ.NETと同じように実装は難しい、一先ず動くものを実装したが変更が必要だと思う */
35    Sub FileStream(path As String, mode As FileMode, access As FileAccess, share As FileShare, options As FileOptions)
36        If ActiveBasic.IsNothing(path) Then
37            Throw New ArgumentNullException("path")
38        ElseIf path.Length = 0 Then
39            Throw New ArgumentException
40        End If
41
42
43        Dim ac = access As DWord
44        Dim sh = share As DWord
45        Dim mo = mode As DWord
46        Dim op = options As DWord
47'       If (Environment.OSVersion.Platform As DWord) <> (PlatformID.Win32NT As DWord) Then 'ToDo: なぜかアクセス違反になる
48            op And= Not FILE_FLAG_OVERLAPPED
49'       End If
50
51        This.handle=CreateFile(ToTCStr(path),ac,sh,ByVal NULL,mo,op,0)
52        If This.handle=INVALID_HANDLE_VALUE Then
53        'エラー処理
54        'Throw ArgumentException
55        'Throw IOException
56        'Throw System.IO.FileNotFoundException
57            This.handle=0
58            Detail.ThrowWinLastErrorIOException("Failed to open/create file.")
59            Exit Sub
60        End If
61
62        This.filePath = path
63        This.fileMode = mo
64        This.fileAccess = ac
65        This.fileShare = sh
66        This.fileOptions = op
67        This.offset = 0
68        This.ownsHandle = True
69
70        If FileMode.Append = This.fileMode Then
71            Seek(0, SeekOrigin.End)
72        End If
73    End Sub
74    Sub FileStream(path As String, mode As FileMode, access As FileAccess, share As FileShare)
75        This.FileStream(path,mode,access,share,FileOptions.None)
76    End Sub
77    Sub FileStream(path As String, mode As FileMode, access As FileAccess)
78        This.FileStream(path,mode,access,FileShare.None,FileOptions.None)
79    End Sub
80    Sub FileStream(path As String, mode As FileMode)
81        Dim access As FileAccess
82        Select Case mode
83            Case FileMode.Append
84                access=FileAccess.Write
85            Case FileMode.Create
86                access=FileAccess.ReadWrite
87            Case FileMode.CreateNew
88                access=FileAccess.ReadWrite
89            Case FileMode.Open
90                access=FileAccess.ReadWrite
91            Case FileMode.OpenOrCreate
92                access=FileAccess.ReadWrite
93            Case FileMode.Truncate
94                access=FileAccess.Write
95        End Select
96        This.FileStream(path,mode,access,FileShare.None,FileOptions.None)
97    End Sub
98    /*
99    @date 2008/02/26
100    @auther Egtra
101    '不要になったら削除すること
102    */
103    Sub FileStream(h As HANDLE, access As FileAccess, owns As Boolean)
104        handle = h
105        fileAccess = access As DWord
106        ownsHandle = owns
107    End Sub
108
109Public
110    /*!
111    @brief  ファイルが読み込みに対応しているかを返す
112    */
113    Override Function CanRead() As Boolean
114        If This.fileAccess And GENERIC_READ Then
115            Return True
116        Else
117            Return False
118        End If
119    End Function
120
121    /*!
122    @brief  ファイルがシークに対応しているかを返す
123    */
124    Override Function CanSeek() As Boolean
125        If GetFileType(This.handle)=FILE_TYPE_DISK Then
126            Return True
127        Else
128            Return False
129        End If
130    End Function
131
132'   Override Function CanTimeout() As Boolean
133'       /* ファイルがタイムアウトに対応しているかを返す */
134'       Return False /*今のところ対応していないのでFalse*/
135'   End Function*/
136
137    /*!
138    @brief  ファイルが書き込みに対応しているかを返す
139    */
140    Override Function CanWrite() As Boolean
141        If This.fileAccess And GENERIC_WRITE Then
142            Return True
143        Else
144            Return False
145        End If
146    End Function
147
148    Function Handle() As HANDLE
149        Return handle
150    End Function
151
152    /*!
153    @brief  ファイルが非同期操作に対応しているかを返す
154    */
155    Function IsAsync() As Boolean
156        If This.fileOptions And FILE_FLAG_OVERLAPPED /*FileOptions.Asynchronous*/ Then
157            Return True
158        Else
159            Return False
160        End If
161    End Function
162
163    Override Function Length() As Int64
164        disposedCheck()
165        If This.CanSeek() Then
166            Dim length = VarPtr(Length) As *ULARGE_INTEGER
167            length->LowPart = GetFileSize(This.handle, VarPtr(length->HighPart))
168            If LODWORD(Length) = INVALID_FILE_SIZE Then
169                Dim error = GetLastError()
170                If error <> NO_ERROR Then
171'                   Detail.ThrowWinIOException("FileStream.Read: Failed to read.", error)
172                End If
173            End If
174           
175            If Length < 0 Then
176                Debug 'Throw OverflowException
177            End If
178        End If
179    End Function
180
181    Function Name() As String
182        Return This.filePath
183    End Function
184   
185    Override Sub Position(value As Int64)
186        disposedCheck()
187        If This.CanSeek() Then
188            If This.IsAsync() Then
189                offset = value As QWord
190            Else
191                Dim position As LARGE_INTEGER
192                position.LowPart=LODWORD(value)
193                position.HighPart=HIDWORD(value)
194                SetFilePointer(This.handle,position.LowPart,VarPtr(position.HighPart) As *DWord,FILE_BEGIN)
195            End If
196        End If
197    End Sub
198    Override Function Position() As Int64
199        disposedCheck()
200        If This.CanSeek() Then
201            If This.IsAsync() Then
202                Return offset As Int64
203            Else
204                Dim position As LARGE_INTEGER
205                ZeroMemory(VarPtr(position),SizeOf(LARGE_INTEGER))
206                position.LowPart=SetFilePointer(This.handle,position.LowPart,VarPtr(position.HighPart) As *DWord,FILE_CURRENT)
207                Return MAKEQWORD(position.LowPart,position.HighPart) As Int64
208            End If
209        End If
210    End Function
211
212/*  Override Sub ReadTimeout(value As Long)
213        'TODO
214    End Sub
215    Override Function ReadTimeout() As Long
216        'TODO
217    End Function*/
218
219    /* Safe~Handle系の実装は要相談!! */
220/*  Function SafeFileHandle() As SafeFileHandle
221    End Function*/
222
223    Override Sub WriteTimeout(value As Long)
224        'TODO
225    End Sub
226    Override Function WriteTimeout() As Long
227        'TODO
228    End Function
229   
230
231Public
232    Override Function BeginRead(buffer As *Byte, offset As Long, count As Long, callback As AsyncCallback, state As Object) As System.IAsyncResult
233        If This.IsAsync() Then
234        Else
235            Read(buffer,offset,count)
236        End If
237    End Function
238
239    Override Function BeginWrite(buffer As *Byte, offset As Long, count As Long, callback As AsyncCallback, state As Object) As System.IAsyncResult
240        If This.IsAsync() Then
241        Else
242            Write(buffer,offset,count)
243        End If
244    End Function
245
246/*  CreateObjRef*/
247   
248    Override Function EndRead(asyncResult As System.IAsyncResult) As Long
249        'TODO
250    End Function
251
252    Override Sub EndWrite(asyncResult As System.IAsyncResult)
253        'TODO
254    End Sub
255
256/*  Equals*/
257
258    Override Sub Flush()
259        disposedCheck()
260        Dim ret = FlushFileBuffers(This.handle)
261        If ret = FALSE Then
262'           Detail.ThrowWinLastErrorIOException("FileStream.Read: Failed to read.")
263        End If
264    End Sub
265
266/*  Function GetAccessControl() As FileSecurity
267    FileSecurityの実装がまだできてない。
268    End Function*/
269
270/*  GetLifetimeService*/
271
272/*  Override Function GetType() As TypeInfo
273        Return Super.GetType()
274    End Function*/
275
276/*  InitializeLifetimeService*/
277
278    Sub Lock(position As Int64, length As Int64)
279        disposedCheck()
280        If position < 0 Then
281            Throw New ArgumentOutOfRangeException("FileStream.Lock: An argument is negative value.", New System.Int64(position), "position")
282        ElseIf length < 0 Then
283            Throw New ArgumentOutOfRangeException("FileStream.Lock: An argument is negative value.", New System.Int64(length), "length")
284        End If
285        LockFile(handle, LODWORD(position As QWord), HIDWORD(position As QWord),
286            LODWORD(length As QWord), HIDWORD(length As QWord))
287    End Sub
288
289    Override Function Read(buffer As *Byte, offset As Long, count As Long) As Long
290        disposedCheck()
291        If buffer = 0 Then
292            Throw New ArgumentNullException("FileStream.Read: An argument is null value.", "buffer")
293        ElseIf Not This.CanRead() Then
294            Throw New NotSupportedException("FileStream.Read: This stream is not readable.")
295        End If
296
297        Dim ret As BOOL
298        Dim readBytes As DWord
299        If This.IsAsync() Then
300            Dim overlapped As OVERLAPPED
301            SetQWord(VarPtr(overlapped.Offset), offset)
302            overlapped.hEvent = CreateEvent(0, TRUE, FALSE, 0)
303            If overlapped.hEvent = 0 Then
304                Throw New OutOfMemoryException("FileStream.Read: Failed to create an event object.")
305            End If
306            Try
307                ret = ReadFile(This.handle, VarPtr(buffer[offset]), count, 0, overlapped)
308                If ret = FALSE Then
309                    Dim error = GetLastError()
310                    If error <> ERROR_IO_PENDING Then
311                        Detail.ThrowWinIOException("FileStream.Read: Failed to read.", error)
312                    End If
313                End If
314                ret = GetOverlappedResult(This.handle, overlapped, readBytes, TRUE)
315                If ret = FALSE Then
316                    Detail.ThrowWinLastErrorIOException("FileStream.Read: Failed to read.")
317                End If
318                offset += Read
319            Finally
320                CloseHandle(overlapped.hEvent)
321            End Try
322        Else
323            ret = ReadFile(This.handle,VarPtr(buffer[offset]),count,VarPtr(readBytes),ByVal NULL)
324            If ret = FALSE Then
325                Detail.ThrowWinLastErrorIOException("FileStream.Read: Failed to read.")
326            End If
327        End If
328        Read = readBytes As Long
329    End Function
330
331    /*!
332    @brief  ストリームの現在位置を移動させる。
333    @param[in] offset   originからの移動量
334    @param[in] origin   移動の基準位置
335    @return 移動後の新しい現在位置
336    @exception DisposedException    既にストリームが閉じられている場合
337    @exception ArgumentException    移動後の位置が負の位置(ファイル先頭より手前)になる場合
338    @exception IOException  その他エラーが発生した場合
339    */
340    Override Function Seek(offset As Int64, origin As SeekOrigin) As Int64
341        disposedCheck()
342        If This.CanSeek() Then
343            If This.IsAsync() Then
344                Select Case origin
345                    Case SeekOrigin.Begin
346                        This.offset = offset
347                    Case SeekOrigin.Current
348                        This.offset += offset
349                    Case SeekOrigin.End
350                        This.offset = This.Length + offset
351                End Select
352                Seek = This.offset As Int64
353                If Seek < 0 Then
354'                   Throw ArgumentException("FileStream.Seek: Cannot seek to negative offset.")
355                End If
356            Else
357                Dim seek = VarPtr(offset) As *ULARGE_INTEGER
358                Dim ret = SetFilePointer(This.handle, seek->LowPart, VarPtr(seek->HighPart), origin As DWord)
359                If ret = INVALID_SET_FILE_POINTER Then
360                    Dim error = GetLastError()
361                    If error = ERROR_NEGATIVE_SEEK Then
362'                       Throw ArgumentException("FileStream.Seek: Cannot seek to negative offset.")
363                    ElseIf error <> NO_ERROR Then
364'                       Throw Detail.ThrowWinIOException("FileStream.Seek: Failed to seek.", error)
365                    End If
366                End If
367                seek->LowPart = ret
368                Seek = offset
369            End If
370        End If
371    End Function
372
373/*  Sub SetAccessControl(fileSecurity As FileSecurity)
374    FileSecurityの実装がまだできてない。
375    End Sub*/
376
377    Override Sub SetLength(value As Int64)
378        disposedCheck()
379        If This.CanWrite() and This.CanSeek() Then
380            If This.IsAsync() Then
381            Else
382                Dim current = This.Position()
383                This.Position(value)
384                Dim ret = SetEndOfFile(This.handle)
385                If ret = FALSE Then
386                    Detail.ThrowWinLastErrorIOException("FileStream.Read: Failed to read.")
387                End If
388                Position = current
389            End If
390        End If
391    End Sub
392
393/*  Synchronized*/
394
395    Override Function ToString() As String
396        Return This.Name()
397    End Function
398
399    Sub Unlock(position As Int64, length As Int64)
400        disposedCheck()
401        If position < 0 Then
402            Throw New ArgumentOutOfRangeException("FileStream.Lock: An argument is negative value.", New System.Int64(position), "position")
403        ElseIf length < 0 Then
404            Throw New ArgumentOutOfRangeException("FileStream.Lock: An argument is negative value.", New System.Int64(length), "length")
405        End If
406        Dim ret = UnlockFile(handle, LODWORD(position As QWord), HIDWORD(position As QWord),
407            LODWORD(length As QWord), HIDWORD(length As QWord))
408        If ret = FALSE Then
409            Detail.ThrowWinLastErrorIOException("FileStream.Read: Failed to read.")
410        End If
411    End Sub
412
413    Override Sub Write(buffer As *Byte, offset As Long, count As Long)
414        disposedCheck()
415        If This.CanWrite() Then
416            Dim writeBytes As DWord
417            If This.IsAsync() Then
418                Dim overlapped As OVERLAPPED
419                SetQWord(VarPtr(overlapped.Offset), offset)
420                overlapped.hEvent = CreateEvent(0, TRUE, FALSE, 0)
421                Dim ret = WriteFile(This.handle, VarPtr(buffer[offset]), count, 0, overlapped)
422                If ret <> FALSE Or GetLastError() = ERROR_IO_PENDING Then
423                    GetOverlappedResult(This.handle, overlapped, writeBytes, TRUE)
424                End If
425                offset += writeBytes
426                CloseHandle(overlapped.hEvent)
427            Else
428                WriteFile(This.handle, VarPtr(buffer[offset]), count, VarPtr(writeBytes), ByVal NULL)
429            End If
430        End If
431    End Sub
432
433Protected
434    Override Sub Dispose(disposing As Boolean)
435        If handle <> 0 Then
436            Flush()
437            CloseHandle(InterlockedExchangePointer(ByVal VarPtr(handle), NULL))
438        End If
439    End Sub
440
441    Override Function CreateWaitHandle() As System.Threading.WaitHandle
442        Return New System.Threading.AutoResetEvent(False)
443    End Function
444
445Private
446    Sub disposedCheck()
447        If handle = 0 Then
448'           Throw ObjectDisposedException("FileStream: This stream has closed.")
449        End If
450    End Sub
451
452End Class
453
454
455End Namespace
456End Namespace
Note: See TracBrowser for help on using the repository browser.