X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fsfs%2FsfsZipFS.pas;h=7a1852a483234eb17258564015322b3b38a76550;hb=844441154d1220d6c83f75043300c2851ec87109;hp=9fb1137e0ca70d054282ddc68c6a01a190b67717;hpb=20428038ea09152f824e5947da1d550a4774207e;p=d2df-sdl.git diff --git a/src/sfs/sfsZipFS.pas b/src/sfs/sfsZipFS.pas index 9fb1137..7a1852a 100644 --- a/src/sfs/sfsZipFS.pas +++ b/src/sfs/sfsZipFS.pas @@ -9,6 +9,7 @@ // dfwad : D2D:F wad archives // {.$DEFINE SFS_DEBUG_ZIPFS} +{.$DEFINE SFS_ZIPFS_FULL} {$MODE DELPHI} {.$R-} unit sfsZipFS; @@ -19,18 +20,27 @@ uses SysUtils, Classes, Contnrs, sfs; - type - TSFSZipVolumeType = (sfszvNone, sfszvZIP, sfszvF2DAT, sfszvVTDB, sfszvDFWAD); + TSFSZipVolumeType = ( + sfszvNone, + sfszvZIP, + {$IFDEF SFS_ZIPFS_FULL} + sfszvF2DAT, + sfszvVTDB, + {$ENDIF} + sfszvDFWAD + ); TSFSZipVolume = class(TSFSVolume) protected fType: TSFSZipVolumeType; procedure ZIPReadDirectory (); + procedure DFWADReadDirectory (); + {$IFDEF SFS_ZIPFS_FULL} procedure F2DATReadDirectory (); procedure VTDBReadDirectory (); - procedure DFWADReadDirectory (); + {$ENDIF} procedure ReadDirectory (); override; procedure removeCommonPath (); override; @@ -51,7 +61,7 @@ type implementation uses - zstream, xstreams; + zstream, xstreams, utils; type @@ -89,6 +99,7 @@ begin result := true; end; +{$IFDEF SFS_ZIPFS_FULL} function F2DATCheckMagic (st: TStream): Boolean; var dsize, fiSz: Integer; @@ -115,6 +126,7 @@ begin if (fcnt < 0) or (dofs < 32) or (dofs+fcnt*8 > st.Size) then exit; result := true; end; +{$ENDIF} function DFWADCheckMagic (st: TStream): Boolean; var @@ -141,7 +153,7 @@ 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; + if UpCase1251(s0[f]) <> UpCase1251(s1[f]) then begin result := f; exit; end; end; result := length(s0); end; @@ -191,6 +203,7 @@ begin end; end; + { TSFSZipVolume } procedure TSFSZipVolume.ZIPReadDirectory (); var @@ -202,6 +215,9 @@ var crc, psz, usz: LongWord; buf: packed array of Byte; bufPos, bufUsed: Integer; + efid, efsz: Word; + izver: Byte; + izcrc: LongWord; begin SetLength(buf, 0); // read local directory @@ -217,12 +233,54 @@ begin 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 := name; - fFileStream.Seek(lhdr.localExtraSz, soCurrent); + fi.fName := utf8to1251(name); + //writeln(Format('0x%08x : %s', [Integer(fi.fOfs), name])); + + // 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); + 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 @@ -271,8 +329,7 @@ begin begin bufPos := 0; // int64! - if fFileStream.Size-fFileStream.Position > Length(buf) then - bufUsed := Length(buf) + 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); @@ -319,6 +376,7 @@ begin end; end; +{$IFDEF SFS_ZIPFS_FULL} procedure TSFSZipVolume.F2DATReadDirectory (); var dsize: Integer; @@ -392,6 +450,7 @@ begin fi.fMethod := 255; end; end; +{$ENDIF} procedure TSFSZipVolume.DFWADReadDirectory (); // idiotic format @@ -445,8 +504,10 @@ procedure TSFSZipVolume.ReadDirectory (); begin case fType of sfszvZIP: ZIPReadDirectory(); + {$IFDEF SFS_ZIPFS_FULL} sfszvF2DAT: F2DATReadDirectory(); sfszvVTDB: VTDBReadDirectory(); + {$ENDIF} sfszvDFWAD: DFWADReadDirectory(); else raise ESFSError.Create('invalid zipped SFS'); end; @@ -455,7 +516,7 @@ end; function TSFSZipVolume.OpenFileByIndex (const index: Integer): TStream; var zs: TZDecompressionStream; - fs: TStream; + fs, rs: TStream; gs: TSFSGuardStream; kill: Boolean; buf: packed array [0..1023] of Char; @@ -465,6 +526,7 @@ begin 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; @@ -489,37 +551,41 @@ begin fs.Seek(TSFSZipFileInfo(fFiles[index]).fOfs, soBeginning); if TSFSZipFileInfo(fFiles[index]).fMethod = 255 then begin - zs := TZDecompressionStream.Create(fs) + // 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, ']'); + zs := TZDecompressionStream.Create(fs); + 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); + 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; + rs := TSFSPartialStream.Create(fs, TSFSZipFileInfo(fFiles[index]).fOfs, TSFSZipFileInfo(fFiles[index]).fPackSz, true); + zs := TZDecompressionStream.Create(rs); + rs := nil; 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; + rs := TSFSPartialStream.Create(fs, TSFSZipFileInfo(fFiles[index]).fOfs, TSFSZipFileInfo(fFiles[index]).fPackSz, true); + zs := TZDecompressionStream.Create(rs, true {-15}{MAX_WBITS}); + rs := nil; end; gs := TSFSGuardStream.Create(zs, fs, true, kill, false); zs := nil; @@ -527,6 +593,7 @@ begin result := TSFSPartialStream.Create(gs, 0, TSFSZipFileInfo(fFiles[index]).fSize, true); end; except + FreeAndNil(rs); FreeAndNil(gs); FreeAndNil(zs); if kill then FreeAndNil(fs); @@ -540,12 +607,15 @@ end; function TSFSZipVolumeFactory.IsMyVolumePrefix (const prefix: TSFSString): 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, 'dfwad') + {$IFDEF SFS_ZIPFS_FULL} + or StrEquCI1251(prefix, 'jar') or + StrEquCI1251(prefix, 'fout2') or + StrEquCI1251(prefix, 'vtdb') or + StrEquCI1251(prefix, 'wad') + {$ENDIF} + ; end; procedure TSFSZipVolumeFactory.Recycle (vol: TSFSVolume); @@ -558,10 +628,13 @@ var vt: TSFSZipVolumeType; begin vt := sfszvNone; - if ZIPCheckMagic(st) then vt := sfszvZIP + if ZIPCheckMagic(st) then vt := sfszvZIP else if DFWADCheckMagic(st) then vt := sfszvDFWAD + {$IFDEF SFS_ZIPFS_FULL} else if F2DATCheckMagic(st) then vt := sfszvF2DAT - else if VTDBCheckMagic(st) then vt := sfszvVTDB; + else if VTDBCheckMagic(st) then vt := sfszvVTDB + {$ENDIF} + ; if vt <> sfszvNone then begin @@ -589,6 +662,6 @@ var initialization zipf := TSFSZipVolumeFactory.Create(); SFSRegisterVolumeFactory(zipf); -finalization - SFSUnregisterVolumeFactory(zipf); +//finalization +// SFSUnregisterVolumeFactory(zipf); end.