From 0254d3a7db2238dbb2f4f376ba5fd5559becd161 Mon Sep 17 00:00:00 2001 From: Ketmar Dark Date: Mon, 18 Apr 2016 10:09:36 +0300 Subject: [PATCH] more sfs cleanup; slightly faster DFWAD processing --- src/sfs/sfsZipFS.pas | 231 +++------------------------------------- src/shared/xstreams.pas | 52 ++++++--- 2 files changed, 56 insertions(+), 227 deletions(-) diff --git a/src/sfs/sfsZipFS.pas b/src/sfs/sfsZipFS.pas index 892dd63..941f2d4 100644 --- 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 f62582b..abf8bec 100644 --- 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; -- 2.29.2