Maps can be saved to zip

diff --git a/src/editor/Editor.lpr b/src/editor/Editor.lpr
index 21d8fe5df9a97c8f5cf532dac8b453175148170d..ccbcb60f5a95cd469fd060445b2d7c62a2f202f0 100644 (file)
--- a/src/editor/Editor.lpr
+++ b/src/editor/Editor.lpr
@@ -16,6 +16,7 @@ uses
   WADSTRUCT in '../shared/WADSTRUCT.pas',
   CONFIG in '../shared/CONFIG.pas',
   xstreams in '../shared/xstreams.pas',
+  dfzip in '../shared/dfzip.pas',
   sfs in '../sfs/sfs.pas',
   sfsPlainFS in '../sfs/sfsPlainFS.pas',
   sfsZipFS in '../sfs/sfsZipFS.pas',

diff --git a/src/editor/f_main.pas b/src/editor/f_main.pas
index 2dbada8e169ea4660e46625b66fe98fba88f58e1..32c13a2751b0f54851c87a98e2e5d105c10073ee 100644 (file)
--- a/src/editor/f_main.pas
+++ b/src/editor/f_main.pas
@@ -336,7 +336,7 @@ uses
   f_mapoptions, g_basic, f_about, f_mapoptimization,
   f_mapcheck, f_addresource_texture, g_textures,
   f_activationtype, f_keys,
-  MAPREADER, f_selectmap, f_savemap, WADEDITOR, WADSTRUCT, MAPDEF,
+  MAPREADER, f_selectmap, f_savemap, WADEDITOR, MAPDEF,
   g_map, f_saveminimap, f_addresource, CONFIG, f_packmap,
   f_addresource_sound, f_maptest, f_choosetype,
   g_language, f_selectlang, ClipBrd, g_resources;
@@ -6157,69 +6157,48 @@ end;
 
 procedure TMainForm.aDeleteMap(Sender: TObject);
 var
-  WAD: TWADEditor_1;
-  MapList: SArray;
-  MapName: Char16;
-  a: Integer;
-  str: String;
+  res: Integer;
+  FileName: String;
+  MapName: String;
 begin
   OpenDialog.Filter := _lc[I_FILE_FILTER_WAD];
 
   if not OpenDialog.Execute() then
     Exit;
 
-  WAD := TWADEditor_1.Create();
-
-  if not WAD.ReadFile(OpenDialog.FileName) then
-  begin
-    WAD.Free();
-    Exit;
-  end;
-
-  WAD.CreateImage();
-
-  MapList := WAD.GetResourcesList('');
-
+  FileName := OpenDialog.FileName;
   SelectMapForm.Caption := _lc[I_CAP_REMOVE];
   SelectMapForm.lbMapList.Items.Clear();
+  SelectMapForm.GetMaps(FileName);
 
-  if MapList <> nil then
-    for a := 0 to High(MapList) do
-      SelectMapForm.lbMapList.Items.Add(win2utf(MapList[a]));
+  if SelectMapForm.ShowModal() <> mrOK then
+    Exit;
 
-  if (SelectMapForm.ShowModal() = mrOK) then
-  begin
-    str := SelectMapForm.lbMapList.Items[SelectMapForm.lbMapList.ItemIndex];
-    MapName := '';
-    Move(str[1], MapName[0], Min(16, Length(str)));
-
-    if MessageBox(0, PChar(Format(_lc[I_MSG_DELETE_MAP_PROMT],
-                           [MapName, OpenDialog.FileName])),
-                  PChar(_lc[I_MSG_DELETE_MAP]),
-                  MB_ICONQUESTION or MB_YESNO or
-                  MB_DEFBUTTON2) <> mrYes then
-      Exit;
+  MapName := SelectMapForm.lbMapList.Items[SelectMapForm.lbMapList.ItemIndex];
+  if MessageBox(0, PChar(Format(_lc[I_MSG_DELETE_MAP_PROMT], [MapName, OpenDialog.FileName])), PChar(_lc[I_MSG_DELETE_MAP]), MB_ICONQUESTION or MB_YESNO or MB_DEFBUTTON2) <> mrYes then
+    Exit;
 
-    WAD.RemoveResource('', utf2win(MapName));
-    
-    MessageBox(0, PChar(Format(_lc[I_MSG_MAP_DELETED_PROMT],
-                               [MapName])),
-               PChar(_lc[I_MSG_MAP_DELETED]),
-               MB_ICONINFORMATION or MB_OK or
-               MB_DEFBUTTON1);
+  g_DeleteResource(FileName, '', utf2win(MapName), res);
+  if res <> 0 then
+  begin
+    MessageBox(0, PChar('Cant delete map res=' + IntToStr(res)), PChar('Map not deleted!'), MB_ICONINFORMATION or MB_OK or MB_DEFBUTTON1);
+    Exit
+  end;
 
-    WAD.SaveTo(OpenDialog.FileName);
+  MessageBox(
+    0,
+    PChar(Format(_lc[I_MSG_MAP_DELETED_PROMT], [MapName])),
+    PChar(_lc[I_MSG_MAP_DELETED]),
+    MB_ICONINFORMATION or MB_OK or MB_DEFBUTTON1
+  );
 
   // Удалили текущую карту - сохранять по старому ее нельзя:
-    if OpenedMap = (OpenDialog.FileName+':\'+MapName) then
-    begin
-      OpenedMap := '';
-      OpenedWAD := '';
-      MainForm.Caption := FormCaption;
-    end;
-  end;
-
-  WAD.Free();
+  if OpenedMap = (FileName + ':\' + MapName) then
+  begin
+    OpenedMap := '';
+    OpenedWAD := '';
+    MainForm.Caption := FormCaption
+  end
 end;
 
 procedure TMainForm.vleObjectPropertyKeyDown(Sender: TObject;

diff --git a/src/editor/f_savemap.pas b/src/editor/f_savemap.pas
index f5feee313ce5291af9041bcdb5c43ba9646c6ebe..14336d9e3581cffa64f538bcdebd7cfe9d227d74 100644 (file)
--- a/src/editor/f_savemap.pas
+++ b/src/editor/f_savemap.pas
@@ -35,7 +35,7 @@ var
 implementation
 
 uses
-  BinEditor, MAPREADER, WADEDITOR, WADSTRUCT, MAPSTRUCT, g_language;
+  MAPREADER, MAPSTRUCT, g_language, g_resources, sfs;
 
 {$R *.lfm}
 
@@ -85,67 +85,64 @@ begin
 end;
 
 procedure TSaveMapForm.GetMaps(FileName: String; placeName: Boolean);
-var
-  WAD: TWADEditor_1;
-  a, max_num, j: Integer;
-  ResList: SArray;
-  Data: Pointer;
-  Len: Integer;
-  Sign: Array [0..2] of Char;
-  nm: String;
-
+  var
+    nm: String;
+    data: Pbyte;
+    list: TSFSFileList;
+    i, j, len, max_num: Integer;
+    sign: Array [0..2] of Char;
 begin
   lbMapList.Items.Clear();
   max_num := 1;
 
-  WAD := TWADEditor_1.Create();
-  WAD.ReadFile(FileName);
-  ResList := WAD.GetResourcesList('');  
-
-  if ResList <> nil then
-    for a := 0 to High(ResList) do
+  list := SFSFileList(FileName);
+  if list <> nil then
+  begin
+    for i := 0 to list.Count - 1 do
     begin
-      if not WAD.GetResource('', ResList[a], Data, Len) then
-        Continue;
+      g_ReadResource(FileName, list.Files[i].path, list.Files[i].name, data, len);
 
-      CopyMemory(@Sign[0], Data, 3);
-      FreeMem(Data);
-   
-      if Sign = MAP_SIGNATURE then
+      if len >= 3 then
       begin
-        nm := win2utf(ResList[a]);
-        lbMapList.Items.Add(nm);
-
-        if placeName then
+        sign[0] := chr(data[0]);
+        sign[1] := chr(data[1]);
+        sign[2] := chr(data[2]);
+        if sign = MAP_SIGNATURE then
         begin
-          nm := UpperCase(nm);
-          if (nm[1] = 'M') and
-             (nm[2] = 'A') and
-             (nm[3] = 'P') then
+          nm := win2utf(list.Files[i].name);
+          lbMapList.Items.Add(nm);
+          if placeName then
           begin
-            nm := Trim(Copy(nm, 4, Length(nm)-3));
-            j := StrToIntDef(nm, 0);
-            if j >= max_num then
-              max_num := j + 1;
-          end;
-        end;
+            nm := UpperCase(nm);
+            if (nm[1] = 'M') and (nm[2] = 'A') and (nm[3] = 'P') then
+            begin
+              nm := Trim(Copy(nm, 4, Length(nm)-3));
+              j := StrToIntDef(nm, 0);
+              if j >= max_num then
+                max_num := j + 1;
+            end
+          end
+        end
       end;
 
-      Sign := '';
+      if len > 0 then FreeMem(data)
     end;
 
-  WAD.Free();
+    list.Destroy;
+  end;
+
 
   if placeName then
-    begin
-      nm := IntToStr(max_num);
-      if Length(nm) < 2 then
-        nm := '0' + nm;
-      nm := 'MAP' + nm;
-      eMapName.Text := nm;
-    end
+  begin
+    nm := IntToStr(max_num);
+    if Length(nm) < 2 then
+      nm := '0' + nm;
+    eMapName.Text := 'MAP' + nm
+  end
   else
-    eMapName.Text := '';
+  begin
+    eMapName.Text := ''
+  end
 end;
 
 end.

diff --git a/src/editor/f_selectmap.pas b/src/editor/f_selectmap.pas
index 46f365c7f6cfe4c9bf0a50ebc6046f559d8c9f69..8d5eecc654bee87e7eefedca55c69fc99ab46ecb 100644 (file)
--- a/src/editor/f_selectmap.pas
+++ b/src/editor/f_selectmap.pas
@@ -32,7 +32,7 @@ var
 implementation
 
 uses
-  BinEditor, MAPREADER, WADEDITOR, WADSTRUCT, MAPSTRUCT;
+  MAPREADER, MAPSTRUCT, g_resources, sfs;
 
 {$R *.lfm}
 
@@ -54,41 +54,35 @@ begin
 end;
 
 procedure TSelectMapForm.GetMaps(FileName: String);
-var
-  WAD: TWADEditor_1;
-  a: Integer;
-  ResList: SArray;
-  Data: Pointer;
-  Len: Integer;
-  Sign: Array [0..2] of Char;
-
+  var
+    data: PByte;
+    list: TSFSFileList;
+    sign: Array [0..2] of Char;
+    i, len: Integer;
 begin
   lbMapList.Items.Clear();
 
-  WAD := TWADEditor_1.Create();
-  if not WAD.ReadFile(FileName) then
-  begin
-    WAD.Free();
-    Exit;
-  end;
+  list := SFSFileList(FileName);
+  if list = nil then Exit;
 
-  ResList := WAD.GetResourcesList('');
+  for i := 0 to list.Count - 1 do
+  begin
+    writeln('GetMap "' + list.Files[i].path + '" "' + list.Files[i].name + '"');
+    g_ReadResource(FileName, list.Files[i].path, list.Files[i].name, data, len);
 
-  if ResList <> nil then
-    for a := 0 to High(ResList) do
+    if len >= 3 then
     begin
-      if not WAD.GetResource('', ResList[a], Data, Len) then
-        Continue;
-
-      CopyMemory(@Sign[0], Data, 3);
-      FreeMem(Data);
-
-      if Sign = MAP_SIGNATURE then
-        lbMapList.Items.Add(win2utf(ResList[a]));
-      Sign := '';
+      sign[0] := chr(data[0]);
+      sign[1] := chr(data[1]);
+      sign[2] := chr(data[2]);
+      if sign = MAP_SIGNATURE then
+        lbMapList.Items.Add(win2utf(list.Files[i].name))
     end;
 
-  WAD.Free();
+    if len > 0 then FreeMem(data)
+  end;
+
+  list.Destroy
 end;
 
 end.

diff --git a/src/editor/g_map.pas b/src/editor/g_map.pas
index fa091deb2cb1c32b6aed93c8fa2975c85e798385..15a83dcd348800152892aca67197aa3577f4fc69 100644 (file)
--- a/src/editor/g_map.pas
+++ b/src/editor/g_map.pas
@@ -246,7 +246,7 @@ implementation
 
 uses
   BinEditor, g_textures, Dialogs, SysUtils, CONFIG, f_main,
-  Forms, Math, f_addresource_texture, WADEDITOR, g_language;
+  Forms, Math, f_addresource_texture, WADEDITOR, g_language, g_resources;
 
 const
   OLD_ITEM_MEDKIT_SMALL          = 1;
@@ -1053,7 +1053,6 @@ end;
 
 function SaveMap(Res: String): Pointer;
 var
-  WAD: TWADEditor_1;
   MapWriter: TMapWriter_1;
   textures: TTexturesRec1Array;
   panels: TPanelsRec1Array;
@@ -1071,7 +1070,6 @@ var
   Len: LongWord;
 
 begin
-  WAD := nil;
   textures := nil;
   panels := nil;
   items := nil;
@@ -1083,17 +1081,6 @@ begin
   Data := nil;
   Len := 0;
 
-// Открываем WAD, если надо:
-  if Res <> '' then
-  begin
-    WAD := TWADEditor_1.Create();
-    g_ProcessResourceStr(Res, FileName, SectionName, ResName);
-    if not WAD.ReadFile(FileName) then
-      WAD.FreeWAD();
-
-    WAD.CreateImage();
-  end;
-
   MapWriter := TMapWriter_1.Create();
 
 // Сохраняем заголовок:
@@ -1350,19 +1337,17 @@ begin
 
 // Записываем в WAD, если надо:
   if Res <> '' then
-    begin
-      s := utf2win(ResName);
-      WAD.RemoveResource('', s);
-      WAD.AddResource(Data, Len, s, '');
-      WAD.SaveTo(FileName);
-
-      FreeMem(Data);
-      WAD.Free();
-
-      Result := nil;
-    end
+  begin
+    g_ProcessResourceStr(Res, FileName, SectionName, ResName);
+    g_AddResource(FileName, SectionName, utf2win(ResName), Data, Len, a);
+    ASSERT(a = 0);
+    FreeMem(Data);
+    Result := nil
+  end
   else
-    Result := Data;
+  begin
+    Result := Data
+  end
 end;
 
 procedure AddTexture(res: String; Error: Boolean);
@@ -1383,7 +1368,6 @@ end;
 
 function LoadMap(Res: String): Boolean;
 var
-  WAD: TWADEditor_1;
   MapReader: TMapReader_1;
   Header: TMapHeaderRec_1;
   textures: TTexturesRec1Array;
@@ -1423,24 +1407,10 @@ begin
   MainForm.lLoad.Caption := _lc[I_LOAD_WAD];
   Application.ProcessMessages();
 
-// Открываем WAD:
-  WAD := TWADEditor_1.Create();
+// Читаем ресурс карты
   g_ProcessResourceStr(Res, FileName, SectionName, ResName);
-
-  if not WAD.ReadFile(FileName) then
-  begin
-    WAD.Free();
-    Exit;
-  end;
-
-// Читаем ресурс карты:
-  if not WAD.GetResource('', utf2win(ResName), pData, Len) then
-  begin
-    WAD.Free();
-    Exit;
-  end;
-
-  WAD.Free();
+  g_ReadResource(FileName, SectionName, ResName, pData, Len);
+  if pData = nil then Exit;
 
   MapReader := TMapReader_1.Create();
 

diff --git a/src/editor/g_resources.pas b/src/editor/g_resources.pas
index efed1250499e8047dadb1a04f18988219a47be32..6b73f6518988695352cb2f7b325629d2c9b805a9 100644 (file)
--- a/src/editor/g_resources.pas
+++ b/src/editor/g_resources.pas
@@ -2,12 +2,149 @@ unit g_resources;
 
 interface
 
+  (**
+    g_ReadResource
+      Read whole file from wad
+
+    g_ReadSubResource
+      Read whole file from folded wad
+
+    g_DeleteResource
+      Delete file from wad, res = 0 when ok
+
+    g_AddResource
+      Add/overwrite file to wad, res = 0 when ok
+  **)
+
   procedure g_ReadResource (wad, section, name: String; out data: PByte; out len: Integer);
   procedure g_ReadSubResource (wad, section0, name0, section1, name1: String; out data: PByte; out len: Integer);
+  procedure g_DeleteResource (wad, section, name: String; out res: Integer);
+  procedure g_AddResource (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
 
 implementation
 
-  uses sfs, utils, Classes;
+  uses sfs, xstreams, dfzip, utils, Classes, SysUtils, WADEDITOR;
+
+  procedure g_AddResourceToDFWAD (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
+    var f: TWADEditor_1;
+  begin
+    res := 1; (* error *)
+    f := TWADEditor_1.Create();
+    if not f.ReadFile(wad) then
+    begin
+      (* do nothing *)
+    end;
+    f.CreateImage;
+    f.RemoveResource(section, name);
+    f.AddResource(data, len, name, section);
+    f.SaveTo(wad);
+    f.Free;
+    res := 0
+  end;
+
+  procedure g_AddResourceToZip (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
+    var
+      i, n, len0: Integer;
+      data0: PByte;
+      list: TSFSFileList;
+      tmp, entry: String;
+      ts: TFileStream;
+      dir: array of TFileInfo;
+
+    procedure Add (name: String; data: PByte; len: Integer);
+      var ds: TSFSMemoryChunkStream;
+    begin
+      SetLength(dir, n + 1);
+      ds := TSFSMemoryChunkStream.Create(data, len, false);
+      dir[n] := dfzip.ZipOne(ts, name, ds);
+      ds.Free;
+      INC(n);
+    end;
+
+  begin
+    res := 1;
+    wad := ExpandFileName(wad);
+    list := SFSFileList(wad);
+    tmp := wad + '.tmp' + IntToStr(Random(100000));
+    ts := TFileStream.Create(tmp, fmCreate);
+    n := 0;
+    SetLength(dir, 0);
+    if list <> nil then
+    begin
+      for i := 0 to list.Count - 1 do
+      begin
+        if (list.Files[i].path <> section) or (list.Files[i].name <> section) then
+        begin
+          g_ReadResource(wad, list.Files[i].path, list.Files[i].name, data0, len0);
+          if list.Files[i].path = '' then
+            entry := list.Files[i].name
+          else
+            entry := list.Files[i].path + '/' + list.Files[i].name;
+          Add(entry, data0, len0);
+          FreeMem(data0)
+        end
+      end;
+      list.Destroy
+    end;
+
+    if section = '' then
+      entry := name
+    else
+      entry := section + '/' + name;
+
+    Add(entry, data, len);
+    dfzip.writeCentralDir(ts, dir);
+    ts.Free;
+
+    if FileExists(wad) then
+      ASSERT(RenameFile(wad, wad + '.bak'));
+    ASSERT(RenameFile(tmp, wad));
+    res := 0
+  end;
+
+  procedure g_AddResource (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
+    var ext: String;
+  begin
+    res := 2; (* unknown type *)
+    ext := LowerCase(SysUtils.ExtractFileExt(wad));
+    if ext = '.wad' then
+      g_AddResourceToDFWAD(wad, section, name, data, len, res)
+    else if (ext = '.pk3') or (ext = '.zip') or (ext = '.dfzip') then
+      g_AddResourceToZip(wad, section, name, data, len, res)
+  end;
+
+  procedure g_DeleteResourceFromDFWAD (wad, section, name: String; out res: Integer);
+    var f: TWADEditor_1;
+  begin
+    res := 1; (* error *)
+    f := TWADEditor_1.Create;
+    if not f.ReadFile(wad) then
+    begin
+      f.Free;
+      Exit
+    end;
+    f.CreateImage;
+    f.RemoveResource(section, name);
+    f.SaveTo(wad);
+    f.Free;
+    res := 0 (* ok *)
+  end;
+
+  procedure g_DeleteResourceFromZip (wad, section, name: String; out res: Integer);
+  begin
+    res := 1 (* not implemented *)
+  end;
+
+  procedure g_DeleteResource (wad, section, name: String; out res: Integer);
+    var ext: String;
+  begin
+    res := 2; (* unknown type *)
+    ext := LowerCase(SysUtils.ExtractFileExt(wad));
+    if ext = '.wad' then
+      g_DeleteResourceFromDFWAD(wad, section, name, res)
+    else if (ext = '.pk3') or (ext = '.zip') or (ext = '.dfzip') then
+      g_DeleteResourceFromZip(wad, section, name, res)
+  end;
 
   procedure g_ReadResource (wad, section, name: String; out data: PByte; out len: Integer);
     var

diff --git a/src/shared/dfzip.pas b/src/shared/dfzip.pas
new file mode 100644 (file)
index 0000000..ade97a5
--- /dev/null
+++ b/src/shared/dfzip.pas
@@ -0,0 +1,391 @@
+(* 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/>.
+ *)
+{$INCLUDE ../shared/a_modes.inc}
+unit dfzip;
+
+  (** Based on WadCvt tool **)
+
+interface
+
+  uses SysUtils, Classes;
+
+  type
+    TFileInfo = class
+    public
+      name: AnsiString;
+      pkofs: Int64; // offset of file header
+      size: Int64;
+      pksize: Int64;
+      crc: LongWord;
+      method: Word;
+
+      constructor Create ();
+    end;
+
+  function ZipOne (ds: TStream; fname: AnsiString; st: TStream; dopack: Boolean=true): TFileInfo;
+  procedure writeCentralDir (ds: TStream; files: array of TFileInfo);
+
+implementation
+
+  uses utils, xstreams, crc, paszlib, e_log;
+
+  const
+    uni2wint: array [128..255] of Word = (
+      $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
+      $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
+      $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
+      $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
+      $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
+      $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
+      $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
+      $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F
+    );
+
+constructor TFileInfo.Create;
+begin
+  name := '';
+  pkofs := 0;
+  size := 0;
+  pksize := 0;
+  crc := crc32(0, nil, 0);
+  method := 0;
+end;
+
+function toUtf8 (const s: AnsiString): AnsiString;
+var
+  uc: PUnicodeChar;
+  xdc: PChar;
+  pos, f: Integer;
+begin
+  GetMem(uc, length(s)*8);
+  GetMem(xdc, length(s)*8);
+  try
+    FillChar(uc^, length(s)*8, 0);
+    FillChar(xdc^, length(s)*8, 0);
+    pos := 0;
+    for f := 1 to length(s) do
+    begin
+      if ord(s[f]) < 128 then
+        uc[pos] := UnicodeChar(ord(s[f]))
+      else
+        uc[pos] := UnicodeChar(uni2wint[ord(s[f])]);
+      Inc(pos);
+    end;
+    FillChar(xdc^, length(s)*8, 0);
+    f := UnicodeToUtf8(xdc, length(s)*8, uc, pos);
+    while (f > 0) and (xdc[f-1] = #0) do Dec(f);
+    SetLength(result, f);
+    Move(xdc^, result[1], f);
+  finally
+    FreeMem(xdc);
+    FreeMem(uc);
+  end;
+end;
+
+// returs crc
+function zpack (ds: TStream; ss: TStream; var aborted: Boolean): LongWord;
+const
+  IBSize = 65536;
+  OBSize = 65536;
+var
+  zst: TZStream;
+  ib, ob: PByte;
+  err: Integer;
+  rd: Integer;
+  eof: Boolean;
+  crc: LongWord;
+  dstp, srcsize: Int64;
+begin
+  result := 0;
+  //aborted := true; exit;
+  aborted := false;
+  crc := crc32(0, nil, 0);
+  GetMem(ib, IBSize);
+  GetMem(ob, OBSize);
+  ss.position := 0;
+  dstp := ds.position;
+  srcsize := ss.size;
+  try
+    zst.next_out := ob;
+    zst.avail_out := OBSize;
+    zst.next_in := ib;
+    zst.avail_in := 0;
+    err := deflateInit2(zst, Z_BEST_COMPRESSION, Z_DEFLATED, -15, 9, 0);
+    if err <> Z_OK then raise Exception.Create(zerror(err));
+    try
+      eof := false;
+      repeat
+        if zst.avail_in = 0 then
+        begin
+          // read input buffer part
+          rd := ss.read(ib^, IBSize);
+          if rd < 0 then raise Exception.Create('reading error');
+          //writeln('  read ', rd, ' bytes');
+          eof := (rd = 0);
+          if rd <> 0 then begin crc := crc32(crc, Pointer(ib), rd); result := crc; end;
+          zst.next_in := ib;
+          zst.avail_in := rd;
+        end;
+        // now process the whole input
+        while zst.avail_in > 0 do
+        begin
+          err := deflate(zst, Z_NO_FLUSH);
+          if err <> Z_OK then raise Exception.Create(zerror(err));
+          if zst.avail_out < OBSize then
+          begin
+            //writeln('  written ', OBSize-zst.avail_out, ' bytes');
+            if ds.position+(OBSize-zst.avail_out)-dstp >= srcsize then
+            begin
+              // this will be overwritten anyway
+              aborted := true;
+              exit;
+            end;
+            ds.writeBuffer(ob^, OBSize-zst.avail_out);
+            zst.next_out := ob;
+            zst.avail_out := OBSize;
+          end;
+        end;
+      until eof;
+      // do leftovers
+      while true do
+      begin
+        zst.avail_in := 0;
+        err := deflate(zst, Z_FINISH);
+        if (err <> Z_OK) and (err <> Z_STREAM_END) then raise Exception.Create(zerror(err));
+        if zst.avail_out < OBSize then
+        begin
+          //writeln('  .written ', OBSize-zst.avail_out, ' bytes');
+          if ds.position+(OBSize-zst.avail_out)-dstp >= srcsize then
+          begin
+            // this will be overwritten anyway
+            aborted := true;
+            exit;
+          end;
+          ds.writeBuffer(ob^, OBSize-zst.avail_out);
+          zst.next_out := ob;
+          zst.avail_out := OBSize;
+        end;
+        if err <> Z_OK then break;
+      end;
+      // succesfully flushed?
+      if (err <> Z_STREAM_END) then raise Exception.Create(zerror(err));
+    finally
+      deflateEnd(zst);
+    end;
+  finally
+    FreeMem(ob);
+    FreeMem(ib);
+  end;
+end;
+
+// this will write "extra field length" and extra field itself
+{$IFDEF UTFEXTRA}
+const UtfFlags = 0;
+
+type
+  TByteArray = array of Byte;
+
+function buildUtfExtra (fname: AnsiString): TByteArray;
+var
+  crc: LongWord;
+  fu: AnsiString;
+  sz: Word;
+begin
+  fu := toUtf8(fname);
+  if fu = fname then begin result := nil; exit; end; // no need to write anything
+  crc := crc32(0, @fname[1], length(fname));
+  sz := 2+2+1+4+length(fu);
+  SetLength(result, sz);
+  result[0] := ord('u');
+  result[1] := ord('p');
+  Dec(sz, 4);
+  result[2] := sz and $ff;
+  result[3] := (sz shr 8) and $ff;
+  result[4] := 1;
+  result[5] := crc and $ff;
+  result[6] := (crc shr 8) and $ff;
+  result[7] := (crc shr 16) and $ff;
+  result[8] := (crc shr 24) and $ff;
+  Move(fu[1], result[9], length(fu));
+end;
+{$ELSE}
+const UtfFlags = (1 shl 10); // bit 11
+{$ENDIF}
+
+function ZipOne (ds: TStream; fname: AnsiString; st: TStream; dopack: Boolean=true): TFileInfo;
+var
+  oldofs, nfoofs, pkdpos, rd: Int64;
+  sign: packed array [0..3] of Char;
+  buf: PChar;
+  bufsz: Integer;
+  aborted: Boolean = false;
+{$IFDEF UTFEXTRA}
+  ef: TByteArray;
+{$ENDIF}
+begin
+  result := TFileInfo.Create();
+  result.pkofs := ds.position;
+  result.size := st.size;
+  if result.size > 0 then result.method := 8 else result.method := 0;
+  if not dopack then
+  begin
+    result.method := 0;
+    result.pksize := result.size;
+  end;
+{$IFDEF UTFEXTRA}
+  result.name := fname;
+  ef := buildUtfExtra(result.name);
+{$ELSE}
+  result.name := toUtf8(fname);
+{$ENDIF}
+  // write local header
+  sign := 'PK'#3#4;
+  ds.writeBuffer(sign, 4);
+  writeInt(ds, Word($0A10)); // version to extract
+  writeInt(ds, Word(UtfFlags)); // flags
+  writeInt(ds, Word(result.method)); // compression method
+  writeInt(ds, Word(0)); // file time
+  writeInt(ds, Word(0)); // file date
+  nfoofs := ds.position;
+  writeInt(ds, LongWord(result.crc)); // crc32
+  writeInt(ds, LongWord(result.pksize)); // packed size
+  writeInt(ds, LongWord(result.size)); // unpacked size
+  writeInt(ds, Word(length(fname))); // name length
+{$IFDEF UTFEXTRA}
+  writeInt(ds, Word(length(ef))); // extra field length
+{$ELSE}
+  writeInt(ds, Word(0)); // extra field length
+{$ENDIF}
+  ds.writeBuffer(fname[1], length(fname));
+{$IFDEF UTFEXTRA}
+  if length(ef) > 0 then ds.writeBuffer(ef[0], length(ef));
+{$ENDIF}
+  if dopack then
+  begin
+    // now write packed data
+    if result.size > 0 then
+    begin
+      pkdpos := ds.position;
+      st.position := 0;
+      result.crc := zpack(ds, st, aborted);
+      result.pksize := ds.position-pkdpos;
+      if {result.pksize >= result.size} aborted then
+      begin
+        // there's no sence to pack this file, so just store it
+        st.position := 0;
+        ds.position := result.pkofs;
+        result.Free();
+        // store it
+        result := ZipOne(ds, fname, st, false);
+        exit;
+      end
+      else
+      begin
+        // fix header
+        oldofs := ds.position;
+        ds.position := nfoofs;
+        writeInt(ds, LongWord(result.crc)); // crc32
+        writeInt(ds, LongWord(result.pksize)); // crc32
+        ds.position := oldofs;
+      end;
+    end;
+  end
+  else
+  begin
+    bufsz := 1024*1024;
+    GetMem(buf, bufsz);
+    try
+      st.position := 0;
+      result.crc := crc32(0, nil, 0);
+      result.pksize := 0;
+      while result.pksize < result.size do
+      begin
+        rd := result.size-result.pksize;
+        if rd > bufsz then rd := bufsz;
+        st.readBuffer(buf^, rd);
+        ds.writeBuffer(buf^, rd);
+        Inc(result.pksize, rd);
+        result.crc := crc32(result.crc, buf, rd);
+      end;
+    finally
+      FreeMem(buf);
+    end;
+    // fix header
+    oldofs := ds.position;
+    ds.position := nfoofs;
+    writeInt(ds, LongWord(result.crc)); // crc32
+    ds.position := oldofs;
+    write('(S) ');
+  end;
+end;
+
+
+procedure writeCentralDir (ds: TStream; files: array of TFileInfo);
+var
+  cdofs, cdend: Int64;
+  sign: packed array [0..3] of Char;
+  f: Integer;
+{$IFDEF UTFEXTRA}
+  ef: TByteArray;
+{$ENDIF}
+begin
+  cdofs := ds.position;
+  for f := 0 to high(files) do
+  begin
+{$IFDEF UTFEXTRA}
+    ef := buildUtfExtra(files[f].name);
+{$ENDIF}
+    sign := 'PK'#1#2;
+    ds.writeBuffer(sign, 4);
+    writeInt(ds, Word($0A10)); // version made by
+    writeInt(ds, Word($0010)); // version to extract
+    writeInt(ds, Word(UtfFlags)); // flags
+    writeInt(ds, Word(files[f].method)); // compression method
+    writeInt(ds, Word(0)); // file time
+    writeInt(ds, Word(0)); // file date
+    writeInt(ds, LongWord(files[f].crc));
+    writeInt(ds, LongWord(files[f].pksize));
+    writeInt(ds, LongWord(files[f].size));
+    writeInt(ds, Word(length(files[f].name))); // name length
+{$IFDEF UTFEXTRA}
+    writeInt(ds, Word(length(ef))); // extra field length
+{$ELSE}
+    writeInt(ds, Word(0)); // extra field length
+{$ENDIF}
+    writeInt(ds, Word(0)); // comment length
+    writeInt(ds, Word(0)); // disk start
+    writeInt(ds, Word(0)); // internal attributes
+    writeInt(ds, LongWord(0)); // external attributes
+    writeInt(ds, LongWord(files[f].pkofs)); // header offset
+    ds.writeBuffer(files[f].name[1], length(files[f].name));
+{$IFDEF UTFEXTRA}
+    if length(ef) > 0 then ds.writeBuffer(ef[0], length(ef));
+{$ENDIF}
+  end;
+  cdend := ds.position;
+  // write end of central dir
+  sign := 'PK'#5#6;
+  ds.writeBuffer(sign, 4);
+  writeInt(ds, Word(0)); // disk number
+  writeInt(ds, Word(0)); // disk with central dir
+  writeInt(ds, Word(length(files))); // number of files on this dist
+  writeInt(ds, Word(length(files))); // number of files total
+  writeInt(ds, LongWord(cdend-cdofs)); // size of central directory
+  writeInt(ds, LongWord(cdofs)); // central directory offset
+  writeInt(ds, Word(0)); // archive comment length
+end;
+
+end.