Context Navigation

FileStream.ab@ 256

Last change on this file since 256 was 256, checked in by NoWest, 19 years ago
同期的なファイル読み込み、書き込みは何とか動くようになってきたが、まだ完成度は4割くらいだと思う。コンストラクタも改善の余地あり。
File size: 9.8 KB

Line
1
2	/* ほんとはmiscかファイルを分けたほうがいいかもしれないが一先ず実装 */
3	Enum FileOptions
4	Asynchronous
5	DeleteOnClose
6	Encrypted
7	None
8	RandomAccess
9	SequentialScan
10	WriteThrough
11	End Enum
12
13	Class FileStream
14	Inherits Stream
15
16	handle As HANDLE
17
18	/*
19	ファイルハンドルからこれらを取得できれば入らないが
20	今のところは不明なので自前で実装するしかない
21	*/
22	filePath As String
23	fileMode As DWord
24	fileAccess As DWord
25	fileShare As DWord
26	fileOptions As DWord
27
28	/* 現在は未使用 */
29	/Overlapped As OVERLAPPED/
30
31	Public
32	/* コンストラクタ.NETと同じように実装は難しい、一先ず動くものを実装したが要変更だと思う */
33	Sub FileStream(path As String, mode As FileMode, access As FileAccess, share As FileShare, options As FileOptions)
34	Dim acc As DWord
35	Dim mod As DWord
36	Dim sha As DWord
37	Dim opt As DWord
38
39	Select Case access
40	Case FileAccess.Read
41	acc=GENERIC_READ
42	Case FileAccess.ReadWrite
43	acc=GENERIC_READ or GENERIC_WRITE
44	Case FileAccess.Write
45	acc=GENERIC_WRITE
46	End Select
47
48	Select Case share
49	Case FileShare.DeleteFile
50	sha=FILE_SHARE_DELETE
51	Case FileShare.None
52	sha=0
53	Case FileShare.Read
54	sha=FILE_SHARE_READ
55	Case FileShare.ReadWrite
56	sha=FILE_SHARE_READ or FILE_SHARE_WRITE
57	Case Write
58	sha=FILE_SHARE_WRITE
59	End Select
60
61	Select Case mode
62	Case FileMode.Append
63	mo=OPEN_ALWAYS
64	Case FileMode.Create
65	mo=CREATE_ALWAYS
66	Case FileMode.CreateNew
67	mo=CREATE_NEW
68	Case FileMode.Open
69	mo=OPEN_EXISTING
70	Case FileMode.OpenOrCreate
71	mo=OPEN_ALWAYS
72	Case FileMode.Truncate
73	mo=TRUNCATE_EXISTING
74	End Select
75
76	Select Case options
77	Case FileOption.Asynchronous
78	opt=FILE_FLAG_OVERLAPPED
79	Case FileOptions.DeleteOnClose
80	opt=FILE_FLAG_DELETE_ON_CLOSE
81	Case FileOptions.Encrypted
82	Case FileOptions.None
83	opt=0
84	Case FileOptions.RandomAccess
85	opt=FILE_FLAG_RANDOM_ACCESS
86	Case FileOptions.SequentialScan
87	opt=FILE_FLAG_SEQUENTIAL_SCAN
88	Case FileOptions.WriteThrough
89	opt=FILE_FLAG_WRITE_THROUGH
90	End Select
91
92	This.handle=CreateFile(path.Chars As PSTR,acc,sha,ByVal NULL,mo,opt,0)
93	If This.handle=HANDLE_INVALIDATE Then
94	'エラー処理
95	'Throw ArgumentException
96	'Throw IOException
97	'Throw System.IO.FileNotFoundException
98	Exit Sub
99	End If
100
101	fileMode = mod
102	fileAccess = acc
103	fileShare = sha
104	fileOptions = opt
105	End Sub
106	Sub FileStream(path As String, mode As FileMode)
107	Dim acc As DWord
108	Dim mo As DWord
109	Select Case mode
110	Case FileMode.Append
111	acc=GENERIC_WRITE
112	mo=OPEN_ALWAYS
113	' OutputDebugString(Ex"append\n")
114	Case FileMode.Create
115	acc=GENERIC_READ or GENERIC_WRITE
116	mo=CREATE_ALWAYS
117	' OutputDebugString(Ex"create\n")
118	Case FileMode.CreateNew
119	acc=GENERIC_READ or GENERIC_WRITE
120	mo=CREATE_NEW
121	' OutputDebugString(Ex"create new\n")
122	Case FileMode.Open
123	acc=GENERIC_READ or GENERIC_WRITE
124	mo=OPEN_EXISTING
125	' OutputDebugString(Ex"open\n")
126	Case FileMode.OpenOrCreate
127	acc=GENERIC_READ or GENERIC_WRITE
128	mo=OPEN_ALWAYS
129	' OutputDebugString(Ex"open or create\n")
130	Case FileMode.Truncate
131	acc=GENERIC_WRITE
132	mo=TRUNCATE_EXISTING
133	' OutputDebugString(Ex"truncate\n")
134	End Select
135
136	'ファイルを作成または開く
137	This.handle=CreateFile(path.Chars As PSTR,acc,0,ByVal NULL,mo,0,0)
138
139	'エラー処理
140	'Throw ArgumentException
141	'Throw IOException
142	'Throw System.IO.FileNotFoundException
143
144
145	'ファイルを作成または開いた後の処理
146	If mode=FileMode.Append Then
147	SetFilePointer(This.handle,0,NULL,FILE_END)
148	End If
149	End Sub
150
151	Sub ~FileStream()
152	This.Flush()
153	This.Close()
154	End Sub
155
156	Public
157	Override Function CanRead() As Boolean
158	/* ファイルが読み込みに対応しているかを返す */
159	If fileAccess=GENERIC_READ/FileAccess.Read/ or fileAccess=GENERIC_READ or GENERIC_WRITE/FileAccess.ReadWrite/ Then
160	Return True
161	Else
162	Return False
163	End If
164	End Function
165
166	Override Function CanSeek() As Boolean
167	/* ファイルがシークに対応しているかを返す */
168	Return True
169	End Function
170
171	Override Function CanTimeout() As Boolean
172	/* ファイルがタイムアウトに対応しているかを返す */
173	Return False /今のところ対応していないのでFalse/
174	End Function
175
176	Override Function CanWrite() As Boolean
177	/* ファイルが書き込みに対応しているかを返す */
178	If fileAccess=GENERIC_WRITE/FileAccess.Write/ or fileAccess=GENERIC_READ or GENERIC_WRITE/FileAccess.ReadWrite/ Then
179	Return True
180	Else
181	Return False
182	End If
183	End Function
184
185	/Handle/
186
187	Function IsAsync() As Boolean
188	/* ファイルが非同期操作に対応しているかを返す */
189	If fileOptions=FILE_FLAG_OVERLAPPED/FileOptions.Asynchronous/ Then
190	Return True
191	Else
192	Return False
193	End If
194	End Function
195
196	Override Function Length() As Int64
197	/* ファイルのサイズの取得 */
198	Dim s As LARGE_INTEGER
199	s.LowPart=GetFileSize(This.handle,VarPtr(s.HighPart) As *DWord)
200	memcpy(VarPtr(Length),VarPtr(s),SizeOf(LARGE_INTEGER))
201	End Function
202
203	Function Name() As String
204	/* 多分文字列をコピーして返す方がいいのと思うが。。。*/
205	Return filePath
206	End Function
207
208	Override Sub Position(value As Int64)
209	/* ファイルポインタの位置の設定 */
210	Dim o As LARGE_INTEGER
211	memcpy(VarPtr(o),VarPtr(value),SizeOf(LARGE_INTEGER))
212	If o.HighPart=0 And value<0 Then
213	o.LowPart=-Abs(o.LowPart) As Long
214	End If
215	Dim ret As LARGE_INTEGER
216	SetFilePointer(This.handle,o.LowPart,VarPtr(o.HighPart) As *DWord,FILE_CURRENT)
217	End Sub
218	Override Function Position() As Int64
219	/* ファイルポインタの位置の取得 */
220	Dim o As LARGE_INTEGER
221	o.HighPart=0
222	o.LowPart=0
223	o.LowPart=SetFilePointer(This.handle,0,VarPtr(o.HighPart) As *DWord,FILE_CURRENT)
224	memcpy(VarPtr(Position),VarPtr(o),SizeOf(LARGE_INTEGER))
225	End Function
226
227	Override Sub ReadTimeout(value As Long)
228	'TODO
229	End Sub
230	Override Function ReadTimeout() As Long
231	'TODO
232	End Function
233
234	/* Safe～Handle系の実装は要相談！！ */
235	/* Function SafeFileHandle() As SafeFileHandle
236	End Function*/
237
238	Override Sub WriteTimeout(value As Long)
239	'TODO
240	End Sub
241	Override Function WriteTimeout() As Long
242	'TODO
243	End Function
244
245
246	Public
247	Override Function BeginRead(ByRef buffer[] As Byte, offset As Long, count As Long, callback As AsyncCallback, state As Object) As IAsyncResult
248	'TODO
249	End Function
250
251	Override Function BeginWrite(ByRef buffer[] As Byte, offset As Long, count As Long, callback As AsyncCallback, state As Object) As IAsyncResult
252	'TODO
253	End Function
254
255	Override Sub Close()
256	CloseHandle(This.handle)
257	End Sub
258
259	/* CreateObjRef*/
260	/* Dispose*/
261
262	Override Sub EndRead(ByRef asyncResult As IAsyncResult)
263	'TODO
264	End Sub
265
266	Override Sub EndWrite(ByRef asyncResult As IAsyncResult)
267	'TODO
268	End Sub
269
270	/* Equals*/
271
272	Override Sub Flush()
273	FlushFileBuffers(This.handle)
274	End Sub
275
276	/* Function GetAccessControl() As FileSecurity
277	FileSecurityの実装がまだできてない。
278	End Function*/
279
280	Override Function GetHashCode() As Long
281	Return ObjPtr(This) As Long
282	End Function
283
284	/* GetLifetimeService*/
285
286	/* Override Function GetType() As TypeInfo
287	Return Super.GetType()
288	End Function*/
289
290	/* InitializeLifetimeService*/
291
292	Sub Lock(position As Int64, length As Int64)
293	Dim p As LARGE_INTEGER
294	Dim l As LARGE_INTEGER
295	memcpy(VarPtr(p),VarPtr(position),SizeOf(LARGE_INTEGER))
296	memcpy(VarPtr(l),VarPtr(length),SizeOf(LARGE_INTEGER))
297	LockFile(This.handle,p.LowPart,p.HighPart,l.LowPart,l.HighPart)
298	End Sub
299
300	Override Function Read(ByRef buffer[] As Byte, offset As Long, count As Long) As Long
301	If offset Then
302	SetFilePointer(This.handle,offset,NULL,FILE_CURRENT)
303	End If
304	ReadFile(This.handle,buffer,count,VarPtr(Read) As *DWord,ByVal NULL)
305	End Function
306
307	Override Function ReadByte() As Long
308	Dim b As Byte
309	Dim ret = Read(b, 0, 1)
310	If ret <> 0 Then
311	Return b As Long
312	Else
313	Return -1
314	End If
315	End Function
316	/* ReferenceEquals*/
317
318	Override Function Seek(offset As Int64, origin As SeekOrigin) As Long
319	Dim o As LARGE_INTEGER
320	memcpy(VarPtr(o),VarPtr(offset),SizeOf(LARGE_INTEGER))
321	If o.HighPart=0 And offset<0 Then
322	o.LowPart=-o.LowPart
323	End If
324	Select Case origin
325	Case SeekOrigin.Begin
326	SetFilePointer(This.handle,o.LowPart,VarPtr(o.HighPart) As *DWord,FILE_BEGIN)
327	Case SeekOrigin.Current
328	SetFilePointer(This.handle,o.LowPart,VarPtr(o.HighPart) As *DWord,FILE_CURRENT)
329	Case SeekOrigin.End
330	SetFilePointer(This.handle,o.LowPart,VarPtr(o.HighPart) As *DWord,FILE_END)
331	End Select
332	End Function
333
334	/* Sub SetAccessControl(fileSecurity As FileSecurity)
335	FileSecurityの実装がまだできてない。
336	End Sub*/
337
338	Override Sub SetLength(value As Int64)
339	Dim o As LARGE_INTEGER
340	memcpy(VarPtr(o),VarPtr(value),SizeOf(LARGE_INTEGER))
341	If o.HighPart=0 And value<0 Then
342	o.LowPart=-o.LowPart
343	End If
344	If Length()=>value Then
345	SetFilePointer(This.handle,o.LowPart,VarPtr(o.HighPart) As *DWord,FILE_BEGIN)
346	SetEndOfFile(This.handle)
347	End If
348	End Sub
349
350	/* Synchronized*/
351
352	Override Function ToString() As String
353	Return Name()
354	End Function
355
356	Sub Unlock(position As Int64, length As Int64)
357	Dim p As LARGE_INTEGER
358	Dim l As LARGE_INTEGER
359	memcpy(VarPtr(p),VarPtr(position),SizeOf(LARGE_INTEGER))
360	memcpy(VarPtr(l),VarPtr(length),SizeOf(LARGE_INTEGER))
361	UnlockFile(This.handle,p.LowPart,p.HighPart,l.LowPart,l.HighPart)
362	End Sub
363
364	Override Sub Write(ByRef buffer[] As Byte, offset As Long, count As Long)
365	If offset Then
366	SetFilePointer(This.handle,offset,NULL,FILE_CURRENT)
367	End If
368	Dim ret As DWord
369	WriteFile(This.handle,buffer,count,VarPtr(ret),ByVal NULL)
370	End Sub
371
372	Override Sub WriteByte(b As Byte)
373	Write(b, 0, 1)
374	End Sub
375
376	Protected
377	/非同期ファイル操作に必須だがどうやって実装しようか検討中/
378	Override Function CreateWaitHandle() As WaitHandle
379	' Return Nothing
380	End Function
381
382	/* Dispose
383	Finalize
384	MemberwiseClone*/
385	End Class

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format