src/editor/g_resources.pas

   1 unit g_resources;
   2
   3 interface
   4
   5   (**
   6     g_ReadResource
   7       Read whole file from wad
   8       (data <> nil) and (len > 0) when ok
   9       use FreeMem(data) when done
  10
  11     g_ReadSubResource
  12       Read whole file from folded wad
  13       (data <> nil) and (len > 0) when ok
  14       use FreeMem(data) when done
  15
  16     g_DeleteResource
  17       Delete file from wad
  18       res = 0 when ok
  19
  20     g_AddResource
  21       Add/overwrite file to wad
  22       res = 0 when ok
  23
  24     g_ExistsResource
  25       Check that resource exists
  26       res = 0 when ok
  27   **)
  28
  29   procedure g_ReadResource (wad, section, name: String; out data: PByte; out len: Integer);
  30   procedure g_ReadSubResource (wad, section0, name0, section1, name1: String; out data: PByte; out len: Integer);
  31   procedure g_DeleteResource (wad, section, name: String; out res: Integer);
  32   procedure g_AddResource (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
  33   procedure g_ExistsResource (wad, section, name: String; out res: Integer);
  34
  35 implementation
  36
  37   uses sfs, xstreams, dfzip, utils, Classes, SysUtils, WADEDITOR;
  38
  39   procedure g_AddResourceToDFWAD (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
  40     var f: TWADEditor_1;
  41   begin
  42     res := 1; (* error *)
  43     wad := utf2win(wad);
  44     section := utf2win(section);
  45     name := utf2win(name);
  46     f := TWADEditor_1.Create();
  47     if not f.ReadFile(wad) then
  48     begin
  49       (* do nothing *)
  50     end;
  51     f.CreateImage;
  52     f.RemoveResource(section, name);
  53     f.AddResource(data, len, name, section);
  54     if FileExists(wad) then
  55       ASSERT(RenameFile(wad, wad + '.bak'));
  56     f.SaveTo(wad);
  57     f.Free;
  58     res := 0
  59   end;
  60
  61   procedure g_AddResourceToZip (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
  62     var
  63       i, n, len0: Integer;
  64       data0: PByte;
  65       list: TSFSFileList;
  66       tmp, entry: String;
  67       ts: TFileStream;
  68       dir: array of TFileInfo;
  69
  70     procedure Add (name: String; data: PByte; len: Integer);
  71       var ds: TSFSMemoryChunkStream;
  72     begin
  73       SetLength(dir, n + 1);
  74       ds := TSFSMemoryChunkStream.Create(data, len, false);
  75       dir[n] := dfzip.ZipOne(ts, name, ds);
  76       ds.Free;
  77       INC(n);
  78     end;
  79
  80   begin
  81     res := 1;
  82     wad := ExpandFileName(wad);
  83     section := utf2win(section);
  84     name := utf2win(name);
  85     list := SFSFileList(wad);
  86     tmp := wad + '.tmp' + IntToStr(Random(100000));
  87     ts := TFileStream.Create(tmp, fmCreate);
  88     n := 0;
  89     SetLength(dir, 0);
  90     if list <> nil then
  91     begin
  92       for i := 0 to list.Count - 1 do
  93       begin
  94         if (list.Files[i].path <> section) or (list.Files[i].name <> section) then
  95         begin
  96           g_ReadResource(wad, list.Files[i].path, list.Files[i].name, data0, len0);
  97           if list.Files[i].path = '' then
  98             entry := list.Files[i].name
  99           else
 100             entry := list.Files[i].path + '/' + list.Files[i].name;
 101           Add(entry, data0, len0);
 102           FreeMem(data0)
 103         end
 104       end;
 105       list.Destroy
 106     end;
 107
 108     if section = '' then
 109       entry := name
 110     else
 111       entry := section + '/' + name;
 112
 113     Add(entry, data, len);
 114     dfzip.writeCentralDir(ts, dir);
 115     ts.Free;
 116
 117     if FileExists(wad) then
 118       ASSERT(RenameFile(wad, wad + '.bak'));
 119     ASSERT(RenameFile(tmp, wad));
 120     res := 0
 121   end;
 122
 123   procedure g_AddResource (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
 124     var ext: String;
 125   begin
 126     res := 2; (* unknown type *)
 127     ext := LowerCase(SysUtils.ExtractFileExt(wad));
 128     if ext = '.wad' then
 129       g_AddResourceToDFWAD(wad, section, name, data, len, res)
 130     else if (ext = '.pk3') or (ext = '.zip') or (ext = '.dfzip') then
 131       g_AddResourceToZip(wad, section, name, data, len, res)
 132   end;
 133
 134   procedure g_DeleteResourceFromDFWAD (wad, section, name: String; out res: Integer);
 135     var f: TWADEditor_1;
 136   begin
 137     res := 1; (* error *)
 138     section := utf2win(section);
 139     name := utf2win(name);
 140     f := TWADEditor_1.Create;
 141     if not f.ReadFile(wad) then
 142     begin
 143       f.Free;
 144       Exit
 145     end;
 146     f.CreateImage;
 147     f.RemoveResource(section, name);
 148     f.SaveTo(wad);
 149     f.Free;
 150     res := 0 (* ok *)
 151   end;
 152
 153   procedure g_DeleteResourceFromZip (wad, section, name: String; out res: Integer);
 154     var
 155       data0: PByte;
 156       i, n, len0: Integer;
 157       list: TSFSFileList;
 158       tmp, entry: String;
 159       ts: TFileStream;
 160       dir: array of TFileInfo;
 161
 162     procedure Add (name: String; data: PByte; len: Integer);
 163       var ds: TSFSMemoryChunkStream;
 164     begin
 165       SetLength(dir, n + 1);
 166       ds := TSFSMemoryChunkStream.Create(data, len, false);
 167       dir[n] := dfzip.ZipOne(ts, name, ds);
 168       ds.Free;
 169       INC(n);
 170     end;
 171
 172   begin
 173     res := 1;
 174     wad := ExpandFileName(wad);
 175     section := utf2win(section);
 176     name := utf2win(name);
 177     list := SFSFileList(wad);
 178     tmp := wad + '.tmp' + IntToStr(Random(100000));
 179     ts := TFileStream.Create(tmp, fmCreate);
 180     n := 0;
 181     SetLength(dir, 0);
 182     if list <> nil then
 183     begin
 184       for i := 0 to list.Count - 1 do
 185       begin
 186         if (list.Files[i].path <> section) or (list.Files[i].name <> section) then
 187         begin
 188           g_ReadResource(wad, list.Files[i].path, list.Files[i].name, data0, len0);
 189           if list.Files[i].path = '' then
 190             entry := list.Files[i].name
 191           else
 192             entry := list.Files[i].path + '/' + list.Files[i].name;
 193           Add(entry, data0, len0);
 194           FreeMem(data0)
 195         end
 196       end;
 197       list.Destroy
 198     end;
 199
 200     dfzip.writeCentralDir(ts, dir);
 201     ts.Free;
 202
 203     if FileExists(wad) then
 204       ASSERT(RenameFile(wad, wad + '.bak'));
 205     ASSERT(RenameFile(tmp, wad));
 206     res := 0
 207   end;
 208
 209   procedure g_DeleteResource (wad, section, name: String; out res: Integer);
 210     var ext: String;
 211   begin
 212     res := 2; (* unknown type *)
 213     ext := LowerCase(SysUtils.ExtractFileExt(wad));
 214     if ext = '.wad' then
 215       g_DeleteResourceFromDFWAD(wad, section, name, res)
 216     else if (ext = '.pk3') or (ext = '.zip') or (ext = '.dfzip') then
 217       g_DeleteResourceFromZip(wad, section, name, res)
 218   end;
 219
 220   procedure g_ExistsResource (wad, section, name: String; out res: Integer);
 221     var str: String; stream: TStream;
 222   begin
 223     res := 1;
 224     section := utf2win(section);
 225     name := utf2win(name);
 226     if SFSAddDataFileTemp(wad, TRUE) then
 227     begin
 228       str := SFSGetLastVirtualName(section + '\' + name);
 229       stream := SFSFileOpen(wad + '::' + str);
 230       if stream <> nil then
 231       begin
 232         res := 0;
 233         stream.Destroy
 234       end
 235     end;
 236     SFSGCCollect
 237   end;
 238
 239   procedure g_ReadResource (wad, section, name: String; out data: PByte; out len: Integer);
 240     var stream: TStream; str: String; i: Integer;
 241   begin
 242     section := utf2win(section);
 243     name := utf2win(name);
 244     data := nil;
 245     len := 0;
 246     if SFSAddDataFileTemp(wad, TRUE) then
 247     begin
 248       str := SFSGetLastVirtualName(section + '\' + name);
 249       stream := SFSFileOpen(wad + '::' + str);
 250       if stream <> nil then
 251       begin
 252         len := stream.Size;
 253         GetMem(data, len);
 254         //stream.ReadBuffer(data, len); (* leads to segfault *)
 255         for i := 0 to len - 1 do
 256           data[i] := stream.ReadByte();
 257         stream.Destroy
 258       end
 259     end;
 260     SFSGCCollect
 261   end;
 262
 263   procedure g_ReadSubResource (wad, section0, name0, section1, name1: String; out data: PByte; out len: Integer);
 264     var stream0, stream1: TStream; str0, str1: String; i: Integer;
 265   begin
 266     data := nil;
 267     len := 0;
 268     if (wad = '') OR (section0 = '') OR (name0 = '') OR (section1 = '') OR (name1 = '') then Exit;
 269     section0 := utf2win(section0);
 270     name0 := utf2win(name0);
 271     section1 := utf2win(section1);
 272     name1 := utf2win(name1);
 273     if SFSAddDataFileTemp(wad, TRUE) then
 274     begin
 275       str0 := SFSGetLastVirtualName(section0 + '\' + name0);
 276       stream0 := SFSFileOpen(wad + '::' + str0);
 277       if stream0 <> nil then
 278       begin
 279         if SFSAddSubDataFile(wad + '\' + str0, stream0, TRUE) then
 280         begin
 281           str1 := SFSGetLastVirtualName(section1 + '\' + name1);
 282           stream1 := SFSFileOpen(wad + '\' + str0 + '::' + str1);
 283           if stream1 <> nil then
 284           begin
 285             len := stream1.Size;
 286             GetMem(data, len);
 287             //stream1.ReadBuffer(data, len); (* leads to segfault *)
 288             for i := 0 to len - 1 do
 289               data[i] := stream1.ReadByte();
 290             stream1.Destroy
 291           end
 292         end
 293       end
 294       else
 295       begin
 296         stream0.Destroy
 297       end
 298     end;
 299     SFSGCCollect
 300   end;
 301
 302 end.