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_GetResourceSection (path: String; out wad, section, name: String);
  30
  31   procedure g_ReadResource (wad, section, name: String; out data: PByte; out len: Integer);
  32   procedure g_ReadSubResource (wad, section0, name0, section1, name1: String; out data: PByte; out len: Integer);
  33   procedure g_DeleteResource (wad, section, name: String; out res: Integer);
  34   procedure g_AddResource (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
  35   procedure g_ExistsResource (wad, section, name: String; out res: Integer);
  36
  37 implementation
  38
  39   uses sfs, xstreams, dfzip, utils, Classes, SysUtils, WADEDITOR, e_log;
  40
  41   function NoTrailing (path: String): String;
  42     var i: Integer;
  43   begin
  44     i := Length(path);
  45     while (i > 0) and ((path[i] = '/') or (path[i] = '\')) do dec(i);
  46     result := Copy(path, 1, i)
  47   end;
  48
  49   function g_CleanPath (path: String; sys: Boolean = False): String;
  50     var i, len: Integer;
  51   begin
  52     i := 1;
  53     result := '';
  54     len := Length(path);
  55     (* drop separators at the end *)
  56     while (len > 1) and ((path[i] = '/') or (path[i] = '\')) do dec(len);
  57     while i <= len do
  58     begin
  59       while (i <= len) and (path[i] <> '/') and (path[i] <> '\') do
  60       begin
  61         result := result + path[i];
  62         inc(i)
  63       end;
  64       if i <= len then
  65         if sys then
  66           result := result + DirectorySeparator
  67         else
  68           result := result + '/';
  69       inc(i);
  70       while (i <= len) and ((path[i] = '/') or (path[i] = '\')) do inc(i)
  71     end;
  72   end;
  73
  74   procedure g_GetResourceSection (path: String; out wad, section, name: String);
  75     var i, j, len: Integer;
  76   begin
  77     len := Length(path);
  78     i := len;
  79     while (i > 0) and (path[i] <> '/') and (path[i] <> '\') do dec(i);
  80     name := Copy(path, i + 1, len);
  81     j := i;
  82     while (i > 0) and (path[i] <> ':') do dec(i);
  83     section := Copy(path, i + 1, j - i - 1);
  84     wad := Copy(path, 1, i - 1);
  85   end;
  86
  87   procedure g_AddResourceToDFWAD (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
  88     var f: TWADEditor_1;
  89   begin
  90     res := 1; (* error *)
  91     wad := utf2win(wad);
  92     section := utf2win(NoTrailing(section));
  93     name := utf2win(name);
  94     ASSERT(name <> '');
  95     f := TWADEditor_1.Create();
  96     if not f.ReadFile(wad) then
  97     begin
  98       (* do nothing *)
  99     end;
 100     f.CreateImage;
 101     f.RemoveResource(section, name);
 102     f.AddResource(data, len, name, section);
 103     if FileExists(wad) then
 104     begin
 105       if FileExists(wad + '.bak') then
 106         ASSERT(DeleteFile(wad + '.bak'));
 107       ASSERT(RenameFile(wad, wad + '.bak'))
 108     end;
 109     f.SaveTo(wad);
 110     f.Free;
 111     res := 0
 112   end;
 113
 114   procedure g_AddResourceToZip (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
 115     var
 116       i, n, len0: Integer;
 117       data0: PByte;
 118       list: TSFSFileList;
 119       tmp, path: String;
 120       ts: TFileStream;
 121       dir: array of TFileInfo;
 122
 123     procedure Add (name: String; data: PByte; len: Integer);
 124       var ds: TSFSMemoryChunkStream;
 125     begin
 126       SetLength(dir, n + 1);
 127       ds := TSFSMemoryChunkStream.Create(data, len, false);
 128       dir[n] := dfzip.ZipOne(ts, name, ds);
 129       ds.Free;
 130       INC(n);
 131     end;
 132
 133   begin
 134     res := 1;
 135     wad := ExpandFileName(wad);
 136     section := utf2win(NoTrailing(section));
 137     name := utf2win(name);
 138     ASSERT(name <> '');
 139     list := SFSFileList(wad);
 140     tmp := wad + '.tmp' + IntToStr(Random(100000));
 141     ts := TFileStream.Create(tmp, fmCreate);
 142     n := 0;
 143     SetLength(dir, 0);
 144     if list <> nil then
 145     begin
 146       for i := 0 to list.Count - 1 do
 147       begin
 148         path := NoTrailing(list.Files[i].path);
 149         if (path <> section) or (list.Files[i].name <> section) then
 150         begin
 151           g_ReadResource(wad, path, list.Files[i].name, data0, len0);
 152           ASSERT(data0 <> nil);
 153           if path = '' then
 154             path := list.Files[i].name
 155           else
 156             path := path + '/' + list.Files[i].name;
 157           Add(path, data0, len0);
 158           FreeMem(data0)
 159         end
 160       end;
 161       list.Destroy
 162     end;
 163
 164     if section = '' then
 165       path := name
 166     else
 167       path := section + '/' + name;
 168     Add(path, data, len);
 169
 170     dfzip.writeCentralDir(ts, dir);
 171     ts.Free;
 172
 173     if FileExists(wad) then
 174     begin
 175       if FileExists(wad + '.bak') then
 176         ASSERT(DeleteFile(wad + '.bak'));
 177       ASSERT(RenameFile(wad, wad + '.bak'))
 178     end;
 179     ASSERT(RenameFile(tmp, wad));
 180     res := 0
 181   end;
 182
 183   procedure g_AddResource (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
 184     var ext: String;
 185   begin
 186     ASSERT(name <> '');
 187     res := 2; (* unknown type *)
 188     ext := LowerCase(SysUtils.ExtractFileExt(wad));
 189     e_WriteLog('g_AddResource "' + wad + '" "' + section + '" "' + name + '"', MSG_NOTIFY);
 190     if ext = '.wad' then
 191       g_AddResourceToDFWAD(wad, section, name, data, len, res)
 192     else if (ext = '.pk3') or (ext = '.zip') or (ext = '.dfzip') then
 193       g_AddResourceToZip(wad, section, name, data, len, res)
 194   end;
 195
 196   procedure g_DeleteResourceFromDFWAD (wad, section, name: String; out res: Integer);
 197     var f: TWADEditor_1;
 198   begin
 199     ASSERT(name <> '');
 200     res := 1; (* error *)
 201     section := utf2win(NoTrailing(section));
 202     name := utf2win(name);
 203     f := TWADEditor_1.Create;
 204     if not f.ReadFile(wad) then
 205     begin
 206       f.Free;
 207       Exit
 208     end;
 209     f.CreateImage;
 210     f.RemoveResource(section, name);
 211     f.SaveTo(wad);
 212     f.Free;
 213     res := 0 (* ok *)
 214   end;
 215
 216   procedure g_DeleteResourceFromZip (wad, section, name: String; out res: Integer);
 217     var
 218       data0: PByte;
 219       i, n, len0: Integer;
 220       list: TSFSFileList;
 221       tmp, path: String;
 222       ts: TFileStream;
 223       dir: array of TFileInfo;
 224
 225     procedure Add (name: String; data: PByte; len: Integer);
 226       var ds: TSFSMemoryChunkStream;
 227     begin
 228       SetLength(dir, n + 1);
 229       ds := TSFSMemoryChunkStream.Create(data, len, false);
 230       dir[n] := dfzip.ZipOne(ts, name, ds);
 231       ds.Free;
 232       INC(n);
 233     end;
 234
 235   begin
 236     res := 1;
 237     wad := ExpandFileName(wad);
 238     section := utf2win(NoTrailing(section));
 239     name := utf2win(name);
 240     ASSERT(name <> '');
 241     list := SFSFileList(wad);
 242     tmp := wad + '.tmp' + IntToStr(Random(100000));
 243     ts := TFileStream.Create(tmp, fmCreate);
 244     n := 0;
 245     SetLength(dir, 0);
 246     if list <> nil then
 247     begin
 248       for i := 0 to list.Count - 1 do
 249       begin
 250         path := NoTrailing(list.Files[i].path);
 251         if (path <> section) or (list.Files[i].name <> section) then
 252         begin
 253           g_ReadResource(wad, path, list.Files[i].name, data0, len0);
 254           ASSERT(data0 <> nil);
 255           if path = '' then
 256             path := list.Files[i].name
 257           else
 258             path := path + '/' + list.Files[i].name;
 259           Add(path, data0, len0);
 260           FreeMem(data0)
 261         end
 262       end;
 263       list.Destroy
 264     end;
 265
 266     dfzip.writeCentralDir(ts, dir);
 267     ts.Free;
 268
 269     if FileExists(wad) then
 270     begin
 271       if FileExists(wad + '.bak') then
 272         ASSERT(DeleteFile(wad + '.bak'));
 273       ASSERT(RenameFile(wad, wad + '.bak'))
 274     end;
 275     ASSERT(RenameFile(tmp, wad));
 276     res := 0
 277   end;
 278
 279   procedure g_DeleteResource (wad, section, name: String; out res: Integer);
 280     var ext: String;
 281   begin
 282     ASSERT(name <> '');
 283     res := 2; (* unknown type *)
 284     ext := LowerCase(SysUtils.ExtractFileExt(wad));
 285     if ext = '.wad' then
 286       g_DeleteResourceFromDFWAD(wad, section, name, res)
 287     else if (ext = '.dfz') or (ext = '.pk3') or (ext = '.zip') or (ext = '.dfzip') then
 288       g_DeleteResourceFromZip(wad, section, name, res)
 289   end;
 290
 291   procedure g_ExistsResource (wad, section, name: String; out res: Integer);
 292     var str: String; stream: TStream;
 293   begin
 294     res := 1;
 295     section := utf2win(NoTrailing(section));
 296     name := utf2win(name);
 297     ASSERT(name <> '');
 298     if SFSAddDataFileTemp(wad, TRUE) then
 299     begin
 300       str := SFSGetLastVirtualName(section + '\' + name);
 301       stream := SFSFileOpen(wad + '::' + str);
 302       if stream <> nil then
 303       begin
 304         res := 0;
 305         stream.Destroy
 306       end
 307     end;
 308     SFSGCCollect
 309   end;
 310
 311   procedure g_ReadResource (wad, section, name: String; out data: PByte; out len: Integer);
 312     var stream: TStream; str: String; i: Integer;
 313   begin
 314     e_WriteLog('g_ReadResource: "' + wad + '" "' + section + '" "' + name + '"', MSG_NOTIFY);
 315     section := utf2win(NoTrailing(section));
 316     name := utf2win(name);
 317     data := nil;
 318     len := 0;
 319     //ASSERT(name <> '');
 320     if name = '' then Exit; (* SKY can be void *)
 321     if SFSAddDataFileTemp(wad, TRUE) then
 322     begin
 323       str := SFSGetLastVirtualName(section + '/' + name);
 324       stream := SFSFileOpen(wad + '::' + str);
 325       if stream <> nil then
 326       begin
 327         len := stream.Size;
 328         GetMem(data, len);
 329         ASSERT(data <> nil);
 330         //stream.ReadBuffer(data, len); (* leads to segfault *)
 331         for i := 0 to len - 1 do
 332           data[i] := stream.ReadByte();
 333         stream.Destroy
 334       end
 335     end;
 336     SFSGCCollect
 337   end;
 338
 339   procedure g_ReadSubResource (wad, section0, name0, section1, name1: String; out data: PByte; out len: Integer);
 340     var stream0, stream1: TStream; str0, str1: String; i: Integer;
 341   begin
 342     data := nil;
 343     len := 0;
 344     section0 := utf2win(NoTrailing(section0));
 345     name0 := utf2win(name0);
 346     section1 := utf2win(NoTrailing(section1));
 347     name1 := utf2win(name1);
 348     //ASSERT(name0 <> '');
 349     //ASSERT(name1 <> '');
 350     if (wad = '') OR (name0 = '') OR (name1 = '') then Exit; (* ??? *)
 351     if SFSAddDataFileTemp(wad, TRUE) then
 352     begin
 353       str0 := SFSGetLastVirtualName(section0 + '\' + name0);
 354       stream0 := SFSFileOpen(wad + '::' + str0);
 355       if stream0 <> nil then
 356       begin
 357         if SFSAddSubDataFile(wad + '\' + str0, stream0, TRUE) then
 358         begin
 359           str1 := SFSGetLastVirtualName(section1 + '\' + name1);
 360           stream1 := SFSFileOpen(wad + '\' + str0 + '::' + str1);
 361           if stream1 <> nil then
 362           begin
 363             len := stream1.Size;
 364             GetMem(data, len);
 365             ASSERT(data <> nil);
 366             //stream1.ReadBuffer(data, len); (* leads to segfault *)
 367             for i := 0 to len - 1 do
 368               data[i] := stream1.ReadByte();
 369             stream1.Destroy
 370           end
 371         end
 372       end
 373       else
 374       begin
 375         stream0.Destroy
 376       end
 377     end;
 378     SFSGCCollect
 379   end;
 380
 381 end.