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

Last change on this file since 435 was 435, checked in by イグトランス (egtra), 16 years ago

Consoleをスレッド安全化（クリティカルセクション使用）。
Exception.HResultをPublicにした。
StringBuilder.Replaceが正しく機能しない問題を解消。
File size: 13.0 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 End Sub
70 Sub FileStream(path As String, mode As FileMode, access As FileAccess, share As FileShare)
71 This.FileStream(path,mode,access,share,FileOptions.None)
72 End Sub
73 Sub FileStream(path As String, mode As FileMode, access As FileAccess)
74 This.FileStream(path,mode,access,FileShare.None,FileOptions.None)
75 End Sub
76 Sub FileStream(path As String, mode As FileMode)
77 Dim access As FileAccess
78 Select Case mode
79 Case FileMode.Append
80 access=FileAccess.Write
81 Case FileMode.Create
82 access=FileAccess.ReadWrite
83 Case FileMode.CreateNew
84 access=FileAccess.ReadWrite
85 Case FileMode.Open
86 access=FileAccess.ReadWrite
87 Case FileMode.OpenOrCreate
88 access=FileAccess.ReadWrite
89 Case FileMode.Truncate
90 access=FileAccess.Write
91 End Select
92 This.FileStream(path,mode,access,FileShare.None,FileOptions.None)
93 End Sub
94 /*
95 @date 2008/02/26
96 @auther Egtra
97 '不要になったら削除すること
98 */
99 Sub FileStream(h As HANDLE, access As FileAccess, owns As Boolean)
100 handle = h
101 fileAccess = access As DWord
102 ownsHandle = owns
103 End Sub
104
105Public
106 /*!
107 @brief ファイルが読み込みに対応しているかを返す
108 */
109 Override Function CanRead() As Boolean
110 If This.fileAccess And GENERIC_READ Then
111 Return True
112 Else
113 Return False
114 End If
115 End Function
116
117 /*!
118 @brief ファイルがシークに対応しているかを返す
119 */
120 Override Function CanSeek() As Boolean
121 If GetFileType(This.handle)=FILE_TYPE_DISK Then
122 Return True
123 Else
124 Return False
125 End If
126 End Function
127
128' Override Function CanTimeout() As Boolean
129' /* ファイルがタイムアウトに対応しているかを返す */
130' Return False /*今のところ対応していないのでFalse*/
131' End Function*/
132
133 /*!
134 @brief ファイルが書き込みに対応しているかを返す
135 */
136 Override Function CanWrite() As Boolean
137 If This.fileAccess And GENERIC_WRITE Then
138 Return True
139 Else
140 Return False
141 End If
142 End Function
143
144 /*Handle*/
145
146 /*!
147 @brief ファイルが非同期操作に対応しているかを返す
148 */
149 Function IsAsync() As Boolean
150 If This.fileOptions And FILE_FLAG_OVERLAPPED /*FileOptions.Asynchronous*/ Then
151 Return True
152 Else
153 Return False
154 End If
155 End Function
156
157 Override Function Length() As Int64
158 disposedCheck()
159 If This.CanSeek() Then
160 Dim length = VarPtr(Length) As *ULARGE_INTEGER
161 length->LowPart = GetFileSize(This.handle, VarPtr(length->HighPart))
162 If LODWORD(Length) = INVALID_FILE_SIZE Then
163 Dim error = GetLastError()
164 If error <> NO_ERROR Then
165' Detail.ThrowWinIOException("FileStream.Read: Failed to read.", error)
166 End If
167 End If
168
169 If Length < 0 Then
170 Debug 'Throw OverflowException
171 End If
172 End If
173 End Function
174
175 Function Name() As String
176 Return This.filePath
177 End Function
178
179 Override Sub Position(value As Int64)
180 disposedCheck()
181 If This.CanSeek() Then
182 If This.IsAsync() Then
183 offset = value As QWord
184 Else
185 Dim position As LARGE_INTEGER
186 position.LowPart=LODWORD(value)
187 position.HighPart=HIDWORD(value)
188 SetFilePointer(This.handle,position.LowPart,VarPtr(position.HighPart) As *DWord,FILE_BEGIN)
189 End If
190 End If
191 End Sub
192 Override Function Position() As Int64
193 disposedCheck()
194 If This.CanSeek() Then
195 If This.IsAsync() Then
196 Return offset As Int64
197 Else
198 Dim position As LARGE_INTEGER
199 ZeroMemory(VarPtr(position),SizeOf(LARGE_INTEGER))
200 position.LowPart=SetFilePointer(This.handle,position.LowPart,VarPtr(position.HighPart) As *DWord,FILE_CURRENT)
201 Return MAKEQWORD(position.LowPart,position.HighPart) As Int64
202 End If
203 End If
204 End Function
205
206/* Override Sub ReadTimeout(value As Long)
207 'TODO
208 End Sub
209 Override Function ReadTimeout() As Long
210 'TODO
211 End Function*/
212
213 /* Safe～Handle系の実装は要相談！！ */
214/* Function SafeFileHandle() As SafeFileHandle
215 End Function*/
216
217 Override Sub WriteTimeout(value As Long)
218 'TODO
219 End Sub
220 Override Function WriteTimeout() As Long
221 'TODO
222 End Function
223
224
225Public
226 Override Function BeginRead(buffer As *Byte, offset As Long, count As Long, callback As AsyncCallback, state As Object) As System.IAsyncResult
227 If This.IsAsync() Then
228 Else
229 Read(buffer,offset,count)
230 End If
231 End Function
232
233 Override Function BeginWrite(buffer As *Byte, offset As Long, count As Long, callback As AsyncCallback, state As Object) As System.IAsyncResult
234 If This.IsAsync() Then
235 Else
236 Write(buffer,offset,count)
237 End If
238 End Function
239
240/* CreateObjRef*/
241
242 Override Function EndRead(asyncResult As System.IAsyncResult) As Long
243 'TODO
244 End Function
245
246 Override Sub EndWrite(asyncResult As System.IAsyncResult)
247 'TODO
248 End Sub
249
250/* Equals*/
251
252 Override Sub Flush()
253 disposedCheck()
254 Dim ret = FlushFileBuffers(This.handle)
255 If ret = FALSE Then
256' Detail.ThrowWinLastErrorIOException("FileStream.Read: Failed to read.")
257 End If
258 End Sub
259
260/* Function GetAccessControl() As FileSecurity
261 FileSecurityの実装がまだできてない。
262 End Function*/
263
264/* GetLifetimeService*/
265
266/* Override Function GetType() As TypeInfo
267 Return Super.GetType()
268 End Function*/
269
270/* InitializeLifetimeService*/
271
272 Sub Lock(position As Int64, length As Int64)
273 disposedCheck()
274 If position < 0 Then
275 Throw New ArgumentOutOfRangeException("FileStream.Lock: An argument is negative value.", New System.Int64(position), "position")
276 ElseIf length < 0 Then
277 Throw New ArgumentOutOfRangeException("FileStream.Lock: An argument is negative value.", New System.Int64(length), "length")
278 End If
279 LockFile(handle, LODWORD(position As QWord), HIDWORD(position As QWord),
280 LODWORD(length As QWord), HIDWORD(length As QWord))
281 End Sub
282
283 Override Function Read(buffer As *Byte, offset As Long, count As Long) As Long
284 disposedCheck()
285 If buffer = 0 Then
286 Throw New ArgumentNullException("FileStream.Read: An argument is null value.", "buffer")
287 ElseIf Not This.CanRead() Then
288 Throw New NotSupportedException("FileStream.Read: This stream is not readable.")
289 End If
290
291 Dim ret As BOOL
292 Dim readBytes As DWord
293 If This.IsAsync() Then
294 Dim overlapped As OVERLAPPED
295 SetQWord(VarPtr(overlapped.Offset), offset)
296 overlapped.hEvent = CreateEvent(0, TRUE, FALSE, 0)
297 If overlapped.hEvent = 0 Then
298 Throw New OutOfMemoryException("FileStream.Read: Failed to create an event object.")
299 End If
300 Try
301 ret = ReadFile(This.handle, VarPtr(buffer[offset]), count, 0, overlapped)
302 If ret = FALSE Then
303 Dim error = GetLastError()
304 If error <> ERROR_IO_PENDING Then
305 Detail.ThrowWinIOException("FileStream.Read: Failed to read.", error)
306 End If
307 End If
308 ret = GetOverlappedResult(This.handle, overlapped, readBytes, TRUE)
309 If ret = FALSE Then
310 Detail.ThrowWinLastErrorIOException("FileStream.Read: Failed to read.")
311 End If
312 offset += Read
313 Finally
314 CloseHandle(overlapped.hEvent)
315 End Try
316 Else
317 ret = ReadFile(This.handle,VarPtr(buffer[offset]),count,VarPtr(readBytes),ByVal NULL)
318 If ret = FALSE Then
319 Detail.ThrowWinLastErrorIOException("FileStream.Read: Failed to read.")
320 End If
321 End If
322 Read = readBytes As Long
323 End Function
324
325 /*!
326 @brief ストリームの現在位置を移動させる。
327 @param[in] offset originからの移動量
328 @param[in] origin 移動の基準位置
329 @return 移動後の新しい現在位置
330 @exception DisposedException 既にストリームが閉じられている場合
331 @exception ArgumentException 移動後の位置が負の位置（ファイル先頭より手前）になる場合
332 @exception IOException その他エラーが発生した場合
333 */
334 Override Function Seek(offset As Int64, origin As SeekOrigin) As Int64
335 disposedCheck()
336 If This.CanSeek() Then
337 If This.IsAsync() Then
338 Select Case origin
339 Case SeekOrigin.Begin
340 This.offset = offset
341 Case SeekOrigin.Current
342 This.offset += offset
343 Case SeekOrigin.End
344 This.offset = This.Length + offset
345 End Select
346 Seek = This.offset As Int64
347 If Seek < 0 Then
348' Throw ArgumentException("FileStream.Seek: Cannot seek to negative offset.")
349 End If
350 Else
351 Dim seek = VarPtr(offset) As *ULARGE_INTEGER
352 Dim ret = SetFilePointer(This.handle, seek->LowPart, VarPtr(seek->HighPart), origin As DWord)
353 If ret = INVALID_SET_FILE_POINTER Then
354 Dim error = GetLastError()
355 If error = ERROR_NEGATIVE_SEEK Then
356' Throw ArgumentException("FileStream.Seek: Cannot seek to negative offset.")
357 ElseIf error <> NO_ERROR Then
358' Throw Detail.ThrowWinIOException("FileStream.Seek: Failed to seek.", error)
359 End If
360 End If
361 seek->LowPart = ret
362 Seek = offset
363 End If
364 End If
365 End Function
366
367/* Sub SetAccessControl(fileSecurity As FileSecurity)
368 FileSecurityの実装がまだできてない。
369 End Sub*/
370
371 Override Sub SetLength(value As Int64)
372 disposedCheck()
373 If This.CanWrite() and This.CanSeek() Then
374 If This.IsAsync() Then
375 Else
376 Dim current = This.Position()
377 This.Position(value)
378 Dim ret = SetEndOfFile(This.handle)
379 If ret = FALSE Then
380 Detail.ThrowWinLastErrorIOException("FileStream.Read: Failed to read.")
381 End If
382 Position = current
383 End If
384 End If
385 End Sub
386
387/* Synchronized*/
388
389 Override Function ToString() As String
390 Return This.Name()
391 End Function
392
393 Sub Unlock(position As Int64, length As Int64)
394 disposedCheck()
395 If position < 0 Then
396 Throw New ArgumentOutOfRangeException("FileStream.Lock: An argument is negative value.", New System.Int64(position), "position")
397 ElseIf length < 0 Then
398 Throw New ArgumentOutOfRangeException("FileStream.Lock: An argument is negative value.", New System.Int64(length), "length")
399 End If
400 Dim ret = UnlockFile(handle, LODWORD(position As QWord), HIDWORD(position As QWord),
401 LODWORD(length As QWord), HIDWORD(length As QWord))
402 If ret = FALSE Then
403 Detail.ThrowWinLastErrorIOException("FileStream.Read: Failed to read.")
404 End If
405 End Sub
406
407 Override Sub Write(buffer As *Byte, offset As Long, count As Long)
408 disposedCheck()
409 If This.CanWrite() Then
410 Dim writeBytes As DWord
411 If This.IsAsync() Then
412 Dim overlapped As OVERLAPPED
413 SetQWord(VarPtr(overlapped.Offset), offset)
414 overlapped.hEvent = CreateEvent(0, TRUE, FALSE, 0)
415 Dim ret = WriteFile(This.handle, VarPtr(buffer[offset]), count, 0, overlapped)
416 If ret <> FALSE Or GetLastError() = ERROR_IO_PENDING Then
417 GetOverlappedResult(This.handle, overlapped, writeBytes, TRUE)
418 End If
419 offset += writeBytes
420 CloseHandle(overlapped.hEvent)
421 Else
422 WriteFile(This.handle, VarPtr(buffer[offset]), count, VarPtr(writeBytes), ByVal NULL)
423 End If
424 End If
425 End Sub
426
427Protected
428 Override Sub Dispose(disposing As Boolean)
429 If handle <> 0 Then
430 Flush()
431 CloseHandle(InterlockedExchangePointer(VarPtr(handle), NULL))
432 End If
433 End Sub
434
435 Override Function CreateWaitHandle() As System.Threading.WaitHandle
436 '調査した限りでは、System.Threading.EventWaitHandleクラスをNewする模様。
437 '現状ではSystem.Threading.WaitHandleクラスをNewしてからHandleにて設定
438 Dim wh As System.Threading.WaitHandle
439 wh.Handle=CreateEvent(NULL,TRUE,FALSE,NULL)
440 Return wh
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.