sfs: remove common dir from pk3 (this should fix invalid zips)

[d2df-sdl.git] / src / sfs / sfs.pas

diff --git a/src/sfs/sfs.pas b/src/sfs/sfs.pas
index 9615d4b4db7549457453df0d0933e3bb57725303..3776a0036d7742c6df3160222d12328f5d35e3b1 100644 (file)
--- a/src/sfs/sfs.pas
+++ b/src/sfs/sfs.pas
@@ -73,6 +73,8 @@ type
     // íèêàêèõ ïàäåíèé íà íåïðàâèëüíûå èíäåêñû!
     function GetFiles (index: Integer): TSFSFileInfo; virtual;
 
+    procedure removeCommonPath (); virtual;
+
   public
     // pSt íå îáÿçàòåëüíî çàïîìèíàòü, åñëè îí íå íóæåí.
     constructor Create (const pFileName: TSFSString; pSt: TStream); virtual;
@@ -195,10 +197,7 @@ function SFSFileList (const dataFileName: TSFSString): TSFSFileList;
 
 function SFSReplacePathDelims (const s: TSFSString; newDelim: TSFSChar): TSFSString;
 // èãíîðèðóåò ðåãèñòð ñèìâîëîâ
-// <0: s0 < s1
-// =0: s0 = s1
-// >0: s0 > s1
-function SFSStrComp (const s0, s1: TSFSString): Integer;
+function SFSStrEqu (const s0, s1: TSFSString): Boolean;
 
 // ðàçîáðàòü òîëñòîå èìÿ ôàéëà, âåðíóòü âèðòóàëüíîå èìÿ ïîñëåäíåãî ñïèñêà
 // èëè ïóñòóþ ñòîðîêó, åñëè ñïèñêîâ íå áûëî.
@@ -227,6 +226,11 @@ function WildMatch (pattern, text: TSFSString): Boolean;
 function WildListMatch (wildList, text: TSFSString; delimChar: AnsiChar=':'): Integer;
 function HasWildcards (const pattern: TSFSString): Boolean;
 
+// this will compare only last path element from sfspath
+function SFSDFPathEqu (sfspath: string; path: string): Boolean;
+
+function SFSUpCase (ch: Char): Char;
+
 
 var
   // ïðàâäà: ðàçðåøåíî èñêàòü ôàéëî íå òîëüêî â ôàéëàõ äàííûõ, íî è íà äèñêå.
@@ -519,7 +523,7 @@ begin
       vi := TVolumeInfo(volumes[f]);
       if not onlyPerm or vi.fPermanent then
       begin
-        if SFSStrComp(vi.fPackName, dataFileName) = 0 then
+        if SFSStrEqu(vi.fPackName, dataFileName) then
         begin
           result := f;
           exit;
@@ -546,12 +550,62 @@ begin
   end;
 end;
 
-// <0: s0 < s1
-// =0: s0 = s1
-// >0: s0 > s1
-function SFSStrComp (const s0, s1: TSFSString): Integer;
+function SFSUpCase (ch: Char): Char;
+begin
+  if ch < #128 then
+  begin
+    if (ch >= 'a') and (ch <= 'z') then Dec(ch, 32);
+  end
+  else
+  begin
+    if (ch >= #224) and (ch <= #255) then
+    begin
+      Dec(ch, 32);
+    end
+    else
+    begin
+      case ch of
+        #184, #186, #191: Dec(ch, 16);
+        #162, #179: Dec(ch);
+      end;
+    end;
+  end;
+  result := ch;
+end;
+
+function SFSStrEqu (const s0, s1: TSFSString): Boolean;
+var
+  i: Integer;
+begin
+  //result := (AnsiCompareText(s0, s1) == 0);
+  result := false;
+  if length(s0) <> length(s1) then exit;
+  for i := 1 to length(s0) do
+  begin
+    if SFSUpCase(s0[i]) <> SFSUpCase(s1[i]) then exit;
+  end;
+  result := true;
+end;
+
+// this will compare only last path element from sfspath
+function SFSDFPathEqu (sfspath: string; path: string): Boolean;
+{var
+  i: Integer;}
 begin
-  result := AnsiCompareText(s0, s1);
+  result := SFSStrEqu(sfspath, path);
+(*
+  if not result and (length(sfspath) > 1) then
+  begin
+    i := length(sfspath);
+    while i > 1 do
+    begin
+      while (i > 1) and (sfspath[i-1] <> '/') do Dec(i);
+      if i <= 1 then exit;
+      writeln('{', sfspath, '} [', Copy(sfspath, i, length(sfspath)), '] : [', path, ']');
+      result := SFSStrEqu(Copy(sfspath, i, length(sfspath)), path);
+    end;
+  end;
+*)
 end;
 
 function SFSReplacePathDelims (const s: TSFSString; newDelim: TSFSChar): TSFSString;
@@ -674,6 +728,10 @@ begin
   fFiles := TObjectList.Create(true);
 end;
 
+procedure TSFSVolume.removeCommonPath ();
+begin
+end;
+
 procedure TSFSVolume.DoDirectoryRead ();
 var
   fl: TStringList; //!!!FIXME! change to list of wide TSFSStrings or so!
@@ -729,6 +787,7 @@ begin
     fl.Free();
     raise;
   end;
+  removeCommonPath();
 end;
 
 destructor TSFSVolume.Destroy ();
@@ -755,8 +814,8 @@ begin
       Dec(result);
       if fFiles[result] <> nil then
       begin
-        if (SFSStrComp(fPath, TSFSFileInfo(fFiles[result]).fPath) = 0) and
-           (SFSStrComp(fName, TSFSFileInfo(fFiles[result]).fName) = 0) then exit;
+        if SFSStrEqu(fPath, TSFSFileInfo(fFiles[result]).fPath) and
+           SFSStrEqu(fName, TSFSFileInfo(fFiles[result]).fName) then exit;
       end;
     end;
     result := -1;