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

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

Stringなどで例外を投げるようにした。
#147の解決。
CType ASCII文字判定関数群の追加。

File size: 11.2 KB
Line 
1Namespace System
2Namespace IO
3
4/* ほんとはmiscに入れるかかファイルを分けたほうがいいかもしれないが一先ず実装 */
5Enum FileOptions
6 Asynchronous
7 DeleteOnClose
8 Encrypted
9 None
10 RandomAccess
11 SequentialScan
12 WriteThrough
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
30 offset As QWord 'オーバーラップドIO用
31
32Public
33 /* コンストラクタ.NETと同じように実装は難しい、一先ず動くものを実装したが変更が必要だと思う */
34 Sub FileStream(path As String, mode As FileMode, access As FileAccess, share As FileShare, options As FileOptions)
35 Dim ac As DWord
36 Dim mo As DWord
37 Dim sh As DWord
38 Dim op As DWord
39
40 Select Case access
41 Case FileAccess.Read
42 ac=GENERIC_READ
43 Case FileAccess.ReadWrite
44 ac=GENERIC_READ or GENERIC_WRITE
45 Case FileAccess.Write
46 ac=GENERIC_WRITE
47 End Select
48
49 Select Case share
50 Case FileShare.DeleteFile
51 sh=FILE_SHARE_DELETE
52 Case FileShare.None
53 sh=0
54 Case FileShare.Read
55 sh=FILE_SHARE_READ
56 Case FileShare.ReadWrite
57 sh=FILE_SHARE_READ or FILE_SHARE_WRITE
58 Case FileShare.Write
59 sh=FILE_SHARE_WRITE
60 End Select
61
62 Select Case mode
63 Case FileMode.Append
64 mo=OPEN_ALWAYS
65 Case FileMode.Create
66 mo=CREATE_ALWAYS
67 Case FileMode.CreateNew
68 mo=CREATE_NEW
69 Case FileMode.Open
70 mo=OPEN_EXISTING
71 Case FileMode.OpenOrCreate
72 mo=OPEN_ALWAYS
73 Case FileMode.Truncate
74 mo=TRUNCATE_EXISTING
75 End Select
76
77 Select Case options
78 Case FileOptions.Asynchronous
79 op=FILE_FLAG_OVERLAPPED
80 Case FileOptions.DeleteOnClose
81 op=FILE_FLAG_DELETE_ON_CLOSE
82 Case FileOptions.Encrypted
83 Case FileOptions.None
84 op=0
85 Case FileOptions.RandomAccess
86 op=FILE_FLAG_RANDOM_ACCESS
87 Case FileOptions.SequentialScan
88 op=FILE_FLAG_SEQUENTIAL_SCAN
89 Case FileOptions.WriteThrough
90 op=FILE_FLAG_WRITE_THROUGH
91 End Select
92
93 This.handle=CreateFile(path As PSTR,ac,sh,ByVal NULL,mo,op,0)
94 If This.handle=INVALID_HANDLE_VALUE Then
95 'エラー処理
96 'Throw ArgumentException
97 'Throw IOException
98 'Throw System.IO.FileNotFoundException
99 This.handle=0
100 Beep(220,500)
101 Exit Sub
102 End If
103
104 This.filePath = path
105 This.fileMode = mo
106 This.fileAccess = ac
107 This.fileShare = sh
108 This.fileOptions = op
109 This.offset = 0
110 End Sub
111 Sub FileStream(path As String, mode As FileMode, access As FileAccess, share As FileShare)
112 This.FileStream(path,mode,access,share,FileOptions.None)
113 End Sub
114 Sub FileStream(path As String, mode As FileMode, access As FileAccess)
115 This.FileStream(path,mode,access,FileShare.None,FileOptions.None)
116 End Sub
117 Sub FileStream(path As String, mode As FileMode)
118 Dim access As FileAccess
119 Select Case mode
120 Case FileMode.Append
121 access=FileAccess.Write
122 Case FileMode.Create
123 access=FileAccess.ReadWrite
124 Case FileMode.CreateNew
125 access=FileAccess.ReadWrite
126 Case FileMode.Open
127 access=FileAccess.ReadWrite
128 Case FileMode.OpenOrCreate
129 access=FileAccess.ReadWrite
130 Case FileMode.Truncate
131 access=FileAccess.Write
132 End Select
133 This.FileStream(path,mode,access,FileShare.None,FileOptions.None)
134 End Sub
135Public
136 Override Function CanRead() As Boolean
137 /* ファイルが読み込みに対応しているかを返す */
138 If This.fileAccess And GENERIC_READ Then
139 Return True
140 Else
141 Return False
142 End If
143 End Function
144
145 Override Function CanSeek() As Boolean
146 /* ファイルがシークに対応しているかを返す */
147 If GetFileType(This.handle)=FILE_TYPE_DISK Then
148 Return True
149 Else
150 Return False
151 End If
152 End Function
153
154' Override Function CanTimeout() As Boolean
155' /* ファイルがタイムアウトに対応しているかを返す */
156' Return False /*今のところ対応していないのでFalse*/
157' End Function*/
158
159 Override Function CanWrite() As Boolean
160 /* ファイルが書き込みに対応しているかを返す */
161 If This.fileAccess And GENERIC_WRITE Then
162 Return True
163 Else
164 Return False
165 End If
166 End Function
167
168 /*Handle*/
169
170 Function IsAsync() As Boolean
171 /* ファイルが非同期操作に対応しているかを返す */
172 If This.fileOptions And FILE_FLAG_OVERLAPPED /*FileOptions.Asynchronous*/ Then
173 Return True
174 Else
175 Return False
176 End If
177 End Function
178
179 Override Function Length() As Int64
180 If This.CanSeek() Then
181 Dim length As LARGE_INTEGER
182 length.LowPart=GetFileSize(This.handle,VarPtr(length.HighPart) As *DWord)
183 Return MAKEQWORD(length.LowPart,length.HighPart) As Int64
184 End If
185 End Function
186
187 Function Name() As String
188 Return This.filePath
189 End Function
190
191 Override Sub Position(value As Int64)
192 If This.CanSeek() Then
193 If This.IsAsync() Then
194 offset = value As QWord
195 Else
196 Dim position As LARGE_INTEGER
197 position.LowPart=LODWORD(value)
198 position.HighPart=HIDWORD(value)
199 SetFilePointer(This.handle,position.LowPart,VarPtr(position.HighPart) As *DWord,FILE_BEGIN)
200 End If
201 End If
202 End Sub
203 Override Function Position() As Int64
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 Sub Dispose(disposing As Boolean)
253 Flush()
254 CloseHandle(InterlockedExchangePointer(VarPtr(This.handle),NULL))
255 End Sub
256
257 Override Function EndRead(asyncResult As System.IAsyncResult) As Long
258 'TODO
259 End Function
260
261 Override Sub EndWrite(asyncResult As System.IAsyncResult)
262 'TODO
263 End Sub
264
265/* Equals*/
266
267 Override Sub Flush()
268 FlushFileBuffers(This.handle)
269 End Sub
270
271/* Function GetAccessControl() As FileSecurity
272 FileSecurityの実装がまだできてない。
273 End Function*/
274
275 Override Function GetHashCode() As Long
276 Return ObjPtr(This) As Long
277 End Function
278
279/* GetLifetimeService*/
280
281/* Override Function GetType() As TypeInfo
282 Return Super.GetType()
283 End Function*/
284
285/* InitializeLifetimeService*/
286
287 Sub Lock(position As Int64, length As Int64)
288 If position < 0 Then
289 Throw New ArgumentOutOfRangeException("FileStream.Lock: An argument is negative value.", New System.Int64(position), "position")
290 ElseIf length < 0 Then
291 Throw New ArgumentOutOfRangeException("FileStream.Lock: An argument is negative value.", New System.Int64(length), "length")
292 End If
293 LockFile(handle, LODWORD(position As QWord), HIDWORD(position As QWord),
294 LODWORD(length As QWord), HIDWORD(length As QWord))
295 End Sub
296
297 Override Function Read( buffer As *Byte, offset As Long, count As Long) As Long
298 If This.CanRead() Then
299 Dim readBytes As DWord
300 If This.IsAsync() Then
301 Dim overlapped As OVERLAPPED
302 SetQWord(VarPtr(overlapped.Offset), offset)
303 Dim ret = ReadFile(This.handle, VarPtr(buffer[offset]), count, 0, overlapped)
304 If ret = FALSE Then
305 If GetLastError() = ERROR_IO_PENDING Then
306 GetOverlappedResult(This.handle, overlapped, readBytes, TRUE)
307 End If
308 End If
309 offset += Read
310 Else
311 ReadFile(This.handle,VarPtr(buffer[offset]),count,VarPtr(readBytes),ByVal NULL)
312 End If
313 Read = readBytes As Long
314 End If
315 End Function
316
317/* ReferenceEquals*/
318
319 Override Function Seek(offset As Int64, origin As SeekOrigin) As Long
320 If This.CanSeek() Then
321 If This.IsAsync() Then
322 Select Case origin
323 Case SeekOrigin.Begin
324 This.offset = offset
325 Case SeekOrigin.Current
326 This.offset += offset
327 Case SeekOrigin.End
328 This.offset = This.Length + offset
329 End Select
330 Else
331 Dim seek As LARGE_INTEGER
332 seek.LowPart=LODWORD(offset)
333 seek.HighPart=HIDWORD(offset)
334 Select Case origin
335 Case SeekOrigin.Begin
336 Return SetFilePointer(This.handle,seek.LowPart,VarPtr(seek.HighPart) As *DWord,FILE_BEGIN)
337 Case SeekOrigin.Current
338 Return SetFilePointer(This.handle,seek.LowPart,VarPtr(seek.HighPart) As *DWord,FILE_CURRENT)
339 Case SeekOrigin.End
340 Return SetFilePointer(This.handle,seek.LowPart,VarPtr(seek.HighPart) As *DWord,FILE_CURRENT)
341 End Select
342 End If
343 End If
344 End Function
345
346/* Sub SetAccessControl(fileSecurity As FileSecurity)
347 FileSecurityの実装がまだできてない。
348 End Sub*/
349
350 Override Sub SetLength(value As Int64)
351 If This.CanWrite() and This.CanSeek() Then
352 If This.IsAsync() Then
353 Else
354 Dim current = This.Position()
355 This.Position(value)
356 SetEndOfFile(This.handle)
357 End If
358 End If
359 End Sub
360
361/* Synchronized*/
362
363 Override Function ToString() As String
364 Return This.Name()
365 End Function
366
367 Sub Unlock(position As Int64, length As Int64)
368 If position < 0 Then
369 Throw New ArgumentOutOfRangeException("FileStream.Lock: An argument is negative value.", New System.Int64(position), "position")
370 ElseIf length < 0 Then
371 Throw New ArgumentOutOfRangeException("FileStream.Lock: An argument is negative value.", New System.Int64(length), "length")
372 End If
373 UnlockFile(handle, LODWORD(position As QWord), HIDWORD(position As QWord),
374 LODWORD(length As QWord), HIDWORD(length As QWord))
375 End Sub
376
377
378 Override Sub Write(buffer As *Byte, offset As Long, count As Long)
379 If This.CanWrite() Then
380 Dim writeBytes As DWord
381 If This.IsAsync() Then
382 Dim overlapped As OVERLAPPED
383 SetQWord(VarPtr(overlapped.Offset), offset)
384 Dim ret = WriteFile(This.handle, VarPtr(buffer[offset]), count, 0, overlapped)
385 If ret = FALSE Then
386 If GetLastError() = ERROR_IO_PENDING Then
387 GetOverlappedResult(This.handle, overlapped, writeBytes, TRUE)
388 End If
389 End If
390 offset += writeBytes
391 Else
392 WriteFile(This.handle, VarPtr(buffer[offset]), count, VarPtr(writeBytes), ByVal NULL)
393 End If
394 End If
395 End Sub
396
397
398Protected
399 Override Function CreateWaitHandle() As System.Threading.WaitHandle
400 '調査した限りでは、System.Threading.EventWaitHandleクラスをNewする模様。
401 '現状ではSystem.Threading.WaitHandleクラスをNewしてからHandleにて設定
402 Dim wh As System.Threading.WaitHandle
403 wh.Handle=CreateEvent(NULL,TRUE,FALSE,NULL)
404 Return wh
405 End Function
406
407/* Dispose
408 Finalize
409 MemberwiseClone*/
410Private
411End Class
412
413
414End Namespace
415End Namespace
Note: See TracBrowser for help on using the repository browser.