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