X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fsfs%2FsfsZipFS.pas;h=d76114c5f5bb760a5f6152708e6a32eca66079af;hb=7908eab8a8bb5a2de31a03e588b2f12900c898c5;hp=9fb1137e0ca70d054282ddc68c6a01a190b67717;hpb=20428038ea09152f824e5947da1d550a4774207e;p=d2df-sdl.git diff --git a/src/sfs/sfsZipFS.pas b/src/sfs/sfsZipFS.pas index 9fb1137..d76114c 100644 --- a/src/sfs/sfsZipFS.pas +++ b/src/sfs/sfsZipFS.pas @@ -3,14 +3,12 @@ // 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} {$MODE DELPHI} -{.$R-} +{$R+} unit sfsZipFS; interface @@ -19,49 +17,41 @@ uses SysUtils, Classes, Contnrs, sfs; - type - TSFSZipVolumeType = (sfszvNone, sfszvZIP, sfszvF2DAT, sfszvVTDB, sfszvDFWAD); + TSFSZipVolumeType = (sfszvNone, sfszvZIP, sfszvDFWAD); TSFSZipVolume = class(TSFSVolume) protected fType: TSFSZipVolumeType; procedure ZIPReadDirectory (); - procedure F2DATReadDirectory (); - procedure VTDBReadDirectory (); procedure DFWADReadDirectory (); procedure ReadDirectory (); override; - procedure removeCommonPath (); override; public function OpenFileByIndex (const index: Integer): TStream; override; end; - TSFSZipVolumeFactory = class (TSFSVolumeFactory) + TSFSZipVolumeFactory = class(TSFSVolumeFactory) public - function IsMyVolumePrefix (const prefix: TSFSString): Boolean; override; - function Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume; override; + function IsMyVolumePrefix (const prefix: AnsiString): Boolean; override; + function Produce (const prefix, fileName: AnsiString; st: TStream): TSFSVolume; override; procedure Recycle (vol: TSFSVolume); override; end; - implementation uses - zstream, xstreams; + 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 @@ -77,6 +67,21 @@ type localExtraSz: Word; end; +procedure readLFH (st: TStream; var hdr: TZLocalFileHeader); +{.$IFDEF ENDIAN_LITTLE} +begin + hdr.version := readByte(st); + hdr.hostOS := readByte(st); + hdr.flags := readWord(st); + hdr.method := readWord(st); + hdr.time := readLongWord(st); + hdr.crc := readLongWord(st); + hdr.packSz := readLongWord(st); + hdr.unpackSz := readLongWord(st); + hdr.fnameSz := readWord(st); + hdr.localExtraSz := readWord(st); +end; + function ZIPCheckMagic (st: TStream): Boolean; var @@ -89,42 +94,15 @@ begin result := true; end; -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; function DFWADCheckMagic (st: TStream): Boolean; var sign: packed array [0..5] of Char; - fcnt: Word; begin result := false; if st.Size < 10 then exit; st.ReadBuffer(sign[0], 6); - st.ReadBuffer(fcnt, 2); + {fcnt :=} readWord(st); st.Seek(-8, soCurrent); //writeln('trying DFWAD... [', sign, ']'); if (sign[0] <> 'D') and (sign[1] <> 'F') and (sign[2] <> 'W') and @@ -134,95 +112,81 @@ begin result := true; end; -function maxPrefix (s0: string; s1: string): Integer; -var - f: Integer; -begin - for f := 1 to length(s0) do - begin - if f > length(s1) then begin result := f; exit; end; - if SFSUpCase(s0[f]) <> SFSUpCase(s1[f]) then begin result := f; exit; end; - end; - result := length(s0); -end; - -procedure TSFSZipVolume.removeCommonPath (); -var - f, pl, maxsc, sc, c: integer; - cp, s: string; - fi: TSFSZipFileInfo; -begin - if fType <> sfszvZIP then exit; - maxsc := 0; - if fFiles.Count = 0 then exit; - cp := ''; - for f := 0 to fFiles.Count-1 do - begin - fi := TSFSZipFileInfo(fFiles[f]); - s := fi.fPath; - if length(s) > 0 then begin cp := s; break; end; - end; - if length(cp) = 0 then exit; - for f := 0 to fFiles.Count-1 do - begin - fi := TSFSZipFileInfo(fFiles[f]); - s := fi.fPath; - if length(s) = 0 then continue; - pl := maxPrefix(cp, s); - //writeln('s=[', s, ']; cp=[', cp, ']; pl=', pl); - if pl = 0 then exit; // no common prefix at all - cp := Copy(cp, 1, pl); - sc := 0; - for c := 1 to length(s) do if s[c] = '/' then Inc(sc); - if sc > maxsc then maxsc := sc; - end; - if maxsc < 2 then exit; // alas - while (length(cp) > 0) and (cp[length(cp)] <> '/') do cp := Copy(cp, 1, length(cp)-1); - if length(cp) < 2 then exit; // nothing to do - for f := 0 to fFiles.Count-1 do - begin - fi := TSFSZipFileInfo(fFiles[f]); - if length(fi.fPath) >= length(cp) then - begin - s := fi.fPath; - fi.fPath := Copy(fi.fPath, length(cp)+1, length(fi.fPath)); - //writeln('FIXED [', s, '] -> [', fi.fPath, ']'); - end; - end; -end; { TSFSZipVolume } procedure TSFSZipVolume.ZIPReadDirectory (); var fi: TSFSZipFileInfo; name: ShortString; - sign, dSign: packed array [0..3] of Char; + sign: packed array [0..3] of Char; lhdr: TZLocalFileHeader; - ignoreFile, skipped: Boolean; - crc, psz, usz: LongWord; - buf: packed array of Byte; - bufPos, bufUsed: Integer; + ignoreFile: Boolean; + efid, efsz: Word; + izver: Byte; + izcrc: LongWord; begin - SetLength(buf, 0); // read local directory repeat fFileStream.ReadBuffer(sign[0], Length(sign)); + // skip data descriptor + if sign = 'PK'#7#8 then + begin + fFileStream.seek(3*4, soCurrent); + continue; + end; + if sign <> 'PK'#3#4 then break; ignoreFile := false; - skipped := false; + + readLFH(fFileStream, lhdr); fi := TSFSZipFileInfo.Create(self); fi.fPackSz := 0; fi.fMethod := 0; - fFileStream.ReadBuffer(lhdr, SizeOf(lhdr)); if lhdr.fnameSz > 255 then name[0] := #255 else name[0] := chr(lhdr.fnameSz); fFileStream.ReadBuffer(name[1], Length(name)); fFileStream.Seek(lhdr.fnameSz-Length(name), soCurrent); // rest of the name (if any) - fi.fName := name; - fFileStream.Seek(lhdr.localExtraSz, soCurrent); + fi.fName := utf8to1251(name); + + // here we should process extra field: it may contain utf8 filename + while lhdr.localExtraSz >= 4 do + begin + efid := readWord(fFileStream); + efsz := readWord(fFileStream); + Dec(lhdr.localExtraSz, 4); + if efsz > lhdr.localExtraSz then break; + // Info-ZIP Unicode Path Extra Field? + if (efid = $7075) and (efsz <= 255+5) and (efsz > 5) then + begin + fFileStream.ReadBuffer(izver, 1); + if izver <> 1 then + begin + // skip it + Dec(efsz, 1); + end + else + begin + Dec(lhdr.localExtraSz, efsz); + fFileStream.ReadBuffer(izcrc, 4); // name crc, ignore it + Dec(efsz, 5); + name[0] := chr(efsz); + fFileStream.ReadBuffer(name[1], Length(name)); + fi.fName := utf8to1251(name); + break; + end; + end; + // skip it + if efsz > 0 then + begin + fFileStream.Seek(efsz, soCurrent); + Dec(lhdr.localExtraSz, efsz); + end; + end; + // skip the rest + if lhdr.localExtraSz > 0 then fFileStream.Seek(lhdr.localExtraSz, soCurrent); if (lhdr.flags and 1) <> 0 then begin @@ -241,74 +205,11 @@ begin fi.fPackSz := lhdr.packSz; fi.fMethod := lhdr.method; - if (lhdr.flags and (1 shl 3)) <> 0 then - begin - // it has a descriptor. stupid thing at all... - {$IFDEF SFS_DEBUG_ZIPFS} - WriteLn(ErrOutput, 'descr: $', IntToHex(fFileStream.Position, 8)); - WriteLn(ErrOutput, 'size: ', lhdr.unpackSz); - WriteLn(ErrOutput, 'psize: ', lhdr.packSz); - {$ENDIF} - skipped := true; - - if lhdr.packSz <> 0 then - begin - // some kind of idiot already did our work (maybe paritally) - // trust him (her? %-) - fFileStream.Seek(lhdr.packSz, soCurrent); - end; - - // scan for descriptor - if Length(buf) = 0 then SetLength(buf, 65536); - bufPos := 0; bufUsed := 0; - fFileStream.ReadBuffer(dSign[0], 4); - repeat - if dSign <> 'PK'#7#8 then - begin - // skip one byte - Move(dSign[1], dSign[0], 3); - if bufPos >= bufUsed then - begin - bufPos := 0; - // int64! - if fFileStream.Size-fFileStream.Position > Length(buf) then - bufUsed := Length(buf) - else bufUsed := fFileStream.Size-fFileStream.Position; - if bufUsed = 0 then raise ESFSError.Create('invalid ZIP file'); - fFileStream.ReadBuffer(buf[0], bufUsed); - end; - dSign[3] := chr(buf[bufPos]); Inc(bufPos); - Inc(lhdr.packSz); - continue; - end; - // signature found: check if it is a real one - // ???: make stronger check (for the correct following signature)? - // sign, crc, packsize, unpacksize - fFileStream.Seek(-bufUsed+bufPos, soCurrent); bufPos := 0; bufUsed := 0; - fFileStream.ReadBuffer(crc, 4); // crc - fFileStream.ReadBuffer(psz, 4); // packed size - // is size correct? - if psz = lhdr.packSz then - begin - // this is a real description. fuck it off - fFileStream.ReadBuffer(usz, 4); // unpacked size - break; - end; - // this is just a sequence of bytes - fFileStream.Seek(-8, soCurrent); - fFileStream.ReadBuffer(dSign[0], 4); - Inc(lhdr.packSz, 4); - until false; - // store correct values - fi.fSize := usz; - fi.fPackSz := psz; - end; - // skip packed data - if not skipped then fFileStream.Seek(lhdr.packSz, soCurrent); + fFileStream.Seek(lhdr.packSz, soCurrent); if ignoreFile then fi.Free(); until false; - + (* if (sign <> 'PK'#1#2) and (sign <> 'PK'#5#6) then begin {$IFDEF SFS_DEBUG_ZIPFS} @@ -317,101 +218,30 @@ begin {$ENDIF} raise ESFSError.Create('invalid .ZIP archive (no central dir)'); end; + *) end; -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; procedure TSFSZipVolume.DFWADReadDirectory (); // idiotic format var fcnt: Word; fi: TSFSZipFileInfo; - f, c, fofs, fpksize: Integer; + f, c: Integer; + fofs, fpksize: LongWord; curpath, fname: string; name: packed array [0..15] of Char; begin curpath := ''; fFileStream.Seek(6, soCurrent); // skip signature - fFileStream.ReadBuffer(fcnt, 2); + fcnt := readWord(fFileStream); if fcnt = 0 then exit; // read files for f := 0 to fcnt-1 do begin fFileStream.ReadBuffer(name[0], 16); - fFileStream.ReadBuffer(fofs, 4); - fFileStream.ReadBuffer(fpksize, 4); + fofs := readLongWord(fFileStream); + fpksize := readLongWord(fFileStream); c := 0; fname := ''; while (c < 16) and (name[c] <> #0) do @@ -445,91 +275,31 @@ procedure TSFSZipVolume.ReadDirectory (); begin case fType of sfszvZIP: ZIPReadDirectory(); - sfszvF2DAT: F2DATReadDirectory(); - sfszvVTDB: VTDBReadDirectory(); 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: 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 - zs := TZDecompressionStream.Create(fs) - end - else - begin - zs := TZDecompressionStream.Create(fs, true {-15}{MAX_WBITS}); - end; - // 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, ']'); - 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); - zs := TZDecompressionStream.Create(fs) - 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; - 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(gs); - FreeAndNil(zs); - if kill then FreeAndNil(fs); + FreeAndNil(rs); result := nil; exit; end; @@ -537,15 +307,12 @@ end; { TSFSZipVolumeFactory } -function TSFSZipVolumeFactory.IsMyVolumePrefix (const prefix: TSFSString): Boolean; +function TSFSZipVolumeFactory.IsMyVolumePrefix (const prefix: AnsiString): Boolean; begin result := - SFSStrEqu(prefix, 'zip') or - SFSStrEqu(prefix, 'jar') or - SFSStrEqu(prefix, 'fout2') or - SFSStrEqu(prefix, 'vtdb') or - SFSStrEqu(prefix, 'wad') or - SFSStrEqu(prefix, 'dfwad'); + StrEquCI1251(prefix, 'zip') or + StrEquCI1251(prefix, 'pk3') or + StrEquCI1251(prefix, 'dfwad'); end; procedure TSFSZipVolumeFactory.Recycle (vol: TSFSVolume); @@ -553,15 +320,13 @@ begin vol.Free(); end; -function TSFSZipVolumeFactory.Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume; +function TSFSZipVolumeFactory.Produce (const prefix, fileName: AnsiString; st: TStream): TSFSVolume; var vt: TSFSZipVolumeType; begin vt := sfszvNone; - if ZIPCheckMagic(st) then vt := sfszvZIP - else if DFWADCheckMagic(st) then vt := sfszvDFWAD - else if F2DATCheckMagic(st) then vt := sfszvF2DAT - else if VTDBCheckMagic(st) then vt := sfszvVTDB; + if ZIPCheckMagic(st) then vt := sfszvZIP + else if DFWADCheckMagic(st) then vt := sfszvDFWAD; if vt <> sfszvNone then begin @@ -589,6 +354,6 @@ var initialization zipf := TSFSZipVolumeFactory.Create(); SFSRegisterVolumeFactory(zipf); -finalization - SFSUnregisterVolumeFactory(zipf); +//finalization +// SFSUnregisterVolumeFactory(zipf); end.