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   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));
 308 end;
 309
 310
 311 destructor TUnZStream.destroy ();
 312 begin
 313   inflateEnd(fZlibSt);
 314   FreeMem(fBuffer);
 315   if fKillSrc then fSrcSt.Free();
 316   inherited Destroy();
 317 end;
 318
 319
 320 function TUnZStream.readBuf (var buffer; count: LongInt): LongInt;
 321 var
 322   err: Integer;
 323   sz: LongInt;
 324 begin
 325   result := 0;
 326   if (fSize >= 0) and (fPos >= fSize) then exit;
 327   if count > 0 then
 328   begin
 329     fZlibSt.next_out := @buffer;
 330     fZlibSt.avail_out := count;
 331     sz := fZlibSt.avail_out;
 332     while fZlibSt.avail_out > 0 do
 333     begin
 334       if fZlibSt.avail_in = 0 then
 335       begin
 336         // refill the buffer
 337         fZlibSt.next_in := fBuffer;
 338         fZlibSt.avail_in := fSrcSt.read(Fbuffer^, ZBufSize);
 339       end;
 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;
 346     end;
 347   end;
 348 end;
 349
 350
 351 procedure TUnZStream.fixPos ();
 352 var
 353   buf: array [0..4095] of Byte;
 354   rd, rr: LongInt;
 355 begin
 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
 360   begin
 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 rd <= 0 then raise XStreamError.Create('seek error');
 366   end;
 367   //writeln('  pos: fPos=', fPos, '; fSkipToPos=', fSkipToPos);
 368   fSkipToPos := -1;
 369 end;
 370
 371
 372 procedure TUnZStream.determineSize ();
 373 var
 374   buf: array [0..4095] of Byte;
 375   rd: LongInt;
 376   opos: Int64;
 377 begin
 378   if fSize >= 0 then exit;
 379   opos := fPos;
 380   try
 381     //writeln('determining unzstream size...');
 382     while true do
 383     begin
 384       rd := readBuf(buf, 4096);
 385       if rd = 0 then break;
 386     end;
 387     fSize := fPos;
 388     //writeln('  unzstream size is ', fSize);
 389   finally
 390     if fSkipToPos < 0 then fSkipToPos := opos;
 391   end;
 392 end;
 393
 394
 395 function TUnZStream.read (var buffer; count: LongInt): LongInt;
 396 begin
 397   if fSkipToPos >= 0 then fixPos();
 398   result := readBuf(buffer, count);
 399 end;
 400
 401
 402 function TUnZStream.write (const buffer; count: LongInt): LongInt;
 403 begin
 404   result := 0;
 405   raise XStreamError.Create('can''t write to read-only stream');
 406 end;
 407
 408
 409 procedure TUnZStream.reset ();
 410 var
 411   err: Integer;
 412 begin
 413   //writeln('doing RESET');
 414   fSrcSt.position := fSrcStPos;
 415   fPos := 0;
 416   inflateEnd(fZlibSt);
 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));
 420 end;
 421
 422
 423 function TUnZStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64;
 424 var
 425   cpos: Int64;
 426 begin
 427   cpos := fPos;
 428   if fSkipToPos >= 0 then cpos := fSkipToPos;
 429   case origin of
 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     // äðóãèõ íå áûâàåò. à ó êîãî áûâàåò, òîìó ÿ íå äîêòîð.
 435   end;
 436   if result < 0 then result := 0;
 437   fSkipToPos := result;
 438   //writeln('seek: ofs=', offset, '; origin=', origin, '; result=', result);
 439 end;
 440
 441
 442 end.