src/shared/WADEDITOR_dfwad.pas

   1 unit WADEDITOR_dfwad;
   2
   3 {
   4 -----------------------------------
   5 WADEDITOR.PAS ÂÅÐÑÈß ÎÒ 26.08.08
   6
   7 Ïîääåðæêà âàäîâ âåðñèè 1
   8 -----------------------------------
   9 }
  10
  11 interface
  12
  13 uses WADEDITOR, WADSTRUCT;
  14
  15 type
  16   TWADEditor_1 = class sealed(WADEDITOR.TWADEditor)
  17    private
  18     FResData:   Pointer;
  19     FResTable:  packed array of TResourceTableRec_1;
  20     FHeader:    TWADHeaderRec_1;
  21     FDataSize:  LongWord;
  22     FOffset:    LongWord;
  23     FFileName:  string;
  24     FWADOpened: Byte;
  25     FLastError: Integer;
  26     FVersion:   Byte;
  27     function LastErrorString(): string;
  28     function GetResName(ResName: string): Char16;
  29    public
  30     constructor Create();
  31     destructor Destroy(); override;
  32     procedure FreeWAD(); override;
  33     function  ReadFile2(FileName: string): Boolean; override;
  34     function  ReadMemory(Data: Pointer; Len: LongWord): Boolean; override;
  35     procedure CreateImage(); override;
  36     function AddResource(Data: Pointer; Len: LongWord; Name: string;
  37                          Section: string): Boolean; override; overload;
  38     function AddResource(FileName, Name, Section: string): Boolean; override; overload;
  39     function AddAlias(Res, Alias: string): Boolean; override;
  40     procedure AddSection(Name: string); override;
  41     procedure RemoveResource(Section, Resource: string); override;
  42     procedure SaveTo(FileName: string); override;
  43     function HaveResource(Section, Resource: string): Boolean; override;
  44     function HaveSection(Section: string): Boolean; override;
  45     function GetResource(Section, Resource: string; var pData: Pointer;
  46                          var Len: Integer): Boolean; override;
  47     function GetSectionList(): SArray; override;
  48     function GetResourcesList(Section: string): SArray; override;
  49
  50     function GetLastError: Integer; override;
  51     function GetLastErrorStr: String; override;
  52     function GetResourcesCount: Word; override;
  53     function GetVersion: Byte; override;
  54
  55     // property GetLastError: Integer read FLastError;
  56     // property GetLastErrorStr: string read LastErrorString;
  57     // property GetResourcesCount: Word read FHeader.RecordsCount;
  58     // property GetVersion: Byte read FVersion;
  59   end;
  60
  61 const
  62   DFWAD_NOERROR                = 0;
  63   DFWAD_ERROR_WADNOTFOUND      = -1;
  64   DFWAD_ERROR_CANTOPENWAD      = -2;
  65   DFWAD_ERROR_RESOURCENOTFOUND = -3;
  66   DFWAD_ERROR_FILENOTWAD       = -4;
  67   DFWAD_ERROR_WADNOTLOADED     = -5;
  68   DFWAD_ERROR_READRESOURCE     = -6;
  69   DFWAD_ERROR_READWAD          = -7;
  70   DFWAD_ERROR_WRONGVERSION     = -8;
  71
  72 implementation
  73
  74 uses
  75   SysUtils, BinEditor, ZLib, utils, e_log;
  76
  77 const
  78   DFWAD_OPENED_NONE   = 0;
  79   DFWAD_OPENED_FILE   = 1;
  80   DFWAD_OPENED_MEMORY = 2;
  81
  82 procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
  83   OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);
  84 var
  85   strm: TZStreamRec;
  86   P: Pointer;
  87   BufInc: Integer;
  88 begin
  89   FillChar(strm, sizeof(strm), 0);
  90   BufInc := (InBytes + 255) and not 255;
  91   if OutEstimate = 0 then
  92     OutBytes := BufInc
  93   else
  94     OutBytes := OutEstimate;
  95   GetMem(OutBuf, OutBytes);
  96   try
  97     strm.next_in := InBuf;
  98     strm.avail_in := InBytes;
  99     strm.next_out := OutBuf;
 100     strm.avail_out := OutBytes;
 101     inflateInit_(strm, zlib_version, sizeof(strm));
 102     try
 103       while inflate(strm, Z_FINISH) <> Z_STREAM_END do
 104       begin
 105         P := OutBuf;
 106         Inc(OutBytes, BufInc);
 107         ReallocMem(OutBuf, OutBytes);
 108         strm.next_out := PByteF(PChar(OutBuf) + (PChar(strm.next_out) - PChar(P)));
 109         strm.avail_out := BufInc;
 110       end;
 111     finally
 112       inflateEnd(strm);
 113     end;
 114     ReallocMem(OutBuf, strm.total_out);
 115     OutBytes := strm.total_out;
 116   except
 117     FreeMem(OutBuf);
 118     raise
 119   end;
 120 end;
 121
 122 procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;
 123                       out OutBuf: Pointer; out OutBytes: Integer);
 124 var
 125   strm: TZStreamRec;
 126   P: Pointer;
 127 begin
 128   FillChar(strm, sizeof(strm), 0);
 129   OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255;
 130   GetMem(OutBuf, OutBytes);
 131   try
 132     strm.next_in := InBuf;
 133     strm.avail_in := InBytes;
 134     strm.next_out := OutBuf;
 135     strm.avail_out := OutBytes;
 136     deflateInit_(strm, Z_BEST_COMPRESSION, zlib_version, sizeof(strm));
 137     try
 138       while deflate(strm, Z_FINISH) <> Z_STREAM_END do
 139       begin
 140         P := OutBuf;
 141         Inc(OutBytes, 256);
 142         ReallocMem(OutBuf, OutBytes);
 143         strm.next_out := PByteF(PtrUInt(OutBuf + (strm.next_out - P)));
 144         strm.avail_out := 256;
 145       end;
 146     finally
 147       deflateEnd(strm);
 148     end;
 149     ReallocMem(OutBuf, strm.total_out);
 150     OutBytes := strm.total_out;
 151   except
 152     FreeMem(OutBuf);
 153     raise
 154   end;
 155 end;
 156
 157 { TWADEditor_1 }
 158
 159 function TWADEditor_1.AddResource(Data: Pointer; Len: LongWord; Name: string;
 160                                   Section: string): Boolean;
 161 var
 162   ResCompressed: Pointer;
 163   ResCompressedSize: Integer;
 164   a, b: Integer;
 165 begin
 166  Result := False;
 167
 168  SetLength(FResTable, Length(FResTable)+1);
 169
 170  if Section = '' then
 171  begin
 172   if Length(FResTable) > 1 then
 173    for a := High(FResTable) downto 1 do
 174     FResTable[a] := FResTable[a-1];
 175
 176   a := 0;
 177  end
 178   else
 179  begin
 180   Section := AnsiUpperCase(Section);
 181   b := -1;
 182
 183   for a := 0 to High(FResTable) do
 184    if (FResTable[a].Length = 0) and (FResTable[a].ResourceName = Section) then
 185    begin
 186     for b := High(FResTable) downto a+2 do
 187      FResTable[b] := FResTable[b-1];
 188
 189     b := a+1;
 190     Break;
 191    end;
 192
 193   if b = -1 then
 194   begin
 195    SetLength(FResTable, Length(FResTable)-1);
 196    Exit;
 197   end;
 198   a := b;
 199  end;
 200
 201  ResCompressed := nil;
 202  ResCompressedSize := 0;
 203  CompressBuf(Data, Len, ResCompressed, ResCompressedSize);
 204  if ResCompressed = nil then Exit;
 205  e_WriteLog('Fuck me (D)', MSG_NOTIFY);
 206
 207  if FResData = nil then FResData := AllocMem(ResCompressedSize)
 208   else ReallocMem(FResData, FDataSize+Cardinal(ResCompressedSize));
 209
 210  FDataSize := FDataSize+LongWord(ResCompressedSize);
 211
 212  CopyMemory(Pointer(PChar(FResData)+FDataSize-PChar(ResCompressedSize)),
 213             ResCompressed, ResCompressedSize);
 214  FreeMemory(ResCompressed);
 215
 216  Inc(FHeader.RecordsCount);
 217
 218  with FResTable[a] do
 219  begin
 220   ResourceName := GetResName(Name);
 221   Address := FOffset;
 222   Length := ResCompressedSize;
 223  end;
 224
 225  FOffset := FOffset+Cardinal(ResCompressedSize);
 226
 227  Result := True;
 228 end;
 229
 230 function TWADEditor_1.AddAlias(Res, Alias: string): Boolean;
 231 var
 232   a, b: Integer;
 233   ares: Char16;
 234 begin
 235  Result := False;
 236
 237  if FResTable = nil then Exit;
 238
 239  b := -1;
 240  ares := GetResName(Alias);
 241  for a := 0 to High(FResTable) do
 242   if FResTable[a].ResourceName = Res then
 243   begin
 244    b := a;
 245    Break;
 246   end;
 247
 248  if b = -1 then Exit;
 249
 250  Inc(FHeader.RecordsCount);
 251
 252  SetLength(FResTable, Length(FResTable)+1);
 253
 254  with FResTable[High(FResTable)] do
 255  begin
 256   ResourceName := ares;
 257   Address := FResTable[b].Address;
 258   Length := FResTable[b].Length;
 259  end;
 260
 261  Result := True;
 262 end;
 263
 264 function TWADEditor_1.AddResource(FileName, Name, Section: string): Boolean;
 265 var
 266   ResCompressed: Pointer;
 267   ResCompressedSize: Integer;
 268   ResourceFile: File;
 269   TempResource: Pointer;
 270   OriginalSize: Integer;
 271   a, b: Integer;
 272 begin
 273  Result := False;
 274
 275  AssignFile(ResourceFile, FileName);
 276
 277  try
 278   Reset(ResourceFile, 1);
 279  except
 280   FLastError := DFWAD_ERROR_CANTOPENWAD;
 281   Exit;
 282  end;
 283
 284  OriginalSize := FileSize(ResourceFile);
 285  GetMem(TempResource, OriginalSize);
 286
 287  try
 288   BlockRead(ResourceFile, TempResource^, OriginalSize);
 289  except
 290   FLastError := DFWAD_ERROR_READWAD;
 291   FreeMemory(TempResource);
 292   CloseFile(ResourceFile);
 293   Exit;
 294  end;
 295
 296  CloseFile(ResourceFile);
 297
 298  ResCompressed := nil;
 299  ResCompressedSize := 0;
 300  CompressBuf(TempResource, OriginalSize, ResCompressed, ResCompressedSize);
 301  FreeMemory(TempResource);
 302  if ResCompressed = nil then Exit;
 303
 304  SetLength(FResTable, Length(FResTable)+1);
 305
 306  if Section = '' then
 307  begin
 308   if Length(FResTable) > 1 then
 309    for a := High(FResTable) downto 1 do
 310     FResTable[a] := FResTable[a-1];
 311
 312   a := 0;
 313  end
 314   else
 315  begin
 316   Section := AnsiUpperCase(Section);
 317   b := -1;
 318
 319   for a := 0 to High(FResTable) do
 320    if (FResTable[a].Length = 0) and (FResTable[a].ResourceName = Section) then
 321    begin
 322     for b := High(FResTable) downto a+2 do
 323      FResTable[b] := FResTable[b-1];
 324
 325     b := a+1;
 326     Break;
 327    end;
 328
 329   if b = -1 then
 330   begin
 331    FreeMemory(ResCompressed);
 332    SetLength(FResTable, Length(FResTable)-1);
 333    Exit;
 334   end;
 335
 336   a := b;
 337  end;
 338
 339  if FResData = nil then FResData := AllocMem(ResCompressedSize)
 340   else ReallocMem(FResData, FDataSize+Cardinal(ResCompressedSize));
 341
 342  FDataSize := FDataSize+LongWord(ResCompressedSize);
 343  CopyMemory(Pointer(PChar(FResData)+FDataSize-PChar(ResCompressedSize)),
 344             ResCompressed, ResCompressedSize);
 345  FreeMemory(ResCompressed);
 346
 347  Inc(FHeader.RecordsCount);
 348
 349  with FResTable[a] do
 350  begin
 351   ResourceName := GetResName(Name);
 352   Address := FOffset;
 353   Length := ResCompressedSize;
 354  end;
 355
 356  FOffset := FOffset+Cardinal(ResCompressedSize);
 357
 358  Result := True;
 359 end;
 360
 361 procedure TWADEditor_1.AddSection(Name: string);
 362 begin
 363  if Name = '' then Exit;
 364
 365  Inc(FHeader.RecordsCount);
 366
 367  SetLength(FResTable, Length(FResTable)+1);
 368  with FResTable[High(FResTable)] do
 369  begin
 370   ResourceName := GetResName(Name);
 371   Address := $00000000;
 372   Length := $00000000;
 373  end;
 374 end;
 375
 376 constructor TWADEditor_1.Create();
 377 begin
 378  FResData := nil;
 379  FResTable := nil;
 380  FDataSize := 0;
 381  FOffset := 0;
 382  FHeader.RecordsCount := 0;
 383  FFileName := '';
 384  FWADOpened := DFWAD_OPENED_NONE;
 385  FLastError := DFWAD_NOERROR;
 386  FVersion := DFWAD_VERSION;
 387 end;
 388
 389 procedure TWADEditor_1.CreateImage();
 390 var
 391   WADFile: File;
 392   b: LongWord;
 393 begin
 394  if FWADOpened = DFWAD_OPENED_NONE then
 395  begin
 396   FLastError := DFWAD_ERROR_WADNOTLOADED;
 397   Exit;
 398  end;
 399
 400  if FWADOpened = DFWAD_OPENED_MEMORY then Exit;
 401
 402  if FResData <> nil then FreeMem(FResData);
 403
 404  try
 405   AssignFile(WADFile, FFileName);
 406   Reset(WADFile, 1);
 407
 408   b := 6+SizeOf(TWADHeaderRec_1)+SizeOf(TResourceTableRec_1)*Length(FResTable);
 409
 410   FDataSize := LongWord(FileSize(WADFile))-b;
 411
 412   GetMem(FResData, FDataSize);
 413
 414   Seek(WADFile, b);
 415   BlockRead(WADFile, FResData^, FDataSize);
 416
 417   CloseFile(WADFile);
 418
 419   FOffset := FDataSize;
 420  except
 421   FLastError := DFWAD_ERROR_CANTOPENWAD;
 422   CloseFile(WADFile);
 423   Exit;
 424  end;
 425
 426  FLastError := DFWAD_NOERROR;
 427 end;
 428
 429 destructor TWADEditor_1.Destroy();
 430 begin
 431  FreeWAD();
 432
 433  inherited;
 434 end;
 435
 436 procedure TWADEditor_1.FreeWAD();
 437 begin
 438  if FResData <> nil then FreeMem(FResData);
 439  FResTable := nil;
 440  FDataSize := 0;
 441  FOffset := 0;
 442  FHeader.RecordsCount := 0;
 443  FFileName := '';
 444  FWADOpened := DFWAD_OPENED_NONE;
 445  FLastError := DFWAD_NOERROR;
 446  FVersion := DFWAD_VERSION;
 447 end;
 448
 449 function TWADEditor_1.GetResName(ResName: string): Char16;
 450 begin
 451  ZeroMemory(@Result[0], 16);
 452  if ResName = '' then Exit;
 453
 454  ResName := Trim(UpperCase(ResName));
 455  if Length(ResName) > 16 then SetLength(ResName, 16);
 456
 457  CopyMemory(@Result[0], @ResName[1], Length(ResName));
 458 end;
 459
 460 function TWADEditor_1.HaveResource(Section, Resource: string): Boolean;
 461 var
 462   a: Integer;
 463   CurrentSection: string;
 464 begin
 465  Result := False;
 466
 467  if FResTable = nil then Exit;
 468
 469  CurrentSection := '';
 470  Section := AnsiUpperCase(Section);
 471  Resource := AnsiUpperCase(Resource);
 472
 473  for a := 0 to High(FResTable) do
 474  begin
 475   if FResTable[a].Length = 0 then
 476   begin
 477    CurrentSection := FResTable[a].ResourceName;
 478    Continue;
 479   end;
 480
 481   if (FResTable[a].ResourceName = Resource) and
 482      (CurrentSection = Section) then
 483   begin
 484    Result := True;
 485    Break;
 486   end;
 487  end;
 488 end;
 489
 490 function TWADEditor_1.HaveSection(Section: string): Boolean;
 491 var
 492   a: Integer;
 493 begin
 494  Result := False;
 495
 496  if FResTable = nil then Exit;
 497  if Section = '' then
 498  begin
 499   Result := True;
 500   Exit;
 501  end;
 502
 503  Section := AnsiUpperCase(Section);
 504
 505  for a := 0 to High(FResTable) do
 506   if (FResTable[a].Length = 0) and (FResTable[a].ResourceName = Section) then
 507   begin
 508    Result := True;
 509    Exit;
 510   end;
 511 end;
 512
 513 function TWADEditor_1.GetResource(Section, Resource: string;
 514   var pData: Pointer; var Len: Integer): Boolean;
 515 var
 516   a: LongWord;
 517   i: Integer;
 518   WADFile: File;
 519   CurrentSection: string;
 520   TempData: Pointer;
 521   OutBytes: Integer;
 522 begin
 523  Result := False;
 524
 525  CurrentSection := '';
 526
 527  if FWADOpened = DFWAD_OPENED_NONE then
 528  begin
 529   FLastError := DFWAD_ERROR_WADNOTLOADED;
 530   Exit;
 531  end;
 532
 533  Section := toLowerCase1251(Section);
 534  Resource := toLowerCase1251(Resource);
 535
 536  i := -1;
 537  for a := 0 to High(FResTable) do
 538  begin
 539   if FResTable[a].Length = 0 then
 540   begin
 541    CurrentSection := toLowerCase1251(FResTable[a].ResourceName);
 542    Continue;
 543   end;
 544
 545   if (toLowerCase1251(FResTable[a].ResourceName) = Resource) and
 546      (CurrentSection = Section) then
 547   begin
 548    i := a;
 549    Break;
 550   end;
 551  end;
 552
 553  if i = -1 then
 554  begin
 555   FLastError := DFWAD_ERROR_RESOURCENOTFOUND;
 556   Exit;
 557  end;
 558
 559  if FWADOpened = DFWAD_OPENED_FILE then
 560  begin
 561   try
 562    AssignFile(WADFile, FFileName);
 563    Reset(WADFile, 1);
 564
 565    Seek(WADFile, FResTable[i].Address+6+
 566         LongWord(SizeOf(TWADHeaderRec_1)+SizeOf(TResourceTableRec_1)*Length(FResTable)));
 567    TempData := GetMemory(FResTable[i].Length);
 568    BlockRead(WADFile, TempData^, FResTable[i].Length);
 569    DecompressBuf(TempData, FResTable[i].Length, 0, pData, OutBytes);
 570    FreeMem(TempData);
 571
 572    Len := OutBytes;
 573
 574    CloseFile(WADFile);
 575   except
 576    FLastError := DFWAD_ERROR_CANTOPENWAD;
 577    CloseFile(WADFile);
 578    Exit;
 579   end;
 580  end
 581   else
 582  begin
 583   TempData := GetMemory(FResTable[i].Length);
 584   CopyMemory(TempData, Pointer(PtrUInt(FResData)+FResTable[i].Address+6+
 585              PtrUInt(SizeOf(TWADHeaderRec_1)+SizeOf(TResourceTableRec_1)*Length(FResTable))),
 586              FResTable[i].Length);
 587   DecompressBuf(TempData, FResTable[i].Length, 0, pData, OutBytes);
 588   FreeMem(TempData);
 589
 590   Len := OutBytes;
 591  end;
 592
 593  FLastError := DFWAD_NOERROR;
 594  Result := True;
 595 end;
 596
 597 function TWADEditor_1.GetResourcesList(Section: string): SArray;
 598 var
 599   a: Integer;
 600   CurrentSection: Char16;
 601 begin
 602  Result := nil;
 603
 604  if FResTable = nil then Exit;
 605  if Length(Section) > 16 then Exit;
 606
 607  CurrentSection := '';
 608
 609  for a := 0 to High(FResTable) do
 610  begin
 611   if FResTable[a].Length = 0 then
 612   begin
 613    CurrentSection := FResTable[a].ResourceName;
 614    Continue;
 615   end;
 616
 617   if CurrentSection = Section then
 618   begin
 619    SetLength(Result, Length(Result)+1);
 620    Result[High(Result)] := FResTable[a].ResourceName;
 621   end;
 622  end;
 623 end;
 624
 625 function TWADEditor_1.GetSectionList(): SArray;
 626 var
 627   i: DWORD;
 628 begin
 629  Result := nil;
 630
 631  if FResTable = nil then Exit;
 632
 633  if FResTable[0].Length <> 0 then
 634  begin
 635   SetLength(Result, 1);
 636   Result[0] := '';
 637  end;
 638
 639  for i := 0 to High(FResTable) do
 640   if FResTable[i].Length = 0 then
 641   begin
 642    SetLength(Result, Length(Result)+1);
 643    Result[High(Result)] := FResTable[i].ResourceName;
 644   end;
 645 end;
 646
 647 function TWADEditor_1.LastErrorString(): string;
 648 begin
 649  case FLastError of
 650   DFWAD_NOERROR: Result := '';
 651   DFWAD_ERROR_WADNOTFOUND: Result := 'DFWAD file not found';
 652   DFWAD_ERROR_CANTOPENWAD: Result := 'Can''t open DFWAD file';
 653   DFWAD_ERROR_RESOURCENOTFOUND: Result := 'Resource not found';
 654   DFWAD_ERROR_FILENOTWAD: Result := 'File is not DFWAD';
 655   DFWAD_ERROR_WADNOTLOADED: Result := 'DFWAD file is not loaded';
 656   DFWAD_ERROR_READRESOURCE: Result := 'Read resource error';
 657   DFWAD_ERROR_READWAD: Result := 'Read DFWAD error';
 658  end;
 659 end;
 660
 661 function TWADEditor_1.ReadFile2(FileName: string): Boolean;
 662 var
 663   WADFile: File;
 664   Signature: array[0..4] of Char;
 665   a: Integer;
 666 begin
 667  FreeWAD();
 668
 669  Result := False;
 670
 671  if not FileExists(FileName) then
 672  begin
 673   FLastError := DFWAD_ERROR_WADNOTFOUND;
 674   Exit;
 675  end;
 676
 677  FFileName := FileName;
 678
 679  AssignFile(WADFile, FFileName);
 680
 681  try
 682   Reset(WADFile, 1);
 683  except
 684   FLastError := DFWAD_ERROR_CANTOPENWAD;
 685   Exit;
 686  end;
 687
 688  try
 689   BlockRead(WADFile, Signature, 5);
 690   if Signature <> DFWAD_SIGNATURE then
 691   begin
 692    FLastError := DFWAD_ERROR_FILENOTWAD;
 693    CloseFile(WADFile);
 694    Exit;
 695   end;
 696
 697   BlockRead(WADFile, FVersion, 1);
 698   if FVersion <> DFWAD_VERSION then
 699   begin
 700     FLastError := DFWAD_ERROR_WRONGVERSION;
 701     CloseFile(WADFile);
 702     Exit;
 703   end;
 704
 705   BlockRead(WADFile, FHeader, SizeOf(TWADHeaderRec_1));
 706   FHeader.RecordsCount := LEtoN(FHeader.RecordsCount);
 707   SetLength(FResTable, FHeader.RecordsCount);
 708   if FResTable <> nil then
 709   begin
 710    BlockRead(WADFile, FResTable[0], SizeOf(TResourceTableRec_1)*FHeader.RecordsCount);
 711
 712    for a := 0 to High(FResTable) do
 713    begin
 714     FResTable[a].Address := LEtoN(FResTable[a].Address);
 715     FResTable[a].Length := LEtoN(FResTable[a].Length);
 716     if FResTable[a].Length <> 0 then
 717      FResTable[a].Address := FResTable[a].Address-6-(LongWord(SizeOf(TWADHeaderRec_1)+
 718                              SizeOf(TResourceTableRec_1)*Length(FResTable)));
 719    end;
 720   end;
 721
 722   CloseFile(WADFile);
 723  except
 724   FLastError := DFWAD_ERROR_READWAD;
 725   CloseFile(WADFile);
 726   Exit;
 727  end;
 728
 729  FWADOpened := DFWAD_OPENED_FILE;
 730  FLastError := DFWAD_NOERROR;
 731  Result := True;
 732 end;
 733
 734 function TWADEditor_1.ReadMemory(Data: Pointer; Len: LongWord): Boolean;
 735 var
 736   Signature: array[0..4] of Char;
 737   a: Integer;
 738 begin
 739  FreeWAD();
 740
 741  Result := False;
 742
 743  CopyMemory(@Signature[0], Data, 5);
 744  if Signature <> DFWAD_SIGNATURE then
 745  begin
 746   FLastError := DFWAD_ERROR_FILENOTWAD;
 747   Exit;
 748  end;
 749
 750  CopyMemory(@FVersion, Pointer(PtrUInt(Data)+5), 1);
 751  if FVersion <> DFWAD_VERSION then
 752  begin
 753    FLastError := DFWAD_ERROR_WRONGVERSION;
 754    Exit;
 755  end;
 756
 757  CopyMemory(@FHeader, Pointer(PtrUInt(Data)+6), SizeOf(TWADHeaderRec_1));
 758  FHeader.RecordsCount := LEtoN(FHeader.RecordsCount);
 759
 760  SetLength(FResTable, FHeader.RecordsCount);
 761  if FResTable <> nil then
 762  begin
 763   CopyMemory(@FResTable[0], Pointer(PtrUInt(Data)+6+SizeOf(TWADHeaderRec_1)),
 764              SizeOf(TResourceTableRec_1)*FHeader.RecordsCount);
 765
 766   for a := 0 to High(FResTable) do
 767   begin
 768    FResTable[a].Address := LEtoN(FResTable[a].Address);
 769    FResTable[a].Length := LEtoN(FResTable[a].Length);
 770    if FResTable[a].Length <> 0 then
 771     FResTable[a].Address := FResTable[a].Address-6-(LongWord(SizeOf(TWADHeaderRec_1)+
 772                             SizeOf(TResourceTableRec_1)*Length(FResTable)));
 773   end;
 774  end;
 775
 776  GetMem(FResData, Len);
 777  CopyMemory(FResData, Data, Len);
 778
 779  FWADOpened := DFWAD_OPENED_MEMORY;
 780  FLastError := DFWAD_NOERROR;
 781
 782  Result := True;
 783 end;
 784
 785 procedure TWADEditor_1.RemoveResource(Section, Resource: string);
 786 var
 787   a, i: Integer;
 788   CurrentSection: Char16;
 789   b, c, d: LongWord;
 790 begin
 791  if FResTable = nil then Exit;
 792
 793  e_WriteLog('Fuck me (B) ' + Section + ' ' + Resource, MSG_NOTIFY);
 794
 795  i := -1;
 796  b := 0;
 797  c := 0;
 798  CurrentSection := '';
 799
 800  for a := 0 to High(FResTable) do
 801  begin
 802   if FResTable[a].Length = 0 then
 803   begin
 804    CurrentSection := FResTable[a].ResourceName;
 805    Continue;
 806   end;
 807
 808   if (FResTable[a].ResourceName = Resource) and
 809      (CurrentSection = Section) then
 810   begin
 811    i := a;
 812    b := FResTable[a].Length;
 813    c := FResTable[a].Address;
 814    Break;
 815   end;
 816  end;
 817
 818  if i = -1 then Exit;
 819
 820  e_WriteLog('Fuck me (C) ' + Section + ' ' + Resource, MSG_NOTIFY);
 821
 822  for a := i to High(FResTable)-1 do
 823   FResTable[a] := FResTable[a+1];
 824
 825  SetLength(FResTable, Length(FResTable)-1);
 826
 827  d := 0;
 828  for a := 0 to High(FResTable) do
 829   if (FResTable[a].Length <> 0) and (FResTable[a].Address > c) then
 830   begin
 831    FResTable[a].Address := FResTable[a].Address-b;
 832    d := d+FResTable[a].Length;
 833   end;
 834
 835  CopyMemory(Pointer(PtrUInt(FResData)+c), Pointer(PtrUInt(FResData)+c+b), d);
 836
 837  FDataSize := FDataSize-b;
 838  FOffset := FOffset-b;
 839  ReallocMem(FResData, FDataSize);
 840
 841  FHeader.RecordsCount := FHeader.RecordsCount-1;
 842 end;
 843
 844 procedure TWADEditor_1.SaveTo(FileName: string);
 845 var
 846   WADFile: File;
 847   sign: string;
 848   ver: Byte;
 849   Header, HeaderLE: TWADHeaderRec_1;
 850   i: Integer;
 851 begin
 852  sign := DFWAD_SIGNATURE;
 853  ver := DFWAD_VERSION;
 854
 855  Header.RecordsCount := Length(FResTable);
 856  HeaderLE := Header;
 857  HeaderLE.RecordsCount := NtoLE(HeaderLE.RecordsCount);
 858
 859  if FResTable <> nil then
 860   for i := 0 to High(FResTable) do
 861   begin
 862    if FResTable[i].Length <> 0 then
 863     FResTable[i].Address := FResTable[i].Address+6+SizeOf(TWADHeaderRec_1)+
 864                             SizeOf(TResourceTableRec_1)*Header.RecordsCount;
 865 {$IFDEF FPC_BIG_ENDIAN}
 866     FResTable[i].Address := NtoLE(FResTable[i].Address);
 867     FResTable[i].Length := NtoLE(FResTable[i].Length);
 868 {$ENDIF}
 869   end;
 870
 871  AssignFile(WADFile, FileName);
 872  Rewrite(WADFile, 1);
 873   BlockWrite(WADFile, sign[1], 5);
 874   BlockWrite(WADFile, ver, 1);
 875   BlockWrite(WADFile, HeaderLE, SizeOf(TWADHeaderRec_1));
 876   if FResTable <> nil then BlockWrite(WADFile, FResTable[0],
 877                                       SizeOf(TResourceTableRec_1)*Header.RecordsCount);
 878   if FResData <> nil then BlockWrite(WADFile, FResData^, FDataSize);
 879  CloseFile(WADFile);
 880
 881 {$IFDEF FPC_BIG_ENDIAN}
 882  // restore back to native endian
 883  if FResTable <> nil then
 884   for i := 0 to High(FResTable) do
 885   begin
 886     FResTable[i].Address := LEtoN(FResTable[i].Address);
 887     FResTable[i].Length := LEtoN(FResTable[i].Length);
 888   end;
 889 {$ENDIF}
 890 end;
 891
 892 function TWADEditor_1.GetLastError: Integer;
 893 begin
 894   Result := FLastError;
 895 end;
 896
 897 function TWADEditor_1.GetLastErrorStr: String;
 898 begin
 899   Result := LastErrorString();
 900 end;
 901
 902 function TWADEditor_1.GetResourcesCount: Word;
 903 begin
 904   Result := FHeader.RecordsCount;
 905 end;
 906
 907 function TWADEditor_1.GetVersion: Byte;
 908 begin
 909   Result := FVersion;
 910 end;
 911
 912 begin
 913   gWADEditorFactory.RegisterEditor('DFWAD', TWADEditor_1);
 914 end.