5 type tMemoryStream
=object
10 procedure Seek(absolute:LongWord
);
11 procedure Skip(cnt
:Word);
12 procedure Read(var buf
; cnt
:Word);
13 function ReadPtr(cnt
:Word):pointer;
14 function ReadByte
:byte;
15 function ReadWord(cnt
:byte): LongWord
;
18 function Tell
:LongWord
;
19 procedure Write(const buf
; cnt
:word);
20 procedure WriteByte(v
:byte);
21 procedure WriteWord(v
:LongWord
; cnt
:byte);
22 procedure Init(ibuf
:pointer; ilen
,isize
:LongWord
);
23 procedure Init(isize
:LongWord
);
24 function WRBuf
:pointer;
25 function WRBufLen
:LongWord
;
26 procedure WREnd(used
:LongWord
);
27 function RDBuf
:pointer;
28 function RDBufLen
:LongWord
;
29 procedure RDEnd(used
:LongWord
);
32 type eInvalidMemStreamAccess
=class(Exception
)
38 procedure tMemoryStream
.Seek(absolute:LongWord
);
40 if absolute>size
then raise eInvalidMemStreamAccess
.Create('Seek out of bounds');
44 procedure tMemoryStream
.Skip(cnt
:Word);
49 procedure tMemoryStream
.Read(var buf
; cnt
:Word);
51 if (position
+cnt
)>length
then raise eInvalidMemStreamAccess
.Create('Read out of bounds');
52 Move((base
+position
)^,buf
,cnt
);
53 position
:=position
+cnt
;
56 function tMemoryStream
.ReadPtr(cnt
:Word):pointer;
58 result
:=base
+position
;
62 function tMemoryStream
.ReadByte
:byte;
63 begin Read(result
, 1); end;
65 function tMemoryStream
.ReadWord(cnt
:byte): LongWord
;
66 {$IFDEF ENDIAN_LITTLE}
67 var tm
:packed array [0..3] of byte;
71 if (position
+cnt
)>length
then raise eInvalidMemStreamAccess
.Create('Read out of bounds');
72 for i
:=cnt
-1 downto 0 do begin
73 tm
[i
]:=byte((base
+position
)^);
80 ReadWord
:=LongWord(pointer(@tm
)^);
83 procedure tMemoryStream
.Trunc
;
84 begin length
:=position
; end;
85 procedure tMemoryStream
.Append
;
86 begin position
:=length
; end;
87 function tMemoryStream
.Tell
:LongWord
;
88 begin Tell
:=position
; end;
90 procedure tMemoryStream
.Write(const buf
; cnt
:word);
92 if (position
+cnt
)>size
then raise eInvalidMemStreamAccess
.Create('Write out of bounds');
93 Move(buf
,(base
+position
)^,cnt
);
94 position
:=position
+cnt
;
95 if position
>length
then length
:=position
;
97 procedure tMemoryStream
.WriteByte(v
:byte);
98 begin Write(v
,1); end;
100 procedure tMemoryStream
.WriteWord(v
:LongWord
; cnt
:byte);
101 var tm
:packed array [0..3] of byte absolute v
;
104 {$IFDEF ENDIAN_LITTLE}
105 if (position
+cnt
)>size
then raise eInvalidMemStreamAccess
.Create('Write out of bounds');
106 for i
:=cnt
-1 downto 0 do begin
107 byte((base
+position
)^):=tm
[i
];
110 if position
>length
then length
:=position
;
112 Write(tm
[4-cnt
],cnt
);
116 procedure tMemoryStream
.Init(ibuf
:pointer; ilen
,isize
:LongWord
);
123 procedure tMemoryStream
.Init(isize
:LongWord
);
125 Init(GetMem(isize
),0,isize
);
128 function tMemoryStream
.WRBuf
:pointer;
129 begin result
:=base
+position
end;
130 function tMemoryStream
.WRBufLen
:LongWord
;
131 begin result
:=size
-position
end;
132 procedure tMemoryStream
.WREnd(used
:LongWord
);
133 begin RDEnd(used
); if position
>length
then length
:=position
end;
134 function tMemoryStream
.RDBuf
:pointer;
135 begin result
:=base
+position
end;
136 function tMemoryStream
.RDBufLen
:LongWord
;
137 begin result
:=length
-position
end;
138 procedure tMemoryStream
.RDEnd(used
:LongWord
);
139 begin skip(used
) end;