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               except
 538                 FreeMem(ptr);
 539                 raise;
 540               end;
 541             end
 542             else
 543             begin
 544               GetMem(ptr, p.data.usize);
 545               try
 546                 tmp.ReadBuffer(ptr[0], p.data.usize);
 547                 pData := ptr;
 548                 Len := p.data.usize;
 549                 Result := True;
 550               except
 551                 FreeMem(ptr);
 552                 raise;
 553               end;
 554             end;
 555           finally
 556             tmp.Free();
 557           end;
 558         except
 559           on e: EStreamError do
 560           begin
 561             if gWADEditorLogLevel >= DFWAD_LOG_INFO then
 562               e_WriteLog('DFWAD: Failed to decompress DEFLATEd data, reason: ' + e.Message, MSG_WARNING);
 563             raise e;
 564           end;
 565         end;
 566       end
 567       else
 568       begin
 569         if gWADEditorLogLevel >= DFWAD_LOG_WARN then
 570           e_WriteLog('DFWAD: No available source for file data', MSG_WARNING);
 571         FLastError := DFWAD_ERROR_WADNOTLOADED;
 572       end;
 573     end
 574     else
 575     begin
 576       if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
 577         e_WriteLog('DFWAD: Resource not found', MSG_NOTIFY);
 578       FLastError := DFWAD_ERROR_RESOURCENOTFOUND;
 579     end;
 580   end;
 581
 582   function TDFWEditor.GetResourcesList(Section: String): SArray;
 583     var p: PSection; i: Integer;
 584   begin
 585     Section := win2utf(Section);
 586     Result := nil;
 587     p := FindSection(Section);
 588     if (p <> nil) and (p.list <> nil) then
 589     begin
 590       SetLength(Result, Length(p.list));
 591       for i := 0 to High(p.list) do
 592       begin
 593         Result[i] := utf2win(p.list[i].name);
 594       end;
 595     end;
 596   end;
 597
 598   function TDFWEditor.GetSectionList(): SArray;
 599     var i: Integer;
 600   begin
 601     Result := nil;
 602     if FSection <> nil then
 603     begin
 604       SetLength(Result, Length(FSection));
 605       for i := 0 to High(FSection) do
 606       begin
 607         Result[i] := utf2win(FSection[i].name);
 608       end;
 609     end;
 610   end;
 611
 612   procedure TDFWEditor.ReadFromStream(s: TStream);
 613     var sig: packed array [0..4] of Char;
 614     var ver: UInt8; nrec: UInt16; offset, csize: UInt32;
 615     var name1251: packed array [0..16] of Char;
 616     var section, name: AnsiString;
 617     var i: Integer;
 618     var sec: PSection;
 619     var res: PResource;
 620   begin
 621     s.ReadBuffer(sig[0], 5);
 622     if sig = 'DFWAD' then
 623     begin
 624       ver := s.ReadByte();
 625       if ver = 1 then
 626       begin
 627         nrec := LEtoN(s.ReadWord());
 628         section := '';
 629         for i := 0 to nrec - 1 do
 630         begin
 631           s.ReadBuffer(name1251[0], 16);
 632           name1251[16] := #0;
 633           name := win2utf(PChar(@name1251[0]));
 634           offset := LEtoN(s.ReadDWord());
 635           csize := LEtoN(s.ReadDWord());
 636           if csize = 0 then
 637           begin
 638             section := name;
 639             sec := InsertSectionRAW(section);
 640             if sec = nil then
 641               raise Exception.Create('Failed to register section [' + section + ']');
 642           end
 643           else
 644           begin
 645             if sec = nil then
 646               sec := InsertSectionRAW('');
 647             res := InsertFileInfoS(sec, name, offset, csize, -1, nil);
 648             if res = nil then
 649               raise Exception.Create('Failed to register resource [' + section + '][' + name + ']');
 650             if res.data.csize <> csize then
 651               raise Exception.Create('Invalid compressed size for [' + section + '][' + name + '] (corrupted archive?)');
 652           end;
 653         end;
 654       end
 655       else
 656       begin
 657         FLastError := DFWAD_ERROR_WRONGVERSION;
 658         raise Exception.Create('Unsupported DFWAD version ' + IntToStr(ver) + ' (expected 1)');
 659       end;
 660     end
 661     else
 662     begin
 663       FLastError := DFWAD_ERROR_FILENOTWAD;
 664       raise Exception.Create('Not DFWAD file');
 665     end;
 666   end;
 667
 668   function TDFWEditor.ReadFile2(FileName: String): Boolean;
 669     var s: TFileStream;
 670   begin
 671     FreeWAD();
 672     Result := False;
 673     try
 674       try
 675         s := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
 676         try
 677           ReadFromStream(s);
 678           FStream := s;
 679           FLastError := DFWAD_NOERROR;
 680           Result := True;
 681         except
 682           s.Free();
 683           raise;
 684         end;
 685       except
 686         on e: Exception do
 687         begin
 688           if gWADEditorLogLevel >= DFWAD_LOG_INFO then
 689             e_WriteLog('DFWAD: Failed to read DFWAD from file ' + FileName + ', reason: ' + e.Message, MSG_WARNING);
 690           Clear();
 691         end;
 692       end;
 693     except
 694       on e: EFOpenError do
 695       begin
 696         if gWADEditorLogLevel >= DFWAD_LOG_INFO then
 697           e_WriteLog('DFWAD: Failed to open file ' + FileName + ', reason: ' + e.Message, MSG_WARNING);
 698         if FileExists(FileName) then
 699           FLastError := DFWAD_ERROR_CANTOPENWAD
 700         else
 701           FLastError := DFWAD_ERROR_WADNOTFOUND;
 702       end;
 703     end;
 704   end;
 705
 706   function TDFWEditor.ReadMemory(Data: Pointer; Len: LongWord): Boolean;
 707     var s: TMemoryStream;
 708   begin
 709     FreeWAD();
 710     Result := False;
 711     try
 712       s := TMemoryStream.Create;
 713       try
 714         s.SetSize(Len);
 715         s.WriteBuffer(PByte(Data)[0], Len);
 716         s.Seek(0, soBeginning);
 717         ReadFromStream(s);
 718         FStream := s;
 719         FLastError := DFWAD_NOERROR;
 720         Result := True;
 721       except
 722         s.Free();
 723         raise;
 724       end;
 725     except
 726       on e: Exception do
 727       begin
 728         if gWADEditorLogLevel >= DFWAD_LOG_INFO then
 729           e_WriteLog('DFWAD: Failed to read DFWAD from memory, reason: ' + e.Message, MSG_WARNING);
 730         Clear();
 731       end;
 732     end;
 733   end;
 734
 735   procedure TDFWEditor.Collect();
 736     var i, n: Integer;
 737   begin
 738     if FData <> nil then
 739     begin
 740       n := 0;
 741       for i := 0 to High(FData) do
 742       begin
 743         if FData[i] <> nil then
 744         begin
 745           if FData[i].ref > 0 then
 746           begin
 747             FData[n] := FData[i];
 748             Inc(n);
 749           end
 750           else
 751           begin
 752             if FData[i].stream <> nil then
 753               FreeAndNil(FData[i].stream);
 754             FreeAndNil(FData[i]);
 755           end;
 756         end;
 757       end;
 758       SetLength(FData, n);
 759     end;
 760   end;
 761
 762   procedure TDFWEditor.RemoveResource(Section, Resource: String);
 763     var p: PSection; i: Integer; data: TData;
 764   begin
 765     Section := win2utf(Section);
 766     Resource := win2utf(Resource);
 767     p := FindSection(Section);
 768     i := FindResourceID(p, Resource);
 769     if i >= 0 then
 770     begin
 771       data := p.list[i].data;
 772       for i := i + 1 to High(p.list) do
 773       begin
 774         p.list[i - 1] := p.list[i];
 775       end;
 776       SetLength(p.list, High(p.list));
 777       Dec(data.ref);
 778       if data.ref <= 0 then
 779         Collect();
 780     end;
 781   end;
 782
 783   procedure TDFWEditor.SaveToStream(s: TStream);
 784     type TName16 = packed array [0..16] of Char;
 785     var count: UInt16;
 786     var name1251: TName16;
 787     var i, j: Integer;
 788     var p: PResource;
 789     var data: TData;
 790
 791     function GetOffset(data: TData): UInt32;
 792       var i: Integer;
 793     begin
 794       Assert(data <> nil);
 795       Result := 6 + 2 + count * 24;
 796       for i := 0 to High(FData) do
 797       begin
 798         if FData[i] = data then
 799           exit;
 800         if FData[i] <> nil then
 801           Result := Result + FData[i].csize;
 802       end;
 803       raise Exception.Create('Failed to calculate offset (BUG!)');
 804     end;
 805
 806   begin
 807     count := GetResourcesCount();
 808     s.WriteBuffer('DFWAD', 5);
 809     s.WriteByte(1);
 810     WriteInt(s, UInt16(count));
 811     if FSection <> nil then
 812     begin
 813       for i := 0 to High(FSection) do
 814       begin
 815         if (i <> 0) or (FSection[i].name <> '') then
 816         begin
 817           name1251 := Default(TName16);
 818           name1251 := utf2win(FSection[i].name);
 819           s.WriteBuffer(name1251[0], 16);
 820           WriteInt(s, UInt32(0));
 821           WriteInt(s, UInt32(0));
 822         end;
 823         if FSection[i].list <> nil then
 824         begin
 825           for j := 0 to High(FSection[i].list) do
 826           begin
 827             p := @FSection[i].list[j];
 828             name1251 := Default(TName16);
 829             name1251 := utf2win(p.name);
 830             s.WriteBuffer(name1251[0], 16);
 831             WriteInt(s, UInt32(GetOffset(p.data)));
 832             WriteInt(s, UInt32(p.data.csize));
 833           end;
 834         end;
 835       end;
 836       if FData <> nil then
 837       begin
 838         for i := 0 to High(FData) do
 839         begin
 840           data := FData[i];
 841           if data <> nil then
 842           begin
 843             Assert(s.Position = GetOffset(data));
 844             if data.stream <> nil then
 845             begin
 846               Assert(data.stream.Size = data.csize);
 847               data.stream.SaveToStream(s);
 848             end
 849             else if (data.pos >= 0) and (FStream <> nil) then
 850             begin
 851               FStream.Seek(data.pos, TSeekOrigin.soBeginning);
 852               s.CopyFrom(FStream, data.csize);
 853             end
 854             else
 855             begin
 856               raise Exception.Create('No data source available (somethig very wrong)');
 857             end;
 858           end;
 859         end;
 860       end;
 861     end;
 862   end;
 863
 864   procedure TDFWEditor.SaveTo(FileName: String);
 865     var s: TFileStream;
 866   begin
 867     try
 868       s := TFileStream.Create(FileName, fmCreate);
 869       try
 870         SaveToStream(s);
 871       finally
 872         s.Free();
 873       end;
 874     except
 875       on e: Exception do
 876       begin
 877         if gWADEditorLogLevel >= DFWAD_LOG_INFO then
 878           e_WriteLog('DFWAD: Failed to create file ' + FileName + ', reason: ' + e.Message, MSG_WARNING);
 879         raise e;
 880       end;
 881     end;
 882   end;
 883
 884   function TDFWEditor.GetLastError: Integer;
 885   begin
 886     Result := FLastError;
 887   end;
 888
 889   function TDFWEditor.GetLastErrorStr: String;
 890   begin
 891     case FLastError of
 892       DFWAD_NOERROR: Result := '';
 893       DFWAD_ERROR_WADNOTFOUND: Result := 'DFWAD file not found';
 894       DFWAD_ERROR_CANTOPENWAD: Result := 'Can''t open DFWAD file';
 895       DFWAD_ERROR_RESOURCENOTFOUND: Result := 'Resource not found';
 896       DFWAD_ERROR_FILENOTWAD: Result := 'File is not DFWAD';
 897       DFWAD_ERROR_WADNOTLOADED: Result := 'DFWAD file is not loaded';
 898       DFWAD_ERROR_READRESOURCE: Result := 'Read resource error';
 899       DFWAD_ERROR_READWAD: Result := 'Read DFWAD error';
 900       otherwise Result := IntToStr(FLastError);
 901     end;
 902   end;
 903
 904   function TDFWEditor.GetResourcesCount: Word;
 905     var i: Integer;
 906   begin
 907     Result := 0;
 908     if FSection <> nil then
 909     begin
 910       Result := Result + Length(FSection);
 911       for i := 0 to High(FSection) do
 912         if FSection[i].list <> nil then
 913           Result := Result + Length(FSection[i].list);
 914       if FSection[0].name = '' then
 915         Dec(Result); // First root section not counted
 916     end;
 917   end;
 918
 919   function TDFWEditor.GetVersion: Byte;
 920   begin
 921     Result := FVersion;
 922   end;
 923
 924 begin
 925   gWADEditorFactory.RegisterEditor('DFWAD', TDFWEditor);
 926 end.