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
101 function readBuf (var buffer
; count
: LongInt): LongInt;
103 procedure determineSize ();
106 // `aSize` can be -1 if stream size is unknown
107 constructor create (asrc
: TStream
; aSize
: Int64; aKillSrc
: Boolean; aSkipHeader
: boolean=false);
108 destructor destroy (); override;
109 function read (var buffer
; count
: LongInt): LongInt; override;
110 function write (const buffer
; count
: LongInt): LongInt; override;
111 function seek (const offset
: Int64; origin
: TSeekOrigin
): Int64; override;
121 { TSFSPartialStream }
122 constructor TSFSPartialStream
.Create (aSrc
: TStream
; aPos
, aSize
: Int64; aKillSrc
: Boolean; preBuf
: Pointer=nil; bufSz
: Integer=0);
126 if aPos
< 0 then aPos
:= aSrc
.Position
;
127 if aSize
< 0 then aSize
:= 0;
129 fKillSource
:= aKillSrc
;
136 SetLength(fPreBuf
, bufSz
);
137 Move(preBuf
^, fPreBuf
[0], bufSz
);
146 destructor TSFSPartialStream
.Destroy ();
148 if fKillSource
then FreeAndNil(fSource
);
152 procedure TSFSPartialStream
.CheckPos ();
155 if fSource.Position <> fStartPos+fCurrentPos-Length(fPreBuf) then
157 fSource.Position := fStartPos+fCurrentPos-Length(fPreBuf);
160 if fCurrentPos
>= length(fPreBuf
) then
162 //writeln('seeking at ', fCurrentPos, ' (real: ', fStartPos+fCurrentPos-Length(fPreBuf), ')');
163 fSource
.Position
:= fStartPos
+fCurrentPos
-Length(fPreBuf
);
165 fLastReadPos
:= fCurrentPos
;
168 function TSFSPartialStream
.Write (const buffer
; count
: LongInt): LongInt;
171 raise XStreamError
.Create('can''t write to read-only stream');
172 // à íå õîäè, íåõîðîøèé, â íàø ñàäèê ãóëÿòü!
175 function TSFSPartialStream
.Read (var buffer
; count
: LongInt): LongInt;
181 if count
< 0 then raise XStreamError
.Create('invalid Read() call'); // ñêàçî÷íûé äîëáî¸á...
182 if count
= 0 then begin result
:= 0; exit
; end;
185 if (Length(fPreBuf
) > 0) and (fCurrentPos
< Length(fPreBuf
)) then
187 fLastReadPos
:= fCurrentPos
;
188 left
:= Length(fPreBuf
)-fCurrentPos
;
189 if left
> count
then left
:= count
;
192 Move(fPreBuf
[fCurrentPos
], pc
^, left
);
193 Inc(PChar(pc
), left
);
194 Inc(fCurrentPos
, left
);
195 fLastReadPos
:= fCurrentPos
;
198 if count
= 0 then exit
;
202 left
:= fSize
-fCurrentPos
;
203 if left
< count
then count
:= left
; // è òàê ñëó÷àåòñÿ...
206 rd
:= fSource
.Read(pc
^, count
);
208 Inc(fCurrentPos
, rd
);
209 fLastReadPos
:= fCurrentPos
;
217 function TSFSPartialStream
.Seek (const offset
: Int64; origin
: TSeekOrigin
): Int64;
220 soBeginning
: result
:= offset
;
221 soCurrent
: result
:= offset
+fCurrentPos
;
222 soEnd
: result
:= fSize
+offset
;
223 else raise XStreamError
.Create('invalid Seek() call');
224 // äðóãèõ íå áûâàåò. à ó êîãî áûâàåò, òîìó ÿ íå äîêòîð.
226 if result
< 0 then result
:= 0
227 else if result
> fSize
then result
:= fSize
;
228 fCurrentPos
:= result
;
233 constructor TSFSGuardStream
.Create (aSrc
, aGuarded
: TStream
; aKillSrc
, aKillGuarded
: Boolean; aGuardedFirst
: Boolean=true);
236 fSource
:= aSrc
; fGuardedStream
:= aGuarded
;
237 fKillSource
:= aKillSrc
; fKillGuarded
:= aKillGuarded
;
238 fGuardedFirst
:= aGuardedFirst
;
241 destructor TSFSGuardStream
.Destroy ();
243 if fKillGuarded
and fGuardedFirst
then FreeAndNil(fGuardedStream
);
244 if fKillSource
then FreeAndNil(fSource
);
245 if fKillGuarded
and not fGuardedFirst
then FreeAndNil(fGuardedStream
);
249 function TSFSGuardStream
.Read (var buffer
; count
: LongInt): LongInt;
251 result
:= fSource
.Read(buffer
, count
);
254 function TSFSGuardStream
.Write (const buffer
; count
: LongInt): LongInt;
256 result
:= fSource
.Write(buffer
, count
);
259 function TSFSGuardStream
.Seek (const offset
: Int64; origin
: TSeekOrigin
): Int64;
261 result
:= fSource
.Seek(offset
, origin
);
265 { TSFSMemoryStreamRO }
266 constructor TSFSMemoryStreamRO
.Create (pMem
: Pointer; pSize
: Integer; aFreeMem
: Boolean=false);
268 fFreeMem
:= aFreeMem
;
271 SetPointer(pMem
, pSize
);
275 destructor TSFSMemoryStreamRO
.Destroy ();
277 if fFreeMem
and (fMem
<> nil) then FreeMem(fMem
);
280 function TSFSMemoryStreamRO
.Write (const buffer
; count
: LongInt): LongInt;
283 raise XStreamError
.Create('can''t write to read-only stream');
284 // ñîâñåì ñáðåíäèë...
288 // ////////////////////////////////////////////////////////////////////////// //
290 const ZBufSize
= 32768; // size of the buffer used for temporarily storing data from the child stream
293 constructor TUnZStream
.create (asrc
: TStream
; aSize
: Int64; aKillSrc
: Boolean; aSkipHeader
: boolean=false);
297 fKillSrc
:= aKillSrc
;
302 GetMem(fBuffer
, ZBufSize
);
303 fSkipHeader
:= aSkipHeader
;
304 fSrcStPos
:= fSrcSt
.position
;
305 FillChar(fZlibSt
, sizeof(fZlibSt
), 0);
306 if fSkipHeader
then err
:= inflateInit2(fZlibSt
, -MAX_WBITS
) else err
:= inflateInit(fZlibSt
);
307 if err
<> Z_OK
then raise XStreamError
.Create(zerror(err
));
311 destructor TUnZStream
.destroy ();
315 if fKillSrc
then fSrcSt
.Free();
320 function TUnZStream
.readBuf (var buffer
; count
: LongInt): LongInt;
326 if (fSize
>= 0) and (fPos
>= fSize
) then exit
;
329 fZlibSt
.next_out
:= @buffer
;
330 fZlibSt
.avail_out
:= count
;
331 sz
:= fZlibSt
.avail_out
;
332 while fZlibSt
.avail_out
> 0 do
334 if fZlibSt
.avail_in
= 0 then
337 fZlibSt
.next_in
:= fBuffer
;
338 fZlibSt
.avail_in
:= fSrcSt
.read(Fbuffer
^, ZBufSize
);
340 err
:= inflate(fZlibSt
, Z_NO_FLUSH
);
341 if (err
<> Z_OK
) and (err
<> Z_STREAM_END
) then raise XStreamError
.Create(zerror(err
));
342 Inc(result
, sz
-fZlibSt
.avail_out
);
343 Inc(fPos
, sz
-fZlibSt
.avail_out
);
344 sz
:= fZlibSt
.avail_out
;
345 if err
= Z_STREAM_END
then begin fSize
:= fPos
; break
; end;
351 procedure TUnZStream
.fixPos ();
353 buf
: array [0..4095] of Byte;
356 if fSkipToPos
< 0 then exit
;
357 //writeln('fixing pos: fPos=', fPos, '; fSkipToPos=', fSkipToPos);
358 if fSkipToPos
< fPos
then reset();
359 while fPos
< fSkipToPos
do
361 if fSkipToPos
-fPos
> 4096 then rd
:= 4096 else rd
:= LongInt(fSkipToPos
-fPos
);
362 //writeln(' reading ', rd, ' bytes...');
363 rr
:= readBuf(buf
, rd
);
364 //writeln(' got ', rr, ' bytes; fPos=', fPos, '; fSkipToPos=', fSkipToPos);
365 if rr
<= 0 then raise XStreamError
.Create('seek error');
367 //writeln(' pos: fPos=', fPos, '; fSkipToPos=', fSkipToPos);
372 procedure TUnZStream
.determineSize ();
374 buf
: array [0..4095] of Byte;
378 if fSize
>= 0 then exit
;
381 //writeln('determining unzstream size...');
384 rd
:= readBuf(buf
, 4096);
385 if rd
= 0 then break
;
388 //writeln(' unzstream size is ', fSize);
390 if fSkipToPos
< 0 then fSkipToPos
:= opos
;
395 function TUnZStream
.read (var buffer
; count
: LongInt): LongInt;
397 if fSkipToPos
>= 0 then fixPos();
398 result
:= readBuf(buffer
, count
);
402 function TUnZStream
.write (const buffer
; count
: LongInt): LongInt;
405 raise XStreamError
.Create('can''t write to read-only stream');
409 procedure TUnZStream
.reset ();
413 //writeln('doing RESET');
414 fSrcSt
.position
:= fSrcStPos
;
417 FillChar(fZlibSt
, sizeof(fZlibSt
), 0);
418 if fSkipHeader
then err
:= inflateInit2(fZlibSt
, -MAX_WBITS
) else err
:= inflateInit(fZlibSt
);
419 if err
<> Z_OK
then raise XStreamError
.Create(zerror(err
));
423 function TUnZStream
.Seek (const offset
: Int64; origin
: TSeekOrigin
): Int64;
428 if fSkipToPos
>= 0 then cpos
:= fSkipToPos
;
430 soBeginning
: result
:= offset
;
431 soCurrent
: result
:= offset
+cpos
;
432 soEnd
: begin determineSize(); result
:= fSize
+offset
; end;
433 else raise XStreamError
.Create('invalid Seek() call');
434 // äðóãèõ íå áûâàåò. à ó êîãî áûâàåò, òîìó ÿ íå äîêòîð.
436 if result
< 0 then result
:= 0;
437 fSkipToPos
:= result
;
438 //writeln('seek: ofs=', offset, '; origin=', origin, '; result=', result);