src/shared/xstreams.pas

   1 // special stream classes
   2 {$MODE DELPHI}
   3 {$R+}
   4 unit xstreams;
   5
   6 interface
   7
   8 uses
   9   SysUtils, Classes,
  10   zbase{z_stream};
  11
  12
  13 type
  14   XStreamError = class(Exception);
  15
  16   // read-only ïîòîê äëÿ èçâëå÷åíèÿ èç èñõîäíîãî òîëüêî êóñî÷êà
  17   TSFSPartialStream = class(TStream)
  18   protected
  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; // ýòîò áóôåð áóäåò ïåðåä ôàéëîì
  26
  27     procedure CheckPos ();
  28
  29   public
  30     // aSrc: ïîòîê-èñõîäíèê.
  31     // aPos: íà÷àëüíàÿ ïîçèöèÿ â ïîòîêå. -1 -- ñ òåêóùåé.
  32     //       åñëè aPos < òåêóùåé ïîçèöèè, òî èñõîäíûé ïîòîê äîëæåí
  33     //       íîðìàëüíî ïîääåðæèâàòü Seek()!
  34     // aSize: êîëè÷åñòâî áàéòèêîâ, êîòîðîå ìîæíî ïðî÷åñòü èç ïîòîêà.
  35     //        åñëè ìåíüøå íóëÿ -- òî äî êîíöà.
  36     // aKillSrc: óáèâàòü ëè èñõîäíûé ïîòîê, êîãäà ñàìè óìèðàåì?
  37     // òàêæå ìîæåò ïðèøïàíäîðèòü ê íà÷àëó ôàéëà áóôåð. bufSz áóäåò äîáàâëåíî ê
  38     // äëèíå ôàéëà.
  39     constructor Create (aSrc: TStream; aPos, aSize: Int64; aKillSrc: Boolean; preBuf: Pointer=nil; bufSz: Integer=0);
  40     destructor Destroy (); override;
  41
  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     // áîëüíîé íà ãîëîâó êîäåð áóäåò ïîëó÷àòü ðàçìåð ïðè ïîìîùè
  49     // Seek()'à?
  50     function Seek (const offset: Int64; origin: TSeekOrigin): Int64; override;
  51   end;
  52
  53   // this stream can kill both `proxied` and `guarded` streams on closing
  54   TSFSGuardStream = class(TStream)
  55   protected
  56     fSource: TStream;        // èñõîäíûé ïîòîê
  57     fGuardedStream: TStream; // ïîòîê, êîòîðûé çàâàëèì ïðè ïîìèðàíèè
  58     fKillSource: Boolean;    // óáèâàòü èñõîäíèê ïðè ïîìèðàíèè?
  59     fKillGuarded: Boolean;   // óáèâàòü îõðàíÿåìûé ïðè ïîìèðàíèè?
  60     fGuardedFirst: Boolean;  // ïðè ñìåðòè ïåðâûì ïðèøèáàåì îõðàíÿåìîãî?
  61
  62   public
  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;
  69
  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;
  74   end;
  75
  76   TSFSMemoryStreamRO = class(TCustomMemoryStream)
  77   private
  78     fFreeMem: Boolean;
  79     fMem: Pointer;
  80
  81   public
  82     constructor Create (pMem: Pointer; pSize: Integer; aFreeMem: Boolean=false);
  83     destructor Destroy (); override;
  84
  85     function Write (const buffer; count: LongInt): LongInt; override;
  86   end;
  87
  88   TUnZStream = class(TStream)
  89   protected
  90     fSrcSt: TStream;
  91     fZlibSt: z_stream;
  92     fBuffer: PByte;
  93     fPos: Int64;
  94     fSkipHeader: Boolean;
  95     fSize: Int64; // can be -1
  96     fSrcStPos: Int64;
  97     fSkipToPos: Int64; // >0: skip to this position
  98     fKillSrc: Boolean;
  99
 100     procedure reset ();
 101     function readBuf (var buffer; count: LongInt): LongInt;
 102     procedure fixPos ();
 103     procedure determineSize ();
 104
 105   public
 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;
 112   end;
 113
 114
 115 implementation
 116
 117 uses
 118   zinflate;
 119
 120
 121 { TSFSPartialStream }
 122 constructor TSFSPartialStream.Create (aSrc: TStream; aPos, aSize: Int64; aKillSrc: Boolean; preBuf: Pointer=nil; bufSz: Integer=0);
 123 begin
 124   inherited Create();
 125   ASSERT(aSrc <> nil);
 126   if aPos < 0 then aPos := aSrc.Position;
 127   if aSize < 0 then aSize := 0;
 128   fSource := aSrc;
 129   fKillSource := aKillSrc;
 130   fLastReadPos := 0;
 131   fCurrentPos := 0;
 132   fStartPos := aPos;
 133   fSize := aSize;
 134   if bufSz > 0 then
 135   begin
 136     SetLength(fPreBuf, bufSz);
 137     Move(preBuf^, fPreBuf[0], bufSz);
 138     Inc(fSize, bufSz);
 139   end
 140   else
 141   begin
 142     fPreBuf := nil;
 143   end;
 144 end;
 145
 146 destructor TSFSPartialStream.Destroy ();
 147 begin
 148   if fKillSource then FreeAndNil(fSource);
 149   inherited Destroy();
 150 end;
 151
 152 procedure TSFSPartialStream.CheckPos ();
 153 begin
 154   {
 155   if fSource.Position <> fStartPos+fCurrentPos-Length(fPreBuf) then
 156   begin
 157     fSource.Position := fStartPos+fCurrentPos-Length(fPreBuf);
 158   end;
 159   }
 160   if fCurrentPos >= length(fPreBuf) then
 161   begin
 162     //writeln('seeking at ', fCurrentPos, ' (real: ', fStartPos+fCurrentPos-Length(fPreBuf), ')');
 163     fSource.Position := fStartPos+fCurrentPos-Length(fPreBuf);
 164   end;
 165   fLastReadPos := fCurrentPos;
 166 end;
 167
 168 function TSFSPartialStream.Write (const buffer; count: LongInt): LongInt;
 169 begin
 170   result := 0;
 171   raise XStreamError.Create('can''t write to read-only stream');
 172   // à íå õîäè, íåõîðîøèé, â íàø ñàäèê ãóëÿòü!
 173 end;
 174
 175 function TSFSPartialStream.Read (var buffer; count: LongInt): LongInt;
 176 var
 177   left: Int64;
 178   pc: Pointer;
 179   rd: LongInt;
 180 begin
 181   if count < 0 then raise XStreamError.Create('invalid Read() call'); // ñêàçî÷íûé äîëáî¸á...
 182   if count = 0 then begin result := 0; exit; end;
 183   pc := @buffer;
 184   result := 0;
 185   if (Length(fPreBuf) > 0) and (fCurrentPos < Length(fPreBuf)) then
 186   begin
 187     fLastReadPos := fCurrentPos;
 188     left := Length(fPreBuf)-fCurrentPos;
 189     if left > count then left := count;
 190     if left > 0 then
 191     begin
 192       Move(fPreBuf[fCurrentPos], pc^, left);
 193       Inc(PChar(pc), left);
 194       Inc(fCurrentPos, left);
 195       fLastReadPos := fCurrentPos;
 196       Dec(count, left);
 197       result := left;
 198       if count = 0 then exit;
 199     end;
 200   end;
 201   CheckPos();
 202   left := fSize-fCurrentPos;
 203   if left < count then count := left; // è òàê ñëó÷àåòñÿ...
 204   if count > 0 then
 205   begin
 206     rd := fSource.Read(pc^, count);
 207     Inc(result, rd);
 208     Inc(fCurrentPos, rd);
 209     fLastReadPos := fCurrentPos;
 210   end
 211   else
 212   begin
 213     result := 0;
 214   end;
 215 end;
 216
 217 function TSFSPartialStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64;
 218 begin
 219   case origin of
 220     soBeginning: result := offset;
 221     soCurrent: result := offset+fCurrentPos;
 222     soEnd: result := fSize+offset;
 223     else raise XStreamError.Create('invalid Seek() call');
 224     // äðóãèõ íå áûâàåò. à ó êîãî áûâàåò, òîìó ÿ íå äîêòîð.
 225   end;
 226   if result < 0 then result := 0
 227   else if result > fSize then result := fSize;
 228   fCurrentPos := result;
 229 end;
 230
 231
 232 { TSFSGuardStream }
 233 constructor TSFSGuardStream.Create (aSrc, aGuarded: TStream; aKillSrc, aKillGuarded: Boolean; aGuardedFirst: Boolean=true);
 234 begin
 235   inherited Create();
 236   fSource := aSrc; fGuardedStream := aGuarded;
 237   fKillSource := aKillSrc; fKillGuarded := aKillGuarded;
 238   fGuardedFirst := aGuardedFirst;
 239 end;
 240
 241 destructor TSFSGuardStream.Destroy ();
 242 begin
 243   if fKillGuarded and fGuardedFirst then FreeAndNil(fGuardedStream);
 244   if fKillSource then FreeAndNil(fSource);
 245   if fKillGuarded and not fGuardedFirst then FreeAndNil(fGuardedStream);
 246   inherited Destroy();
 247 end;
 248
 249 function TSFSGuardStream.Read (var buffer; count: LongInt): LongInt;
 250 begin
 251   result := fSource.Read(buffer, count);
 252 end;
 253
 254 function TSFSGuardStream.Write (const buffer; count: LongInt): LongInt;
 255 begin
 256   result := fSource.Write(buffer, count);
 257 end;
 258
 259 function TSFSGuardStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64;
 260 begin
 261   result := fSource.Seek(offset, origin);
 262 end;
 263
 264
 265 { TSFSMemoryStreamRO }
 266 constructor TSFSMemoryStreamRO.Create (pMem: Pointer; pSize: Integer; aFreeMem: Boolean=false);
 267 begin
 268   fFreeMem := aFreeMem;
 269   fMem := pMem;
 270   inherited Create();
 271   SetPointer(pMem, pSize);
 272   Position := 0;
 273 end;
 274
 275 destructor TSFSMemoryStreamRO.Destroy ();
 276 begin
 277   if fFreeMem and (fMem <> nil) then FreeMem(fMem);
 278 end;
 279
 280 function TSFSMemoryStreamRO.Write (const buffer; count: LongInt): LongInt;
 281 begin
 282   result := 0;
 283   raise XStreamError.Create('can''t write to read-only stream');
 284   // ñîâñåì ñáðåíäèë...
 285 end;
 286
 287
 288 // ////////////////////////////////////////////////////////////////////////// //
 289 { TUnZStream }
 290 const ZBufSize = 32768; // size of the buffer used for temporarily storing data from the child stream
 291
 292
 293 constructor TUnZStream.create (asrc: TStream; aSize: Int64; aKillSrc: Boolean; aSkipHeader: boolean=false);
 294 var
 295   err: Integer;
 296 begin
 297   fKillSrc := aKillSrc;
 298   fPos := 0;
 299   fSkipToPos := -1;
 300   fSrcSt := asrc;
 301   fSize := aSize;
 302   GetMem(fBuffer, ZBufSize);
 303   fSkipHeader := aSkipHeader;
 304   if fSkipHeader then err := inflateInit2(fZlibSt, -MAX_WBITS) else err := inflateInit(fZlibSt);
 305   if err <> Z_OK then raise XStreamError.Create(zerror(err));
 306   fSrcStPos := fSrcSt.position;
 307 end;
 308
 309
 310 destructor TUnZStream.destroy ();
 311 begin
 312   inflateEnd(fZlibSt);
 313   FreeMem(fBuffer);
 314   if fKillSrc then fSrcSt.Free();
 315   inherited Destroy();
 316 end;
 317
 318
 319 function TUnZStream.readBuf (var buffer; count: LongInt): LongInt;
 320 var
 321   err: Integer;
 322   lastavail: LongInt;
 323 begin
 324   fZlibSt.next_out := @buffer;
 325   fZlibSt.avail_out := count;
 326   lastavail := count;
 327   while fZlibSt.avail_out <> 0 do
 328   begin
 329     if fZlibSt.avail_in = 0 then
 330     begin
 331       // refill the buffer
 332       fZlibSt.next_in := fBuffer;
 333       fZlibSt.avail_in := fSrcSt.read(Fbuffer^, ZBufSize);
 334       //Inc(compressed_read, fZlibSt.avail_in);
 335       Inc(fPos, lastavail-fZlibSt.avail_out);
 336       lastavail := fZlibSt.avail_out;
 337     end;
 338     err := inflate(fZlibSt, Z_NO_FLUSH);
 339     if err = Z_STREAM_END then fSize := fPos; break;
 340     if err <> Z_OK then raise XStreamError.Create(zerror(err));
 341   end;
 342   //if err = Z_STREAM_END then Dec(compressed_read, fZlibSt.avail_in);
 343   Inc(fPos, lastavail-fZlibSt.avail_out);
 344   result := count-fZlibSt.avail_out;
 345 end;
 346
 347
 348 procedure TUnZStream.fixPos ();
 349 var
 350   buf: array [0..4095] of Byte;
 351   rd, rr: LongInt;
 352 begin
 353   if fSkipToPos < 0 then exit;
 354   //writeln('fixing pos: fPos=', fPos, '; fSkipToPos=', fSkipToPos);
 355   if fSkipToPos < fPos then reset();
 356   while fPos < fSkipToPos do
 357   begin
 358     if fSkipToPos-fPos > 4096 then rd := 4096 else rd := LongInt(fSkipToPos-fPos);
 359     //writeln('  reading ', rd, ' bytes...');
 360     rr := readBuf(buf, rd);
 361     //writeln('  got ', rr, ' bytes; fPos=', fPos, '; fSkipToPos=', fSkipToPos);
 362     if rd <> rr then raise XStreamError.Create('seek error');
 363   end;
 364   //writeln('  pos: fPos=', fPos, '; fSkipToPos=', fSkipToPos);
 365   fSkipToPos := -1;
 366 end;
 367
 368
 369 procedure TUnZStream.determineSize ();
 370 var
 371   buf: array [0..4095] of Byte;
 372   rd: LongInt;
 373   opos: Int64;
 374 begin
 375   if fSize >= 0 then exit;
 376   opos := fPos;
 377   try
 378     //writeln('determining unzstream size...');
 379     while true do
 380     begin
 381       rd := readBuf(buf, 4096);
 382       if rd <> 4096 then break;
 383     end;
 384     fSize := fPos;
 385     //writeln('  unzstream size is ', fSize);
 386   finally
 387     fSkipToPos := opos;
 388   end;
 389 end;
 390
 391
 392 function TUnZStream.read (var buffer; count: LongInt): LongInt;
 393 begin
 394   if fSkipToPos >= 0 then fixPos();
 395   result := readBuf(buffer, count);
 396 end;
 397
 398
 399 function TUnZStream.write (const buffer; count: LongInt): LongInt;
 400 begin
 401   result := 0;
 402   raise XStreamError.Create('can''t write to read-only stream');
 403 end;
 404
 405
 406 procedure TUnZStream.reset ();
 407 var
 408   err: Integer;
 409 begin
 410   fSrcSt.position := fSrcStPos;
 411   fPos := 0;
 412   inflateEnd(fZlibSt);
 413   if fSkipHeader then err := inflateInit2(fZlibSt, -MAX_WBITS) else err := inflateInit(fZlibSt);
 414   if err <> Z_OK then raise XStreamError.Create(zerror(err));
 415 end;
 416
 417
 418 function TUnZStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64;
 419 var
 420   cpos: Int64;
 421 begin
 422   cpos := fPos;
 423   if fSkipToPos >= 0 then cpos := fSkipToPos;
 424   case origin of
 425     soBeginning: result := offset;
 426     soCurrent: result := offset+cpos;
 427     soEnd: begin determineSize(); result := fSize+offset; end;
 428     else raise XStreamError.Create('invalid Seek() call');
 429     // äðóãèõ íå áûâàåò. à ó êîãî áûâàåò, òîìó ÿ íå äîêòîð.
 430   end;
 431   if result < 0 then result := 0;
 432   fSkipToPos := result;
 433   //writeln('seek: ofs=', offset, '; origin=', origin, '; result=', result);
 434 end;
 435
 436
 437 end.