src/shared/WADEDITOR_dfwad.pas

   1 {$INCLUDE ../shared/a_modes.inc}
   2
   3 unit WADEDITOR_dfwad;
   4
   5 interface
   6
   7   uses Classes, WADEDITOR;
   8
   9   type
  10     TData = class
  11       ref: Integer;          // number of links
  12       pos: Int64;            // position in source (if pos < 0 -> not in source file)
  13       csize: Int64;          // compressed size
  14       usize: Int64;          // decompressed size (usize < 0 -> unknown)
  15       stream: TMemoryStream; // copy of compressed data
  16     end;
  17
  18     TResource = record
  19       name: AnsiString;
  20       data: TData;
  21     end;
  22
  23     TSection = record
  24       name: AnsiString;
  25       list: array of TResource;
  26     end;
  27
  28     PResource = ^TResource;
  29     PSection = ^TSection;
  30
  31     TDFWEditor = class sealed(WADEDITOR.TWADEditor)
  32       private
  33         FSection: array of TSection;
  34         FData: array of TData;
  35         FStream: TStream;
  36         FLastError: Integer;
  37         FVersion: Byte;
  38
  39         function FindSectionIDRAW(name: AnsiString; caseSensitive: Boolean): Integer;
  40         function FindSectionRAW(name: AnsiString; caseSensitive: Boolean): PSection;
  41         function InsertSectionRAW(name: AnsiString): PSection;
  42
  43         function FindSectionID(name: AnsiString): Integer;
  44         function FindSection(name: AnsiString): PSection;
  45         function InsertSection(name: AnsiString): PSection;
  46
  47         function FindDataID(pos: Int64): Integer;
  48         function FindData(pos: Int64): TData;
  49         function InsertData(ref, pos, csize, usize: Int64; stream: TMemoryStream): TData;
  50
  51         function InsertFileInfoS(p: PSection; const name: AnsiString; pos, csize, usize: Int64; stream: TMemoryStream): PResource;
  52         function InsertFileInfo(const section, name: AnsiString; pos, csize, usize: Int64; stream: TMemoryStream): PResource;
  53         function Preload(data: TData): Boolean;
  54         function GetSourceStream(p: PResource): TStream;
  55
  56         procedure Clear();
  57         procedure Collect();
  58         procedure ReadFromStream(s: TStream);
  59         procedure SaveToStream(s: TStream);
  60
  61       public
  62         constructor Create();
  63         destructor Destroy(); override;
  64         procedure FreeWAD(); override;
  65         function  ReadFile2(FileName: string): Boolean; override;
  66         function  ReadMemory(Data: Pointer; Len: LongWord): Boolean; override;
  67         procedure CreateImage(); override;
  68         function AddResource(Data: Pointer; Len: LongWord; Name, Section: String): Boolean; override; overload;
  69         function AddResource(FileName, Name, Section: String): Boolean; override; overload;
  70         function AddAlias(Res, Alias: String): Boolean; override;
  71         procedure AddSection(Name: String); override;
  72         procedure RemoveResource(Section, Resource: String); override;
  73         procedure SaveTo(FileName: String); override;
  74         function HaveResource(Section, Resource: String): Boolean; override;
  75         function HaveSection(Section: string): Boolean; override;
  76         function GetResource(Section, Resource: String; var pData: Pointer; var Len: Integer): Boolean; override;
  77         function GetSectionList(): SArray; override;
  78         function GetResourcesList(Section: String): SArray; override;
  79
  80         function GetLastError: Integer; override;
  81         function GetLastErrorStr: String; override;
  82         function GetResourcesCount: Word; override;
  83         function GetVersion: Byte; override;
  84     end;
  85
  86 implementation
  87
  88   uses SysUtils, StrUtils, DateUtils, Math, utils, zstream, crc, e_log;
  89
  90   function PrepString(const s: AnsiString; caseSensitive, extSensitive: Boolean): AnsiString; inline;
  91     var i: Integer;
  92   begin
  93     Result := s;
  94     if caseSensitive = False then
  95     begin
  96       Result := UpperCase(Result);
  97     end;
  98     if extSensitive = False then
  99     begin
 100       i := Pos('.', Result); // fix dotfiles
 101       if i > 1 then
 102         SetLength(Result, i - 1);
 103     end;
 104   end;
 105
 106   function FindResourceIDRAW(p: PSection; name: AnsiString; caseSensitive, extSensitive: Boolean): Integer;
 107     var i: Integer; pname: AnsiString;
 108   begin
 109     if p <> nil then
 110     begin
 111       pname := PrepString(name, caseSensitive, extSensitive);
 112       for i := 0 to High(p.list) do
 113       begin
 114         if PrepString(p.list[i].name, caseSensitive, extSensitive) = pname then
 115         begin
 116           Result := i;
 117           exit;
 118         end;
 119       end;
 120     end;
 121     Result := -1;
 122   end;
 123
 124   function FindResourceID(p: PSection; name: AnsiString): Integer;
 125     var i: Integer;
 126   begin
 127     i := FindResourceIDRAW(p, name, True, True); // CaSeNaMe.Ext
 128     if i < 0 then
 129     begin
 130       i := FindResourceIDRAW(p, name, False, True); // CASENAME.EXT
 131       if i < 0 then
 132       begin
 133         i := FindResourceIDRAW(p, name, True, False); // CaSeNaMe
 134         if i < 0 then
 135         begin
 136           i := FindResourceIDRAW(p, name, False, False); // CASENAME
 137         end;
 138       end;
 139     end;
 140     Result := i;
 141   end;
 142
 143   function FindResource(p: PSection; name: AnsiString): PResource;
 144     var i: Integer;
 145   begin
 146     i := FindResourceID(p, name);
 147     if i >= 0 then Result := @p.list[i] else Result := nil;
 148   end;
 149
 150
 151
 152   function TDFWEditor.FindSectionIDRAW(name: AnsiString; caseSensitive: Boolean): Integer;
 153     var i: Integer; pname: AnsiString;
 154   begin
 155     if FSection <> nil then
 156     begin
 157       pname := PrepString(name, caseSensitive, True);
 158       for i := 0 to High(FSection) do
 159       begin
 160         if PrepString(FSection[i].name, caseSensitive, True) = pname then
 161         begin
 162           Result := i;
 163           exit;
 164         end;
 165       end;
 166     end;
 167     Result := -1;
 168   end;
 169
 170   function TDFWEditor.FindSectionRAW(name: AnsiString; caseSensitive: Boolean): PSection;
 171     var i: Integer;
 172   begin
 173     i := FindSectionIDRAW(name, caseSensitive);
 174     if i >= 0 then Result := @FSection[i] else Result := nil;
 175   end;
 176
 177   function TDFWEditor.InsertSectionRAW(name: AnsiString): PSection;
 178     var i: Integer;
 179   begin
 180     if FSection = nil then i := 0 else i := Length(FSection);
 181     SetLength(FSection, i + 1);
 182     FSection[i] := Default(TSection);
 183     FSection[i].name := name;
 184     Result := @FSection[i];
 185   end;
 186
 187
 188
 189   function TDFWEditor.FindSectionID(name: AnsiString): Integer;
 190     var fixName: AnsiString;
 191   begin
 192     fixName := StringReplace(name, '\', '/', [rfReplaceAll], TStringReplaceAlgorithm.sraManySmall);
 193     Result := FindSectionIDRAW(fixName, True); // CaSeNaMe
 194     if Result < 0 then
 195       Result := FindSectionIDRAW(fixName, False); // CASENAME
 196   end;
 197
 198   function TDFWEditor.FindSection(name: AnsiString): PSection;
 199     var fixName: AnsiString;
 200   begin
 201     fixName := StringReplace(name, '\', '/', [rfReplaceAll], TStringReplaceAlgorithm.sraManySmall);
 202     Result := FindSectionRAW(fixName, True); // CaSeNaMe
 203     if Result = nil then
 204       Result := FindSectionRAW(fixName, False); // CASENAME
 205   end;
 206
 207   function TDFWEditor.InsertSection(name: AnsiString): PSection;
 208   begin
 209     Result := FindSection(name);
 210     if Result = nil then
 211       Result := InsertSectionRAW(name);
 212   end;
 213
 214
 215
 216   function TDFWEditor.FindDataID(pos: Int64): Integer;
 217     var i: Integer;
 218   begin
 219     if (pos >= 0) and (FData <> nil) then
 220     begin
 221       for i := 0 to High(FData) do
 222       begin
 223         if FData[i].pos = pos then
 224         begin
 225           Result := i;
 226           exit;
 227         end;
 228       end;
 229     end;
 230     Result := -1;
 231   end;
 232
 233   function TDFWEditor.FindData(pos: Int64): TData;
 234     var i: Integer;
 235   begin
 236     i := FindDataID(pos);
 237     if i >= 0 then Result := FData[i] else Result := nil;
 238   end;
 239
 240   function TDFWEditor.InsertData(ref, pos, csize, usize: Int64; stream: TMemoryStream): TData;
 241     var i: Integer; data: TData;
 242   begin
 243     data := TData.Create();
 244     data.ref := ref;
 245     data.pos := pos;
 246     data.csize := csize;
 247     data.usize := usize;
 248     data.stream := stream;
 249
 250     if FData = nil then i := 0 else i := Length(FData);
 251     SetLength(FData, i + 1);
 252     FData[i] := data;
 253     Result := data;
 254   end;
 255
 256
 257
 258   function TDFWEditor.InsertFileInfoS(p: PSection; const name: AnsiString; pos, csize, usize: Int64; stream: TMemoryStream): PResource;
 259     var i: Integer; data: TData;
 260   begin
 261     Result := nil;
 262     if p = nil then
 263       exit;
 264
 265     data := FindData(pos);
 266     if data = nil then
 267       data := InsertData(0, pos, csize, usize, stream);
 268
 269     if p.list = nil then i := 0 else i := Length(p.list);
 270     SetLength(p.list, i + 1);
 271     Inc(data.ref);
 272     p.list[i] := Default(TResource);
 273     p.list[i].name := name;
 274     p.list[i].data := data;
 275     Result := @p.list[i];
 276   end;
 277
 278   function TDFWEditor.InsertFileInfo(const section, name: AnsiString; pos, csize, usize: Int64; stream: TMemoryStream): PResource;
 279     var p: PSection;
 280   begin
 281     p := FindSectionRAW(section, True);
 282     if p = nil then
 283       p := InsertSectionRAW(section);
 284
 285     Result := InsertFileInfoS(p, name, pos, csize, usize, stream);
 286   end;
 287
 288
 289
 290   function TDFWEditor.AddAlias(Res, Alias: String): Boolean;
 291   begin
 292     // New hard-links are not supported
 293     // However, they never created by editor
 294     Result := False;
 295   end;
 296
 297   function TDFWEditor.AddResource(Data: Pointer; Len: LongWord; Name, Section: String): Boolean;
 298     const level: TCompressionLevel = TCompressionLevel.clMax;
 299     var s: TMemoryStream; cs: TCompressionStream; p: PResource;
 300   begin
 301     Name := win2utf(Name);
 302     Section := win2utf(Section);
 303     Result := False;
 304     if Name <> '' then
 305     begin
 306       s := TMemoryStream.Create();
 307       try
 308         cs := TCompressionStream.Create(level, s, False);
 309         try
 310           cs.WriteBuffer(PByte(Data)[0], Len);
 311           cs.Flush();
 312         finally
 313           cs.Free();
 314         end;
 315         p := InsertFileInfo(Section, Name, -1, s.Size, Len, s);
 316         Result := p <> nil;
 317       except
 318         s.Free();
 319         raise;
 320       end;
 321     end;
 322   end;
 323
 324   function TDFWEditor.AddResource(FileName, Name, Section: String): Boolean;
 325     var s: TFileStream; ptr: PByte;
 326   begin
 327     Result := False;
 328     FLastError := DFWAD_ERROR_READWAD;
 329     try
 330       s := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
 331       try
 332         GetMem(ptr, s.Size);
 333         try
 334           s.ReadBuffer(ptr[0], s.Size);
 335           Result := AddResource(ptr, s.Size, Name, Section);
 336           if Result = True then FLastError := DFWAD_NOERROR;
 337         finally
 338           FreeMem(ptr);
 339         end;
 340       finally
 341         s.Free();
 342       end;
 343     except
 344       on e: EFOpenError do
 345       begin
 346         if gWADEditorLogLevel >= DFWAD_LOG_INFO then
 347           e_WriteLog('DFWAD: AddResource: failed to open file ' + FileName, MSG_NOTIFY);
 348         FLastError := DFWAD_ERROR_CANTOPENWAD;
 349       end;
 350     end;
 351   end;
 352
 353   constructor TDFWEditor.Create();
 354   begin
 355     FSection := nil;
 356     FData := nil;
 357     FStream := nil;
 358     FLastError := DFWAD_NOERROR;
 359     FVersion := 1;
 360     FreeWAD();
 361   end;
 362
 363   destructor TDFWEditor.Destroy();
 364   begin
 365     Clear();
 366     inherited;
 367   end;
 368
 369   procedure TDFWEditor.Clear();
 370     var i: Integer;
 371   begin
 372     if FSection <> nil then
 373     begin
 374       for i := 0 to High(FSection) do
 375         if FSection[i].list <> nil then
 376           SetLength(FSection[i].list, 0);
 377       SetLength(FSection, 0);
 378     end;
 379     if FData <> nil then
 380     begin
 381       for i := 0 to High(FData) do
 382       begin
 383         if FData[i] <> nil then
 384         begin
 385           if FData[i].stream <> nil then
 386             FreeAndNil(FData[i].stream);
 387           FreeAndNil(FData[i]);
 388         end;
 389       end;
 390       SetLength(FData, 0);
 391     end;
 392     if FStream <> nil then
 393       FreeAndNil(FStream);
 394   end;
 395
 396   procedure TDFWEditor.FreeWAD();
 397   begin
 398     Clear();
 399     FLastError := DFWAD_NOERROR;
 400     FVersion := 1;
 401   end;
 402
 403   function TDFWEditor.Preload(data: TData): Boolean;
 404     var s: TMemoryStream;
 405   begin
 406     Result := False;
 407     if data <> nil then
 408     begin
 409       Result := data.stream <> nil;
 410       if (data.stream = nil) and (FStream <> nil) then
 411       begin
 412         s := TMemoryStream.Create();
 413         try
 414           if data.csize > 0 then
 415           begin
 416             FStream.Seek(data.pos, TSeekOrigin.soBeginning);
 417             s.CopyFrom(FStream, data.csize);
 418           end;
 419           Assert(s.Size = data.csize); // wtf, random size if copied zero bytes!
 420           data.stream := s;
 421           Result := True;
 422         except
 423           s.Free();
 424         end;
 425       end;
 426     end;
 427   end;
 428
 429   procedure TDFWEditor.CreateImage();
 430     var i, j: Integer;
 431   begin
 432     if FStream = nil then
 433     begin
 434       if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
 435         e_WriteLog('DFWAD: CreateImage: File not assigned', MSG_NOTIFY);
 436       FLastError := DFWAD_ERROR_WADNOTLOADED;
 437     end
 438     else if FStream is TMemoryStream then
 439     begin
 440       if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
 441         e_WriteLog('DFWAD: CreateImage: Memory stream', MSG_NOTIFY);
 442       FLastError := DFWAD_NOERROR;
 443     end
 444     else
 445     begin
 446       if FSection <> nil then
 447       begin
 448         for i := 0 to High(FData) do
 449         begin
 450           if Preload(FData[i]) = False then
 451           begin
 452             if gWADEditorLogLevel >= DFWAD_LOG_WARN then
 453               e_WriteLog('DFWAD: CreateImage: failed to preload resource data #' + IntToStr(i), MSG_WARNING);
 454             FLastError := DFWAD_ERROR_CANTOPENWAD;
 455             exit;
 456           end;
 457           FData[i].pos := -1;
 458         end;
 459       end;
 460       FreeAndNil(FStream);
 461       FLastError := DFWAD_NOERROR;
 462     end;
 463   end;
 464
 465   procedure TDFWEditor.AddSection(Name: String);
 466   begin
 467     Name := win2utf(Name);
 468     if InsertSection(Name) = nil then
 469       raise Exception.Create('DFWAD: AddSection[' + Name + ']: failed to insert');
 470   end;
 471
 472   function TDFWEditor.HaveResource(Section, Resource: String): Boolean;
 473   begin
 474     Section := win2utf(Section);
 475     Resource := win2utf(Resource);
 476     Result := FindResource(FindSection(Section), Resource) <> nil;
 477   end;
 478
 479   function TDFWEditor.HaveSection(Section: String): Boolean;
 480   begin
 481     Section := win2utf(Section);
 482     Result := FindSection(Section) <> nil;
 483   end;
 484
 485   function TDFWEditor.GetSourceStream(p: PResource): TStream;
 486     var src: TStream;
 487   begin
 488     src := nil;
 489     if p.data.stream <> nil then
 490     begin
 491       src := p.data.stream;
 492       src.Seek(0, TSeekOrigin.soBeginning);
 493     end
 494     else if (p.data.pos >= 0) and (FStream <> nil) then
 495     begin
 496       src := FStream;
 497       src.Seek(p.data.pos, TSeekOrigin.soBeginning);
 498     end;
 499     Result := src;
 500   end;
 501
 502   function TDFWEditor.GetResource(Section, Resource: String; var pData: Pointer; var Len: Integer): Boolean;
 503     const BLOCK_STEP = 4096;
 504     var p: PResource; src: TStream; tmp: TDecompressionStream; ptr: PByte; size, r: Int64;
 505   begin
 506     Section := win2utf(Section);
 507     Resource := win2utf(Resource);
 508     FLastError := DFWAD_ERROR_CANTOPENWAD;
 509     Result := False;
 510     pData := nil;
 511     Len := 0;
 512     p := FindResource(FindSection(Section), Resource);
 513     if p <> nil then
 514     begin
 515       src := GetSourceStream(p);
 516       if src <> nil then
 517       begin
 518         try
 519           tmp := TDecompressionStream.Create(src, False);
 520           try
 521             if p.data.usize < 0 then
 522             begin
 523               size := 0;
 524               GetMem(ptr, BLOCK_STEP);
 525               try
 526                 repeat
 527                   r := tmp.Read(ptr[size], BLOCK_STEP);
 528                   size := size + r;
 529                   if r <> 0 then
 530                     ReallocMem(ptr, size + BLOCK_STEP);
 531                 until r = 0;
 532                 ReallocMem(ptr, size);
 533                 p.data.usize := size; // cache size
 534                 pData := ptr;
 535                 Len := size;
 536                 Result := True;
 537                 FLastError := DFWAD_NOERROR;
 538               except
 539                 FreeMem(ptr);
 540                 raise;
 541               end;
 542             end
 543             else
 544             begin
 545               GetMem(ptr, p.data.usize);
 546               try
 547                 tmp.ReadBuffer(ptr[0], p.data.usize);
 548                 pData := ptr;
 549                 Len := p.data.usize;
 550                 Result := True;
 551                 FLastError := DFWAD_NOERROR;
 552               except
 553                 FreeMem(ptr);
 554                 raise;
 555               end;
 556             end;
 557           finally
 558             tmp.Free();
 559           end;
 560         except
 561           on e: EStreamError do
 562           begin
 563             if gWADEditorLogLevel >= DFWAD_LOG_INFO then
 564               e_WriteLog('DFWAD: Failed to decompress DEFLATEd data, reason: ' + e.Message, MSG_WARNING);
 565             raise e;
 566           end;
 567         end;
 568       end
 569       else
 570       begin
 571         if gWADEditorLogLevel >= DFWAD_LOG_WARN then
 572           e_WriteLog('DFWAD: No available source for file data', MSG_WARNING);
 573         FLastError := DFWAD_ERROR_WADNOTLOADED;
 574       end;
 575     end
 576     else
 577     begin
 578       if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
 579         e_WriteLog('DFWAD: Resource not found', MSG_NOTIFY);
 580       FLastError := DFWAD_ERROR_RESOURCENOTFOUND;
 581     end;
 582   end;
 583
 584   function TDFWEditor.GetResourcesList(Section: String): SArray;
 585     var p: PSection; i: Integer;
 586   begin
 587     Section := win2utf(Section);
 588     Result := nil;
 589     p := FindSection(Section);
 590     if (p <> nil) and (p.list <> nil) then
 591     begin
 592       SetLength(Result, Length(p.list));
 593       for i := 0 to High(p.list) do
 594       begin
 595         Result[i] := utf2win(p.list[i].name);
 596       end;
 597     end;
 598   end;
 599
 600   function TDFWEditor.GetSectionList(): SArray;
 601     var i: Integer;
 602   begin
 603     Result := nil;
 604     if FSection <> nil then
 605     begin
 606       SetLength(Result, Length(FSection));
 607       for i := 0 to High(FSection) do
 608       begin
 609         Result[i] := utf2win(FSection[i].name);
 610       end;
 611     end;
 612   end;
 613
 614   procedure TDFWEditor.ReadFromStream(s: TStream);
 615     var sig: packed array [0..4] of Char;
 616     var ver: UInt8; nrec: UInt16; offset, csize: UInt32;
 617     var name1251: packed array [0..16] of Char;
 618     var section, name: AnsiString;
 619     var i: Integer;
 620     var sec: PSection;
 621     var res: PResource;
 622   begin
 623     s.ReadBuffer(sig[0], 5);
 624     if sig = 'DFWAD' then
 625     begin
 626       ver := s.ReadByte();
 627       if ver = 1 then
 628       begin
 629         nrec := LEtoN(s.ReadWord());
 630         section := '';
 631         sec := nil;
 632         for i := 0 to nrec - 1 do
 633         begin
 634           s.ReadBuffer(name1251[0], 16);
 635           name1251[16] := #0;
 636           name := win2utf(PChar(@name1251[0]));
 637           offset := LEtoN(s.ReadDWord());
 638           csize := LEtoN(s.ReadDWord());
 639           if csize = 0 then
 640           begin
 641             section := name;
 642             sec := InsertSectionRAW(section);
 643             if sec = nil then
 644               raise Exception.Create('Failed to register section [' + section + ']');
 645           end
 646           else
 647           begin
 648             if sec = nil then
 649               sec := InsertSectionRAW('');
 650             if sec = nil then
 651               raise Exception.Create('Failed to create root section');
 652             res := InsertFileInfoS(sec, name, offset, csize, -1, nil);
 653             if res = nil then
 654               raise Exception.Create('Failed to register resource [' + section + '][' + name + ']');
 655             if res.data.csize <> csize then
 656               raise Exception.Create('Invalid compressed size for [' + section + '][' + name + '] (corrupted archive?)');
 657           end;
 658         end;
 659       end
 660       else
 661       begin
 662         FLastError := DFWAD_ERROR_WRONGVERSION;
 663         raise Exception.Create('Unsupported DFWAD version ' + IntToStr(ver) + ' (expected 1)');
 664       end;
 665     end
 666     else
 667     begin
 668       FLastError := DFWAD_ERROR_FILENOTWAD;
 669       raise Exception.Create('Not DFWAD file');
 670     end;
 671   end;
 672
 673   function TDFWEditor.ReadFile2(FileName: String): Boolean;
 674     var s: TFileStream;
 675   begin
 676     FreeWAD();
 677     Result := False;
 678     try
 679       s := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
 680       try
 681         ReadFromStream(s);
 682         FStream := s;
 683         FLastError := DFWAD_NOERROR;
 684         Result := True;
 685       except
 686         s.Free();
 687         raise;
 688       end;
 689     except
 690       on e: EFOpenError do
 691       begin
 692         if gWADEditorLogLevel >= DFWAD_LOG_INFO then
 693           e_WriteLog('DFWAD: Failed to open file ' + FileName + ', reason: ' + e.Message, MSG_WARNING);
 694         if FileExists(FileName) then
 695           FLastError := DFWAD_ERROR_CANTOPENWAD
 696         else
 697           FLastError := DFWAD_ERROR_WADNOTFOUND;
 698       end;
 699       on e: Exception do
 700       begin
 701         if gWADEditorLogLevel >= DFWAD_LOG_INFO then
 702           e_WriteLog('DFWAD: Failed to read DFWAD from file ' + FileName + ', reason: ' + e.Message, MSG_WARNING);
 703         Clear();
 704       end;
 705     end;
 706   end;
 707
 708   function TDFWEditor.ReadMemory(Data: Pointer; Len: LongWord): Boolean;
 709     var s: TMemoryStream;
 710   begin
 711     FreeWAD();
 712     Result := False;
 713     try
 714       s := TMemoryStream.Create;
 715       try
 716         s.SetSize(Len);
 717         s.WriteBuffer(PByte(Data)[0], Len);
 718         s.Seek(0, soBeginning);
 719         ReadFromStream(s);
 720         FStream := s;
 721         FLastError := DFWAD_NOERROR;
 722         Result := True;
 723       except
 724         s.Free();
 725         raise;
 726       end;
 727     except
 728       on e: Exception do
 729       begin
 730         if gWADEditorLogLevel >= DFWAD_LOG_INFO then
 731           e_WriteLog('DFWAD: Failed to read DFWAD from memory, reason: ' + e.Message, MSG_WARNING);
 732         Clear();
 733       end;
 734     end;
 735   end;
 736
 737   procedure TDFWEditor.Collect();
 738     var i, n: Integer;
 739   begin
 740     if FData <> nil then
 741     begin
 742       n := 0;
 743       for i := 0 to High(FData) do
 744       begin
 745         if FData[i] <> nil then
 746         begin
 747           if FData[i].ref > 0 then
 748           begin
 749             FData[n] := FData[i];
 750             Inc(n);
 751           end
 752           else
 753           begin
 754             if FData[i].stream <> nil then
 755               FreeAndNil(FData[i].stream);
 756             FreeAndNil(FData[i]);
 757           end;
 758         end;
 759       end;
 760       SetLength(FData, n);
 761     end;
 762   end;
 763
 764   procedure TDFWEditor.RemoveResource(Section, Resource: String);
 765     var p: PSection; i: Integer; data: TData;
 766   begin
 767     Section := win2utf(Section);
 768     Resource := win2utf(Resource);
 769     p := FindSection(Section);
 770     i := FindResourceID(p, Resource);
 771     if i >= 0 then
 772     begin
 773       data := p.list[i].data;
 774       for i := i + 1 to High(p.list) do
 775       begin
 776         p.list[i - 1] := p.list[i];
 777       end;
 778       SetLength(p.list, High(p.list));
 779       Dec(data.ref);
 780       if data.ref <= 0 then
 781         Collect();
 782     end;
 783   end;
 784
 785   procedure TDFWEditor.SaveToStream(s: TStream);
 786     type TName16 = packed array [0..16] of Char;
 787     var count: UInt16;
 788     var name1251: TName16;
 789     var i, j: Integer;
 790     var p: PResource;
 791     var data: TData;
 792
 793     function GetOffset(data: TData): UInt32;
 794       var i: Integer;
 795     begin
 796       Assert(data <> nil);
 797       Result := 6 + 2 + count * 24;
 798       for i := 0 to High(FData) do
 799       begin
 800         if FData[i] = data then
 801           exit;
 802         if FData[i] <> nil then
 803           Result := Result + FData[i].csize;
 804       end;
 805       raise Exception.Create('Failed to calculate offset (BUG!)');
 806     end;
 807
 808   begin
 809     count := GetResourcesCount();
 810     s.WriteBuffer('DFWAD', 5);
 811     s.WriteByte(1);
 812     WriteInt(s, UInt16(count));
 813     if FSection <> nil then
 814     begin
 815       for i := 0 to High(FSection) do
 816       begin
 817         if (i <> 0) or (FSection[i].name <> '') then
 818         begin
 819           name1251 := Default(TName16);
 820           name1251 := utf2win(FSection[i].name);
 821           s.WriteBuffer(name1251[0], 16);
 822           WriteInt(s, UInt32(0));
 823           WriteInt(s, UInt32(0));
 824         end;
 825         if FSection[i].list <> nil then
 826         begin
 827           for j := 0 to High(FSection[i].list) do
 828           begin
 829             p := @FSection[i].list[j];
 830             name1251 := Default(TName16);
 831             name1251 := utf2win(p.name);
 832             s.WriteBuffer(name1251[0], 16);
 833             WriteInt(s, UInt32(GetOffset(p.data)));
 834             WriteInt(s, UInt32(p.data.csize));
 835           end;
 836         end;
 837       end;
 838       if FData <> nil then
 839       begin
 840         for i := 0 to High(FData) do
 841         begin
 842           data := FData[i];
 843           if data <> nil then
 844           begin
 845             Assert(s.Position = GetOffset(data));
 846             if data.stream <> nil then
 847             begin
 848               Assert(data.stream.Size = data.csize);
 849               data.stream.SaveToStream(s);
 850             end
 851             else if (data.pos >= 0) and (FStream <> nil) then
 852             begin
 853               FStream.Seek(data.pos, TSeekOrigin.soBeginning);
 854               s.CopyFrom(FStream, data.csize);
 855             end
 856             else
 857             begin
 858               raise Exception.Create('No data source available (somethig very wrong)');
 859             end;
 860           end;
 861         end;
 862       end;
 863     end;
 864   end;
 865
 866   procedure TDFWEditor.SaveTo(FileName: String);
 867     var s: TFileStream;
 868   begin
 869     try
 870       s := TFileStream.Create(FileName, fmCreate);
 871       try
 872         SaveToStream(s);
 873       finally
 874         s.Free();
 875       end;
 876     except
 877       on e: Exception do
 878       begin
 879         if gWADEditorLogLevel >= DFWAD_LOG_INFO then
 880           e_WriteLog('DFWAD: Failed to create file ' + FileName + ', reason: ' + e.Message, MSG_WARNING);
 881         raise e;
 882       end;
 883     end;
 884   end;
 885
 886   function TDFWEditor.GetLastError: Integer;
 887   begin
 888     Result := FLastError;
 889   end;
 890
 891   function TDFWEditor.GetLastErrorStr: String;
 892   begin
 893     case FLastError of
 894       DFWAD_NOERROR: Result := '';
 895       DFWAD_ERROR_WADNOTFOUND: Result := 'DFWAD file not found';
 896       DFWAD_ERROR_CANTOPENWAD: Result := 'Can''t open DFWAD file';
 897       DFWAD_ERROR_RESOURCENOTFOUND: Result := 'Resource not found';
 898       DFWAD_ERROR_FILENOTWAD: Result := 'File is not DFWAD';
 899       DFWAD_ERROR_WADNOTLOADED: Result := 'DFWAD file is not loaded';
 900       DFWAD_ERROR_READRESOURCE: Result := 'Read resource error';
 901       DFWAD_ERROR_READWAD: Result := 'Read DFWAD error';
 902       otherwise Result := IntToStr(FLastError);
 903     end;
 904   end;
 905
 906   function TDFWEditor.GetResourcesCount: Word;
 907     var i: Integer;
 908   begin
 909     Result := 0;
 910     if FSection <> nil then
 911     begin
 912       Result := Result + Length(FSection);
 913       for i := 0 to High(FSection) do
 914         if FSection[i].list <> nil then
 915           Result := Result + Length(FSection[i].list);
 916       if FSection[0].name = '' then
 917         Dec(Result); // First root section not counted
 918     end;
 919   end;
 920
 921   function TDFWEditor.GetVersion: Byte;
 922   begin
 923     Result := FVersion;
 924   end;
 925
 926 begin
 927   gWADEditorFactory.RegisterEditor('DFWAD', TDFWEditor);
 928 end.