1 { $O+,F+,I-,S-,R-,V-}
2 {$I-}
3 Unit MKFFile; {Buffered File Object Unit}
4
5 {$IfDef FPC}
6 {$PackRecords 1}
7 {$EndIf}
8
9 Interface
10
11 Type FBufType = Array[0..$fff0] of Byte;
12
13 Type FFileObj = Object
14 BufFile: File; {File to be buffered}
15 Buf: ^FBufType; {Pointer to the buffer-actual size given by init}
16 BufStart: LongInt; {File position of buffer start}
17 BufSize: LongInt; {Size of the buffer}
18 {$IFDEF VirtualPascal}
19 BufChars: LongInt;
20 {$ELSE}
21 BufChars: Word; {Number of valid characters in the buffer}
22 {$ENDIF}
23 CurrSize: LongInt; {Current file size}
24 NeedWritten: Boolean; {Buffer dirty/needs written flag}
25 IsOpen: Boolean; {File is currently open flag}
26 CurrPos: LongInt; {Current position in file/buffer}
27 Constructor Init(BSize: Word);
28 {Initialize object and set buffer size/allocate memory}
29 Destructor Done; Virtual; {Done}
OpenFilenull30 Function OpenFile(FName: String; FMode: Word): Boolean; Virtual;
31 {Open a file FNAME in the filemode FMode}
CloseFilenull32 Function CloseFile: Boolean; Virtual; {Close the currently open file}
BlkReadnull33 Function BlkRead(Var V; Num: Word; Var NumRead: Word): Boolean; Virtual;
34 {Equivalent to BlockRead but makes use of buffer to reduce real reads}
BlkWritenull35 Function BlkWrite(Var V; Num: Word): Boolean; Virtual;
36 {Equivalent to BlockWrite but uses buffer to reduce real writes}
SeekFilenull37 Function SeekFile(FP: LongInt): Boolean; Virtual;
38 {Equivalent to seek but uses buffer to reduce real seeks}
WriteBuffernull39 Function WriteBuffer: Boolean; Virtual;
40 {Internal use normally - flushes buffer if needed}
ReadBuffernull41 Function ReadBuffer: Boolean; Virtual;
42 {Internal use normally - refills buffer}
RawSizenull43 Function RawSize: LongInt; Virtual;
44 {Pass through to filesize function}
FilePosnull45 Function FilePos: LongInt; Virtual;
46 End;
47
48
49 Implementation
50
51 Uses MKFile
52 {$IfDef WINDOWS}
53 , WinDOS
54 {$Else}
55 , DOS
56 {$IfDef OPRO}
57 , OpCRT
58 {$Else}
59 {$IfNDef FPC}
60 , CRT
61 {$EndIf}
62 {$EndIf}
63 {$EndIf}
64 ;
65
66 Constructor FFileObj.Init(BSize: Word);
67 Begin
68 Buf := Nil;
69 BufSize := BSize;
70 BufStart := 0; {Invalidate buffer}
71 BufChars := 0;
72 IsOpen := False; {Initialize values}
73 NeedWritten := False;
74 CurrPos := 0;
75 GetMem(Buf, BufSize); {Allocate memory for buffer}
76 If Buf = Nil Then
77 Fail;
78 End;
79
80
81 Destructor FFileObj.Done;
82 Begin
83 If IsOpen Then CloseFile;
84 If Buf <> Nil Then FreeMem(Buf, BufSize);
85 End;
86
87
88
FFileObj.OpenFilenull89 Function FFileObj.OpenFile(FName: String; FMode: Word): Boolean;
90 Var
91 DoneOk: Boolean;
92
93 Begin
94 If IoResult <> 0 Then; {protect against unchecked errors in calling proc}
95 DoneOk := True;
96 If IsOpen Then CloseFile;
97 If DoneOk Then Begin {Create file if needed}
98 If Not FileExist(FName) Then
99 DoneOk := SaveFile(FName, DoneOk, 0) = 0;
100 End;
101 If DoneOk Then
102 Begin {open file}
103 Assign(BufFile, FName);
104 FileMode := FMode;
105 If DoneOk Then
106 DoneOk := shReset(BufFile, 1);
107 IsOpen := DoneOk;
108 CurrPos := 0; {Initialize file position}
109 BufStart := 0; {Invalidate buffer}
110 BufChars := 0;
111 NeedWritten := False;
112 CurrSize := RawSize;
113 End;
114 OpenFile := DoneOk;
115 End;
116
117
FFileObj.CloseFilenull118 Function FFileObj.CloseFile: Boolean;
119 Var
120 DoneOk: Boolean;
121
122 Begin
123 If not IsOpen then Exit;
124 If IoResult <> 0 Then;
125 DoneOk := True;
126 If NeedWritten Then DoneOk := WriteBuffer;
127 If DoneOk Then Begin
128 Close(BufFile); {Close file}
129 DoneOk := (IoResult = 0);
130 End;
131 If DoneOk Then IsOpen := False;
132 CloseFile := DoneOk;
133 End;
134
135
FFileObj.BlkReadnull136 Function FFileObj.BlkRead(Var V; Num: Word; Var NumRead: Word): Boolean;
137 Var
138 Tmp: LongInt; {Number of chars to write}
139 DoneOk: Boolean;
140
141 Begin
142 If IoResult <> 0 Then;
143 DoneOk := IsOpen;
144 NumRead := 0; {Initialize number read to zero}
145 DoneOk := SeekFile(CurrPos); {Make currpos valid}
146 While ((NumRead < Num) and (DoneOk)) Do
147 Begin
148 If BufChars = 0 Then
149 DoneOk := ReadBuffer;
150 Tmp := Num - NumRead;
151 If Tmp > (BufChars - (CurrPos - BufStart)) Then
152 Tmp := (BufChars - (CurrPos - BufStart));
153 Move(Buf^[CurrPos - BufStart], FBufType(V)[NumRead] , Tmp);
154 Inc(NumRead, Tmp);
155 DoneOk := SeekFile(CurrPos + Tmp);
156 If CurrPos >= CurrSize Then
157 Num := NumRead;
158 End;
159 BlkRead := DoneOk;
160 End;
161
162
FFileObj.BlkWritenull163 Function FFileObj.BlkWrite(Var V; Num: Word): Boolean;
164 Var
165 Tmp: LongInt; {Number of chars to write}
166 NumWritten: LongInt; {Number of chars written}
167 DoneOk: Boolean;
168
169 Begin
170 NumWritten := 0;
171 DoneOk := IsOpen;
172 While ((NumWritten < Num) and (DoneOk)) Do
173 Begin
174 Tmp := Num - NumWritten; {num left to write}
175 If (CurrPos >= CurrSize) Then
176 Begin
177 If CurrPos - BufStart + Tmp > BufChars Then
178 BufChars := CurrPos - BufStart + Tmp;
179 If BufChars > BufSize Then
180 BufChars := BufSize;
181 End;
182 If Tmp > (BufChars - (CurrPos - BufStart)) Then
183 Tmp := (BufChars - (CurrPos - BufStart));
184 If ((Tmp > 0) and (DoneOk)) Then
185 Begin
186 Move(FBufType(V)[NumWritten], Buf^[CurrPos - BufStart] , Tmp);
187 Inc(NumWritten, Tmp);
188 NeedWritten := True;
189 End;
190 DoneOk := SeekFile(CurrPos + Tmp);
191 If DoneOk Then
192 Begin
193 If BufChars = 0 Then
194 Begin
195 If Num - NumWritten < BufSize Then
196 DoneOk := ReadBuffer
197 Else
198 BufChars := BufSize;
199 End;
200 End;
201 End;
202 BlkWrite := DoneOk;
203 End;
204
205
FFileObj.null206 Function FFileObj. SeekFile(FP: LongInt): Boolean;
207 Var
208 DoneOk: Boolean;
209
210 Begin
211 DoneOk := IsOpen;
212 If (FP < BufStart) or (FP > (BufStart + BufChars - 1)) Then
213 Begin {not in buffer}
214 If (FP >= BufStart) and (FP < (BufStart + BufSize - 1)) and
215 (FP >= CurrSize) Then
216 Begin {Out of orig buffer but beyond eof and within bufsize}
217 CurrPos := FP;
218 If (CurrPos - BufStart) > BufChars Then
219 BufChars := CurrPos - BufStart;
220 End
221 Else
222 Begin {write buffer if needed and reposition}
223 If (NeedWritten and (BufChars > 0)) Then {Write old buffer first if needed}
224 DoneOk := WriteBuffer;
225 BufStart := FP;
226 CurrPos := FP;
227 BufChars := 0;
228 End;
229 End
230 Else
231 Begin {was within buffer}
232 CurrPos := FP;
233 End;
234 SeekFile := DoneOk;
235 End;
236
237
238
FFileObj.WriteBuffernull239 Function FFileObj.WriteBuffer: Boolean;
240 Var
241 DoneOK: Boolean;
242
243 Begin
244 If IoResult <> 0 Then;
245 DoneOk := shSeekFile(BufFile, BufStart);
246 If DoneOk Then
247 DoneOk := shWrite(BufFile, Buf^, BufChars); {Write buffer}
248 If (BufStart + BufChars - 1) > CurrSize Then
249 CurrSize := BufStart + BufChars - 1;
250 If DoneOk Then
251 NeedWritten := False; {Turn off needs-written flag}
252 WriteBuffer := DoneOk; {Return result}
253 End;
254
255
FFileObj.ReadBuffernull256 Function FFileObj.ReadBuffer: Boolean;
257 Var
258 DoneOK: Boolean;
259
260 Begin
261 If IoResult <> 0 Then;
262 If NeedWritten Then
263 DoneOk := WriteBuffer;
264 Seek(BufFile, BufStart);
265 DoneOk := (ioResult = 0); {Seek to buffer start first}
266 If DoneOk Then
267 Begin
268 If BufStart >= RawSize Then
269 BufChars := 0
270 Else
271 DoneOk := shRead(BufFile, Buf^, BufSize, BufChars); {Read buffer}
272 End;
273 ReadBuffer := DoneOk; {Return result}
274 End;
275
276
FFileObj.RawSizenull277 Function FFileObj.RawSize: LongInt;
278 Begin
279 If IoResult <> 0 Then;
280 RawSize := FileSize(BufFile);
281 If IoResult <> 0 Then;
282 End;
283
284
FFileObj.FilePosnull285 Function FFileObj.FilePos: LongInt;
286 Begin
287 FilePos := CurrPos;
288 End;
289
290
291 End.
292