diff --git a/src/sfs/sfsZipFS.pas b/src/sfs/sfsZipFS.pas
index 22235a866b02e95a86184cbcd1c0ac548278cc06..e5e996841f803b4888dddd5a8467e5105ded8196 100644 (file)
--- a/src/sfs/sfsZipFS.pas
+++ b/src/sfs/sfsZipFS.pas
-// Streaming R/O Virtual File System v0.2.0
-// Copyright (C) XL A.S. Ketmar. All rights reserved
-// See the file aplicense.txt for conditions of use.
-//
+(* Copyright (C) Doom 2D: Forever Developers
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program. If not, see <http://www.gnu.org/licenses/>.
+ *)
// grouping files with packing:
// zip, pk3: PKZIP-compatible archives (store, deflate)
// dfwad : D2D:F wad archives
//
{.$DEFINE SFS_DEBUG_ZIPFS}
-{$MODE DELPHI}
-{$R+}
+{$INCLUDE ../shared/a_modes.inc}
+{$SCOPEDENUMS OFF}
+{.$R+}
unit sfsZipFS;
interface
procedure DFWADReadDirectory ();
procedure ReadDirectory (); override;
- procedure removeCommonPath (); override;
public
function OpenFileByIndex (const index: Integer): TStream; override;
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
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
(sign[3] <> 'A') and (sign[4] <> 'D') and (sign[5] <> #$01) then exit;
- //writeln('DFWAD FOUND, with ', fcnt, ' files');
- //if (fcnt < 0) then exit;
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 UpCase1251(s0[f]) <> UpCase1251(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;
+ fname: AnsiString = '';
+ 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;
+ buf: PByte;
+ bufsz, f: Integer;
+ cdofs, hdrofs: Int64;
+ cdsize: LongWord;
+ fileOffsets: array of Int64 = nil;
+ nameLen, extraLen, commentLen: Word;
+ fileIdx: Integer = -1;
begin
- SetLength(buf, 0);
+ // search for central dir pointer
+ if fFileStream.size > 65636 then bufsz := 65636 else bufsz := fFileStream.size;
+ fFileStream.position := fFileStream.size-bufsz;
+ GetMem(buf, bufsz);
+ cdofs := -1;
+ cdsize := 0;
+ try
+ fFileStream.readBuffer(buf^, bufsz);
+ for f := bufsz-16 downto 4 do
+ begin
+ if (buf[f-4] = ord('P')) and (buf[f-3] = ord('K')) and (buf[f-2] = 5) and (buf[f-1] = 6) then
+ begin
+ cdsize := LongWord(buf[f+8])+(LongWord(buf[f+9])<<8)+(LongWord(buf[f+10])<<16)+(LongWord(buf[f+11])<<24);
+ cdofs := Int64(buf[f+12])+(Int64(buf[f+13])<<8)+(Int64(buf[f+14])<<16)+(Int64(buf[f+15])<<24);
+ break;
+ end;
+ end;
+ finally
+ FreeMem(buf);
+ end;
+
+ if (cdofs >= 0) and (cdsize > 0) then
+ begin
+ // wow, we got central directory! process it
+ fFileStream.position := cdofs;
+ while cdsize >= 4 do
+ begin
+ Dec(cdsize, 4);
+ fFileStream.readBuffer(sign, 4);
+ if sign = 'PK'#1#2 then
+ begin
+ if cdsize < 42 then break;
+ Dec(cdsize, 42);
+ // skip uninteresting fields
+ fFileStream.seek(2+2+2+2+2+2+4+4+4, soCurrent);
+ nameLen := readWord(fFileStream);
+ extraLen := readWord(fFileStream);
+ commentLen := readWord(fFileStream);
+ // skip uninteresting fields
+ fFileStream.seek(2+2+4, soCurrent);
+ hdrofs := readLongWord(fFileStream);
+ // now skip name, extra and comment
+ if cdsize < nameLen+extraLen+commentLen then break;
+ Dec(cdsize, nameLen+extraLen+commentLen);
+ fFileStream.seek(nameLen+extraLen+commentLen, soCurrent);
+ SetLength(fileOffsets, length(fileOffsets)+1);
+ fileOffsets[high(fileOffsets)] := hdrofs;
+ //writeln('file #', high(fileOffsets), ' found at ', hdrofs);
+ end
+ else if sign = 'PK'#7#8 then
+ begin
+ if cdsize < 3*4 then break;
+ Dec(cdsize, 3*4);
+ fFileStream.seek(3*4, soCurrent);
+ end
+ else
+ begin
+ break;
+ end;
+ end;
+ if length(fileOffsets) = 0 then exit; // no files at all
+ fileIdx := 0;
+ end
+ else
+ begin
+ fFileStream.position := 0;
+ end;
+
// read local directory
repeat
- fFileStream.ReadBuffer(sign[0], Length(sign));
+ if fileIdx >= 0 then
+ begin
+ if fileIdx > High(fileOffsets) then break;
+ //writeln('reading file #', fileIdx, ' at ', fileOffsets[fileIdx]);
+ fFileStream.position := fileOffsets[fileIdx];
+ Inc(fileIdx);
+ end;
+ while true do
+ begin
+ fFileStream.ReadBuffer(sign[0], Length(sign));
+ // skip data descriptor
+ if sign = 'PK'#7#8 then
+ begin
+ fFileStream.seek(3*4, soCurrent);
+ continue;
+ end;
+ break;
+ 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;
- //fi.fOfs := fFileStream.Position;
-
- 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 := utf8to1251(name);
- //writeln(Format('0x%08x : %s', [Integer(fi.fOfs), name]));
+ SetLength(fname, lhdr.fnameSz);
+ if lhdr.fnameSz > 0 then
+ begin
+ fFileStream.ReadBuffer(fname[1], length(fname));
+ fi.fName := utf8to1251(fname);
+ end;
// here we should process extra field: it may contain utf8 filename
- //fFileStream.Seek(lhdr.localExtraSz, soCurrent);
while lhdr.localExtraSz >= 4 do
begin
- efid := 0;
- efsz := 0;
- fFileStream.ReadBuffer(efid, 2);
- fFileStream.ReadBuffer(efsz, 2);
+ 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
+ if (efid = $7075) and (efsz > 5) then
begin
fFileStream.ReadBuffer(izver, 1);
- if izver <> 1 then
- begin
- // skip it
- Dec(efsz, 1);
- end
- else
+ Dec(efsz, 1);
+ Dec(lhdr.localExtraSz, 1);
+ if izver = 1 then
begin
+ //writeln('!!!!!!!!!!!!');
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;
+ fFileStream.ReadBuffer(izcrc, 4); // name crc, ignore it for now
+ Dec(efsz, 4);
+ SetLength(fname, efsz);
+ if length(fname) > 0 then fFileStream.readBuffer(fname[1], length(fname));
+ fi.fName := utf8to1251(fname);
+ //writeln('++++++ [', fi.fName, ']');
+ efsz := 0;
end;
end;
// skip it
ignoreFile := true;
end;
+ if (length(fi.fName) = 0) or (fname[length(fi.fName)] = '/') or (fname[length(fi.fName)] = '\') then
+ begin
+ ignoreFile := true;
+ end
+ else
+ begin
+ for f := 1 to length(fi.fName) do if fi.fName[f] = '\' then fi.fName[f] := '/';
+ end;
+
fi.fOfs := fFileStream.Position;
fi.fSize := lhdr.unpackSz;
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;
+ if fi.fMethod = 0 then fi.fPackSz := fi.fSize;
// skip packed data
- if not skipped then fFileStream.Seek(lhdr.packSz, soCurrent);
+ if fileIdx < 0 then 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}
{$ENDIF}
raise ESFSError.Create('invalid .ZIP archive (no central dir)');
end;
+ *)
end;
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
result :=
StrEquCI1251(prefix, 'zip') or
StrEquCI1251(prefix, 'pk3') or
- StrEquCI1251(prefix, 'dfwad');
+ StrEquCI1251(prefix, 'dfz') or
+ StrEquCI1251(prefix, 'dfwad') or
+ StrEquCI1251(prefix, 'dfzip');
end;
procedure TSFSZipVolumeFactory.Recycle (vol: TSFSVolume);