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 {$EndIf}
60 {$EndIf}
61 ;
62
63 Constructor FFileObj.Init(BSize: Word);
64 Begin
65 Buf := Nil;
66 BufSize := BSize;
67 BufStart := 0; {Invalidate buffer}
68 BufChars := 0;
69 IsOpen := False; {Initialize values}
70 NeedWritten := False;
71 CurrPos := 0;
72 GetMem(Buf, BufSize); {Allocate memory for buffer}
73 If Buf = Nil Then
74 Fail;
75 End;
76
77
78 Destructor FFileObj.Done;
79 Begin
80 If IsOpen Then CloseFile;
81 If Buf <> Nil Then FreeMem(Buf, BufSize);
82 End;
83
84
85
FFileObj.OpenFilenull86 Function FFileObj.OpenFile(FName: String; FMode: Word): Boolean;
87 Var
88 DoneOk: Boolean;
89
90 Begin
91 If IoResult <> 0 Then; {protect against unchecked errors in calling proc}
92 DoneOk := True;
93 If IsOpen Then CloseFile;
94 If DoneOk Then Begin {Create file if needed}
95 If Not FileExist(FName) Then
96 DoneOk := SaveFile(FName, DoneOk, 0) = 0;
97 End;
98 If DoneOk Then
99 Begin {open file}
100 Assign(BufFile, FName);
101 FileMode := FMode;
102 If DoneOk Then
103 DoneOk := shReset(BufFile, 1);
104 IsOpen := DoneOk;
105 CurrPos := 0; {Initialize file position}
106 BufStart := 0; {Invalidate buffer}
107 BufChars := 0;
108 NeedWritten := False;
109 CurrSize := RawSize;
110 End;
111 OpenFile := DoneOk;
112 End;
113
114
FFileObj.CloseFilenull115 Function FFileObj.CloseFile: Boolean;
116 Var
117 DoneOk: Boolean;
118
119 Begin
120 If not IsOpen then Exit;
121 If IoResult <> 0 Then;
122 DoneOk := True;
123 If NeedWritten Then DoneOk := WriteBuffer;
124 If DoneOk Then Begin
125 Close(BufFile); {Close file}
126 DoneOk := (IoResult = 0);
127 End;
128 If DoneOk Then IsOpen := False;
129 CloseFile := DoneOk;
130 End;
131
132
FFileObj.BlkReadnull133 Function FFileObj.BlkRead(Var V; Num: Word; Var NumRead: Word): Boolean;
134 Var
135 Tmp: LongInt; {Number of chars to write}
136 DoneOk: Boolean;
137
138 Begin
139 If IoResult <> 0 Then;
140 DoneOk := IsOpen;
141 NumRead := 0; {Initialize number read to zero}
142 DoneOk := SeekFile(CurrPos); {Make currpos valid}
143 While ((NumRead < Num) and (DoneOk)) Do
144 Begin
145 If BufChars = 0 Then
146 DoneOk := ReadBuffer;
147 Tmp := Num - NumRead;
148 If Tmp > (BufChars - (CurrPos - BufStart)) Then
149 Tmp := (BufChars - (CurrPos - BufStart));
150 Move(Buf^[CurrPos - BufStart], FBufType(V)[NumRead] , Tmp);
151 Inc(NumRead, Tmp);
152 DoneOk := SeekFile(CurrPos + Tmp);
153 If CurrPos >= CurrSize Then
154 Num := NumRead;
155 End;
156 BlkRead := DoneOk;
157 End;
158
159
FFileObj.BlkWritenull160 Function FFileObj.BlkWrite(Var V; Num: Word): Boolean;
161 Var
162 Tmp: LongInt; {Number of chars to write}
163 NumWritten: LongInt; {Number of chars written}
164 DoneOk: Boolean;
165
166 Begin
167 NumWritten := 0;
168 DoneOk := IsOpen;
169 While ((NumWritten < Num) and (DoneOk)) Do
170 Begin
171 Tmp := Num - NumWritten; {num left to write}
172 If (CurrPos >= CurrSize) Then
173 Begin
174 If CurrPos - BufStart + Tmp > BufChars Then
175 BufChars := CurrPos - BufStart + Tmp;
176 If BufChars > BufSize Then
177 BufChars := BufSize;
178 End;
179 If Tmp > (BufChars - (CurrPos - BufStart)) Then
180 Tmp := (BufChars - (CurrPos - BufStart));
181 If ((Tmp > 0) and (DoneOk)) Then
182 Begin
183 Move(FBufType(V)[NumWritten], Buf^[CurrPos - BufStart] , Tmp);
184 Inc(NumWritten, Tmp);
185 NeedWritten := True;
186 End;
187 DoneOk := SeekFile(CurrPos + Tmp);
188 If DoneOk Then
189 Begin
190 If BufChars = 0 Then
191 Begin
192 If Num - NumWritten < BufSize Then
193 DoneOk := ReadBuffer
194 Else
195 BufChars := BufSize;
196 End;
197 End;
198 End;
199 BlkWrite := DoneOk;
200 End;
201
202
FFileObj.null203 Function FFileObj. SeekFile(FP: LongInt): Boolean;
204 Var
205 DoneOk: Boolean;
206
207 Begin
208 DoneOk := IsOpen;
209 If (FP < BufStart) or (FP > (BufStart + BufChars - 1)) Then
210 Begin {not in buffer}
211 If (FP >= BufStart) and (FP < (BufStart + BufSize - 1)) and
212 (FP >= CurrSize) Then
213 Begin {Out of orig buffer but beyond eof and within bufsize}
214 CurrPos := FP;
215 If (CurrPos - BufStart) > BufChars Then
216 BufChars := CurrPos - BufStart;
217 End
218 Else
219 Begin {write buffer if needed and reposition}
220 If (NeedWritten and (BufChars > 0)) Then {Write old buffer first if needed}
221 DoneOk := WriteBuffer;
222 BufStart := FP;
223 CurrPos := FP;
224 BufChars := 0;
225 End;
226 End
227 Else
228 Begin {was within buffer}
229 CurrPos := FP;
230 End;
231 SeekFile := DoneOk;
232 End;
233
234
235
FFileObj.WriteBuffernull236 Function FFileObj.WriteBuffer: Boolean;
237 Var
238 DoneOK: Boolean;
239
240 Begin
241 If IoResult <> 0 Then;
242 DoneOk := shSeekFile(BufFile, BufStart);
243 If DoneOk Then
244 DoneOk := shWrite(BufFile, Buf^, BufChars); {Write buffer}
245 If (BufStart + BufChars - 1) > CurrSize Then
246 CurrSize := BufStart + BufChars - 1;
247 If DoneOk Then
248 NeedWritten := False; {Turn off needs-written flag}
249 WriteBuffer := DoneOk; {Return result}
250 End;
251
252
FFileObj.ReadBuffernull253 Function FFileObj.ReadBuffer: Boolean;
254 Var
255 DoneOK: Boolean;
256
257 Begin
258 If IoResult <> 0 Then;
259 If NeedWritten Then
260 DoneOk := WriteBuffer;
261 Seek(BufFile, BufStart);
262 DoneOk := (ioResult = 0); {Seek to buffer start first}
263 If DoneOk Then
264 Begin
265 If BufStart >= RawSize Then
266 BufChars := 0
267 Else
268 DoneOk := shRead(BufFile, Buf^, BufSize, BufChars); {Read buffer}
269 End;
270 ReadBuffer := DoneOk; {Return result}
271 End;
272
273
FFileObj.RawSizenull274 Function FFileObj.RawSize: LongInt;
275 Begin
276 If IoResult <> 0 Then;
277 RawSize := FileSize(BufFile);
278 If IoResult <> 0 Then;
279 End;
280
281
FFileObj.FilePosnull282 Function FFileObj.FilePos: LongInt;
283 Begin
284 FilePos := CurrPos;
285 End;
286
287
288 End.
289