source: cprs/branches/HealthSevak-CPRS/VA/HRBuffers.pas

Last change on this file was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27

File size: 12.0 KB
Line 
1// HRBuffers v0.3.1 (03.Aug.2000)
2// Simple buffer classes
3// by Colin A Ridgewell
4//
5// Copyright (C) 1999,2000 Hayden-R Ltd
6// http://www.haydenr.com
7//
8// This program is free software; you can redistribute it and/or modify it
9// under the terms of the GNU General Public License as published by the
10// Free Software Foundation; either version 2 of the License, or (at your
11// option) any later version.
12//
13// This program is distributed in the hope that it will be useful, but
14// WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
15// or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
16// more details.
17//
18// You should have received a copy of the GNU General Public License along
19// with this program (gnu_license.htm); if not, write to the
20//
21// Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
22//
23// To contact us via e-mail use the following addresses...
24//
25// bug@haydenr.u-net.com - to report a bug
26// support@haydenr.u-net.com - for general support
27// wishlist@haydenr.u-net.com - add new requirement to wish list
28//
29unit HRBuffers;
30
31interface
32
33uses
34 Classes, SysUtils;
35
36type
37 {Base buffer.}
38 THRBuffer=class(TObject)
39 private
40 FBuffer:PChar;
41 FSize:LongInt;
42 procedure SetSize(Value:LongInt);
43 procedure CreateBuffer(const Size:LongInt);
44 procedure ResizeBuffer(const Size:LongInt);
45 procedure FreeBuffer;
46 protected
47 function GetItems(Index:LongInt):Char; virtual;
48 procedure SetItems(Index:LongInt;Value:Char); virtual;
49 public
50 constructor Create; virtual;
51 destructor Destroy; override;
52 property Buffer:PChar read FBuffer;
53 property Size:Longint read FSize write SetSize;
54 property Items[Index:LongInt]:Char read GetItems write SetItems; default;
55 end;
56
57 {Base buffer with EOB.}
58 THRBufferEOB=class(THRBuffer)
59 private
60 protected
61 function GetEOB:Boolean; virtual;
62 public
63 property EOB:Boolean read GetEOB;
64 end;
65
66
67 {Buffer for holding a series of char.}
68 THRBufferChar=class(THRBufferEOB)
69 private
70 FEOB:Boolean;
71 FPosition:Longint;
72 protected
73 function GetEOB:Boolean; override;
74 function GetItems(Index:LongInt):Char; override;
75 procedure SetItems(Index:LongInt;Value:Char); override;
76 function GetAsPChar:PChar;
77 procedure SetAsPChar(Value:PChar);
78 function GetAsString:string;
79 procedure SetAsString(Value:string);
80 public
81 constructor Create; override;
82 destructor Destroy; override;
83 property Buffer;
84 property Position:Longint read FPosition write FPosition;
85 procedure Write(const Value:Char);
86 function Read:Char;
87 procedure WritePChar(const Str:PChar);
88 procedure WriteString(const Str:String);
89 property AsPChar:PChar read GetAsPChar write SetAsPChar;
90 property AsString:string read GetAsString write SetAsString;
91 end;
92
93
94 {Buffer for reading from a stream.}
95 THRBufferStream=class(THRBufferEOB)
96 private
97 FEOB:Boolean;
98 FStream:TStream;
99 FStreamSize:Longint;
100 FFirstPosInBuffer:LongInt;
101 protected
102 function GetEOB:Boolean; override;
103 function GetItems(Index:LongInt):Char; override;
104 procedure SetItems(Index:LongInt;Value:Char); override;
105 procedure SetStream(Value:TStream);
106 public
107 constructor Create; override;
108 destructor Destroy; override;
109 property Stream:TStream read FStream write SetStream;
110 end;
111
112 {A buffer containing a list of smaller buffers in one piece of contiguous memory.}
113 THRBufferList=class(THRBuffer)
114 private
115 function GetItemPos(const Index:Integer):Integer;
116 function GetCount:Integer;
117 function GetItemSize(Index:Integer):Integer;
118 procedure SetItemSize(Index:Integer;Value:Integer);
119 function GetItemBuffer(Index:Integer):PChar;
120 public
121 constructor Create; override;
122 destructor Destroy; override;
123 procedure Add(const Index,ItemSize:Integer);
124 procedure Delete(const Index:Integer);
125 property Count:Integer read GetCount;
126 property ItemSize[Index:Integer]:Integer read GetItemSize write SetItemSize;
127 property ItemBuffer[Index:Integer]:PChar read GetItemBuffer;
128 end;
129
130
131implementation
132
133
134{ T H R B u f f e r }
135
136constructor THRBuffer.Create;
137begin
138FBuffer:=nil;
139FSize:=0;
140end;
141
142destructor THRBuffer.Destroy;
143begin
144FreeBuffer;
145inherited Destroy;
146end;
147
148
149procedure THRBuffer.SetSize(Value:LongInt);
150begin
151if FBuffer=nil
152then
153 CreateBuffer(Value)
154else
155 if Value>0
156 then
157 ResizeBuffer(Value)
158 else
159 FreeBuffer;
160end;
161
162
163function THRBuffer.GetItems(Index:LongInt):Char;
164begin
165Result:=#0;
166end;
167
168
169procedure THRBuffer.SetItems(Index:LongInt;Value:Char);
170begin
171end;
172
173
174procedure THRBuffer.CreateBuffer(const Size:LongInt);
175begin
176if FBuffer=nil
177then
178 begin
179 FSize:=Size;
180 GetMem(FBuffer,FSize+1);
181 {Null terminate end of buffer.}
182 FBuffer[FSize]:=#0;
183 end;
184end;
185
186
187procedure THRBuffer.ResizeBuffer(const Size:LongInt);
188var
189 New:PChar;
190 MoveSize:LongInt;
191begin
192if FBuffer<>nil
193then
194 begin
195 GetMem(New,Size+1);
196 if FSize>Size then MoveSize:=Size else MoveSize:=FSize;
197 Move(FBuffer[0],New[0],MoveSize);
198 FreeMem(FBuffer,FSize+1);
199 FBuffer:=New;
200 FSize:=Size;
201 FBuffer[FSize]:=#0;
202 end;
203end;
204
205
206procedure THRBuffer.FreeBuffer;
207begin
208if FBuffer<>nil
209then
210 begin
211 FreeMem(FBuffer,FSize+1);
212 FBuffer:=nil;
213 FSize:=0;
214 end;
215end;
216
217
218{ T H R B u f f e r E O B }
219
220function THRBufferEOB.GetEOB:Boolean;
221begin
222Result:=True;
223end;
224
225
226{ T H R B u f f e r C h a r }
227
228constructor THRBufferChar.Create;
229begin
230inherited Create;
231FEOB:=False;
232end;
233
234
235destructor THRBufferChar.Destroy;
236begin
237inherited Destroy;
238end;
239
240
241function THRBufferChar.GetEOB:Boolean;
242begin
243Result:=FEOB;
244end;
245
246
247function THRBufferChar.GetItems(Index:LongInt):Char;
248begin
249if Index<FSize
250then
251 begin
252 Result:=FBuffer[Index];
253 FEOB:=False;
254 end
255else
256 begin
257 Result:=#0;
258 FEOB:=True;
259 end;
260end;
261
262
263procedure THRBufferChar.SetItems(Index:LongInt;Value:Char);
264begin
265if Index<FSize
266then
267 begin
268 FBuffer[Index]:=Value;
269 FEOB:=False;
270 end
271else
272 begin
273 FEOB:=True;
274 end;
275end;
276
277
278function THRBufferChar.Read:Char;
279begin
280if FPosition<FSize
281then
282 begin
283 Result:=FBuffer[FPosition];
284 Inc(FPosition);
285 FEOB:=False;
286 end
287else
288 begin
289 Result:=#0;
290 FEOB:=True;
291 end;
292end;
293
294
295procedure THRBufferChar.Write(const Value:Char);
296begin
297if FPosition<FSize
298then
299 begin
300 FBuffer[FPosition]:=Value;
301 Inc(FPosition);
302 FEOB:=False;
303 end
304else
305 begin
306 FEOB:=True;
307 end;
308end;
309
310
311procedure THRBufferChar.WritePChar(const Str:PChar);
312var
313 i:Integer;
314begin
315for i:=0 to StrLen(Str)-1 do Write(Str[i]);
316end;
317
318
319procedure THRBufferChar.WriteString(const Str:String);
320var
321 i:Integer;
322begin
323for i:=1 to Length(Str) do Write(Str[i]);
324end;
325
326
327function THRBufferChar.GetAsPChar:PChar;
328begin
329Result:=FBuffer;
330end;
331
332
333procedure THRBufferChar.SetAsPChar(Value:PChar);
334var
335 L:Integer;
336begin
337L:=StrLen(Value);
338if L<=FSize
339then
340 begin
341 {Copies from value buffer to FBuffer.}
342 StrMove(FBuffer,Value,L);
343 FEOB:=False;
344 end
345else
346 begin
347 FEOB:=True;
348 end;
349end;
350
351
352function THRBufferChar.GetAsString:string;
353begin
354Result:='';
355end;
356
357
358procedure THRBufferChar.SetAsString(Value:string);
359begin
360end;
361
362
363
364
365{ T H R B u f f e r S t r e a m }
366
367
368constructor THRBufferStream.Create;
369begin
370inherited Create;
371FStream:=nil;
372FFirstPosInBuffer:=-1;
373end;
374
375
376destructor THRBufferStream.Destroy;
377begin
378inherited Destroy;
379end;
380
381
382procedure THRBufferStream.SetStream(Value:TStream);
383begin
384if Value<>FStream
385then
386 begin
387 FStream:=Value;
388 FStreamSize:=FStream.Size;
389 FFirstPosInBuffer:=-1;
390 end;
391end;
392
393
394function THRBufferStream.GetEOB:Boolean;
395begin
396Result:=FEOB;
397end;
398
399
400function THRBufferStream.GetItems(Index:LongInt):Char;
401begin
402if Index<FStreamSize
403then
404 begin
405 if (Index>=FFirstPosInBuffer+FSize) or
406 (Index<FFirstPosInBuffer) or
407 (FFirstPosInBuffer=-1)
408 then
409 begin
410 {Read next block from stream into buffer.}
411 FStream.Position:=Index;
412 FStream.Read(FBuffer[0],FSize);
413 FFirstPosInBuffer:=Index;
414 end;
415 {Read from buffer}
416 Result:=FBuffer[Index-FFirstPosInBuffer];
417 FEOB:=False;
418 end
419else
420 begin
421 {EOB}
422 Result:=#0;
423 FEOB:=True;
424 end;
425end;
426
427
428procedure THRBufferStream.SetItems(Index:LongInt;Value:Char);
429begin
430end;
431
432
433{ T H R B u f f e r L i s t }
434
435type
436 PHRInteger=^Integer;
437
438
439constructor THRBufferList.Create;
440begin
441inherited Create;
442{Set count to zero.}
443Size:=SizeOf(Integer);
444PHRInteger(Buffer)^:=0;
445end;
446
447
448destructor THRBufferList.Destroy;
449begin
450inherited Destroy;
451end;
452
453
454function THRBufferList.GetItemPos(const Index:Integer):Integer;
455var
456 PosIndex:Integer;
457 Pos:Integer;
458 PosItemSize:Integer;
459begin
460{Check for out of bounds index.}
461Assert(Index<PHRInteger(Buffer)^,'Index out of bounds');
462{Step past count.}
463Pos:=SizeOf(Integer);
464{Loop thought items.}
465PosIndex:=0;
466while PosIndex<Index do
467 begin
468 {Get item size.}
469 PosItemSize:=PHRInteger(Buffer+Pos)^;
470 {Step over item.}
471 Pos:=Pos+SizeOf(Integer)+PosItemSize;
472 Inc(PosIndex);
473 end;
474Result:=Pos;
475end;
476
477
478function THRBufferList.GetCount:Integer;
479begin
480Result:=PHRInteger(Buffer)^;
481end;
482
483
484function THRBufferList.GetItemSize(Index:Integer):Integer;
485begin
486Result:=PHRInteger(Buffer+GetItemPos(Index))^;
487end;
488
489
490procedure THRBufferList.SetItemSize(Index:Integer;Value:Integer);
491var
492 Pos:Integer;
493 ItemSize:Integer;
494 Diff:Integer;
495 OldSize:Integer;
496 S,D:PChar;
497 C:Integer;
498begin
499Pos:=GetItemPos(Index);
500
501{Calc diff is size.}
502ItemSize:=PHRInteger(Buffer+Pos)^;
503Diff:=Value-ItemSize;
504
505{No change in size.}
506if Diff=0 then Exit;
507
508if Diff<0
509then
510 begin
511 {Shrink buffer}
512 {Move items > index down buffer.}
513 S:=Buffer+Pos+SizeOf(Integer)+ItemSize;
514 D:=S+Diff;
515 C:=Size-(Pos+SizeOf(Integer)+ItemSize);
516 Move(S[0],D[0],C);
517 {Dec buffer size}
518 Size:=Size+Diff;
519 end
520else
521 begin
522 {Grow buffer}
523 OldSize:=Size;
524 {Inc buffer size}
525 Size:=Size+Diff;
526 {Move items > index up buffer.}
527 S:=Buffer+Pos+SizeOf(Integer)+ItemSize;
528 D:=S+Diff;
529 C:=OldSize-(Pos+SizeOf(Integer)+ItemSize);
530 Move(S[0],D[0],C);
531 end;
532
533{Set items new size.}
534PHRInteger(Buffer+Pos)^:=Value;
535end;
536
537
538function THRBufferList.GetItemBuffer(Index:Integer):PChar;
539begin
540Result:=Buffer+GetItemPos(Index)+SizeOf(Integer);
541end;
542
543
544procedure THRBufferList.Add(const Index,ItemSize:Integer);
545var
546 PosIndex:Integer;
547 Pos:Integer;
548 PosItemSize:Integer;
549 OldSize:Integer;
550 S,D:PChar;
551 C:Integer;
552begin
553{Step past count.}
554Pos:=SizeOf(Integer);
555
556{Step thought list until up to index or end list.}
557PosIndex:=0;
558while (PosIndex<Index)and(PosIndex<=PHRInteger(Buffer)^-1) do
559 begin
560 {Get item size.}
561 PosItemSize:=PHRInteger(Buffer+Pos)^;
562 {Step over item.}
563 Pos:=Pos+SizeOf(Integer)+PosItemSize;
564 Inc(PosIndex);
565 end;
566
567{Pad list with empty items up to index.}
568while (PosIndex<Index) do
569 begin
570 {Add item.}
571 Size:=Size+SizeOf(Integer);
572 {Set size of item to zero.}
573 PHRInteger(Buffer+Pos)^:=0;
574 {Inc count}
575 Inc(PHRInteger(Buffer)^);
576 {Step over item.}
577 Pos:=Pos+SizeOf(Integer);
578 Inc(PosIndex);
579 end;
580
581{Resize buffer to accomodate new item.}
582OldSize:=Size;
583Size:=Size+SizeOf(Integer)+ItemSize;
584
585{Push any items > index up buffer.}
586if PosIndex<=PHRInteger(Buffer)^-1
587then
588 begin
589 S:=Buffer+Pos;
590 D:=Buffer+Pos+SizeOf(Integer)+ItemSize;
591 C:=OldSize-Pos;
592 Move(S[0],D[0],C);
593 end;
594
595{Set size of item.}
596PHRInteger(Buffer+Pos)^:=ItemSize;
597{Inc count.}
598Inc(PHRInteger(Buffer)^);
599end;
600
601
602procedure THRBufferList.Delete(const Index:Integer);
603begin
604// find index
605// get size
606// move everthing > index down by sizeof(Integer) + index[size]
607// dec buffer size by sizeof(Integer) + index[size]
608// dec count
609end;
610
611
612end.
Note: See TracBrowser for help on using the repository browser.