src/shared/xstreams.pas

   1 (* Copyright (C)  Doom 2D: Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 // special stream classes
  17 {$INCLUDE a_modes.inc}
  18 {.$R+}
  19 unit xstreams;
  20
  21 interface
  22
  23 uses
  24   SysUtils, Classes,
  25   zbase{z_stream};
  26
  27
  28 type
  29   XStreamError = class(Exception);
  30
  31   // read-only ïîòîê äëÿ èçâëå÷åíèÿ èç èñõîäíîãî òîëüêî êóñî÷êà
  32   TSFSPartialStream = class(TStream)
  33   protected
  34     fSource: TStream;     // èñõîäíûé ïîòîê
  35     fKillSource: Boolean; // óáèâàòü èñõîäíèê ïðè ïîìèðàíèè?
  36     fLastReadPos: Int64;  // ïîñëåäíèé Read() îñòàíîâèëñÿ çäåñü (îòíîñ. fStartPos)
  37     fCurrentPos: Int64;   // ïîñëåäíèé Seek() îñòàíîâèëñÿ çäåñü (îòíîñ. fStartPos)
  38     fStartPos: Int64;     // íà÷àëî êóñî÷êà
  39     fSize: Int64;         // äëèíà êóñî÷êà
  40     fPreBuf: packed array of Byte; // ýòîò áóôåð áóäåò ïåðåä ôàéëîì
  41
  42     procedure CheckPos ();
  43
  44   public
  45     // aSrc: ïîòîê-èñõîäíèê.
  46     // aPos: íà÷àëüíàÿ ïîçèöèÿ â ïîòîêå. -1 -- ñ òåêóùåé.
  47     //       åñëè aPos < òåêóùåé ïîçèöèè, òî èñõîäíûé ïîòîê äîëæåí
  48     //       íîðìàëüíî ïîääåðæèâàòü Seek()!
  49     // aSize: êîëè÷åñòâî áàéòèêîâ, êîòîðîå ìîæíî ïðî÷åñòü èç ïîòîêà.
  50     //        åñëè ìåíüøå íóëÿ -- òî äî êîíöà.
  51     // aKillSrc: óáèâàòü ëè èñõîäíûé ïîòîê, êîãäà ñàìè óìèðàåì?
  52     // òàêæå ìîæåò ïðèøïàíäîðèòü ê íà÷àëó ôàéëà áóôåð. bufSz áóäåò äîáàâëåíî ê
  53     // äëèíå ôàéëà.
  54     constructor Create (aSrc: TStream; aPos, aSize: Int64; aKillSrc: Boolean; preBuf: Pointer=nil; bufSz: Integer=0);
  55     destructor Destroy (); override;
  56
  57     // íîðìàëèçóåò count è ÷èòàåò.
  58     function Read (var buffer; count: LongInt): LongInt; override;
  59     // Write() ïðîñòî ãðîìêî ïàäàåò.
  60     function Write (const buffer; count: LongInt): LongInt; override;
  61     // Seek() ðåàëèçîâàíî, ÷òîáû ìîãëà ðàáîòàòü ïðîïåðòÿ Size.
  62     // âîîáùå-òî ìîæíî ïåðåêðûòü ìåòîä GetSize(), íî âäðóã êàêîé
  63     // áîëüíîé íà ãîëîâó êîäåð áóäåò ïîëó÷àòü ðàçìåð ïðè ïîìîùè
  64     // Seek()'à?
  65     function Seek (const offset: Int64; origin: TSeekOrigin): Int64; override;
  66   end;
  67
  68   // this stream can kill both `proxied` and `guarded` streams on closing
  69   TSFSGuardStream = class(TStream)
  70   protected
  71     fSource: TStream;        // èñõîäíûé ïîòîê
  72     fGuardedStream: TStream; // ïîòîê, êîòîðûé çàâàëèì ïðè ïîìèðàíèè
  73     fKillSource: Boolean;    // óáèâàòü èñõîäíèê ïðè ïîìèðàíèè?
  74     fKillGuarded: Boolean;   // óáèâàòü îõðàíÿåìûé ïðè ïîìèðàíèè?
  75     fGuardedFirst: Boolean;  // ïðè ñìåðòè ïåðâûì ïðèøèáàåì îõðàíÿåìîãî?
  76
  77   public
  78     // aSrc: ïîòîê-èñõîäíèê (íà êîòîðûé çàìàïåíû îïåðàöèè ÷òåíèÿ/çàïèñè).
  79     // aKillSrc: óáèâàòü ëè èñõîäíûé ïîòîê, êîãäà ñàìè óìèðàåì?
  80     // aKillGuarded: óáèâàòü ëè îõðàíÿåìûé ïîòîê, êîãäà ñàìè óìèðàåì?
  81     // aGuardedFirst: true: ïðè ñìåðòè ïåðâûì ïðèøèáàåì îõðàíÿåìîãî.
  82     constructor Create (aSrc, aGuarded: TStream; aKillSrc, aKillGuarded: Boolean; aGuardedFirst: Boolean=true);
  83     destructor Destroy (); override;
  84
  85     // íèæåñëåäóþùåå çàìàïëåíî íà fSource
  86     function Read (var buffer; count: LongInt): LongInt; override;
  87     function Write (const buffer; count: LongInt): LongInt; override;
  88     function Seek (const offset: Int64; origin: TSeekOrigin): Int64; override;
  89   end;
  90
  91   TSFSMemoryStreamRO = class(TCustomMemoryStream)
  92   private
  93     fFreeMem: Boolean;
  94     fMem: Pointer;
  95
  96   public
  97     constructor Create (pMem: Pointer; pSize: Integer; aFreeMem: Boolean=false);
  98     destructor Destroy (); override;
  99
 100     function Write (const buffer; count: LongInt): LongInt; override;
 101   end;
 102
 103   TUnZStream = class(TStream)
 104   protected
 105     fSrcSt: TStream;
 106     fZlibSt: z_stream;
 107     fBuffer: PByte;
 108     fPos: Int64;
 109     fSkipHeader: Boolean;
 110     fSize: Int64; // can be -1
 111     fSrcStPos: Int64;
 112     fSkipToPos: Int64; // >0: skip to this position
 113     fKillSrc: Boolean;
 114
 115     procedure reset ();
 116     function readBuf (var buffer; count: LongInt): LongInt;
 117     procedure fixPos ();
 118     procedure determineSize ();
 119
 120   public
 121     // `aSize` can be -1 if stream size is unknown
 122     constructor create (asrc: TStream; aSize: Int64; aKillSrc: Boolean; aSkipHeader: boolean=false);
 123     destructor destroy (); override;
 124     function read (var buffer; count: LongInt): LongInt; override;
 125     function write (const buffer; count: LongInt): LongInt; override;
 126     function seek (const offset: Int64; origin: TSeekOrigin): Int64; override;
 127   end;
 128
 129   // fixed memory chunk
 130   TSFSMemoryChunkStream = class(TStream)
 131   private
 132     fFreeMem: Boolean;
 133     fMemBuf: PByte;
 134     fMemSize: Integer;
 135     fCurPos: Integer;
 136
 137   public
 138     // if `pMem` is `nil`, stream will allocate it
 139     constructor Create (pMem: Pointer; pSize: Integer; aFreeMem: Boolean=false);
 140     destructor Destroy (); override;
 141
 142     procedure setup (pMem: Pointer; pSize: Integer; aFreeMem: Boolean=false);
 143
 144     function Seek (const offset: Int64; origin: TSeekOrigin): Int64; override;
 145     function Read (var buffer; count: LongInt): LongInt; override;
 146     function Write (const buffer; count: LongInt): LongInt; override;
 147
 148     property chunkSize: Integer read fMemSize;
 149     property chunkData: PByte read fMemBuf;
 150   end;
 151
 152
 153 implementation
 154
 155 uses
 156   zinflate;
 157
 158
 159 { TSFSPartialStream }
 160 constructor TSFSPartialStream.Create (aSrc: TStream; aPos, aSize: Int64; aKillSrc: Boolean; preBuf: Pointer=nil; bufSz: Integer=0);
 161 begin
 162   inherited Create();
 163   ASSERT(aSrc <> nil);
 164   if aPos < 0 then aPos := aSrc.Position;
 165   if aSize < 0 then aSize := 0;
 166   fSource := aSrc;
 167   fKillSource := aKillSrc;
 168   fLastReadPos := 0;
 169   fCurrentPos := 0;
 170   fStartPos := aPos;
 171   fSize := aSize;
 172   if bufSz > 0 then
 173   begin
 174     SetLength(fPreBuf, bufSz);
 175     Move(preBuf^, fPreBuf[0], bufSz);
 176     Inc(fSize, bufSz);
 177   end
 178   else
 179   begin
 180     fPreBuf := nil;
 181   end;
 182 end;
 183
 184 destructor TSFSPartialStream.Destroy ();
 185 begin
 186   if fKillSource then FreeAndNil(fSource);
 187   inherited Destroy();
 188 end;
 189
 190 procedure TSFSPartialStream.CheckPos ();
 191 begin
 192   {
 193   if fSource.Position <> fStartPos+fCurrentPos-Length(fPreBuf) then
 194   begin
 195     fSource.Position := fStartPos+fCurrentPos-Length(fPreBuf);
 196   end;
 197   }
 198   if fCurrentPos >= length(fPreBuf) then
 199   begin
 200     //writeln('seeking at ', fCurrentPos, ' (real: ', fStartPos+fCurrentPos-Length(fPreBuf), ')');
 201     fSource.Position := fStartPos+fCurrentPos-Length(fPreBuf);
 202   end;
 203   fLastReadPos := fCurrentPos;
 204 end;
 205
 206 function TSFSPartialStream.Write (const buffer; count: LongInt): LongInt;
 207 begin
 208   result := 0;
 209   raise XStreamError.Create('can''t write to read-only stream');
 210   // à íå õîäè, íåõîðîøèé, â íàø ñàäèê ãóëÿòü!
 211 end;
 212
 213 function TSFSPartialStream.Read (var buffer; count: LongInt): LongInt;
 214 var
 215   left: Int64;
 216   pc: Pointer;
 217   rd: LongInt;
 218 begin
 219   if count < 0 then raise XStreamError.Create('invalid Read() call'); // ñêàçî÷íûé äîëáî¸á...
 220   if count = 0 then begin result := 0; exit; end;
 221   pc := @buffer;
 222   result := 0;
 223   if (Length(fPreBuf) > 0) and (fCurrentPos < Length(fPreBuf)) then
 224   begin
 225     fLastReadPos := fCurrentPos;
 226     left := Length(fPreBuf)-fCurrentPos;
 227     if left > count then left := count;
 228     if left > 0 then
 229     begin
 230       Move(fPreBuf[fCurrentPos], pc^, left);
 231       Inc(PChar(pc), left);
 232       Inc(fCurrentPos, left);
 233       fLastReadPos := fCurrentPos;
 234       Dec(count, left);
 235       result := left;
 236       if count = 0 then exit;
 237     end;
 238   end;
 239   CheckPos();
 240   left := fSize-fCurrentPos;
 241   if left < count then count := left; // è òàê ñëó÷àåòñÿ...
 242   if count > 0 then
 243   begin
 244     rd := fSource.Read(pc^, count);
 245     Inc(result, rd);
 246     Inc(fCurrentPos, rd);
 247     fLastReadPos := fCurrentPos;
 248   end
 249   else
 250   begin
 251     result := 0;
 252   end;
 253 end;
 254
 255 function TSFSPartialStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64;
 256 begin
 257   case origin of
 258     soBeginning: result := offset;
 259     soCurrent: result := offset+fCurrentPos;
 260     soEnd: result := fSize+offset;
 261     else raise XStreamError.Create('invalid Seek() call');
 262     // äðóãèõ íå áûâàåò. à ó êîãî áûâàåò, òîìó ÿ íå äîêòîð.
 263   end;
 264   if result < 0 then result := 0
 265   else if result > fSize then result := fSize;
 266   fCurrentPos := result;
 267 end;
 268
 269
 270 { TSFSGuardStream }
 271 constructor TSFSGuardStream.Create (aSrc, aGuarded: TStream; aKillSrc, aKillGuarded: Boolean; aGuardedFirst: Boolean=true);
 272 begin
 273   inherited Create();
 274   fSource := aSrc; fGuardedStream := aGuarded;
 275   fKillSource := aKillSrc; fKillGuarded := aKillGuarded;
 276   fGuardedFirst := aGuardedFirst;
 277 end;
 278
 279 destructor TSFSGuardStream.Destroy ();
 280 begin
 281   if fKillGuarded and fGuardedFirst then FreeAndNil(fGuardedStream);
 282   if fKillSource then FreeAndNil(fSource);
 283   if fKillGuarded and not fGuardedFirst then FreeAndNil(fGuardedStream);
 284   inherited Destroy();
 285 end;
 286
 287 function TSFSGuardStream.Read (var buffer; count: LongInt): LongInt;
 288 begin
 289   result := fSource.Read(buffer, count);
 290 end;
 291
 292 function TSFSGuardStream.Write (const buffer; count: LongInt): LongInt;
 293 begin
 294   result := fSource.Write(buffer, count);
 295 end;
 296
 297 function TSFSGuardStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64;
 298 begin
 299   result := fSource.Seek(offset, origin);
 300 end;
 301
 302
 303 { TSFSMemoryStreamRO }
 304 constructor TSFSMemoryStreamRO.Create (pMem: Pointer; pSize: Integer; aFreeMem: Boolean=false);
 305 begin
 306   fFreeMem := aFreeMem;
 307   fMem := pMem;
 308   inherited Create();
 309   SetPointer(pMem, pSize);
 310   Position := 0;
 311 end;
 312
 313 destructor TSFSMemoryStreamRO.Destroy ();
 314 begin
 315   if fFreeMem and (fMem <> nil) then FreeMem(fMem);
 316 end;
 317
 318 function TSFSMemoryStreamRO.Write (const buffer; count: LongInt): LongInt;
 319 begin
 320   result := 0;
 321   raise XStreamError.Create('can''t write to read-only stream');
 322   // ñîâñåì ñáðåíäèë...
 323 end;
 324
 325
 326 // ////////////////////////////////////////////////////////////////////////// //
 327 { TUnZStream }
 328 const ZBufSize = 32768; // size of the buffer used for temporarily storing data from the child stream
 329
 330
 331 constructor TUnZStream.create (asrc: TStream; aSize: Int64; aKillSrc: Boolean; aSkipHeader: boolean=false);
 332 var
 333   err: Integer;
 334 begin
 335   fKillSrc := aKillSrc;
 336   fPos := 0;
 337   fSkipToPos := -1;
 338   fSrcSt := asrc;
 339   fSize := aSize;
 340   GetMem(fBuffer, ZBufSize);
 341   fSkipHeader := aSkipHeader;
 342   fSrcStPos := fSrcSt.position;
 343   FillChar(fZlibSt, sizeof(fZlibSt), 0);
 344   if fSkipHeader then err := inflateInit2(fZlibSt, -MAX_WBITS) else err := inflateInit(fZlibSt);
 345   if err <> Z_OK then raise XStreamError.Create(zerror(err));
 346 end;
 347
 348
 349 destructor TUnZStream.destroy ();
 350 begin
 351   inflateEnd(fZlibSt);
 352   FreeMem(fBuffer);
 353   if fKillSrc then fSrcSt.Free();
 354   inherited Destroy();
 355 end;
 356
 357
 358 function TUnZStream.readBuf (var buffer; count: LongInt): LongInt;
 359 var
 360   err: Integer;
 361   sz: LongInt;
 362 begin
 363   result := 0;
 364   if (fSize >= 0) and (fPos >= fSize) then exit;
 365   if count > 0 then
 366   begin
 367     fZlibSt.next_out := @buffer;
 368     fZlibSt.avail_out := count;
 369     sz := fZlibSt.avail_out;
 370     while fZlibSt.avail_out > 0 do
 371     begin
 372       if fZlibSt.avail_in = 0 then
 373       begin
 374         // refill the buffer
 375         fZlibSt.next_in := fBuffer;
 376         fZlibSt.avail_in := fSrcSt.read(Fbuffer^, ZBufSize);
 377       end;
 378       err := inflate(fZlibSt, Z_NO_FLUSH);
 379       if (err <> Z_OK) and (err <> Z_STREAM_END) then raise XStreamError.Create(zerror(err));
 380       Inc(result, sz-fZlibSt.avail_out);
 381       Inc(fPos, sz-fZlibSt.avail_out);
 382       sz := fZlibSt.avail_out;
 383       if err = Z_STREAM_END then begin fSize := fPos; break; end;
 384     end;
 385   end;
 386 end;
 387
 388
 389 procedure TUnZStream.fixPos ();
 390 var
 391   buf: array [0..4095] of Byte;
 392   rd, rr: LongInt;
 393 begin
 394   if fSkipToPos < 0 then exit;
 395   //writeln('fixing pos: fPos=', fPos, '; fSkipToPos=', fSkipToPos);
 396   if fSkipToPos < fPos then reset();
 397   while fPos < fSkipToPos do
 398   begin
 399     if fSkipToPos-fPos > 4096 then rd := 4096 else rd := LongInt(fSkipToPos-fPos);
 400     //writeln('  reading ', rd, ' bytes...');
 401     rr := readBuf(buf, rd);
 402     //writeln('  got ', rr, ' bytes; fPos=', fPos, '; fSkipToPos=', fSkipToPos);
 403     if rr <= 0 then raise XStreamError.Create('seek error');
 404   end;
 405   //writeln('  pos: fPos=', fPos, '; fSkipToPos=', fSkipToPos);
 406   fSkipToPos := -1;
 407 end;
 408
 409
 410 procedure TUnZStream.determineSize ();
 411 var
 412   buf: array [0..4095] of Byte;
 413   rd: LongInt;
 414   opos: Int64;
 415 begin
 416   if fSize >= 0 then exit;
 417   opos := fPos;
 418   try
 419     //writeln('determining unzstream size...');
 420     while true do
 421     begin
 422       rd := readBuf(buf, 4096);
 423       if rd = 0 then break;
 424     end;
 425     fSize := fPos;
 426     //writeln('  unzstream size is ', fSize);
 427   finally
 428     if fSkipToPos < 0 then fSkipToPos := opos;
 429   end;
 430 end;
 431
 432
 433 function TUnZStream.read (var buffer; count: LongInt): LongInt;
 434 begin
 435   if fSkipToPos >= 0 then fixPos();
 436   result := readBuf(buffer, count);
 437 end;
 438
 439
 440 function TUnZStream.write (const buffer; count: LongInt): LongInt;
 441 begin
 442   result := 0;
 443   raise XStreamError.Create('can''t write to read-only stream');
 444 end;
 445
 446
 447 procedure TUnZStream.reset ();
 448 var
 449   err: Integer;
 450 begin
 451   //writeln('doing RESET');
 452   fSrcSt.position := fSrcStPos;
 453   fPos := 0;
 454   inflateEnd(fZlibSt);
 455   FillChar(fZlibSt, sizeof(fZlibSt), 0);
 456   if fSkipHeader then err := inflateInit2(fZlibSt, -MAX_WBITS) else err := inflateInit(fZlibSt);
 457   if err <> Z_OK then raise XStreamError.Create(zerror(err));
 458 end;
 459
 460
 461 function TUnZStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64;
 462 var
 463   cpos: Int64;
 464 begin
 465   cpos := fPos;
 466   if fSkipToPos >= 0 then cpos := fSkipToPos;
 467   case origin of
 468     soBeginning: result := offset;
 469     soCurrent: result := offset+cpos;
 470     soEnd: begin determineSize(); result := fSize+offset; end;
 471     else raise XStreamError.Create('invalid Seek() call');
 472     // äðóãèõ íå áûâàåò. à ó êîãî áûâàåò, òîìó ÿ íå äîêòîð.
 473   end;
 474   if result < 0 then result := 0;
 475   fSkipToPos := result;
 476   //writeln('seek: ofs=', offset, '; origin=', origin, '; result=', result);
 477 end;
 478
 479
 480 // ////////////////////////////////////////////////////////////////////////// //
 481 constructor TSFSMemoryChunkStream.Create (pMem: Pointer; pSize: Integer; aFreeMem: Boolean=false);
 482 begin
 483   fMemBuf := nil;
 484   fFreeMem := false;
 485   fMemSize := 0;
 486   fCurPos := 0;
 487   setup(pMem, pSize, aFreeMem);
 488 end;
 489
 490
 491 procedure TSFSMemoryChunkStream.setup (pMem: Pointer; pSize: Integer; aFreeMem: Boolean=false);
 492 begin
 493   if fFreeMem then FreeMem(fMemBuf);
 494   fMemBuf := nil;
 495   fFreeMem := false;
 496   fMemSize := 0;
 497   fCurPos := 0;
 498   if (pSize < 0) then raise XStreamError.Create('invalid chunk size');
 499   if (pMem = nil) then
 500   begin
 501     if (pSize > 0) then
 502     begin
 503       GetMem(pMem, pSize);
 504       if (pMem = nil) then raise XStreamError.Create('out of memory for chunk');
 505       aFreeMem := true;
 506     end
 507     else
 508     begin
 509       aFreeMem := false;
 510     end;
 511   end;
 512   fFreeMem := aFreeMem;
 513   fMemBuf := PByte(pMem);
 514   fMemSize := pSize;
 515 end;
 516
 517
 518 destructor TSFSMemoryChunkStream.Destroy ();
 519 begin
 520   if fFreeMem then FreeMem(fMemBuf);
 521   inherited;
 522 end;
 523
 524
 525 function TSFSMemoryChunkStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64;
 526 begin
 527   case origin of
 528     soBeginning: result := offset;
 529     soCurrent: result := offset+fCurPos;
 530     soEnd: result := fMemSize+offset;
 531     else raise XStreamError.Create('invalid Seek() call');
 532   end;
 533   if (result < 0) then raise XStreamError.Create('invalid Seek() call');
 534   if (result > fMemSize) then result := fMemSize;
 535   fCurPos := result;
 536 end;
 537
 538
 539 function TSFSMemoryChunkStream.Read (var buffer; count: LongInt): LongInt;
 540 var
 541   left: Integer;
 542 begin
 543   if (count < 0) then raise XStreamError.Create('negative read');
 544   left := fMemSize-fCurPos;
 545   if (left < 0) then raise XStreamError.Create('internal error in TSFSMemoryChunkStream (read)');
 546   if (count > left) then count := left;
 547   if (count > 0) then Move((fMemBuf+fCurPos)^, buffer, count);
 548   Inc(fCurPos, count);
 549   result := count;
 550 end;
 551
 552
 553 function TSFSMemoryChunkStream.Write (const buffer; count: LongInt): LongInt;
 554 var
 555   left: Integer;
 556 begin
 557   if (count < 0) then raise XStreamError.Create('negative write');
 558   left := fMemSize-fCurPos;
 559   if (left < 0) then raise XStreamError.Create('internal error in TSFSMemoryChunkStream (write)');
 560   if (count > left) then count := left;
 561   if (count > 0) then Move(buffer, (fMemBuf+fCurPos)^, count);
 562   Inc(fCurPos, count);
 563   result := count;
 564 end;
 565
 566
 567 end.