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

Last change on this file since 560 was 560, checked in by dai, 17 years ago

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