Add chat unit test.
[brdnet.git] / MemStream.pas
blobe83356e9ae573ca0881a6b66f8fcbb7422527adc
1 unit MemStream;
3 INTERFACE
4 uses SysUtils;
5 type tMemoryStream=object
6 length: LongWord;
7 size: LongWord;
8 base: pointer;
9 position: LongWord;
10 procedure Seek(absolute:LongWord);
11 procedure Skip(cnt:Word);
12 procedure Read(var buf; cnt:Word);
13 function ReadByte:byte;
14 function ReadWord(cnt:byte): LongWord; experimental;
15 procedure Rewind;
16 procedure Append;
17 function Tell:LongWord;
18 procedure Write(var buf; cnt:word);
19 procedure WriteByte(v:byte);
20 procedure WriteWord(v:LongWord; cnt:byte);
21 procedure Init(ibuf:pointer; ilen,isize:LongWord);
22 function WRBuf:pointer;
23 function WRBufLen:LongWord;
24 procedure WREnd(used:LongWord);
25 function RDBuf:pointer;
26 function RDBufLen:LongWord;
27 procedure RDEnd(used:LongWord);
28 end;
30 type eInvalidMemStreamAccess=class(Exception)
31 {no details jet}
32 end;
34 IMPLEMENTATION
36 procedure tMemoryStream.Seek(absolute:LongWord);
37 begin
38 if absolute>size then raise eInvalidMemStreamAccess.Create('Seek out of bounds');
39 position:=absolute;
40 end;
42 procedure tMemoryStream.Skip(cnt:Word);
43 begin
44 Seek(position+cnt);
45 end;
47 procedure tMemoryStream.Read(var buf; cnt:Word);
48 begin
49 if (position+cnt)>length then raise eInvalidMemStreamAccess.Create('Read out of bounds');
50 Move((base+position)^,buf,cnt);
51 position:=position+cnt;
52 end;
54 function tMemoryStream.ReadByte:byte;
55 begin Read(result, 1); end;
57 function tMemoryStream.ReadWord(cnt:byte): LongWord;
58 {$IFDEF ENDIAN_LITTLE}
59 var tm:packed array [0..3] of byte;
60 var i:byte;
61 begin
62 FillChar(tm,4,0);
63 if (position+cnt)>length then raise eInvalidMemStreamAccess.Create('Read out of bounds');
64 for i:=cnt-1 downto 0 do begin
65 tm[i]:=byte((base+position)^);
66 inc(position);
67 end;
68 {$ELSE}
69 begin
70 Read(tm[4-cnt],cnt);
71 {$ENDIF}
72 ReadWord:=LongWord(pointer(@tm)^);
73 end;
75 procedure tMemoryStream.Rewind;
76 begin position:=0; end;
77 procedure tMemoryStream.Append;
78 begin position:=length; end;
79 function tMemoryStream.Tell:LongWord;
80 begin Tell:=position; end;
82 procedure tMemoryStream.Write(var buf; cnt:word);
83 begin
84 if (position+cnt)>size then raise eInvalidMemStreamAccess.Create('Write out of bounds');
85 Move(buf,(base+position)^,cnt);
86 position:=position+cnt;
87 if position>length then length:=position;
88 end;
89 procedure tMemoryStream.WriteByte(v:byte);
90 begin Write(v,1); end;
92 procedure tMemoryStream.WriteWord(v:LongWord; cnt:byte);
93 var tm:packed array [0..3] of byte absolute v;
94 var i:byte;
95 begin
96 {$IFDEF ENDIAN_LITTLE}
97 if (position+cnt)>size then raise eInvalidMemStreamAccess.Create('Write out of bounds');
98 for i:=cnt-1 downto 0 do begin
99 byte((base+position)^):=tm[i];
100 inc(position);
101 end;
102 if position>length then length:=position;
103 {$ELSE}
104 Write(tm[4-cnt],cnt);
105 {$ENDIF}
106 end;
108 procedure tMemoryStream.Init(ibuf:pointer; ilen,isize:LongWord);
109 begin
110 base:=ibuf;
111 length:=ilen;
112 size:=isize;
113 seek(0);
114 end;
116 function tMemoryStream.WRBuf:pointer;
117 begin result:=base+position end;
118 function tMemoryStream.WRBufLen:LongWord;
119 begin result:=size-position end;
120 procedure tMemoryStream.WREnd(used:LongWord);
121 begin RDEnd(used); if position>length then length:=position end;
122 function tMemoryStream.RDBuf:pointer;
123 begin result:=base+position end;
124 function tMemoryStream.RDBufLen:LongWord;
125 begin result:=length-position end;
126 procedure tMemoryStream.RDEnd(used:LongWord);
127 begin skip(used) end;
129 END.