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     begin
  56       if FileExists(wad + '.bak') then
  57         ASSERT(DeleteFile(wad + '.bak'));
  58       ASSERT(RenameFile(wad, wad + '.bak'))
  59     end;
  60     f.SaveTo(wad);
  61     f.Free;
  62     res := 0
  63   end;
  64
  65   procedure g_AddResourceToZip (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
  66     var
  67       i, n, len0: Integer;
  68       data0: PByte;
  69       list: TSFSFileList;
  70       tmp, entry: String;
  71       ts: TFileStream;
  72       dir: array of TFileInfo;
  73
  74     procedure Add (name: String; data: PByte; len: Integer);
  75       var ds: TSFSMemoryChunkStream;
  76     begin
  77       SetLength(dir, n + 1);
  78       ds := TSFSMemoryChunkStream.Create(data, len, false);
  79       dir[n] := dfzip.ZipOne(ts, name, ds);
  80       ds.Free;
  81       INC(n);
  82     end;
  83
  84   begin
  85     res := 1;
  86     wad := ExpandFileName(wad);
  87     section := utf2win(section);
  88     name := utf2win(name);
  89     list := SFSFileList(wad);
  90     tmp := wad + '.tmp' + IntToStr(Random(100000));
  91     ts := TFileStream.Create(tmp, fmCreate);
  92     n := 0;
  93     SetLength(dir, 0);
  94     if list <> nil then
  95     begin
  96       for i := 0 to list.Count - 1 do
  97       begin
  98         if (list.Files[i].path <> section) or (list.Files[i].name <> section) then
  99         begin
 100           g_ReadResource(wad, list.Files[i].path, list.Files[i].name, data0, len0);
 101           if list.Files[i].path = '' then
 102             entry := list.Files[i].name
 103           else
 104             entry := list.Files[i].path + '/' + list.Files[i].name;
 105           Add(entry, data0, len0);
 106           FreeMem(data0)
 107         end
 108       end;
 109       list.Destroy
 110     end;
 111
 112     if section = '' then
 113       entry := name
 114     else
 115       entry := section + '/' + name;
 116
 117     Add(entry, data, len);
 118     dfzip.writeCentralDir(ts, dir);
 119     ts.Free;
 120
 121     if FileExists(wad) then
 122     begin
 123       if FileExists(wad + '.bak') then
 124         ASSERT(DeleteFile(wad + '.bak'));
 125       ASSERT(RenameFile(wad, wad + '.bak'))
 126     end;
 127     ASSERT(RenameFile(tmp, wad));
 128     res := 0
 129   end;
 130
 131   procedure g_AddResource (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
 132     var ext: String;
 133   begin
 134     res := 2; (* unknown type *)
 135     ext := LowerCase(SysUtils.ExtractFileExt(wad));
 136     if ext = '.wad' then
 137       g_AddResourceToDFWAD(wad, section, name, data, len, res)
 138     else if (ext = '.pk3') or (ext = '.zip') or (ext = '.dfzip') then
 139       g_AddResourceToZip(wad, section, name, data, len, res)
 140   end;
 141
 142   procedure g_DeleteResourceFromDFWAD (wad, section, name: String; out res: Integer);
 143     var f: TWADEditor_1;
 144   begin
 145     res := 1; (* error *)
 146     section := utf2win(section);
 147     name := utf2win(name);
 148     f := TWADEditor_1.Create;
 149     if not f.ReadFile(wad) then
 150     begin
 151       f.Free;
 152       Exit
 153     end;
 154     f.CreateImage;
 155     f.RemoveResource(section, name);
 156     f.SaveTo(wad);
 157     f.Free;
 158     res := 0 (* ok *)
 159   end;
 160
 161   procedure g_DeleteResourceFromZip (wad, section, name: String; out res: Integer);
 162     var
 163       data0: PByte;
 164       i, n, len0: Integer;
 165       list: TSFSFileList;
 166       tmp, entry: String;
 167       ts: TFileStream;
 168       dir: array of TFileInfo;
 169
 170     procedure Add (name: String; data: PByte; len: Integer);
 171       var ds: TSFSMemoryChunkStream;
 172     begin
 173       SetLength(dir, n + 1);
 174       ds := TSFSMemoryChunkStream.Create(data, len, false);
 175       dir[n] := dfzip.ZipOne(ts, name, ds);
 176       ds.Free;
 177       INC(n);
 178     end;
 179
 180   begin
 181     res := 1;
 182     wad := ExpandFileName(wad);
 183     section := utf2win(section);
 184     name := utf2win(name);
 185     list := SFSFileList(wad);
 186     tmp := wad + '.tmp' + IntToStr(Random(100000));
 187     ts := TFileStream.Create(tmp, fmCreate);
 188     n := 0;
 189     SetLength(dir, 0);
 190     if list <> nil then
 191     begin
 192       for i := 0 to list.Count - 1 do
 193       begin
 194         if (list.Files[i].path <> section) or (list.Files[i].name <> section) then
 195         begin
 196           g_ReadResource(wad, list.Files[i].path, list.Files[i].name, data0, len0);
 197           if list.Files[i].path = '' then
 198             entry := list.Files[i].name
 199           else
 200             entry := list.Files[i].path + '/' + list.Files[i].name;
 201           Add(entry, data0, len0);
 202           FreeMem(data0)
 203         end
 204       end;
 205       list.Destroy
 206     end;
 207
 208     dfzip.writeCentralDir(ts, dir);
 209     ts.Free;
 210
 211     if FileExists(wad) then
 212     begin
 213       if FileExists(wad + '.bak') then
 214         ASSERT(DeleteFile(wad + '.bak'));
 215       ASSERT(RenameFile(wad, wad + '.bak'))
 216     end;
 217     ASSERT(RenameFile(tmp, wad));
 218     res := 0
 219   end;
 220
 221   procedure g_DeleteResource (wad, section, name: String; out res: Integer);
 222     var ext: String;
 223   begin
 224     res := 2; (* unknown type *)
 225     ext := LowerCase(SysUtils.ExtractFileExt(wad));
 226     if ext = '.wad' then
 227       g_DeleteResourceFromDFWAD(wad, section, name, res)
 228     else if (ext = '.pk3') or (ext = '.zip') or (ext = '.dfzip') then
 229       g_DeleteResourceFromZip(wad, section, name, res)
 230   end;
 231
 232   procedure g_ExistsResource (wad, section, name: String; out res: Integer);
 233     var str: String; stream: TStream;
 234   begin
 235     res := 1;
 236     section := utf2win(section);
 237     name := utf2win(name);
 238     if SFSAddDataFileTemp(wad, TRUE) then
 239     begin
 240       str := SFSGetLastVirtualName(section + '\' + name);
 241       stream := SFSFileOpen(wad + '::' + str);
 242       if stream <> nil then
 243       begin
 244         res := 0;
 245         stream.Destroy
 246       end
 247     end;
 248     SFSGCCollect
 249   end;
 250
 251   procedure g_ReadResource (wad, section, name: String; out data: PByte; out len: Integer);
 252     var stream: TStream; str: String; i: Integer;
 253   begin
 254     section := utf2win(section);
 255     name := utf2win(name);
 256     data := nil;
 257     len := 0;
 258     if SFSAddDataFileTemp(wad, TRUE) then
 259     begin
 260       str := SFSGetLastVirtualName(section + '\' + name);
 261       stream := SFSFileOpen(wad + '::' + str);
 262       if stream <> nil then
 263       begin
 264         len := stream.Size;
 265         GetMem(data, len);
 266         ASSERT(data <> nil);
 267         //stream.ReadBuffer(data, len); (* leads to segfault *)
 268         for i := 0 to len - 1 do
 269           data[i] := stream.ReadByte();
 270         stream.Destroy
 271       end
 272     end;
 273     SFSGCCollect
 274   end;
 275
 276   procedure g_ReadSubResource (wad, section0, name0, section1, name1: String; out data: PByte; out len: Integer);
 277     var stream0, stream1: TStream; str0, str1: String; i: Integer;
 278   begin
 279     data := nil;
 280     len := 0;
 281     if (wad = '') OR (section0 = '') OR (name0 = '') OR (section1 = '') OR (name1 = '') then Exit;
 282     section0 := utf2win(section0);
 283     name0 := utf2win(name0);
 284     section1 := utf2win(section1);
 285     name1 := utf2win(name1);
 286     if SFSAddDataFileTemp(wad, TRUE) then
 287     begin
 288       str0 := SFSGetLastVirtualName(section0 + '\' + name0);
 289       stream0 := SFSFileOpen(wad + '::' + str0);
 290       if stream0 <> nil then
 291       begin
 292         if SFSAddSubDataFile(wad + '\' + str0, stream0, TRUE) then
 293         begin
 294           str1 := SFSGetLastVirtualName(section1 + '\' + name1);
 295           stream1 := SFSFileOpen(wad + '\' + str0 + '::' + str1);
 296           if stream1 <> nil then
 297           begin
 298             len := stream1.Size;
 299             GetMem(data, len);
 300             ASSERT(data <> nil);
 301             //stream1.ReadBuffer(data, len); (* leads to segfault *)
 302             for i := 0 to len - 1 do
 303               data[i] := stream1.ReadByte();
 304             stream1.Destroy
 305           end
 306         end
 307       end
 308       else
 309       begin
 310         stream0.Destroy
 311       end
 312     end;
 313     SFSGCCollect
 314   end;
 315
 316 end.