diff --git a/src/sfs/sfsZipFS.pas b/src/sfs/sfsZipFS.pas
--- a/src/sfs/sfsZipFS.pas
+++ /dev/null
@@ -1,465 +0,0 @@
-(* 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}
-{$INCLUDE ../shared/a_modes.inc}
-{$SCOPEDENUMS OFF}
-{.$R+}
-unit sfsZipFS;
-
-interface
-
-uses
- SysUtils, Classes, Contnrs, sfs;
-
-
-type
- TSFSZipVolumeType = (sfszvNone, sfszvZIP, sfszvDFWAD);
-
- TSFSZipVolume = class(TSFSVolume)
- protected
- fType: TSFSZipVolumeType;
-
- procedure ZIPReadDirectory ();
- procedure DFWADReadDirectory ();
-
- procedure ReadDirectory (); override;
-
- public
- function OpenFileByIndex (const index: Integer): TStream; override;
- end;
-
- TSFSZipVolumeFactory = class(TSFSVolumeFactory)
- public
- 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
- xstreams, utils;
-
-
-type
- TSFSZipFileInfo = class(TSFSFileInfo)
- public
- fMethod: Byte; // 0: store; 8: deflate; 255: other
- fPackSz: Int64; // can be -1
- end;
-
- TZLocalFileHeader = packed record
- version: Byte;
- hostOS: Byte;
- flags: Word;
- method: Word;
- time: LongWord;
- crc: LongWord;
- packSz: LongWord;
- unpackSz: LongWord;
- fnameSz: Word;
- 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
- sign: packed array [0..3] of Char;
-begin
- result := false;
- st.ReadBuffer(sign[0], 4);
- st.Seek(-4, soCurrent);
- if (sign <> 'PK'#3#4) and (sign <> 'PK'#5#6) then exit;
- result := true;
-end;
-
-
-function DFWADCheckMagic (st: TStream): Boolean;
-var
- sign: packed array [0..5] of Char;
-begin
- result := false;
- if st.Size < 10 then exit;
- st.ReadBuffer(sign[0], 6);
- {fcnt :=} readWord(st);
- st.Seek(-8, soCurrent);
- 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;
- result := true;
-end;
-
-
-{ TSFSZipVolume }
-procedure TSFSZipVolume.ZIPReadDirectory ();
-var
- fi: TSFSZipFileInfo;
- 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
- 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;
-
- readLFH(fFileStream, lhdr);
-
- fi := TSFSZipFileInfo.Create(self);
- fi.fPackSz := 0;
- fi.fMethod := 0;
-
- 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
- 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 > 5) then
- begin
- fFileStream.ReadBuffer(izver, 1);
- 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 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
- 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
- // encrypted file: skip it
- ignoreFile := true;
- end;
-
- if (lhdr.method <> 0) and (lhdr.method <> 8) then
- begin
- // not stored. not deflated. skip.
- 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
- 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}
- WriteLn(ErrOutput, 'end: $', IntToHex(fFileStream.Position, 8));
- WriteLn(ErrOutput, 'sign: $', sign[0], sign[1], '#', ord(sign[2]), '#', ord(sign[3]));
- {$ENDIF}
- raise ESFSError.Create('invalid .ZIP archive (no central dir)');
- end;
- *)
-end;
-
-
-procedure TSFSZipVolume.DFWADReadDirectory ();
-// idiotic format
-var
- fcnt: Word;
- fi: TSFSZipFileInfo;
- f, c: Integer;
- fofs, fpksize: LongWord;
- curpath, fname: string;
- name: packed array [0..15] of Char;
-begin
- curpath := '';
- fFileStream.Seek(6, soCurrent); // skip signature
- fcnt := readWord(fFileStream);
- if fcnt = 0 then exit;
- // read files
- for f := 0 to fcnt-1 do
- begin
- fFileStream.ReadBuffer(name[0], 16);
- fofs := readLongWord(fFileStream);
- fpksize := readLongWord(fFileStream);
- c := 0;
- fname := '';
- while (c < 16) and (name[c] <> #0) do
- begin
- if name[c] = '\' then name[c] := '/'
- else if name[c] = '/' then name[c] := '_';
- fname := fname+name[c];
- Inc(c);
- end;
- // new directory?
- if (fofs = 0) and (fpksize = 0) then
- begin
- if length(fname) <> 0 then fname := fname+'/';
- curpath := fname;
- continue;
- end;
- if length(fname) = 0 then continue; // just in case
- //writeln('DFWAD: [', curpath, '] [', fname, '] at ', fofs, ', size ', fpksize);
- // create file record
- fi := TSFSZipFileInfo.Create(self);
- fi.fOfs := fofs;
- fi.fSize := -1;
- fi.fPackSz := fpksize;
- fi.fName := fname;
- fi.fPath := curpath;
- fi.fMethod := 255;
- end;
-end;
-
-procedure TSFSZipVolume.ReadDirectory ();
-begin
- case fType of
- sfszvZIP: ZIPReadDirectory();
- sfszvDFWAD: DFWADReadDirectory();
- else raise ESFSError.Create('invalid archive');
- end;
-end;
-
-function TSFSZipVolume.OpenFileByIndex (const index: Integer): TStream;
-var
- rs: TStream;
-begin
- result := nil;
- rs := nil;
- if fFiles = nil then exit;
- if (index < 0) or (index >= fFiles.Count) or (fFiles[index] = nil) then exit;
- try
- if TSFSZipFileInfo(fFiles[index]).fMethod = 0 then
- begin
- result := TSFSPartialStream.Create(fFileStream, TSFSZipFileInfo(fFiles[index]).fOfs, TSFSZipFileInfo(fFiles[index]).fSize, false);
- end
- else
- begin
- 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);
- result := nil;
- exit;
- end;
-end;
-
-
-{ TSFSZipVolumeFactory }
-function TSFSZipVolumeFactory.IsMyVolumePrefix (const prefix: AnsiString): Boolean;
-begin
- result :=
- StrEquCI1251(prefix, 'zip') or
- StrEquCI1251(prefix, 'pk3') or
- StrEquCI1251(prefix, 'dfwad') or
- StrEquCI1251(prefix, 'dfzip');
-end;
-
-procedure TSFSZipVolumeFactory.Recycle (vol: TSFSVolume);
-begin
- vol.Free();
-end;
-
-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;
-
- if vt <> sfszvNone then
- begin
- result := TSFSZipVolume.Create(fileName, st);
- TSFSZipVolume(result).fType := vt;
- try
- result.DoDirectoryRead();
- except {$IFDEF SFS_DEBUG_ZIPFS} on e: Exception do begin
- WriteLn(errOutput, 'ZIP ERROR: [', e.ClassName, ']: ', e.Message);
- {$ENDIF}
- FreeAndNil(result);
- raise;
- {$IFDEF SFS_DEBUG_ZIPFS}end;{$ENDIF}
- end;
- end
- else
- begin
- result := nil;
- end;
-end;
-
-
-var
- zipf: TSFSZipVolumeFactory;
-initialization
- zipf := TSFSZipVolumeFactory.Create();
- SFSRegisterVolumeFactory(zipf);
-//finalization
-// SFSUnregisterVolumeFactory(zipf);
-end.