1 // special stream classes
14 XStreamError
= class(Exception
);
16 // read-only ïîòîê äëÿ èçâëå÷åíèÿ èç èñõîäíîãî òîëüêî êóñî÷êà
17 TSFSPartialStream
= class(TStream
)
19 fSource
: TStream
; // èñõîäíûé ïîòîê
20 fKillSource
: Boolean; // óáèâàòü èñõîäíèê ïðè ïîìèðàíèè?
21 fLastReadPos
: Int64; // ïîñëåäíèé Read() îñòàíîâèëñÿ çäåñü (îòíîñ. fStartPos)
22 fCurrentPos
: Int64; // ïîñëåäíèé Seek() îñòàíîâèëñÿ çäåñü (îòíîñ. fStartPos)
23 fStartPos
: Int64; // íà÷àëî êóñî÷êà
24 fSize
: Int64; // äëèíà êóñî÷êà
25 fPreBuf
: packed array of Byte; // ýòîò áóôåð áóäåò ïåðåä ôàéëîì
27 procedure CheckPos ();
30 // aSrc: ïîòîê-èñõîäíèê.
31 // aPos: íà÷àëüíàÿ ïîçèöèÿ â ïîòîêå. -1 -- ñ òåêóùåé.
32 // åñëè aPos < òåêóùåé ïîçèöèè, òî èñõîäíûé ïîòîê äîëæåí
33 // íîðìàëüíî ïîääåðæèâàòü Seek()!
34 // aSize: êîëè÷åñòâî áàéòèêîâ, êîòîðîå ìîæíî ïðî÷åñòü èç ïîòîêà.
35 // åñëè ìåíüøå íóëÿ -- òî äî êîíöà.
36 // aKillSrc: óáèâàòü ëè èñõîäíûé ïîòîê, êîãäà ñàìè óìèðàåì?
37 // òàêæå ìîæåò ïðèøïàíäîðèòü ê íà÷àëó ôàéëà áóôåð. bufSz áóäåò äîáàâëåíî ê
39 constructor Create (aSrc
: TStream
; aPos
, aSize
: Int64; aKillSrc
: Boolean; preBuf
: Pointer=nil; bufSz
: Integer=0);
40 destructor Destroy (); override;
42 // íîðìàëèçóåò count è ÷èòàåò.
43 function Read (var buffer
; count
: LongInt): LongInt; override;
44 // Write() ïðîñòî ãðîìêî ïàäàåò.
45 function Write (const buffer
; count
: LongInt): LongInt; override;
46 // Seek() ðåàëèçîâàíî, ÷òîáû ìîãëà ðàáîòàòü ïðîïåðòÿ Size.
47 // âîîáùå-òî ìîæíî ïåðåêðûòü ìåòîä GetSize(), íî âäðóã êàêîé
48 // áîëüíîé íà ãîëîâó êîäåð áóäåò ïîëó÷àòü ðàçìåð ïðè ïîìîùè
50 function Seek (const offset
: Int64; origin
: TSeekOrigin
): Int64; override;
53 // this stream can kill both `proxied` and `guarded` streams on closing
54 TSFSGuardStream
= class(TStream
)
56 fSource
: TStream
; // èñõîäíûé ïîòîê
57 fGuardedStream
: TStream
; // ïîòîê, êîòîðûé çàâàëèì ïðè ïîìèðàíèè
58 fKillSource
: Boolean; // óáèâàòü èñõîäíèê ïðè ïîìèðàíèè?
59 fKillGuarded
: Boolean; // óáèâàòü îõðàíÿåìûé ïðè ïîìèðàíèè?
60 fGuardedFirst
: Boolean; // ïðè ñìåðòè ïåðâûì ïðèøèáàåì îõðàíÿåìîãî?
63 // aSrc: ïîòîê-èñõîäíèê (íà êîòîðûé çàìàïåíû îïåðàöèè ÷òåíèÿ/çàïèñè).
64 // aKillSrc: óáèâàòü ëè èñõîäíûé ïîòîê, êîãäà ñàìè óìèðàåì?
65 // aKillGuarded: óáèâàòü ëè îõðàíÿåìûé ïîòîê, êîãäà ñàìè óìèðàåì?
66 // aGuardedFirst: true: ïðè ñìåðòè ïåðâûì ïðèøèáàåì îõðàíÿåìîãî.
67 constructor Create (aSrc
, aGuarded
: TStream
; aKillSrc
, aKillGuarded
: Boolean; aGuardedFirst
: Boolean=true);
68 destructor Destroy (); override;
70 // íèæåñëåäóþùåå çàìàïëåíî íà fSource
71 function Read (var buffer
; count
: LongInt): LongInt; override;
72 function Write (const buffer
; count
: LongInt): LongInt; override;
73 function Seek (const offset
: Int64; origin
: TSeekOrigin
): Int64; override;
76 TSFSMemoryStreamRO
= class(TCustomMemoryStream
)
82 constructor Create (pMem
: Pointer; pSize
: Integer; aFreeMem
: Boolean=false);
83 destructor Destroy (); override;
85 function Write (const buffer
; count
: LongInt): LongInt; override;
88 TUnZStream
= class(TStream
)
95 fSize
: Int64; // can be -1
97 fSkipToPos
: Int64; // >0: skip to this position
100 function readBuf (var buffer
; count
: LongInt): LongInt;
102 procedure determineSize ();
105 // `aSize` can be -1 if stream size is unknown
106 constructor create (asrc
: TStream
; aSize
: Int64; aSkipHeader
: boolean=false);
107 destructor destroy (); override;
108 function read (var buffer
; count
: LongInt): LongInt; override;
109 function write (const buffer
; count
: LongInt): LongInt; override;
110 function seek (const offset
: Int64; origin
: TSeekOrigin
): Int64; override;
120 { TSFSPartialStream }
121 constructor TSFSPartialStream
.Create (aSrc
: TStream
; aPos
, aSize
: Int64; aKillSrc
: Boolean; preBuf
: Pointer=nil; bufSz
: Integer=0);
125 if aPos
< 0 then aPos
:= aSrc
.Position
;
126 if aSize
< 0 then aSize
:= 0;
128 fKillSource
:= aKillSrc
;
135 SetLength(fPreBuf
, bufSz
);
136 Move(preBuf
^, fPreBuf
[0], bufSz
);
145 destructor TSFSPartialStream
.Destroy ();
147 if fKillSource
then FreeAndNil(fSource
);
151 procedure TSFSPartialStream
.CheckPos ();
154 if fSource.Position <> fStartPos+fCurrentPos-Length(fPreBuf) then
156 fSource.Position := fStartPos+fCurrentPos-Length(fPreBuf);
159 if fCurrentPos
>= length(fPreBuf
) then
161 //writeln('seeking at ', fCurrentPos, ' (real: ', fStartPos+fCurrentPos-Length(fPreBuf), ')');
162 fSource
.Position
:= fStartPos
+fCurrentPos
-Length(fPreBuf
);
164 fLastReadPos
:= fCurrentPos
;
167 function TSFSPartialStream
.Write (const buffer
; count
: LongInt): LongInt;
170 raise XStreamError
.Create('can''t write to read-only stream');
171 // à íå õîäè, íåõîðîøèé, â íàø ñàäèê ãóëÿòü!
174 function TSFSPartialStream
.Read (var buffer
; count
: LongInt): LongInt;
180 if count
< 0 then raise XStreamError
.Create('invalid Read() call'); // ñêàçî÷íûé äîëáî¸á...
181 if count
= 0 then begin result
:= 0; exit
; end;
184 if (Length(fPreBuf
) > 0) and (fCurrentPos
< Length(fPreBuf
)) then
186 fLastReadPos
:= fCurrentPos
;
187 left
:= Length(fPreBuf
)-fCurrentPos
;
188 if left
> count
then left
:= count
;
191 Move(fPreBuf
[fCurrentPos
], pc
^, left
);
192 Inc(PChar(pc
), left
);
193 Inc(fCurrentPos
, left
);
194 fLastReadPos
:= fCurrentPos
;
197 if count
= 0 then exit
;
201 left
:= fSize
-fCurrentPos
;
202 if left
< count
then count
:= left
; // è òàê ñëó÷àåòñÿ...
205 rd
:= fSource
.Read(pc
^, count
);
207 Inc(fCurrentPos
, rd
);
208 fLastReadPos
:= fCurrentPos
;
216 function TSFSPartialStream
.Seek (const offset
: Int64; origin
: TSeekOrigin
): Int64;
219 soBeginning
: result
:= offset
;
220 soCurrent
: result
:= offset
+fCurrentPos
;
221 soEnd
: result
:= fSize
+offset
;
222 else raise XStreamError
.Create('invalid Seek() call');
223 // äðóãèõ íå áûâàåò. à ó êîãî áûâàåò, òîìó ÿ íå äîêòîð.
225 if result
< 0 then result
:= 0
226 else if result
> fSize
then result
:= fSize
;
227 fCurrentPos
:= result
;
232 constructor TSFSGuardStream
.Create (aSrc
, aGuarded
: TStream
; aKillSrc
, aKillGuarded
: Boolean; aGuardedFirst
: Boolean=true);
235 fSource
:= aSrc
; fGuardedStream
:= aGuarded
;
236 fKillSource
:= aKillSrc
; fKillGuarded
:= aKillGuarded
;
237 fGuardedFirst
:= aGuardedFirst
;
240 destructor TSFSGuardStream
.Destroy ();
242 if fKillGuarded
and fGuardedFirst
then FreeAndNil(fGuardedStream
);
243 if fKillSource
then FreeAndNil(fSource
);
244 if fKillGuarded
and not fGuardedFirst
then FreeAndNil(fGuardedStream
);
248 function TSFSGuardStream
.Read (var buffer
; count
: LongInt): LongInt;
250 result
:= fSource
.Read(buffer
, count
);
253 function TSFSGuardStream
.Write (const buffer
; count
: LongInt): LongInt;
255 result
:= fSource
.Write(buffer
, count
);
258 function TSFSGuardStream
.Seek (const offset
: Int64; origin
: TSeekOrigin
): Int64;
260 result
:= fSource
.Seek(offset
, origin
);
264 { TSFSMemoryStreamRO }
265 constructor TSFSMemoryStreamRO
.Create (pMem
: Pointer; pSize
: Integer; aFreeMem
: Boolean=false);
267 fFreeMem
:= aFreeMem
;
270 SetPointer(pMem
, pSize
);
274 destructor TSFSMemoryStreamRO
.Destroy ();
276 if fFreeMem
and (fMem
<> nil) then FreeMem(fMem
);
279 function TSFSMemoryStreamRO
.Write (const buffer
; count
: LongInt): LongInt;
282 raise XStreamError
.Create('can''t write to read-only stream');
283 // ñîâñåì ñáðåíäèë...
287 // ////////////////////////////////////////////////////////////////////////// //
289 const ZBufSize
= 32768; // size of the buffer used for temporarily storing data from the child stream
291 constructor TUnZStream
.create (asrc
: TStream
; aSize
: Int64; aSkipHeader
: boolean=false);
299 GetMem(fBuffer
, ZBufSize
);
300 fSkipHeader
:= aSkipHeader
;
301 if fSkipHeader
then err
:= inflateInit2(fZlibSt
, -MAX_WBITS
) else err
:= inflateInit(fZlibSt
);
302 if err
<> Z_OK
then raise XStreamError
.Create(zerror(err
));
303 fSrcStPos
:= fSrcSt
.position
;
306 destructor TUnZStream
.destroy ();
314 function TUnZStream
.readBuf (var buffer
; count
: LongInt): LongInt;
319 fZlibSt
.next_out
:= @buffer
;
320 fZlibSt
.avail_out
:= count
;
322 while fZlibSt
.avail_out
<> 0 do
324 if fZlibSt
.avail_in
= 0 then
327 fZlibSt
.next_in
:= fBuffer
;
328 fZlibSt
.avail_in
:= fSrcSt
.read(Fbuffer
^, ZBufSize
);
329 //Inc(compressed_read, fZlibSt.avail_in);
330 Inc(fPos
, lastavail
-fZlibSt
.avail_out
);
331 lastavail
:= fZlibSt
.avail_out
;
333 err
:= inflate(fZlibSt
, Z_NO_FLUSH
);
334 if err
= Z_STREAM_END
then fSize
:= fPos
; break
;
335 if err
<> Z_OK
then raise XStreamError
.Create(zerror(err
));
337 //if err = Z_STREAM_END then Dec(compressed_read, fZlibSt.avail_in);
338 Inc(fPos
, lastavail
-fZlibSt
.avail_out
);
339 result
:= count
-fZlibSt
.avail_out
;
342 procedure TUnZStream
.fixPos ();
344 buf
: array [0..4095] of Byte;
347 if fSkipToPos
< 0 then exit
;
348 if fSkipToPos
> fPos
then reset();
349 while fPos
< fSkipToPos
do
351 if fSkipToPos
-fPos
> 4096 then rd
:= 4096 else rd
:= LongInt(fSkipToPos
-fPos
);
352 rr
:= readBuf(buf
, rd
);
353 if rd
<> rr
then raise XStreamError
.Create('seek error');
358 procedure TUnZStream
.determineSize ();
360 buf
: array [0..4095] of Byte;
363 if fSize
>= 0 then exit
;
366 rd
:= readBuf(buf
, 4096);
367 if rd
<> 4096 then break
;
372 function TUnZStream
.read (var buffer
; count
: LongInt): LongInt;
374 if fSkipToPos
>= 0 then fixPos();
375 result
:= readBuf(buffer
, count
);
378 function TUnZStream
.write (const buffer
; count
: LongInt): LongInt;
381 raise XStreamError
.Create('can''t write to read-only stream');
384 procedure TUnZStream
.reset ();
388 fSrcSt
.position
:= fSrcStPos
;
391 if fSkipHeader
then err
:= inflateInit2(fZlibSt
, -MAX_WBITS
) else err
:= inflateInit(fZlibSt
);
392 if err
<> Z_OK
then raise XStreamError
.Create(zerror(err
));
395 function TUnZStream
.Seek (const offset
: Int64; origin
: TSeekOrigin
): Int64;
398 soBeginning
: result
:= offset
;
399 soCurrent
: result
:= offset
+fPos
;
400 soEnd
: begin if fSize
= -1 then determineSize(); result
:= fSize
+offset
; end;
401 else raise XStreamError
.Create('invalid Seek() call');
402 // äðóãèõ íå áûâàåò. à ó êîãî áûâàåò, òîìó ÿ íå äîêòîð.
404 if result
< 0 then result
:= 0;
405 fSkipToPos
:= result
;