X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fsfs%2FsfsZipFS.pas;h=ee1cc1c272b7e6c42e884a78f643632fe376f570;hb=80d272f7000f269b007a393a5e4cc8c09178aa63;hp=b3a83245b24a00609629b52bf32537e68d32a251;hpb=74b8cc24c941b92453f71fa9c912db10119acf81;p=d2df-sdl.git

diff --git a/src/sfs/sfsZipFS.pas b/src/sfs/sfsZipFS.pas
index b3a8324..ee1cc1c 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,20 +20,30 @@ 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;
 
   public
     function OpenFileByIndex (const index: Integer): TStream; override;
@@ -88,6 +99,7 @@ begin
   result := true;
 end;
 
+{$IFDEF SFS_ZIPFS_FULL}
 function F2DATCheckMagic (st: TStream): Boolean;
 var
   dsize, fiSz: Integer;
@@ -114,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
@@ -133,6 +146,63 @@ begin
   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 SFSUpCase(s0[f]) <> SFSUpCase(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 ();
@@ -153,7 +223,9 @@ begin
 
     if sign <> 'PK'#3#4 then break;
 
-    ignoreFile := false; skipped := false;
+    ignoreFile := false;
+    skipped := false;
+
     fi := TSFSZipFileInfo.Create(self);
     fi.fPackSz := 0;
     fi.fMethod := 0;
@@ -260,6 +332,7 @@ begin
   end;
 end;
 
+{$IFDEF SFS_ZIPFS_FULL}
 procedure TSFSZipVolume.F2DATReadDirectory ();
 var
   dsize: Integer;
@@ -333,6 +406,7 @@ begin
     fi.fMethod := 255;
   end;
 end;
+{$ENDIF}
 
 procedure TSFSZipVolume.DFWADReadDirectory ();
 // idiotic format
@@ -386,8 +460,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;
@@ -396,7 +472,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;
@@ -406,6 +482,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;
@@ -430,37 +507,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;
@@ -468,6 +549,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);
@@ -481,12 +563,15 @@ end;
 function TSFSZipVolumeFactory.IsMyVolumePrefix (const prefix: TSFSString): Boolean;
 begin
   result :=
-    (SFSStrComp(prefix, 'zip') = 0) or
-    (SFSStrComp(prefix, 'jar') = 0) or
-    (SFSStrComp(prefix, 'fout2') = 0) or
-    (SFSStrComp(prefix, 'vtdb') = 0) or
-    (SFSStrComp(prefix, 'wad') = 0) or
-    (SFSStrComp(prefix, 'dfwad') = 0);
+    SFSStrEqu(prefix, 'zip') or
+    SFSStrEqu(prefix, 'dfwad')
+    {$IFDEF SFS_ZIPFS_FULL}
+    or SFSStrEqu(prefix, 'jar') or
+    SFSStrEqu(prefix, 'fout2') or
+    SFSStrEqu(prefix, 'vtdb') or
+    SFSStrEqu(prefix, 'wad')
+    {$ENDIF}
+    ;
 end;
 
 procedure TSFSZipVolumeFactory.Recycle (vol: TSFSVolume);
@@ -499,10 +584,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
@@ -530,6 +618,6 @@ var
 initialization
   zipf := TSFSZipVolumeFactory.Create();
   SFSRegisterVolumeFactory(zipf);
-finalization
-  SFSUnregisterVolumeFactory(zipf);
+//finalization
+//  SFSUnregisterVolumeFactory(zipf);
 end.