more sfs cleanup; slightly faster DFWAD processing

diff --git a/src/sfs/sfsZipFS.pas b/src/sfs/sfsZipFS.pas
index 892dd636802cbf3e3e3edbb605a6401468064ce8..941f2d47254655f818f458e02f60910282dfd706 100644 (file)
--- a/src/sfs/sfsZipFS.pas
+++ b/src/sfs/sfsZipFS.pas
@@ -3,13 +3,10 @@
 // See the file aplicense.txt for conditions of use.
 //
 // grouping files with packing:
-//   zip, jar: PKZIP-compatible archives (store, deflate)
-//   fout2   : Fallout II .DAT
-//   vtdb    : Asphyre's VTDb
+//   zip, pk3: PKZIP-compatible archives (store, deflate)
 //   dfwad   : D2D:F wad archives
 //
 {.$DEFINE SFS_DEBUG_ZIPFS}
-{.$DEFINE SFS_ZIPFS_FULL}
 {$MODE OBJFPC}
 {$R+}
 unit sfsZipFS;
@@ -21,15 +18,7 @@ uses
 
 
 type
-  TSFSZipVolumeType = (
-    sfszvNone,
-    sfszvZIP,
-    {$IFDEF SFS_ZIPFS_FULL}
-    sfszvF2DAT,
-    sfszvVTDB,
-    {$ENDIF}
-    sfszvDFWAD
-  );
+  TSFSZipVolumeType = (sfszvNone, sfszvZIP, sfszvDFWAD);
 
   TSFSZipVolume = class(TSFSVolume)
   protected
@@ -37,10 +26,6 @@ type
 
     procedure ZIPReadDirectory ();
     procedure DFWADReadDirectory ();
-    {$IFDEF SFS_ZIPFS_FULL}
-    procedure F2DATReadDirectory ();
-    procedure VTDBReadDirectory ();
-    {$ENDIF}
 
     procedure ReadDirectory (); override;
     procedure removeCommonPath (); override;
@@ -49,7 +34,7 @@ type
     function OpenFileByIndex (const index: Integer): TStream; override;
   end;
 
-  TSFSZipVolumeFactory = class (TSFSVolumeFactory)
+  TSFSZipVolumeFactory = class(TSFSVolumeFactory)
   public
     function IsMyVolumePrefix (const prefix: AnsiString): Boolean; override;
     function Produce (const prefix, fileName: AnsiString; st: TStream): TSFSVolume; override;
@@ -57,21 +42,17 @@ type
   end;
 
 
-
 implementation
 
 uses
-  zstream, xstreams, utils;
-
+  xstreams, utils;
 
-type
-  TZDecompressionStream = TDecompressionStream;
 
 type
-  TSFSZipFileInfo = class (TSFSFileInfo)
+  TSFSZipFileInfo = class(TSFSFileInfo)
   public
     fMethod: Byte; // 0: store; 8: deflate; 255: other
-    fPackSz: Int64;
+    fPackSz: Int64; // can be -1
   end;
 
   TZLocalFileHeader = packed record
@@ -99,34 +80,6 @@ begin
   result := true;
 end;
 
-{$IFDEF SFS_ZIPFS_FULL}
-function F2DATCheckMagic (st: TStream): Boolean;
-var
-  dsize, fiSz: Integer;
-begin
-  result := false;
-  st.Position := st.Size-8;
-  st.ReadBuffer(dsize, 4); st.ReadBuffer(fiSz, 4);
-  st.Position := 0;
-  if (fiSz <> st.Size) or (dsize < 5+13) or (dsize > fiSz-4) then exit;
-  result := true;
-end;
-
-function VTDBCheckMagic (st: TStream): Boolean;
-var
-  sign: packed array [0..3] of Char;
-  fcnt, dofs: Integer;
-begin
-  result := false;
-  if st.Size < 32 then exit;
-  st.ReadBuffer(sign[0], 4);
-  st.ReadBuffer(fcnt, 4); st.ReadBuffer(dofs, 4);
-  st.Seek(-12, soCurrent);
-  if sign <> 'vtdm' then exit;
-  if (fcnt < 0) or (dofs < 32) or (dofs+fcnt*8 > st.Size) then exit;
-  result := true;
-end;
-{$ENDIF}
 
 function DFWADCheckMagic (st: TStream): Boolean;
 var
@@ -146,6 +99,7 @@ begin
   result := true;
 end;
 
+
 function maxPrefix (s0: string; s1: string): Integer;
 var
   f: Integer;
@@ -158,6 +112,7 @@ begin
   result := length(s0);
 end;
 
+
 procedure TSFSZipVolume.removeCommonPath ();
 var
   f, pl, maxsc, sc, c: integer;
@@ -376,81 +331,6 @@ begin
   end;
 end;
 
-{$IFDEF SFS_ZIPFS_FULL}
-procedure TSFSZipVolume.F2DATReadDirectory ();
-var
-  dsize: Integer;
-  fi: TSFSZipFileInfo;
-  name: ShortString;
-  f: Integer;
-  b: Byte;
-begin
-  fFileStream.Position := fFileStream.Size-8;
-  fFileStream.ReadBuffer(dsize, 4);
-  fFileStream.Seek(-dsize, soCurrent); Dec(dsize, 4);
-  while dsize > 0 do
-  begin
-    fi := TSFSZipFileInfo.Create(self);
-    fFileStream.ReadBuffer(f, 4);
-    if (f < 1) or (f > 255) then raise ESFSError.Create('invalid Fallout II .DAT file');
-    Dec(dsize, 4+f+13);
-    if dsize < 0 then raise ESFSError.Create('invalid Fallout II .DAT file');
-    name[0] := chr(f); if f > 0 then fFileStream.ReadBuffer(name[1], f);
-    f := 1; while (f <= ord(name[0])) and (name[f] <> #0) do Inc(f); name[0] := chr(f-1);
-    fi.fName := name;
-    fFileStream.ReadBuffer(b, 1); // packed?
-    if b = 0 then fi.fMethod := 0 else fi.fMethod := 255;
-    fFileStream.ReadBuffer(fi.fSize, 4);
-    fFileStream.ReadBuffer(fi.fPackSz, 4);
-    fFileStream.ReadBuffer(fi.fOfs, 4);
-  end;
-end;
-
-procedure TSFSZipVolume.VTDBReadDirectory ();
-// idiotic format
-var
-  fcnt, dofs: Integer;
-  keys: array of record name: string; ofs: Integer; end;
-  fi: TSFSZipFileInfo;
-  f, c: Integer;
-  rtype: Word;
-begin
-  fFileStream.Seek(4, soCurrent); // skip signature
-  fFileStream.ReadBuffer(fcnt, 4);
-  fFileStream.ReadBuffer(dofs, 4);
-  fFileStream.Seek(dofs, soBeginning);
-
-  // read keys
-  SetLength(keys, fcnt);
-  for f := 0 to fcnt-1 do
-  begin
-    fFileStream.ReadBuffer(c, 4);
-    if (c < 0) or (c > 1023) then raise ESFSError.Create('invalid VTDB file');
-    SetLength(keys[f].name, c);
-    if c > 0 then
-    begin
-      fFileStream.ReadBuffer(keys[f].name[1], c);
-      keys[f].name := SFSReplacePathDelims(keys[f].name, '/');
-      if keys[f].name[1] = '/' then Delete(keys[f].name, 1, 1);
-    end;
-    fFileStream.ReadBuffer(keys[f].ofs, 4);
-  end;
-
-  // read records (record type will be converted to directory name)
-  for f := 0 to fcnt-1 do
-  begin
-    fFileStream.Position := keys[f].ofs;
-    fi := TSFSZipFileInfo.Create(self);
-    fFileStream.ReadBuffer(rtype, 2);
-    fFileStream.ReadBuffer(fi.fSize, 4);
-    fFileStream.ReadBuffer(fi.fPackSz, 4);
-    fi.fOfs := fFileStream.Position+12;
-    fi.fName := keys[f].name;
-    fi.fPath := IntToHex(rtype, 4)+'/';
-    fi.fMethod := 255;
-  end;
-end;
-{$ENDIF}
 
 procedure TSFSZipVolume.DFWADReadDirectory ();
 // idiotic format
@@ -504,99 +384,31 @@ procedure TSFSZipVolume.ReadDirectory ();
 begin
   case fType of
     sfszvZIP: ZIPReadDirectory();
-    {$IFDEF SFS_ZIPFS_FULL}
-    sfszvF2DAT: F2DATReadDirectory();
-    sfszvVTDB: VTDBReadDirectory();
-    {$ENDIF}
     sfszvDFWAD: DFWADReadDirectory();
-    else raise ESFSError.Create('invalid zipped SFS');
+    else raise ESFSError.Create('invalid archive');
   end;
 end;
 
 function TSFSZipVolume.OpenFileByIndex (const index: Integer): TStream;
 var
-  zs: TZDecompressionStream;
-  fs, rs: TStream;
-  gs: TSFSGuardStream;
-  kill: Boolean;
-  buf: packed array [0..1023] of Char;
-  rd: LongInt;
+  rs: TStream;
 begin
   result := nil;
-  zs := nil;
-  fs := nil;
-  gs := nil;
   rs := nil;
   if fFiles = nil then exit;
   if (index < 0) or (index >= fFiles.Count) or (fFiles[index] = nil) then exit;
-  kill := false;
   try
-    {
-    try
-      fs := TFileStream.Create(fFileName, fmOpenRead or fmShareDenyWrite);
-      kill := true;
-    except
-      fs := fFileStream;
-    end;
-    }
-    fs := fFileStream;
     if TSFSZipFileInfo(fFiles[index]).fMethod = 0 then
     begin
-      result := TSFSPartialStream.Create(fs,
-        TSFSZipFileInfo(fFiles[index]).fOfs,
-        TSFSZipFileInfo(fFiles[index]).fSize, kill);
+      result := TSFSPartialStream.Create(fFileStream, TSFSZipFileInfo(fFiles[index]).fOfs, TSFSZipFileInfo(fFiles[index]).fSize, false);
     end
     else
     begin
-      fs.Seek(TSFSZipFileInfo(fFiles[index]).fOfs, soBeginning);
-      if TSFSZipFileInfo(fFiles[index]).fMethod = 255 then
-      begin
-        // sorry, pals, DFWAD is completely broken, so users of it should SUFFER
-        if TSFSZipFileInfo(fFiles[index]).fSize = -1 then
-        begin
-          TSFSZipFileInfo(fFiles[index]).fSize := 0;
-          //writeln('trying to determine file size for [', TSFSZipFileInfo(fFiles[index]).fPath, TSFSZipFileInfo(fFiles[index]).fName, ']');
-          zs := TZDecompressionStream.Create(fs);
-          try
-            while true do
-            begin
-              rd := zs.read(buf, 1024);
-              //writeln('  got ', rd, ' bytes');
-              if rd > 0 then Inc(TSFSZipFileInfo(fFiles[index]).fSize, rd);
-              if rd < 1024 then break;
-            end;
-            //writeln('  resulting size: ', TSFSZipFileInfo(fFiles[index]).fSize, ' bytes');
-            // recreate stream
-            FreeAndNil(zs);
-            fs.Seek(TSFSZipFileInfo(fFiles[index]).fOfs, soBeginning);
-          except
-            //writeln('*** CAN''T determine file size for [', TSFSZipFileInfo(fFiles[index]).fPath, TSFSZipFileInfo(fFiles[index]).fName, ']');
-            FreeAndNil(zs);
-            if kill then FreeAndNil(fs);
-            result := nil;
-            exit;
-          end;
-        end;
-        rs := TSFSPartialStream.Create(fs, TSFSZipFileInfo(fFiles[index]).fOfs, TSFSZipFileInfo(fFiles[index]).fPackSz, true);
-        zs := TZDecompressionStream.Create(rs);
-        rs := nil;
-      end
-      else
-      begin
-        rs := TSFSPartialStream.Create(fs, TSFSZipFileInfo(fFiles[index]).fOfs, TSFSZipFileInfo(fFiles[index]).fPackSz, true);
-        zs := TZDecompressionStream.Create(rs, true {-15}{MAX_WBITS});
-        rs := nil;
-      end;
-      gs := TSFSGuardStream.Create(zs, fs, true, kill, false);
-      zs := nil;
-      fs := nil;
-      result := TSFSPartialStream.Create(gs, 0, TSFSZipFileInfo(fFiles[index]).fSize, true);
+      rs := TSFSPartialStream.Create(fFileStream, TSFSZipFileInfo(fFiles[index]).fOfs, TSFSZipFileInfo(fFiles[index]).fPackSz, false);
+      result := TUnZStream.Create(rs, TSFSZipFileInfo(fFiles[index]).fSize, true, (TSFSZipFileInfo(fFiles[index]).fMethod <> 255));
     end;
   except
     FreeAndNil(rs);
-    FreeAndNil(gs);
-    FreeAndNil(zs);
-    if kill then FreeAndNil(fs);
     result := nil;
     exit;
   end;
@@ -608,14 +420,8 @@ function TSFSZipVolumeFactory.IsMyVolumePrefix (const prefix: AnsiString): Boole
 begin
   result :=
     StrEquCI1251(prefix, 'zip') or
-    StrEquCI1251(prefix, 'dfwad')
-    {$IFDEF SFS_ZIPFS_FULL}
-    or StrEquCI1251(prefix, 'jar') or
-    StrEquCI1251(prefix, 'fout2') or
-    StrEquCI1251(prefix, 'vtdb') or
-    StrEquCI1251(prefix, 'wad')
-    {$ENDIF}
-    ;
+    StrEquCI1251(prefix, 'pk3') or
+    StrEquCI1251(prefix, 'dfwad');
 end;
 
 procedure TSFSZipVolumeFactory.Recycle (vol: TSFSVolume);
@@ -629,12 +435,7 @@ var
 begin
   vt := sfszvNone;
        if ZIPCheckMagic(st) then vt := sfszvZIP
-  else if DFWADCheckMagic(st) then vt := sfszvDFWAD
-  {$IFDEF SFS_ZIPFS_FULL}
-  else if F2DATCheckMagic(st) then vt := sfszvF2DAT
-  else if VTDBCheckMagic(st) then vt := sfszvVTDB
-  {$ENDIF}
-  ;
+  else if DFWADCheckMagic(st) then vt := sfszvDFWAD;
 
   if vt <> sfszvNone then
   begin

diff --git a/src/shared/xstreams.pas b/src/shared/xstreams.pas
index f62582b1bd0854acf19a77242f37788fb80732b9..abf8bec0e731e8e5da1f2c12f12241acb862a033 100644 (file)
--- a/src/shared/xstreams.pas
+++ b/src/shared/xstreams.pas
@@ -95,6 +95,7 @@ type
     fSize: Int64; // can be -1
     fSrcStPos: Int64;
     fSkipToPos: Int64; // >0: skip to this position
+    fKillSrc: Boolean;
 
     procedure reset ();
     function readBuf (var buffer; count: LongInt): LongInt;
@@ -103,7 +104,7 @@ type
 
   public
     // `aSize` can be -1 if stream size is unknown
-    constructor create (asrc: TStream; aSize: Int64; aSkipHeader: boolean=false);
+    constructor create (asrc: TStream; aSize: Int64; aKillSrc: Boolean; aSkipHeader: boolean=false);
     destructor destroy (); override;
     function read (var buffer; count: LongInt): LongInt; override;
     function write (const buffer; count: LongInt): LongInt; override;
@@ -288,10 +289,12 @@ end;
 { TUnZStream }
 const ZBufSize = 32768; // size of the buffer used for temporarily storing data from the child stream
 
-constructor TUnZStream.create (asrc: TStream; aSize: Int64; aSkipHeader: boolean=false);
+
+constructor TUnZStream.create (asrc: TStream; aSize: Int64; aKillSrc: Boolean; aSkipHeader: boolean=false);
 var
   err: Integer;
 begin
+  fKillSrc := aKillSrc;
   fPos := 0;
   fSkipToPos := -1;
   fSrcSt := asrc;
@@ -303,14 +306,16 @@ begin
   fSrcStPos := fSrcSt.position;
 end;
 
+
 destructor TUnZStream.destroy ();
 begin
   inflateEnd(fZlibSt);
   FreeMem(fBuffer);
-  fSrcSt.Free;
-  inherited destroy;
+  if fKillSrc then fSrcSt.Free();
+  inherited Destroy();
 end;
 
+
 function TUnZStream.readBuf (var buffer; count: LongInt): LongInt;
 var
   err: Integer;
@@ -339,48 +344,65 @@ begin
   result := count-fZlibSt.avail_out;
 end;
 
+
 procedure TUnZStream.fixPos ();
 var
   buf: array [0..4095] of Byte;
   rd, rr: LongInt;
 begin
   if fSkipToPos < 0 then exit;
-  if fSkipToPos > fPos then reset();
+  //writeln('fixing pos: fPos=', fPos, '; fSkipToPos=', fSkipToPos);
+  if fSkipToPos < fPos then reset();
   while fPos < fSkipToPos do
   begin
     if fSkipToPos-fPos > 4096 then rd := 4096 else rd := LongInt(fSkipToPos-fPos);
+    //writeln('  reading ', rd, ' bytes...');
     rr := readBuf(buf, rd);
+    //writeln('  got ', rr, ' bytes; fPos=', fPos, '; fSkipToPos=', fSkipToPos);
     if rd <> rr then raise XStreamError.Create('seek error');
   end;
+  //writeln('  pos: fPos=', fPos, '; fSkipToPos=', fSkipToPos);
   fSkipToPos := -1;
 end;
 
+
 procedure TUnZStream.determineSize ();
 var
   buf: array [0..4095] of Byte;
   rd: LongInt;
+  opos: Int64;
 begin
   if fSize >= 0 then exit;
-  while true do
-  begin
-    rd := readBuf(buf, 4096);
-    if rd <> 4096 then break;
+  opos := fPos;
+  try
+    //writeln('determining unzstream size...');
+    while true do
+    begin
+      rd := readBuf(buf, 4096);
+      if rd <> 4096 then break;
+    end;
+    fSize := fPos;
+    //writeln('  unzstream size is ', fSize);
+  finally
+    fSkipToPos := opos;
   end;
-  fSize := fPos;
 end;
 
+
 function TUnZStream.read (var buffer; count: LongInt): LongInt;
 begin
   if fSkipToPos >= 0 then fixPos();
   result := readBuf(buffer, count);
 end;
 
+
 function TUnZStream.write (const buffer; count: LongInt): LongInt;
 begin
   result := 0;
   raise XStreamError.Create('can''t write to read-only stream');
 end;
 
+
 procedure TUnZStream.reset ();
 var
   err: Integer;
@@ -392,17 +414,23 @@ begin
   if err <> Z_OK then raise XStreamError.Create(zerror(err));
 end;
 
+
 function TUnZStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64;
+var
+  cpos: Int64;
 begin
+  cpos := fPos;
+  if fSkipToPos >= 0 then cpos := fSkipToPos;
   case origin of
     soBeginning: result := offset;
-    soCurrent: result := offset+fPos;
-    soEnd: begin if fSize = -1 then determineSize(); result := fSize+offset; end;
+    soCurrent: result := offset+cpos;
+    soEnd: begin determineSize(); result := fSize+offset; end;
     else raise XStreamError.Create('invalid Seek() call');
     // äðóãèõ íå áûâàåò. à ó êîãî áûâàåò, òîìó ÿ íå äîêòîð.
   end;
   if result < 0 then result := 0;
   fSkipToPos := result;
+  //writeln('seek: ofs=', offset, '; origin=', origin, '; result=', result);
 end;