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

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

Consoleをスレッド安全化（クリティカルセクション使用）。
Exception.HResultをPublicにした。
StringBuilder.Replaceが正しく機能しない問題を解消。
File size: 13.0 KB
RevLine 
[271]1Namespace System
2Namespace IO
[256]3
[260]4/* ほんとはmiscに入れるかかファイルを分けたほうがいいかもしれないが一先ず実装 */
[256]5Enum FileOptions
[391]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
[256]13End Enum
14
[105]15Class FileStream
[256]16 Inherits Stream
17
18 handle As HANDLE
19
20 /*
[260]21 ファイルハンドルからこれらを取得できれば、これらは入らないが
[256]22 今のところは不明なので自前で実装するしかない
23 */
24 filePath As String
25 fileMode As DWord
26 fileAccess As DWord
27 fileShare As DWord
28 fileOptions As DWord
[432]29 ownsHandle As Boolean
[388]30
31 offset As QWord 'オーバーラップドIO用
[256]32
33Public
[260]34 /* コンストラクタ.NETと同じように実装は難しい、一先ず動くものを実装したが変更が必要だと思う */
[256]35 Sub FileStream(path As String, mode As FileMode, access As FileAccess, share As FileShare, options As FileOptions)
[435]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
[432]43 Dim ac = access As DWord
44 Dim sh = share As DWord
45 Dim mo = mode As DWord
46 Dim op = options As DWord
[426]47' If (Environment.OSVersion.Platform As DWord) <> (PlatformID.Win32NT As DWord) Then 'ToDo: なぜかアクセス違反になる
[391]48 op And= Not FILE_FLAG_OVERLAPPED
[426]49' End If
[256]50
[391]51 This.handle=CreateFile(ToTCStr(path),ac,sh,ByVal NULL,mo,op,0)
[260]52 If This.handle=INVALID_HANDLE_VALUE Then
[256]53 'エラー処理
54 'Throw ArgumentException
55 'Throw IOException
56 'Throw System.IO.FileNotFoundException
[260]57 This.handle=0
[435]58 Detail.ThrowWinLastErrorIOException("Failed to open/create file.")
[256]59 Exit Sub
60 End If
61
[336]62 This.filePath = path
63 This.fileMode = mo
64 This.fileAccess = ac
65 This.fileShare = sh
66 This.fileOptions = op
[388]67 This.offset = 0
[432]68 This.ownsHandle = True
[256]69 End Sub
[260]70 Sub FileStream(path As String, mode As FileMode, access As FileAccess, share As FileShare)
[336]71 This.FileStream(path,mode,access,share,FileOptions.None)
[260]72 End Sub
73 Sub FileStream(path As String, mode As FileMode, access As FileAccess)
[336]74 This.FileStream(path,mode,access,FileShare.None,FileOptions.None)
[260]75 End Sub
[256]76 Sub FileStream(path As String, mode As FileMode)
[260]77 Dim access As FileAccess
[256]78 Select Case mode
79 Case FileMode.Append
[260]80 access=FileAccess.Write
[256]81 Case FileMode.Create
[260]82 access=FileAccess.ReadWrite
[256]83 Case FileMode.CreateNew
[260]84 access=FileAccess.ReadWrite
[256]85 Case FileMode.Open
[260]86 access=FileAccess.ReadWrite
[256]87 Case FileMode.OpenOrCreate
[260]88 access=FileAccess.ReadWrite
[256]89 Case FileMode.Truncate
[260]90 access=FileAccess.Write
[256]91 End Select
[336]92 This.FileStream(path,mode,access,FileShare.None,FileOptions.None)
[256]93 End Sub
[432]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
[256]105Public
[391]106 /*!
107 @brief ファイルが読み込みに対応しているかを返す
108 */
[256]109 Override Function CanRead() As Boolean
[336]110 If This.fileAccess And GENERIC_READ Then
[256]111 Return True
112 Else
113 Return False
114 End If
115 End Function
116
[391]117 /*!
118 @brief ファイルがシークに対応しているかを返す
119 */
[256]120 Override Function CanSeek() As Boolean
[336]121 If GetFileType(This.handle)=FILE_TYPE_DISK Then
122 Return True
123 Else
124 Return False
125 End If
[256]126 End Function
127
[336]128' Override Function CanTimeout() As Boolean
129' /* ファイルがタイムアウトに対応しているかを返す */
130' Return False /*今のところ対応していないのでFalse*/
131' End Function*/
[256]132
[391]133 /*!
134 @brief ファイルが書き込みに対応しているかを返す
135 */
[256]136 Override Function CanWrite() As Boolean
[336]137 If This.fileAccess And GENERIC_WRITE Then
[256]138 Return True
139 Else
140 Return False
141 End If
142 End Function
143
144 /*Handle*/
145
[391]146 /*!
147 @brief ファイルが非同期操作に対応しているかを返す
148 */
[256]149 Function IsAsync() As Boolean
[388]150 If This.fileOptions And FILE_FLAG_OVERLAPPED /*FileOptions.Asynchronous*/ Then
[256]151 Return True
152 Else
153 Return False
154 End If
155 End Function
156
157 Override Function Length() As Int64
[391]158 disposedCheck()
[336]159 If This.CanSeek() Then
[391]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
[336]172 End If
[256]173 End Function
174
175 Function Name() As String
[388]176 Return This.filePath
[256]177 End Function
178
179 Override Sub Position(value As Int64)
[391]180 disposedCheck()
[336]181 If This.CanSeek() Then
182 If This.IsAsync() Then
[388]183 offset = value As QWord
[336]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
[256]190 End If
191 End Sub
192 Override Function Position() As Int64
[391]193 disposedCheck()
[336]194 If This.CanSeek() Then
195 If This.IsAsync() Then
[388]196 Return offset As Int64
[336]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)
[388]201 Return MAKEQWORD(position.LowPart,position.HighPart) As Int64
[336]202 End If
203 End If
[256]204 End Function
205
[336]206/* Override Sub ReadTimeout(value As Long)
[256]207 'TODO
208 End Sub
209 Override Function ReadTimeout() As Long
210 'TODO
[336]211 End Function*/
[256]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
[348]226 Override Function BeginRead(buffer As *Byte, offset As Long, count As Long, callback As AsyncCallback, state As Object) As System.IAsyncResult
[336]227 If This.IsAsync() Then
228 Else
229 Read(buffer,offset,count)
230 End If
[256]231 End Function
232
[348]233 Override Function BeginWrite(buffer As *Byte, offset As Long, count As Long, callback As AsyncCallback, state As Object) As System.IAsyncResult
[336]234 If This.IsAsync() Then
235 Else
236 Write(buffer,offset,count)
237 End If
[256]238 End Function
239
240/* CreateObjRef*/
[348]241
[388]242 Override Function EndRead(asyncResult As System.IAsyncResult) As Long
[256]243 'TODO
[339]244 End Function
[256]245
[388]246 Override Sub EndWrite(asyncResult As System.IAsyncResult)
[256]247 'TODO
[349]248 End Sub
[256]249
250/* Equals*/
251
252 Override Sub Flush()
[391]253 disposedCheck()
254 Dim ret = FlushFileBuffers(This.handle)
255 If ret = FALSE Then
256' Detail.ThrowWinLastErrorIOException("FileStream.Read: Failed to read.")
257 End If
[256]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)
[391]273 disposedCheck()
[388]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))
[256]281 End Sub
282
[426]283 Override Function Read(buffer As *Byte, offset As Long, count As Long) As Long
[391]284 disposedCheck()
285 If buffer = 0 Then
[426]286 Throw New ArgumentNullException("FileStream.Read: An argument is null value.", "buffer")
[391]287 ElseIf Not This.CanRead() Then
[426]288 Throw New NotSupportedException("FileStream.Read: This stream is not readable.")
[391]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
[426]298 Throw New OutOfMemoryException("FileStream.Read: Failed to create an event object.")
[391]299 End If
300 Try
301 ret = ReadFile(This.handle, VarPtr(buffer[offset]), count, 0, overlapped)
[388]302 If ret = FALSE Then
[391]303 Dim error = GetLastError()
304 If error <> ERROR_IO_PENDING Then
[426]305 Detail.ThrowWinIOException("FileStream.Read: Failed to read.", error)
[388]306 End If
307 End If
[391]308 ret = GetOverlappedResult(This.handle, overlapped, readBytes, TRUE)
309 If ret = FALSE Then
[426]310 Detail.ThrowWinLastErrorIOException("FileStream.Read: Failed to read.")
[391]311 End If
[388]312 offset += Read
[391]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
[426]319 Detail.ThrowWinLastErrorIOException("FileStream.Read: Failed to read.")
[336]320 End If
[256]321 End If
[391]322 Read = readBytes As Long
[256]323 End Function
324
[391]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]336 If This.CanSeek() Then
337 If This.IsAsync() Then
338 Select Case origin
339 Case SeekOrigin.Begin
[388]340 This.offset = offset
[336]341 Case SeekOrigin.Current
[388]342 This.offset += offset
[336]343 Case SeekOrigin.End
[388]344 This.offset = This.Length + offset
[336]345 End Select
[391]346 Seek = This.offset As Int64
347 If Seek < 0 Then
348' Throw ArgumentException("FileStream.Seek: Cannot seek to negative offset.")
349 End If
[336]350 Else
[391]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
[336]363 End If
[256]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)
[391]372 disposedCheck()
[336]373 If This.CanWrite() and This.CanSeek() Then
374 If This.IsAsync() Then
375 Else
376 Dim current = This.Position()
377 This.Position(value)
[391]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
[336]383 End If
[256]384 End If
385 End Sub
386
387/* Synchronized*/
388
389 Override Function ToString() As String
[336]390 Return This.Name()
[256]391 End Function
392
393 Sub Unlock(position As Int64, length As Int64)
[391]394 disposedCheck()
[388]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
[391]400 Dim ret = UnlockFile(handle, LODWORD(position As QWord), HIDWORD(position As QWord),
[388]401 LODWORD(length As QWord), HIDWORD(length As QWord))
[391]402 If ret = FALSE Then
403 Detail.ThrowWinLastErrorIOException("FileStream.Read: Failed to read.")
404 End If
[256]405 End Sub
406
[337]407 Override Sub Write(buffer As *Byte, offset As Long, count As Long)
[391]408 disposedCheck()
[336]409 If This.CanWrite() Then
[388]410 Dim writeBytes As DWord
[336]411 If This.IsAsync() Then
[388]412 Dim overlapped As OVERLAPPED
413 SetQWord(VarPtr(overlapped.Offset), offset)
[391]414 overlapped.hEvent = CreateEvent(0, TRUE, FALSE, 0)
[388]415 Dim ret = WriteFile(This.handle, VarPtr(buffer[offset]), count, 0, overlapped)
[391]416 If ret <> FALSE Or GetLastError() = ERROR_IO_PENDING Then
417 GetOverlappedResult(This.handle, overlapped, writeBytes, TRUE)
[388]418 End If
419 offset += writeBytes
[391]420 CloseHandle(overlapped.hEvent)
[336]421 Else
[388]422 WriteFile(This.handle, VarPtr(buffer[offset]), count, VarPtr(writeBytes), ByVal NULL)
[336]423 End If
[256]424 End If
425 End Sub
426
427Protected
[432]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
[262]435 Override Function CreateWaitHandle() As System.Threading.WaitHandle
[432]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
[256]441 End Function
442
[336]443Private
[391]444 Sub disposedCheck()
445 If handle = 0 Then
446' Throw ObjectDisposedException("FileStream: This stream has closed.")
447 End If
448 End Sub
449
[105]450End Class
[271]451
452
453End Namespace
454End Namespace
Note: See TracBrowser for help on using the repository browser.