diff --git a/src/sfs/sfsZipFS.pas b/src/sfs/sfsZipFS.pas
index 5b6dafda3ee2e07b5a489e143f9f34798db725d5..2f4c613c996c2321804159b120bf3202e31cba17 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, version 3 of the License ONLY.
+ *
+ * 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:
// 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}
// dfwad : D2D:F wad archives
//
{.$DEFINE SFS_DEBUG_ZIPFS}
-{$MODE DELPHI}
-{.$R-}
+{$INCLUDE ../shared/a_modes.inc}
+{$SCOPEDENUMS OFF}
+{.$R+}
unit sfsZipFS;
interface
unit sfsZipFS;
interface
SysUtils, Classes, Contnrs, sfs;
SysUtils, Classes, Contnrs, sfs;
-
type
type
- TSFSZipVolumeType = (sfszvNone, sfszvZIP, sfszvF2DAT, sfszvVTDB, sfszvDFWAD);
+ TSFSZipVolumeType = (sfszvNone, sfszvZIP, sfszvDFWAD);
TSFSZipVolume = class(TSFSVolume)
protected
fType: TSFSZipVolumeType;
procedure ZIPReadDirectory ();
TSFSZipVolume = class(TSFSVolume)
protected
fType: TSFSZipVolumeType;
procedure ZIPReadDirectory ();
- procedure F2DATReadDirectory ();
- procedure VTDBReadDirectory ();
procedure DFWADReadDirectory ();
procedure ReadDirectory (); override;
procedure DFWADReadDirectory ();
procedure ReadDirectory (); override;
function OpenFileByIndex (const index: Integer): TStream; override;
end;
function OpenFileByIndex (const index: Integer): TStream; override;
end;
- TSFSZipVolumeFactory = class (TSFSVolumeFactory)
+ TSFSZipVolumeFactory = class(TSFSVolumeFactory)
public
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;
procedure Recycle (vol: TSFSVolume); override;
end;
-
implementation
uses
implementation
uses
- zstream, xstreams;
-
+ xstreams, utils;
-type
- TZDecompressionStream = TDecompressionStream;
type
type
- TSFSZipFileInfo = class (TSFSFileInfo)
+ TSFSZipFileInfo = class(TSFSFileInfo)
public
fMethod: Byte; // 0: store; 8: deflate; 255: other
public
fMethod: Byte; // 0: store; 8: deflate; 255: other
- fPackSz: Int64;
+ fPackSz: Int64; // can be -1
end;
TZLocalFileHeader = packed record
end;
TZLocalFileHeader = packed record
localExtraSz: Word;
end;
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 ZIPCheckMagic (st: TStream): Boolean;
var
result := true;
end;
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;
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);
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);
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;
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;
result := true;
end;
procedure TSFSZipVolume.ZIPReadDirectory ();
var
fi: TSFSZipFileInfo;
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;
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
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
// 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;
if sign <> 'PK'#3#4 then break;
- ignoreFile := false; skipped := false;
+ ignoreFile := false;
+
+ readLFH(fFileStream, lhdr);
+
fi := TSFSZipFileInfo.Create(self);
fi.fPackSz := 0;
fi.fMethod := 0;
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);
+ 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
if (lhdr.flags and 1) <> 0 then
begin
ignoreFile := true;
end;
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;
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
// 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 ignoreFile then fi.Free();
until false;
-
+ (*
if (sign <> 'PK'#1#2) and (sign <> 'PK'#5#6) then
begin
{$IFDEF SFS_DEBUG_ZIPFS}
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;
{$ENDIF}
raise ESFSError.Create('invalid .ZIP archive (no central dir)');
end;
+ *)
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;
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
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);
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
c := 0;
fname := '';
while (c < 16) and (name[c] <> #0) do
begin
case fType of
sfszvZIP: ZIPReadDirectory();
begin
case fType of
sfszvZIP: ZIPReadDirectory();
- sfszvF2DAT: F2DATReadDirectory();
- sfszvVTDB: VTDBReadDirectory();
sfszvDFWAD: DFWADReadDirectory();
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
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;
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;
if fFiles = nil then exit;
if (index < 0) or (index >= fFiles.Count) or (fFiles[index] = nil) then exit;
- kill := false;
try
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
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
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
end;
except
- FreeAndNil(gs);
- FreeAndNil(zs);
- if kill then FreeAndNil(fs);
+ FreeAndNil(rs);
result := nil;
exit;
end;
result := nil;
exit;
end;
{ TSFSZipVolumeFactory }
{ TSFSZipVolumeFactory }
-function TSFSZipVolumeFactory.IsMyVolumePrefix (const prefix: TSFSString): Boolean;
+function TSFSZipVolumeFactory.IsMyVolumePrefix (const prefix: AnsiString): Boolean;
begin
result :=
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, 'dfz') or
+ StrEquCI1251(prefix, 'dfwad') or
+ StrEquCI1251(prefix, 'dfzip');
end;
procedure TSFSZipVolumeFactory.Recycle (vol: TSFSVolume);
end;
procedure TSFSZipVolumeFactory.Recycle (vol: TSFSVolume);
vol.Free();
end;
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;
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
if vt <> sfszvNone then
begin
initialization
zipf := TSFSZipVolumeFactory.Create();
SFSRegisterVolumeFactory(zipf);
initialization
zipf := TSFSZipVolumeFactory.Create();
SFSRegisterVolumeFactory(zipf);
-finalization
- SFSUnregisterVolumeFactory(zipf);
+//finalization
+// SFSUnregisterVolumeFactory(zipf);
end.
end.