src/shared/WADEDITOR.pas

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