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 {$MODE DELPHI}
  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
 130 implementation
 131
 132 uses
 133   zinflate;
 134
 135
 136 { TSFSPartialStream }
 137 constructor TSFSPartialStream.Create (aSrc: TStream; aPos, aSize: Int64; aKillSrc: Boolean; preBuf: Pointer=nil; bufSz: Integer=0);
 138 begin
 139   inherited Create();
 140   ASSERT(aSrc <> nil);
 141   if aPos < 0 then aPos := aSrc.Position;
 142   if aSize < 0 then aSize := 0;
 143   fSource := aSrc;
 144   fKillSource := aKillSrc;
 145   fLastReadPos := 0;
 146   fCurrentPos := 0;
 147   fStartPos := aPos;
 148   fSize := aSize;
 149   if bufSz > 0 then
 150   begin
 151     SetLength(fPreBuf, bufSz);
 152     Move(preBuf^, fPreBuf[0], bufSz);
 153     Inc(fSize, bufSz);
 154   end
 155   else
 156   begin
 157     fPreBuf := nil;
 158   end;
 159 end;
 160
 161 destructor TSFSPartialStream.Destroy ();
 162 begin
 163   if fKillSource then FreeAndNil(fSource);
 164   inherited Destroy();
 165 end;
 166
 167 procedure TSFSPartialStream.CheckPos ();
 168 begin
 169   {
 170   if fSource.Position <> fStartPos+fCurrentPos-Length(fPreBuf) then
 171   begin
 172     fSource.Position := fStartPos+fCurrentPos-Length(fPreBuf);
 173   end;
 174   }
 175   if fCurrentPos >= length(fPreBuf) then
 176   begin
 177     //writeln('seeking at ', fCurrentPos, ' (real: ', fStartPos+fCurrentPos-Length(fPreBuf), ')');
 178     fSource.Position := fStartPos+fCurrentPos-Length(fPreBuf);
 179   end;
 180   fLastReadPos := fCurrentPos;
 181 end;
 182
 183 function TSFSPartialStream.Write (const buffer; count: LongInt): LongInt;
 184 begin
 185   result := 0;
 186   raise XStreamError.Create('can''t write to read-only stream');
 187   // à íå õîäè, íåõîðîøèé, â íàø ñàäèê ãóëÿòü!
 188 end;
 189
 190 function TSFSPartialStream.Read (var buffer; count: LongInt): LongInt;
 191 var
 192   left: Int64;
 193   pc: Pointer;
 194   rd: LongInt;
 195 begin
 196   if count < 0 then raise XStreamError.Create('invalid Read() call'); // ñêàçî÷íûé äîëáî¸á...
 197   if count = 0 then begin result := 0; exit; end;
 198   pc := @buffer;
 199   result := 0;
 200   if (Length(fPreBuf) > 0) and (fCurrentPos < Length(fPreBuf)) then
 201   begin
 202     fLastReadPos := fCurrentPos;
 203     left := Length(fPreBuf)-fCurrentPos;
 204     if left > count then left := count;
 205     if left > 0 then
 206     begin
 207       Move(fPreBuf[fCurrentPos], pc^, left);
 208       Inc(PChar(pc), left);
 209       Inc(fCurrentPos, left);
 210       fLastReadPos := fCurrentPos;
 211       Dec(count, left);
 212       result := left;
 213       if count = 0 then exit;
 214     end;
 215   end;
 216   CheckPos();
 217   left := fSize-fCurrentPos;
 218   if left < count then count := left; // è òàê ñëó÷àåòñÿ...
 219   if count > 0 then
 220   begin
 221     rd := fSource.Read(pc^, count);
 222     Inc(result, rd);
 223     Inc(fCurrentPos, rd);
 224     fLastReadPos := fCurrentPos;
 225   end
 226   else
 227   begin
 228     result := 0;
 229   end;
 230 end;
 231
 232 function TSFSPartialStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64;
 233 begin
 234   case origin of
 235     soBeginning: result := offset;
 236     soCurrent: result := offset+fCurrentPos;
 237     soEnd: result := fSize+offset;
 238     else raise XStreamError.Create('invalid Seek() call');
 239     // äðóãèõ íå áûâàåò. à ó êîãî áûâàåò, òîìó ÿ íå äîêòîð.
 240   end;
 241   if result < 0 then result := 0
 242   else if result > fSize then result := fSize;
 243   fCurrentPos := result;
 244 end;
 245
 246
 247 { TSFSGuardStream }
 248 constructor TSFSGuardStream.Create (aSrc, aGuarded: TStream; aKillSrc, aKillGuarded: Boolean; aGuardedFirst: Boolean=true);
 249 begin
 250   inherited Create();
 251   fSource := aSrc; fGuardedStream := aGuarded;
 252   fKillSource := aKillSrc; fKillGuarded := aKillGuarded;
 253   fGuardedFirst := aGuardedFirst;
 254 end;
 255
 256 destructor TSFSGuardStream.Destroy ();
 257 begin
 258   if fKillGuarded and fGuardedFirst then FreeAndNil(fGuardedStream);
 259   if fKillSource then FreeAndNil(fSource);
 260   if fKillGuarded and not fGuardedFirst then FreeAndNil(fGuardedStream);
 261   inherited Destroy();
 262 end;
 263
 264 function TSFSGuardStream.Read (var buffer; count: LongInt): LongInt;
 265 begin
 266   result := fSource.Read(buffer, count);
 267 end;
 268
 269 function TSFSGuardStream.Write (const buffer; count: LongInt): LongInt;
 270 begin
 271   result := fSource.Write(buffer, count);
 272 end;
 273
 274 function TSFSGuardStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64;
 275 begin
 276   result := fSource.Seek(offset, origin);
 277 end;
 278
 279
 280 { TSFSMemoryStreamRO }
 281 constructor TSFSMemoryStreamRO.Create (pMem: Pointer; pSize: Integer; aFreeMem: Boolean=false);
 282 begin
 283   fFreeMem := aFreeMem;
 284   fMem := pMem;
 285   inherited Create();
 286   SetPointer(pMem, pSize);
 287   Position := 0;
 288 end;
 289
 290 destructor TSFSMemoryStreamRO.Destroy ();
 291 begin
 292   if fFreeMem and (fMem <> nil) then FreeMem(fMem);
 293 end;
 294
 295 function TSFSMemoryStreamRO.Write (const buffer; count: LongInt): LongInt;
 296 begin
 297   result := 0;
 298   raise XStreamError.Create('can''t write to read-only stream');
 299   // ñîâñåì ñáðåíäèë...
 300 end;
 301
 302
 303 // ////////////////////////////////////////////////////////////////////////// //
 304 { TUnZStream }
 305 const ZBufSize = 32768; // size of the buffer used for temporarily storing data from the child stream
 306
 307
 308 constructor TUnZStream.create (asrc: TStream; aSize: Int64; aKillSrc: Boolean; aSkipHeader: boolean=false);
 309 var
 310   err: Integer;
 311 begin
 312   fKillSrc := aKillSrc;
 313   fPos := 0;
 314   fSkipToPos := -1;
 315   fSrcSt := asrc;
 316   fSize := aSize;
 317   GetMem(fBuffer, ZBufSize);
 318   fSkipHeader := aSkipHeader;
 319   fSrcStPos := fSrcSt.position;
 320   FillChar(fZlibSt, sizeof(fZlibSt), 0);
 321   if fSkipHeader then err := inflateInit2(fZlibSt, -MAX_WBITS) else err := inflateInit(fZlibSt);
 322   if err <> Z_OK then raise XStreamError.Create(zerror(err));
 323 end;
 324
 325
 326 destructor TUnZStream.destroy ();
 327 begin
 328   inflateEnd(fZlibSt);
 329   FreeMem(fBuffer);
 330   if fKillSrc then fSrcSt.Free();
 331   inherited Destroy();
 332 end;
 333
 334
 335 function TUnZStream.readBuf (var buffer; count: LongInt): LongInt;
 336 var
 337   err: Integer;
 338   sz: LongInt;
 339 begin
 340   result := 0;
 341   if (fSize >= 0) and (fPos >= fSize) then exit;
 342   if count > 0 then
 343   begin
 344     fZlibSt.next_out := @buffer;
 345     fZlibSt.avail_out := count;
 346     sz := fZlibSt.avail_out;
 347     while fZlibSt.avail_out > 0 do
 348     begin
 349       if fZlibSt.avail_in = 0 then
 350       begin
 351         // refill the buffer
 352         fZlibSt.next_in := fBuffer;
 353         fZlibSt.avail_in := fSrcSt.read(Fbuffer^, ZBufSize);
 354       end;
 355       err := inflate(fZlibSt, Z_NO_FLUSH);
 356       if (err <> Z_OK) and (err <> Z_STREAM_END) then raise XStreamError.Create(zerror(err));
 357       Inc(result, sz-fZlibSt.avail_out);
 358       Inc(fPos, sz-fZlibSt.avail_out);
 359       sz := fZlibSt.avail_out;
 360       if err = Z_STREAM_END then begin fSize := fPos; break; end;
 361     end;
 362   end;
 363 end;
 364
 365
 366 procedure TUnZStream.fixPos ();
 367 var
 368   buf: array [0..4095] of Byte;
 369   rd, rr: LongInt;
 370 begin
 371   if fSkipToPos < 0 then exit;
 372   //writeln('fixing pos: fPos=', fPos, '; fSkipToPos=', fSkipToPos);
 373   if fSkipToPos < fPos then reset();
 374   while fPos < fSkipToPos do
 375   begin
 376     if fSkipToPos-fPos > 4096 then rd := 4096 else rd := LongInt(fSkipToPos-fPos);
 377     //writeln('  reading ', rd, ' bytes...');
 378     rr := readBuf(buf, rd);
 379     //writeln('  got ', rr, ' bytes; fPos=', fPos, '; fSkipToPos=', fSkipToPos);
 380     if rr <= 0 then raise XStreamError.Create('seek error');
 381   end;
 382   //writeln('  pos: fPos=', fPos, '; fSkipToPos=', fSkipToPos);
 383   fSkipToPos := -1;
 384 end;
 385
 386
 387 procedure TUnZStream.determineSize ();
 388 var
 389   buf: array [0..4095] of Byte;
 390   rd: LongInt;
 391   opos: Int64;
 392 begin
 393   if fSize >= 0 then exit;
 394   opos := fPos;
 395   try
 396     //writeln('determining unzstream size...');
 397     while true do
 398     begin
 399       rd := readBuf(buf, 4096);
 400       if rd = 0 then break;
 401     end;
 402     fSize := fPos;
 403     //writeln('  unzstream size is ', fSize);
 404   finally
 405     if fSkipToPos < 0 then fSkipToPos := opos;
 406   end;
 407 end;
 408
 409
 410 function TUnZStream.read (var buffer; count: LongInt): LongInt;
 411 begin
 412   if fSkipToPos >= 0 then fixPos();
 413   result := readBuf(buffer, count);
 414 end;
 415
 416
 417 function TUnZStream.write (const buffer; count: LongInt): LongInt;
 418 begin
 419   result := 0;
 420   raise XStreamError.Create('can''t write to read-only stream');
 421 end;
 422
 423
 424 procedure TUnZStream.reset ();
 425 var
 426   err: Integer;
 427 begin
 428   //writeln('doing RESET');
 429   fSrcSt.position := fSrcStPos;
 430   fPos := 0;
 431   inflateEnd(fZlibSt);
 432   FillChar(fZlibSt, sizeof(fZlibSt), 0);
 433   if fSkipHeader then err := inflateInit2(fZlibSt, -MAX_WBITS) else err := inflateInit(fZlibSt);
 434   if err <> Z_OK then raise XStreamError.Create(zerror(err));
 435 end;
 436
 437
 438 function TUnZStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64;
 439 var
 440   cpos: Int64;
 441 begin
 442   cpos := fPos;
 443   if fSkipToPos >= 0 then cpos := fSkipToPos;
 444   case origin of
 445     soBeginning: result := offset;
 446     soCurrent: result := offset+cpos;
 447     soEnd: begin determineSize(); result := fSize+offset; end;
 448     else raise XStreamError.Create('invalid Seek() call');
 449     // äðóãèõ íå áûâàåò. à ó êîãî áûâàåò, òîìó ÿ íå äîêòîð.
 450   end;
 451   if result < 0 then result := 0;
 452   fSkipToPos := result;
 453   //writeln('seek: ofs=', offset, '; origin=', origin, '; result=', result);
 454 end;
 455
 456
 457 end.