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

Last change on this file since 506 was 474, checked in by OverTaker, 16 years ago

FileStreamクラスでFileMode.Appendが指定されたとき、ファイルの位置が末尾に移動していない不具合を修正。
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 /*Handle*/
149
150 /*!
151 @brief ファイルが非同期操作に対応しているかを返す
152 */
153 Function IsAsync() As Boolean
154 If This.fileOptions And FILE_FLAG_OVERLAPPED /*FileOptions.Asynchronous*/ Then
155 Return True
156 Else
157 Return False
158 End If
159 End Function
160
161 Override Function Length() As Int64
162 disposedCheck()
163 If This.CanSeek() Then
164 Dim length = VarPtr(Length) As *ULARGE_INTEGER
165 length->LowPart = GetFileSize(This.handle, VarPtr(length->HighPart))
166 If LODWORD(Length) = INVALID_FILE_SIZE Then
167 Dim error = GetLastError()
168 If error <> NO_ERROR Then
169' Detail.ThrowWinIOException("FileStream.Read: Failed to read.", error)
170 End If
171 End If
172
173 If Length < 0 Then
174 Debug 'Throw OverflowException
175 End If
176 End If
177 End Function
178
179 Function Name() As String
180 Return This.filePath
181 End Function
182
183 Override Sub Position(value As Int64)
184 disposedCheck()
185 If This.CanSeek() Then
186 If This.IsAsync() Then
187 offset = value As QWord
188 Else
189 Dim position As LARGE_INTEGER
190 position.LowPart=LODWORD(value)
191 position.HighPart=HIDWORD(value)
192 SetFilePointer(This.handle,position.LowPart,VarPtr(position.HighPart) As *DWord,FILE_BEGIN)
193 End If
194 End If
195 End Sub
196 Override Function Position() As Int64
197 disposedCheck()
198 If This.CanSeek() Then
199 If This.IsAsync() Then
200 Return offset As Int64
201 Else
202 Dim position As LARGE_INTEGER
203 ZeroMemory(VarPtr(position),SizeOf(LARGE_INTEGER))
204 position.LowPart=SetFilePointer(This.handle,position.LowPart,VarPtr(position.HighPart) As *DWord,FILE_CURRENT)
205 Return MAKEQWORD(position.LowPart,position.HighPart) As Int64
206 End If
207 End If
208 End Function
209
210/* Override Sub ReadTimeout(value As Long)
211 'TODO
212 End Sub
213 Override Function ReadTimeout() As Long
214 'TODO
215 End Function*/
216
217 /* Safe～Handle系の実装は要相談！！ */
218/* Function SafeFileHandle() As SafeFileHandle
219 End Function*/
220
221 Override Sub WriteTimeout(value As Long)
222 'TODO
223 End Sub
224 Override Function WriteTimeout() As Long
225 'TODO
226 End Function
227
228
229Public
230 Override Function BeginRead(buffer As *Byte, offset As Long, count As Long, callback As AsyncCallback, state As Object) As System.IAsyncResult
231 If This.IsAsync() Then
232 Else
233 Read(buffer,offset,count)
234 End If
235 End Function
236
237 Override Function BeginWrite(buffer As *Byte, offset As Long, count As Long, callback As AsyncCallback, state As Object) As System.IAsyncResult
238 If This.IsAsync() Then
239 Else
240 Write(buffer,offset,count)
241 End If
242 End Function
243
244/* CreateObjRef*/
245
246 Override Function EndRead(asyncResult As System.IAsyncResult) As Long
247 'TODO
248 End Function
249
250 Override Sub EndWrite(asyncResult As System.IAsyncResult)
251 'TODO
252 End Sub
253
254/* Equals*/
255
256 Override Sub Flush()
257 disposedCheck()
258 Dim ret = FlushFileBuffers(This.handle)
259 If ret = FALSE Then
260' Detail.ThrowWinLastErrorIOException("FileStream.Read: Failed to read.")
261 End If
262 End Sub
263
264/* Function GetAccessControl() As FileSecurity
265 FileSecurityの実装がまだできてない。
266 End Function*/
267
268/* GetLifetimeService*/
269
270/* Override Function GetType() As TypeInfo
271 Return Super.GetType()
272 End Function*/
273
274/* InitializeLifetimeService*/
275
276 Sub Lock(position As Int64, length As Int64)
277 disposedCheck()
278 If position < 0 Then
279 Throw New ArgumentOutOfRangeException("FileStream.Lock: An argument is negative value.", New System.Int64(position), "position")
280 ElseIf length < 0 Then
281 Throw New ArgumentOutOfRangeException("FileStream.Lock: An argument is negative value.", New System.Int64(length), "length")
282 End If
283 LockFile(handle, LODWORD(position As QWord), HIDWORD(position As QWord),
284 LODWORD(length As QWord), HIDWORD(length As QWord))
285 End Sub
286
287 Override Function Read(buffer As *Byte, offset As Long, count As Long) As Long
288 disposedCheck()
289 If buffer = 0 Then
290 Throw New ArgumentNullException("FileStream.Read: An argument is null value.", "buffer")
291 ElseIf Not This.CanRead() Then
292 Throw New NotSupportedException("FileStream.Read: This stream is not readable.")
293 End If
294
295 Dim ret As BOOL
296 Dim readBytes As DWord
297 If This.IsAsync() Then
298 Dim overlapped As OVERLAPPED
299 SetQWord(VarPtr(overlapped.Offset), offset)
300 overlapped.hEvent = CreateEvent(0, TRUE, FALSE, 0)
301 If overlapped.hEvent = 0 Then
302 Throw New OutOfMemoryException("FileStream.Read: Failed to create an event object.")
303 End If
304 Try
305 ret = ReadFile(This.handle, VarPtr(buffer[offset]), count, 0, overlapped)
306 If ret = FALSE Then
307 Dim error = GetLastError()
308 If error <> ERROR_IO_PENDING Then
309 Detail.ThrowWinIOException("FileStream.Read: Failed to read.", error)
310 End If
311 End If
312 ret = GetOverlappedResult(This.handle, overlapped, readBytes, TRUE)
313 If ret = FALSE Then
314 Detail.ThrowWinLastErrorIOException("FileStream.Read: Failed to read.")
315 End If
316 offset += Read
317 Finally
318 CloseHandle(overlapped.hEvent)
319 End Try
320 Else
321 ret = ReadFile(This.handle,VarPtr(buffer[offset]),count,VarPtr(readBytes),ByVal NULL)
322 If ret = FALSE Then
323 Detail.ThrowWinLastErrorIOException("FileStream.Read: Failed to read.")
324 End If
325 End If
326 Read = readBytes As Long
327 End Function
328
329 /*!
330 @brief ストリームの現在位置を移動させる。
331 @param[in] offset originからの移動量
332 @param[in] origin 移動の基準位置
333 @return 移動後の新しい現在位置
334 @exception DisposedException 既にストリームが閉じられている場合
335 @exception ArgumentException 移動後の位置が負の位置（ファイル先頭より手前）になる場合
336 @exception IOException その他エラーが発生した場合
337 */
338 Override Function Seek(offset As Int64, origin As SeekOrigin) As Int64
339 disposedCheck()
340 If This.CanSeek() Then
341 If This.IsAsync() Then
342 Select Case origin
343 Case SeekOrigin.Begin
344 This.offset = offset
345 Case SeekOrigin.Current
346 This.offset += offset
347 Case SeekOrigin.End
348 This.offset = This.Length + offset
349 End Select
350 Seek = This.offset As Int64
351 If Seek < 0 Then
352' Throw ArgumentException("FileStream.Seek: Cannot seek to negative offset.")
353 End If
354 Else
355 Dim seek = VarPtr(offset) As *ULARGE_INTEGER
356 Dim ret = SetFilePointer(This.handle, seek->LowPart, VarPtr(seek->HighPart), origin As DWord)
357 If ret = INVALID_SET_FILE_POINTER Then
358 Dim error = GetLastError()
359 If error = ERROR_NEGATIVE_SEEK Then
360' Throw ArgumentException("FileStream.Seek: Cannot seek to negative offset.")
361 ElseIf error <> NO_ERROR Then
362' Throw Detail.ThrowWinIOException("FileStream.Seek: Failed to seek.", error)
363 End If
364 End If
365 seek->LowPart = ret
366 Seek = offset
367 End If
368 End If
369 End Function
370
371/* Sub SetAccessControl(fileSecurity As FileSecurity)
372 FileSecurityの実装がまだできてない。
373 End Sub*/
374
375 Override Sub SetLength(value As Int64)
376 disposedCheck()
377 If This.CanWrite() and This.CanSeek() Then
378 If This.IsAsync() Then
379 Else
380 Dim current = This.Position()
381 This.Position(value)
382 Dim ret = SetEndOfFile(This.handle)
383 If ret = FALSE Then
384 Detail.ThrowWinLastErrorIOException("FileStream.Read: Failed to read.")
385 End If
386 Position = current
387 End If
388 End If
389 End Sub
390
391/* Synchronized*/
392
393 Override Function ToString() As String
394 Return This.Name()
395 End Function
396
397 Sub Unlock(position As Int64, length As Int64)
398 disposedCheck()
399 If position < 0 Then
400 Throw New ArgumentOutOfRangeException("FileStream.Lock: An argument is negative value.", New System.Int64(position), "position")
401 ElseIf length < 0 Then
402 Throw New ArgumentOutOfRangeException("FileStream.Lock: An argument is negative value.", New System.Int64(length), "length")
403 End If
404 Dim ret = UnlockFile(handle, LODWORD(position As QWord), HIDWORD(position As QWord),
405 LODWORD(length As QWord), HIDWORD(length As QWord))
406 If ret = FALSE Then
407 Detail.ThrowWinLastErrorIOException("FileStream.Read: Failed to read.")
408 End If
409 End Sub
410
411 Override Sub Write(buffer As *Byte, offset As Long, count As Long)
412 disposedCheck()
413 If This.CanWrite() Then
414 Dim writeBytes As DWord
415 If This.IsAsync() Then
416 Dim overlapped As OVERLAPPED
417 SetQWord(VarPtr(overlapped.Offset), offset)
418 overlapped.hEvent = CreateEvent(0, TRUE, FALSE, 0)
419 Dim ret = WriteFile(This.handle, VarPtr(buffer[offset]), count, 0, overlapped)
420 If ret <> FALSE Or GetLastError() = ERROR_IO_PENDING Then
421 GetOverlappedResult(This.handle, overlapped, writeBytes, TRUE)
422 End If
423 offset += writeBytes
424 CloseHandle(overlapped.hEvent)
425 Else
426 WriteFile(This.handle, VarPtr(buffer[offset]), count, VarPtr(writeBytes), ByVal NULL)
427 End If
428 End If
429 End Sub
430
431Protected
432 Override Sub Dispose(disposing As Boolean)
433 If handle <> 0 Then
434 Flush()
435 CloseHandle(InterlockedExchangePointer(ByVal VarPtr(handle), NULL))
436 End If
437 End Sub
438
439 Override Function CreateWaitHandle() As System.Threading.WaitHandle
440 Return New System.Threading.AutoResetEvent(False)
441 End Function
442
443Private
444 Sub disposedCheck()
445 If handle = 0 Then
446' Throw ObjectDisposedException("FileStream: This stream has closed.")
447 End If
448 End Sub
449
450End Class
451
452
453End Namespace
454End Namespace
Note: See TracBrowser for help on using the repository browser.