src/shared/xstreams.pas

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