src/editor/g_resources.pas

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