diff --git a/src/sfs/sfsZipFS.pas b/src/sfs/sfsZipFS.pas
index c39eb4361e3e5fcfd4ff67ac4de62eacffa54734..9db434e96973cdd3b87a66ea7435a038cb83c7f6 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
procedure DFWADReadDirectory ();
procedure ReadDirectory (); override;
- procedure removeCommonPath (); override;
public
function OpenFileByIndex (const index: Integer): TStream; override;
st.ReadBuffer(sign[0], 6);
{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;
+ fname: AnsiString = '';
sign: packed array [0..3] of Char;
lhdr: TZLocalFileHeader;
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
+ // 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));
-
- // skip data descriptor
- if sign = 'PK'#7#8 then
+ if fileIdx >= 0 then
begin
- fFileStream.seek(3*4, soCurrent);
- continue;
+ 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;
fi.fPackSz := 0;
fi.fMethod := 0;
- 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);
+ 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
while lhdr.localExtraSz >= 4 do
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 fi.fMethod = 0 then fi.fPackSz := fi.fSize;
// skip packed data
- fFileStream.Seek(lhdr.packSz, soCurrent);
+ if fileIdx < 0 then fFileStream.Seek(lhdr.packSz, soCurrent);
if ignoreFile then fi.Free();
until false;
(*