src/shared/WADEDITOR_dfzip.pas

   1 {$INCLUDE ../shared/a_modes.inc}
   2
   3 unit WADEDITOR_dfzip;
   4
   5 // Implementation restrictions:
   6 // - File must start with LFH or EOCD signature
   7 // - EOCD must be located strictly at the end of file
   8 // - Multi-disk ZIP files are not supported
   9 // - UTF-8 not supported yet, expected WIN1251 encoding
  10 // - ZIP64 not supported
  11 // - Encryption not supported
  12 // - Zero-length file names not supported
  13 // - CDR holds most actual data about file, LFH mostly ignored
  14 // - Attributes, comments and extra data are ignored and not saved
  15 // - Store and Deflate compression supported
  16
  17 interface
  18
  19   uses Classes, WADEDITOR;
  20
  21   type
  22     TResource = record
  23       name: AnsiString;
  24       pos: UInt32;
  25       csize: UInt32;
  26       usize: UInt32;
  27       comp: UInt32;
  28       chksum: UInt32;
  29       stream: TMemoryStream;
  30     end;
  31
  32     TSection = record
  33       name: AnsiString;
  34       list: array of TResource;
  35     end;
  36
  37     PResource = ^TResource;
  38     PSection = ^TSection;
  39
  40     TZIPEditor = class sealed(WADEDITOR.TWADEditor)
  41       private
  42         FSection: array of TSection;
  43         FStream: TStream;
  44         FLastError: Integer;
  45         FVersion: Byte;
  46
  47         function FindSectionIDRAW(name: AnsiString; caseSensitive: Boolean): Integer;
  48         function FindSectionRAW(name: AnsiString; caseSensitive: Boolean): PSection;
  49         function InsertSectionRAW(name: AnsiString): PSection;
  50
  51         function FindSectionID(name: AnsiString): Integer;
  52         function FindSection(name: AnsiString): PSection;
  53         function InsertSection(name: AnsiString): PSection;
  54
  55         function InsertFileInfo(const section, name: AnsiString; pos, csize, usize, comp, crc: UInt32): PResource;
  56         function Preload(p: PResource): Boolean;
  57         function GetSourceStream(p: PResource): TStream;
  58
  59         procedure ReadLFH(s: TStream; fname: AnsiString; xcsize, xusize, xcomp, xcrc: UInt32);
  60         procedure ReadCDR(s: TStream; cdrid: Integer);
  61         function FindEOCD(s: TStream): Boolean;
  62         procedure ReadEOCD(s: TStream);
  63
  64         procedure WriteLFH(s: TStream; comp, crc, csize, usize: UInt32; const afname: AnsiString);
  65         procedure WriteCDR(s: TStream; comp, crc, csize, usize, eattr, offset: UInt32; const afname: AnsiString; cdrid: Integer);
  66         procedure SaveToStream(s: TStream);
  67
  68       public
  69         constructor Create();
  70         destructor Destroy(); override;
  71         procedure FreeWAD(); override;
  72         function  ReadFile2(FileName: string): Boolean; override;
  73         function  ReadMemory(Data: Pointer; Len: LongWord): Boolean; override;
  74         procedure CreateImage(); override;
  75         function AddResource(Data: Pointer; Len: LongWord; Name, Section: String): Boolean; override; overload;
  76         function AddResource(FileName, Name, Section: String): Boolean; override; overload;
  77         function AddAlias(Res, Alias: String): Boolean; override;
  78         procedure AddSection(Name: String); override;
  79         procedure RemoveResource(Section, Resource: String); override;
  80         procedure SaveTo(FileName: String); override;
  81         function HaveResource(Section, Resource: String): Boolean; override;
  82         function HaveSection(Section: string): Boolean; override;
  83         function GetResource(Section, Resource: String; var pData: Pointer; var Len: Integer): Boolean; override;
  84         function GetSectionList(): SArray; override;
  85         function GetResourcesList(Section: String): SArray; override;
  86
  87         function GetLastError: Integer; override;
  88         function GetLastErrorStr: String; override;
  89         function GetResourcesCount: Word; override;
  90         function GetVersion: Byte; override;
  91     end;
  92
  93 implementation
  94
  95   uses SysUtils, StrUtils, utils, zstream, crc, e_log;
  96
  97   const
  98     ZIP_SIGN_CDR  = 'PK'#1#2;
  99     ZIP_SIGN_LFH  = 'PK'#3#4;
 100     ZIP_SIGN_EOCD = 'PK'#5#6;
 101
 102   const
 103     ZIP_COMP_STORE     = 0;
 104     ZIP_COMP_SHRUNK    = 1;
 105     ZIP_COMP_REDUCE1   = 2;
 106     ZIP_COMP_REDUCE2   = 3;
 107     ZIP_COMP_REDUCE3   = 4;
 108     ZIP_COMP_REDUCE4   = 5;
 109     ZIP_COMP_IMPLODE   = 6;
 110     ZIP_COMP_TOKENIZED = 7;
 111     ZIP_COMP_DEFLATE   = 8;
 112     ZIP_COMP_DEFLATE64 = 9;
 113     ZIP_COMP_TERSE1    = 10;
 114     ZIP_COMP_BZIP2     = 12;
 115     ZIP_COMP_LZMA      = 14;
 116     ZIP_COMP_CMPSC     = 16;
 117     ZIP_COMP_TERSE2    = 18;
 118     ZIP_COMP_LZ77      = 19;
 119     ZIP_COMP_ZSTD1     = 20;
 120     ZIP_COMP_ZSTD2     = 93;
 121     ZIP_COMP_MP3       = 94;
 122     ZIP_COMP_XZ        = 95;
 123     ZIP_COMP_JPEG      = 96;
 124     ZIP_COMP_WAVPACK   = 97;
 125     ZIP_COMP_PPMD      = 98;
 126     ZIP_COMP_AE        = 99;
 127
 128   const
 129     ZIP_SYSTEM     = 0;  // DOS / FAT
 130     ZIP_VERSION    = 20; // Min version
 131     ZIP_MAXVERSION = 63; // Max supported version
 132
 133   procedure ToSectionFile(fname: AnsiString; out section, name: AnsiString); inline;
 134     var i: SizeInt;
 135   begin
 136     i := LastDelimiter('/', fname);
 137     section := Copy(fname, 1, i - 1);
 138     name := Copy(fname, i + 1)
 139   end;
 140
 141   function GetFileName(const Section, Name: AnsiString): AnsiString; inline;
 142   begin
 143     if Section = '' then
 144       Result := Name
 145     else
 146       Result := Section + '/' + Name;
 147   end;
 148
 149   function PrepString(const s: AnsiString; caseSensitive, extSensitive: Boolean): AnsiString; inline;
 150     var i: Integer;
 151   begin
 152     Result := s;
 153     if caseSensitive = False then
 154     begin
 155       Result := UpperCase(Result);
 156     end;
 157     if extSensitive = False then
 158     begin
 159       i := Pos('.', Result); // fix dotfiles
 160       if i > 1 then
 161         SetLength(Result, i - 1);
 162     end;
 163   end;
 164
 165   function FindResourceIDRAW(p: PSection; name: AnsiString; caseSensitive, extSensitive: Boolean): Integer;
 166     var i: Integer; pname: AnsiString;
 167   begin
 168     if p <> nil then
 169     begin
 170       pname := PrepString(name, caseSensitive, extSensitive);
 171       for i := 0 to High(p.list) do
 172       begin
 173         if PrepString(p.list[i].name, caseSensitive, extSensitive) = pname then
 174         begin
 175           Result := i;
 176           exit;
 177         end;
 178       end;
 179     end;
 180     Result := -1;
 181   end;
 182
 183   function FindResourceID(p: PSection; name: AnsiString): Integer;
 184     var i: Integer;
 185   begin
 186     i := FindResourceIDRAW(p, name, True, True); // CaSeNaMe.Ext
 187     if i < 0 then
 188     begin
 189       i := FindResourceIDRAW(p, name, False, True); // CASENAME.EXT
 190       if i < 0 then
 191       begin
 192         i := FindResourceIDRAW(p, name, True, False); // CaSeNaMe
 193         if i < 0 then
 194         begin
 195           i := FindResourceIDRAW(p, name, False, False); // CASENAME
 196         end;
 197       end;
 198     end;
 199     Result := i;
 200   end;
 201
 202   function FindResource(p: PSection; name: AnsiString): PResource;
 203     var i: Integer;
 204   begin
 205     i := FindResourceID(p, name);
 206     if i >= 0 then
 207       Result := @p.list[i]
 208     else
 209       Result := nil;
 210   end;
 211
 212
 213
 214   function TZIPEditor.FindSectionIDRAW(name: AnsiString; caseSensitive: Boolean): Integer;
 215     var i: Integer; pname: AnsiString;
 216   begin
 217     if FSection <> nil then
 218     begin
 219       pname := PrepString(name, caseSensitive, True);
 220       for i := 0 to High(FSection) do
 221       begin
 222         if PrepString(FSection[i].name, caseSensitive, True) = pname then
 223         begin
 224           Result := i;
 225           exit;
 226         end;
 227       end;
 228     end;
 229     Result := -1;
 230   end;
 231
 232   function TZIPEditor.FindSectionRAW(name: AnsiString; caseSensitive: Boolean): PSection;
 233     var i: Integer;
 234   begin
 235     i := FindSectionIDRAW(name, caseSensitive);
 236     if i >= 0 then
 237       Result := @FSection[i]
 238     else
 239       Result := nil;
 240   end;
 241
 242   function TZIPEditor.InsertSectionRAW(name: AnsiString): PSection;
 243     var i: Integer;
 244   begin
 245     if FSection = nil then i := 0 else i := Length(FSection);
 246     SetLength(FSection, i + 1);
 247     FSection[i] := Default(TSection);
 248     FSection[i].name := name;
 249     Result := @FSection[i];
 250   end;
 251
 252
 253
 254   function TZIPEditor.FindSectionID(name: AnsiString): Integer;
 255     var fixName: AnsiString;
 256   begin
 257     fixName := StringReplace(name, '\', '/', [rfReplaceAll], TStringReplaceAlgorithm.sraManySmall);
 258     Result := FindSectionIDRAW(fixName, True); // CaSeNaMe
 259     if Result < 0 then
 260       Result := FindSectionIDRAW(fixName, False); // CASENAME
 261   end;
 262
 263   function TZIPEditor.FindSection(name: AnsiString): PSection;
 264     var fixName: AnsiString;
 265   begin
 266     fixName := StringReplace(name, '\', '/', [rfReplaceAll], TStringReplaceAlgorithm.sraManySmall);
 267     Result := FindSectionRAW(fixName, True); // CaSeNaMe
 268     if Result = nil then
 269       Result := FindSectionRAW(fixName, False); // CASENAME
 270   end;
 271
 272   function TZIPEditor.InsertSection(name: AnsiString): PSection;
 273   begin
 274     Result := FindSection(name);
 275     if Result = nil then
 276       Result := InsertSectionRAW(name);
 277   end;
 278
 279
 280
 281   function TZIPEditor.InsertFileInfo(const section, name: AnsiString; pos, csize, usize, comp, crc: UInt32): PResource;
 282     var p: PSection; i: Integer;
 283   begin
 284     p := FindSectionRAW(section, True);
 285     if p = nil then
 286       p := InsertSectionRAW(section);
 287     if p.list = nil then i := 0 else i := Length(p.list);
 288     SetLength(p.list, i + 1);
 289     p.list[i] := Default(TResource);
 290     p.list[i].name := name;
 291     p.list[i].pos := pos;
 292     p.list[i].csize := csize;
 293     p.list[i].usize := usize;
 294     p.list[i].comp := comp;
 295     p.list[i].chksum := crc;
 296     p.list[i].stream := nil;
 297     Result := @p.list[i];
 298   end;
 299
 300
 301
 302   function TZIPEditor.AddAlias(Res, Alias: String): Boolean;
 303   begin
 304     // Hard-links not supported in ZIP
 305     // However, they never created by editor
 306     Result := False;
 307   end;
 308
 309   function TZIPEditor.AddResource(Data: Pointer; Len: LongWord; Name, Section: String): Boolean;
 310     const compress: Boolean = True;
 311     const level: TCompressionLevel = TCompressionLevel.clMax;
 312     var s: TMemoryStream; cs: TCompressionStream; p: PResource;
 313     var comp, crc: UInt32;
 314   begin
 315     Result := False;
 316     if Name <> '' then
 317     begin
 318       s := TMemoryStream.Create();
 319       try
 320         if compress and (Len > 0) then
 321         begin
 322           cs := TCompressionStream.Create(level, s, True);
 323           try
 324             cs.WriteBuffer(PByte(Data)[0], Len);
 325             cs.Flush();
 326             comp := ZIP_COMP_DEFLATE;
 327           finally
 328             cs.Free();
 329           end;
 330         end;
 331         if (Len = 0) or (compress = False) or (s.Size >= Len) then
 332         begin
 333           s.Seek(0, TSeekOrigin.soBeginning);
 334           s.SetSize(Len);
 335           s.WriteBuffer(PByte(Data)[0], Len);
 336           comp := ZIP_COMP_STORE;
 337           Assert(s.Size = Len);
 338         end;
 339         crc := crc32(0, nil, 0);
 340         crc := crc32(crc, data, len);
 341         p := InsertFileInfo(Section, Name, $ffffffff, s.Size, Len, comp, crc);
 342         p.stream := s;
 343         Result := True;
 344       except
 345         s.Free();
 346         raise;
 347       end;
 348     end;
 349   end;
 350
 351   function TZIPEditor.AddResource(FileName, Name, Section: String): Boolean;
 352     var s: TFileStream; ptr: PByte;
 353   begin
 354     Result := False;
 355     FLastError := DFWAD_ERROR_READWAD;
 356     try
 357       s := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
 358       try
 359         GetMem(ptr, s.Size);
 360         try
 361           s.ReadBuffer(ptr[0], s.Size);
 362           Result := AddResource(ptr, s.Size, Name, Section);
 363           if Result = True then FLastError := DFWAD_NOERROR;
 364         finally
 365           FreeMem(ptr);
 366         end;
 367       finally
 368         s.Free();
 369       end;
 370     except
 371       on e: EFOpenError do
 372       begin
 373         if gWADEditorLogLevel >= DFWAD_LOG_INFO then
 374           e_WriteLog('DFZIP: AddResource: failed to open file ' + FileName, MSG_NOTIFY);
 375         FLastError := DFWAD_ERROR_CANTOPENWAD;
 376       end;
 377     end;
 378   end;
 379
 380   constructor TZIPEditor.Create();
 381   begin
 382     FSection := nil;
 383     FStream := nil;
 384     FLastError := DFWAD_NOERROR;
 385     FVersion := ZIP_VERSION;
 386     FreeWAD();
 387   end;
 388
 389   destructor TZIPEditor.Destroy();
 390   begin
 391     FreeWAD();
 392     inherited;
 393   end;
 394
 395   procedure TZIPEditor.FreeWAD();
 396     var i, j: Integer;
 397   begin
 398     if FSection <> nil then
 399     begin
 400       for i := 0 to High(FSection) do
 401       begin
 402         if FSection[i].list <> nil then
 403         begin
 404           for j := 0 to High(FSection[i].list) do
 405           begin
 406             if FSection[i].list[j].stream <> nil then
 407             begin
 408               FreeAndNil(FSection[i].list[j].stream);
 409             end;
 410           end;
 411           SetLength(FSection[i].list, 0);
 412         end;
 413       end;
 414       SetLength(FSection, 0);
 415     end;
 416     if FStream <> nil then
 417     begin
 418       FreeAndNil(FStream);
 419     end;
 420     FLastError := DFWAD_NOERROR;
 421     FVersion := ZIP_VERSION;
 422   end;
 423
 424   function TZIPEditor.Preload(p: PResource): Boolean;
 425     var s: TMemoryStream;
 426   begin
 427     Result := False;
 428     if p <> nil then
 429     begin
 430       Result := p.stream <> nil;
 431       if (p.stream = nil) and (FStream <> nil) then
 432       begin
 433         s := TMemoryStream.Create();
 434         try
 435           if p.csize > 0 then
 436           begin
 437             FStream.Seek(p.pos, TSeekOrigin.soBeginning);
 438             s.CopyFrom(FStream, p.csize);
 439           end;
 440           Assert(s.Size = p.csize); // wtf, random size if copied zero bytes!
 441           p.stream := s;
 442           Result := True;
 443         except
 444           s.Free();
 445         end;
 446       end;
 447     end;
 448   end;
 449
 450   procedure TZIPEditor.CreateImage();
 451     var i, j: Integer;
 452   begin
 453     if FStream = nil then
 454     begin
 455       if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
 456         e_WriteLog('DFZIP: CreateImage: File not assigned', MSG_NOTIFY);
 457       FLastError := DFWAD_ERROR_WADNOTLOADED;
 458     end
 459     else if FStream is TMemoryStream then
 460     begin
 461       if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
 462         e_WriteLog('DFZIP: CreateImage: Memory stream', MSG_NOTIFY);
 463       FLastError := DFWAD_NOERROR;
 464     end
 465     else
 466     begin
 467       if FSection <> nil then
 468       begin
 469         for i := 0 to High(FSection) do
 470         begin
 471           if FSection[i].list <> nil then
 472           begin
 473             for j := 0 to High(FSection[i].list) do
 474             begin
 475               if Preload(@FSection[i].list[j]) = False then
 476               begin
 477                 if gWADEditorLogLevel >= DFWAD_LOG_WARN then
 478                   e_WriteLog('DFZIP: CreateImage: failed to preload resource [' + FSection[i].name + '][' + FSection[i].list[j].name + ']', MSG_WARNING);
 479                 FLastError := DFWAD_ERROR_CANTOPENWAD;
 480                 exit;
 481               end;
 482             end;
 483           end;
 484         end;
 485       end;
 486       FreeAndNil(FStream);
 487       FLastError := DFWAD_NOERROR;
 488     end;
 489   end;
 490
 491   procedure TZIPEditor.AddSection(Name: String);
 492   begin
 493     if InsertSection(Name) = nil then
 494       raise Exception.Create('DFZIP: AddSection[' + Name + ']: failed to insert');
 495   end;
 496
 497   function TZIPEditor.HaveResource(Section, Resource: String): Boolean;
 498   begin
 499     Result := FindResource(FindSection(Section), Resource) <> nil;
 500   end;
 501
 502   function TZIPEditor.HaveSection(Section: String): Boolean;
 503   begin
 504     Result := FindSection(Section) <> nil;
 505   end;
 506
 507   function TZIPEditor.GetSourceStream(p: PResource): TStream;
 508     var src: TStream;
 509   begin
 510     src := nil;
 511     if p.stream <> nil then
 512     begin
 513       src := p.stream;
 514       src.Seek(0, TSeekOrigin.soBeginning);
 515     end
 516     else if FStream <> nil then
 517     begin
 518       src := FStream;
 519       src.Seek(p.pos, TSeekOrigin.soBeginning);
 520     end;
 521     Result := src;
 522   end;
 523
 524   function TZIPEditor.GetResource(Section, Resource: String; var pData: Pointer; var Len: Integer): Boolean;
 525     var p: PResource; ptr: PByte; src: TStream; tmp: TDecompressionStream; crc: UInt32;
 526   begin
 527     FLastError := DFWAD_ERROR_CANTOPENWAD;
 528     Result := False;
 529     pData := nil;
 530     Len := 0;
 531     p := FindResource(FindSection(Section), Resource);
 532     if p <> nil then
 533     begin
 534       src := GetSourceStream(p);
 535       if src <> nil then
 536       begin
 537         case p.comp of
 538           ZIP_COMP_STORE:
 539             begin
 540               Assert(p.csize = p.usize);
 541               GetMem(ptr, p.usize);
 542               try
 543                 try
 544                   src.ReadBuffer(ptr[0], p.usize);
 545                   Result := True;
 546                 except
 547                   FreeMem(ptr);
 548                   raise;
 549                 end;
 550               except on e: EReadError do
 551                 if gWADEditorLogLevel >= DFWAD_LOG_WARN then
 552                   e_WriteLog('DFZIP: Failed to read STOREd data, reason: ' + e.Message, MSG_WARNING);
 553               end;
 554             end;
 555           ZIP_COMP_DEFLATE:
 556             try
 557               tmp := TDecompressionStream.Create(src, True);
 558               try
 559                 GetMem(ptr, p.usize);
 560                 try
 561                   tmp.ReadBuffer(ptr[0], p.usize);
 562                   Result := True;
 563                 except
 564                   FreeMem(ptr);
 565                   raise;
 566                 end;
 567               finally
 568                 tmp.Free();
 569               end;
 570             except
 571               on e: EStreamError do
 572               begin
 573                 if gWADEditorLogLevel >= DFWAD_LOG_INFO then
 574                   e_WriteLog('DFZIP: Failed to decompress DEFLATEd data, reason: ' + e.Message, MSG_WARNING);
 575                 raise e;
 576               end;
 577             end;
 578           otherwise
 579             if gWADEditorLogLevel >= DFWAD_LOG_INFO then
 580               e_WriteLog('DFZIP: Unsupported compression method: ' + IntToStr(p.comp), MSG_WARNING);
 581         end;
 582       end
 583       else
 584       begin
 585         if gWADEditorLogLevel >= DFWAD_LOG_WARN then
 586           e_WriteLog('DFZIP: No available source for file data', MSG_WARNING);
 587         FLastError := DFWAD_ERROR_WADNOTLOADED;
 588       end;
 589       if Result = True then
 590       begin
 591         crc := crc32(0, nil, 0);
 592         crc := crc32(crc, ptr, p.usize);
 593         Result := crc = p.chksum;
 594         if Result = True then
 595         begin
 596           pData := ptr;
 597           Len := p.usize;
 598           FLastError := DFWAD_NOERROR;
 599         end
 600         else
 601         begin
 602           if gWADEditorLogLevel >= DFWAD_LOG_INFO then
 603             e_WriteLog('DFZIP: File integrity check failed: expected CRC32 $' + IntToHex(p.chksum, 8) + ', calculated CRC32 $' + IntToHex(crc, 8), MSG_WARNING);
 604           FreeMem(ptr);
 605         end;
 606       end;
 607     end
 608     else
 609     begin
 610       if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
 611         e_WriteLog('DFZIP: Resource not found', MSG_NOTIFY);
 612       FLastError := DFWAD_ERROR_RESOURCENOTFOUND;
 613     end;
 614   end;
 615
 616   function TZIPEditor.GetResourcesList(Section: String): SArray;
 617     var p: PSection; i: Integer;
 618   begin
 619     Result := nil;
 620     p := FindSection(Section);
 621     if (p <> nil) and (p.list <> nil) then
 622     begin
 623       SetLength(Result, Length(p.list));
 624       for i := 0 to High(p.list) do
 625       begin
 626         Result[i] := p.list[i].name;
 627       end;
 628     end;
 629   end;
 630
 631   function TZIPEditor.GetSectionList(): SArray;
 632     var i: Integer;
 633   begin
 634     Result := nil;
 635     if FSection <> nil then
 636     begin
 637       SetLength(Result, Length(FSection));
 638       for i := 0 to High(FSection) do
 639       begin
 640         Result[i] := FSection[i].name;
 641       end;
 642     end;
 643   end;
 644
 645   procedure TZIPEditor.ReadLFH(s: TStream; fname: AnsiString; xcsize, xusize, xcomp, xcrc: UInt32);
 646     var sig: packed array [0..3] of Char;
 647     var va, vb, flags, comp: UInt16;
 648     var mtime, crc, csize, usize: UInt32;
 649     var fnlen, extlen: UInt16;
 650     var mypos, datapos: UInt64;
 651     var section, name: AnsiString;
 652     var p: Pointer;
 653   begin
 654     mypos := s.Position;
 655     if mypos + 30 <= s.Size then
 656     begin
 657       s.ReadBuffer(sig[0], 4);
 658       if sig = ZIP_SIGN_LFH then
 659       begin
 660         va := s.ReadByte(); // Min Version
 661         vb := s.ReadByte(); // Min System
 662         flags := LEtoN(s.ReadWord());
 663         comp := LEtoN(s.ReadWord());
 664         mtime := LEtoN(s.ReadDWord());
 665         crc := LEtoN(s.ReadDWord());
 666         csize := LEtoN(s.ReadDWord());
 667         usize := LEtoN(s.ReadDWord());
 668         fnlen := LEtoN(s.ReadWord());
 669         extlen := LEtoN(s.ReadWord());
 670         datapos := s.Position + fnlen + extlen;
 671         if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
 672         begin
 673           e_WriteLog('LFH   @' + IntToHex(mypos, 8) + ': Min Version       : ' + IntToStr(va), MSG_NOTIFY);
 674           e_WriteLog('LFH   @' + IntToHex(mypos, 8) + ': Min System        : ' + IntToStr(vb), MSG_NOTIFY);
 675           e_WriteLog('LFH   @' + IntToHex(mypos, 8) + ': Flags             : $' + IntToHex(flags, 4), MSG_NOTIFY);
 676           e_WriteLog('LFH   @' + IntToHex(mypos, 8) + ': Compression       : ' + IntToStr(comp), MSG_NOTIFY);
 677           e_WriteLog('LFH   @' + IntToHex(mypos, 8) + ': Modification Time : $' + IntToHex(mtime, 8), MSG_NOTIFY);
 678           e_WriteLog('LFH   @' + IntToHex(mypos, 8) + ': CRC-32            : $' + IntToHex(crc, 8), MSG_NOTIFY);
 679           e_WriteLog('LFH   @' + IntToHex(mypos, 8) + ': Compressed size   : ' + IntToStr(csize), MSG_NOTIFY);
 680           e_WriteLog('LFH   @' + IntToHex(mypos, 8) + ': Decompressed size : ' + IntToStr(usize), MSG_NOTIFY);
 681           e_WriteLog('LFH   @' + IntToHex(mypos, 8) + ': Name Length       : ' + IntToStr(fnlen), MSG_NOTIFY);
 682           e_WriteLog('LFH   @' + IntToHex(mypos, 8) + ': Extension Length  : ' + IntToStr(extlen), MSG_NOTIFY);
 683           e_WriteLog('LFH   @' + IntToHex(mypos, 8) + ': <DATA OFFSET>     : $' + IntToHex(datapos, 8), MSG_NOTIFY);
 684         end;
 685         if (va >= 10) and (va <= ZIP_MAXVERSION) then
 686         begin
 687           if datapos + xcsize <= s.Size then
 688           begin
 689             ToSectionFile(fname, section, name);
 690             if name = '' then
 691             begin
 692               p := FindSectionRAW(section, True);
 693               if p = nil then
 694                 p := InsertSectionRAW(section)
 695             end
 696             else
 697             begin
 698               p := InsertFileInfo(section, name, datapos, xcsize, xusize, xcomp, xcrc);
 699             end;
 700             if p = nil then
 701               raise Exception.Create('Failed to register resource [' + fname + ']');
 702           end
 703           else
 704             raise Exception.Create('Invalid LFH size (corrupted file?)');
 705         end
 706         else
 707         begin
 708           FLastError := DFWAD_ERROR_WRONGVERSION;
 709           raise Exception.Create('Unsupported CDR version ' + IntToStr(va) + ', not in range [10..' + IntToStr(ZIP_MAXVERSION) + ']');
 710         end;
 711       end
 712       else
 713         raise Exception.Create('Invalid LFH signature $' +IntToHex(Ord(sig[0]), 2) + ' $' +IntToHex(Ord(sig[1]), 2) + ' $' +IntToHex(Ord(sig[2]), 2) + ' $' +IntToHex(Ord(sig[3]), 2) + ' (corrupted file?)');
 714     end
 715     else
 716       raise Exception.Create('Invalid LFH size (corrupted file?)');
 717   end;
 718
 719   procedure TZIPEditor.ReadCDR(s: TStream; cdrid: Integer);
 720     const ZIP_ENCRYPTION_MASK = (1 << 0) or (1 << 6) or (1 << 13);
 721     var sig: packed array [0..3] of Char;
 722     var vva, vvb, va, vb, flags, comp: UInt16;
 723     var mtime, crc, csize, usize: UInt32;
 724     var fnlen, extlen, comlen, disk, iattr: UInt16;
 725     var eattr, offset: UInt32;
 726     var mypos, next: UInt64;
 727     var name: PChar;
 728   begin
 729     mypos := s.Position;
 730     s.ReadBuffer(sig[0], 4);
 731     if sig = ZIP_SIGN_CDR then
 732     begin
 733       // Valid Central Directory Signature
 734       vva := s.ReadByte(); // Writer Version
 735       vvb := s.ReadByte(); // Writer System
 736       va := s.ReadByte();  // Min Version
 737       vb := s.ReadByte();  // Min System
 738       flags := LEtoN(s.ReadWord());
 739       comp := LEtoN(s.ReadWord());
 740       mtime := LEtoN(s.ReadDWord());
 741       crc := LEtoN(s.ReadDWord());
 742       csize := LEtoN(s.ReadDWord());
 743       usize := LEtoN(s.ReadDWord());
 744       fnlen := LEtoN(s.ReadWord());
 745       extlen := LEtoN(s.ReadWord());
 746       comlen := LEtoN(s.ReadWord());
 747       disk := LEtoN(s.ReadWord());
 748       iattr := LEtoN(s.ReadWord());
 749       eattr := LEtoN(s.ReadDWord());
 750       offset := LEtoN(s.ReadDWord());
 751       next := s.Position + fnlen + extlen + comlen;
 752       FVersion := va;
 753       if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
 754       begin
 755         e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Writer Version    : ' + IntToStr(vva), MSG_NOTIFY);
 756         e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Writer System     : ' + IntToStr(vvb), MSG_NOTIFY);
 757         e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Min Version       : ' + IntToStr(va), MSG_NOTIFY);
 758         e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Min System        : ' + IntToStr(vb), MSG_NOTIFY);
 759         e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Flags             : $' + IntToHex(flags, 4), MSG_NOTIFY);
 760         e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Compression       : ' + IntToStr(comp), MSG_NOTIFY);
 761         e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Modification Time : $' + IntToHex(mtime, 8), MSG_NOTIFY);
 762         e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': CRC-32            : $' + IntToHex(crc, 8), MSG_NOTIFY);
 763         e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Compressed size   : ' + IntToStr(csize), MSG_NOTIFY);
 764         e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Decompressed size : ' + IntToStr(usize), MSG_NOTIFY);
 765         e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Name Length       : ' + IntToStr(fnlen), MSG_NOTIFY);
 766         e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Extension Length  : ' + IntToStr(extlen), MSG_NOTIFY);
 767         e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Comment Length    : ' + IntToStr(comlen), MSG_NOTIFY);
 768         e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Disk              : ' + IntToStr(disk), MSG_NOTIFY);
 769         e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Internal Attrib   : $' + IntToHex(iattr, 4), MSG_NOTIFY);
 770         e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': External Attrib   : $' + IntToHex(eattr, 8), MSG_NOTIFY);
 771         e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': LFH Offset        : $' + IntToHex(offset, 8), MSG_NOTIFY);
 772       end;
 773       if (va >= 10) and (va <= ZIP_MAXVERSION) then
 774       begin
 775         if (flags and ZIP_ENCRYPTION_MASK) = 0 then
 776         begin
 777           if (csize <> $ffffffff) and (usize <> $ffffffff) and (disk <> $ffff) and (offset <> $ffffffff) then
 778           begin
 779             if disk = 0 then
 780             begin
 781               if (next <= s.Size) and (fnlen > 0) then
 782               begin
 783                 case comp of
 784                   ZIP_COMP_STORE:
 785                     if csize <> usize then
 786                       raise Exception.Create('Compressed size ' + IntToStr(csize) + ' != Descompressed size ' + IntToStr(usize) + 'for STORE method (corrupted file?)');
 787                   ZIP_COMP_SHRUNK,
 788                   ZIP_COMP_REDUCE1,
 789                   ZIP_COMP_REDUCE2,
 790                   ZIP_COMP_REDUCE3,
 791                   ZIP_COMP_REDUCE4,
 792                   ZIP_COMP_IMPLODE,
 793                   ZIP_COMP_DEFLATE,
 794                   ZIP_COMP_DEFLATE64,
 795                   ZIP_COMP_TERSE1,
 796                   ZIP_COMP_BZIP2,
 797                   ZIP_COMP_LZMA,
 798                   ZIP_COMP_CMPSC,
 799                   ZIP_COMP_TERSE2,
 800                   ZIP_COMP_LZ77,
 801                   ZIP_COMP_ZSTD1,
 802                   ZIP_COMP_ZSTD2,
 803                   ZIP_COMP_MP3,
 804                   ZIP_COMP_XZ,
 805                   ZIP_COMP_JPEG,
 806                   ZIP_COMP_WAVPACK,
 807                   ZIP_COMP_PPMD:
 808                     ; // ok
 809                   ZIP_COMP_AE:
 810                     raise Exception.Create('Encrypted archives not supported');
 811                   otherwise
 812                     raise Exception.Create('Unknown compression method ' + IntToStr(comp));
 813                 end;
 814                 // TODO: check bit 11 (UTF8 name and comment)
 815                 GetMem(name, UInt32(fnlen) + 1);
 816                 try
 817                   s.ReadBuffer(name[0], fnlen);
 818                   name[fnlen] := #0;
 819                   if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
 820                     e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Name              : "' + name + '"', MSG_NOTIFY);
 821                   s.Seek(offset, TSeekOrigin.soBeginning);
 822                   ReadLFH(s, name, csize, usize, comp, crc);
 823                 finally
 824                   s.Seek(next, TSeekOrigin.soBeginning);
 825                   FreeMem(name);
 826                 end;
 827               end
 828               else
 829                 raise Exception.Create('Empty files names not supported');
 830             end
 831             else
 832               raise Exception.Create('Splitted archives not supported');
 833           end
 834           else
 835           begin
 836             FLastError := DFWAD_ERROR_WRONGVERSION;
 837             raise Exception.Create('ZIP64 not supported');
 838           end;
 839         end
 840         else
 841         begin
 842           FLastError := DFWAD_ERROR_READWAD;
 843           raise Exception.Create('Encrypted archives not supported');
 844         end;
 845       end
 846       else
 847       begin
 848         FLastError := DFWAD_ERROR_WRONGVERSION;
 849         raise Exception.Create('Unsupported CDR version ' + IntToStr(va) + ', not in range [10..' + IntToStr(ZIP_MAXVERSION) + ']');
 850       end;
 851     end
 852     else
 853       raise Exception.Create('Invalid CDR signature $' + IntToHex(Ord(sig[0]), 2) + ' $' +IntToHex(Ord(sig[1]), 2) + ' $' +IntToHex(Ord(sig[2]), 2) + ' $' +IntToHex(Ord(sig[3]), 2) + ' (corrupted file?)');
 854   end;
 855
 856   function TZIPEditor.FindEOCD(s: TStream): Boolean;
 857     const maxedir = 20; // end of central directory entry
 858     const maxecdir = maxedir + 65536; // + comment
 859     var sig: packed array [0..3] of Char; off, lim: Int64;
 860   begin
 861     Result := False;
 862     if s.Size >= maxedir then
 863     begin
 864       if s.Size < maxecdir then lim := s.Size else lim := maxecdir;
 865       lim := lim - maxedir;
 866       off := maxedir;
 867       while (off <= lim) and (Result = False) do
 868       begin
 869         s.Seek(s.Size - off, TSeekOrigin.soBeginning);
 870         s.ReadBuffer(sig[0], 4);
 871         Result := sig = ZIP_SIGN_EOCD;
 872         Inc(off);
 873       end;
 874     end;
 875   end;
 876
 877   procedure TZIPEditor.ReadEOCD(s: TStream);
 878     var sig: packed array [0..3] of Char;
 879     var idisk, ndisk, nrec, total, comlen: UInt16;
 880     var csize, cpos, i: UInt32;
 881     var mypos: UInt64;
 882   begin
 883     FLastError := DFWAD_ERROR_FILENOTWAD;
 884     FVersion := 0;
 885     s.ReadBuffer(sig[0], 4);
 886     if (sig = ZIP_SIGN_LFH) or (sig = ZIP_SIGN_EOCD) then
 887     begin
 888       if FindEOCD(s) then
 889       begin
 890         // End of Central Directory found
 891         FLastError := DFWAD_ERROR_READWAD;
 892         mypos := s.Position - 4;
 893         idisk := LEtoN(s.ReadWord());
 894         ndisk := LEtoN(s.ReadWord());
 895         nrec := LEtoN(s.ReadWord());
 896         total := LEtoN(s.ReadWord());
 897         csize := LEtoN(s.ReadDWord());
 898         cpos := LEtoN(s.ReadDWord());
 899         comlen := LEtoN(s.ReadWord());
 900         if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
 901         begin
 902           e_WriteLog('==============================================', MSG_NOTIFY);
 903           e_WriteLog('EOCD  @' + IntToHex(mypos, 8) + ': Disk ID           : ' + IntToStr(idisk), MSG_NOTIFY);
 904           e_WriteLog('EOCD  @' + IntToHex(mypos, 8) + ': Disk ID with CD   : ' + IntToStr(ndisk), MSG_NOTIFY);
 905           e_WriteLog('EOCD  @' + IntToHex(mypos, 8) + ': Available CDR''s   : ' + IntToStr(nrec), MSG_NOTIFY);
 906           e_WriteLog('EOCD  @' + IntToHex(mypos, 8) + ': Total CDR''s       : ' + IntToStr(total), MSG_NOTIFY);
 907           e_WriteLog('EOCD  @' + IntToHex(mypos, 8) + ': CD Length         : ' + IntToStr(csize), MSG_NOTIFY);
 908           e_WriteLog('EOCD  @' + IntToHex(mypos, 8) + ': CD Offset         : $' + IntToHex(cpos, 8), MSG_NOTIFY);
 909           e_WriteLog('EOCD  @' + IntToHex(mypos, 8) + ': Comment Length    : ' + IntToStr(comlen), MSG_NOTIFY);
 910         end;
 911         if (idisk <> $ffff) and (ndisk <> $ffff) and (nrec <> $ffff) and (total <> $ffff) and (csize <> $ffffffff) and (cpos <> $ffffffff) then
 912         begin
 913           if s.Position + comlen = s.Size then
 914           begin
 915             if (idisk = 0) and (ndisk = 0) and (nrec = total) then
 916             begin
 917               if (nrec * 46 <= csize) and (UInt64(cpos) + csize <= s.Size) then
 918               begin
 919                 if total > 0 then
 920                 begin
 921                   i := 0;
 922                   s.Seek(cpos, TSeekOrigin.soBeginning);
 923                   while i < nrec do
 924                   begin
 925                     if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
 926                       e_WriteLog('==============================================', MSG_NOTIFY);
 927                     ReadCDR(s, i);
 928                     Inc(i);
 929                   end;
 930                   if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
 931                     e_WriteLog('==============================================', MSG_NOTIFY);
 932                 end;
 933               end
 934               else
 935                 raise Exception.Create('Central Directory too big (corrupted file?)');
 936             end
 937             else
 938               raise Exception.Create('Splitted archives not supported');
 939           end
 940           else
 941             raise Exception.Create('EOCD too big (corrupted file?)');
 942         end
 943         else
 944           raise Exception.Create('ZIP64 not supported');
 945       end
 946       else
 947         raise Exception.Create('EOCD not found (corrupted file?)');
 948     end
 949     else
 950       raise Exception.Create('Not DFZIP formated file');
 951   end;
 952
 953   function TZIPEditor.ReadFile2(FileName: String): Boolean;
 954     var s: TFileStream;
 955   begin
 956     FreeWAD();
 957     Result := False;
 958     try
 959       try
 960         s := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
 961         try
 962           ReadEOCD(s);
 963           FStream := s;
 964           FLastError := DFWAD_NOERROR;
 965           Result := True;
 966         except
 967           s.Free();
 968           raise;
 969         end;
 970       except
 971         on e: Exception do
 972         begin
 973           if gWADEditorLogLevel >= DFWAD_LOG_INFO then
 974             e_WriteLog('ZIP: Failed to read ZIP from file ' + FileName + ', reason: ' + e.Message, MSG_WARNING);
 975           FreeWAD();
 976         end;
 977       end;
 978     except
 979       on e: EFOpenError do
 980       begin
 981         if gWADEditorLogLevel >= DFWAD_LOG_INFO then
 982           e_WriteLog('DFZIP: Failed to open file ' + FileName + ', reason: ' + e.Message, MSG_WARNING);
 983         if FileExists(FileName) then
 984           FLastError := DFWAD_ERROR_CANTOPENWAD
 985         else
 986           FLastError := DFWAD_ERROR_WADNOTFOUND;
 987       end;
 988     end;
 989   end;
 990
 991   function TZIPEditor.ReadMemory(Data: Pointer; Len: LongWord): Boolean;
 992     var s: TMemoryStream;
 993   begin
 994     FreeWAD();
 995     Result := False;
 996     try
 997       s := TMemoryStream.Create;
 998       try
 999         s.SetSize(Len);
1000         s.WriteBuffer(PByte(Data)[0], Len);
1001         s.Seek(0, soBeginning);
1002         ReadEOCD(s);
1003         FStream := s;
1004         FLastError := DFWAD_NOERROR;
1005         Result := True;
1006       except
1007         s.Free();
1008         raise;
1009       end;
1010     except
1011       on e: Exception do
1012       begin
1013         if gWADEditorLogLevel >= DFWAD_LOG_INFO then
1014           e_WriteLog('DFZIP: Failed to read ZIP from memory, reason: ' + e.Message, MSG_WARNING);
1015         FreeWAD();
1016       end;
1017     end;
1018   end;
1019
1020   procedure TZIPEditor.RemoveResource(Section, Resource: String);
1021     var p: PSection; i: Integer;
1022   begin
1023     p := FindSection(Section);
1024     i := FindResourceID(p, Resource);
1025     if i >= 0 then
1026     begin
1027       if p.list[i].stream <> nil then
1028         FreeAndNil(p.list[i].stream);
1029       for i := i + 1 to High(p.list) do
1030       begin
1031         p.list[i - 1] := p.list[i];
1032       end;
1033       SetLength(p.list, High(p.list));
1034     end;
1035   end;
1036
1037   procedure TZIPEditor.WriteLFH(s: TStream; comp, crc, csize, usize: UInt32; const afname: AnsiString);
1038     var fname: PChar; fnlen: UInt16; mypos: UInt64;
1039   begin
1040     mypos := s.Position;
1041     fname := PChar(afname);
1042     fnlen := Length(fname);
1043     if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
1044     begin
1045       e_WriteLog('==============================================', MSG_NOTIFY);
1046       e_WriteLog('LFH   @' + IntToHex(mypos, 8) + ': Min Version       : ' + IntToStr(ZIP_VERSION), MSG_NOTIFY);
1047       e_WriteLog('LFH   @' + IntToHex(mypos, 8) + ': Min System        : ' + IntToStr(ZIP_SYSTEM), MSG_NOTIFY);
1048       e_WriteLog('LFH   @' + IntToHex(mypos, 8) + ': Flags             : $' + IntToHex(0, 4), MSG_NOTIFY);
1049       e_WriteLog('LFH   @' + IntToHex(mypos, 8) + ': Compression       : ' + IntToStr(comp), MSG_NOTIFY);
1050       e_WriteLog('LFH   @' + IntToHex(mypos, 8) + ': Modification Time : $' + IntToHex(0, 8), MSG_NOTIFY);
1051       e_WriteLog('LFH   @' + IntToHex(mypos, 8) + ': CRC-32            : $' + IntToHex(crc, 8), MSG_NOTIFY);
1052       e_WriteLog('LFH   @' + IntToHex(mypos, 8) + ': Compressed size   : ' + IntToStr(csize), MSG_NOTIFY);
1053       e_WriteLog('LFH   @' + IntToHex(mypos, 8) + ': Decompressed size : ' + IntToStr(usize), MSG_NOTIFY);
1054       e_WriteLog('LFH   @' + IntToHex(mypos, 8) + ': Name Length       : ' + IntToStr(fnlen), MSG_NOTIFY);
1055       e_WriteLog('LFH   @' + IntToHex(mypos, 8) + ': Extension Length  : ' + IntToStr(0), MSG_NOTIFY);
1056       e_WriteLog('LFH   @' + IntToHex(mypos, 8) + ': Name              : "' + fname + '"', MSG_NOTIFY);
1057     end;
1058     s.WriteBuffer(ZIP_SIGN_LFH, 4); // LFH Signature
1059     s.WriteByte(ZIP_VERSION);       // Min version
1060     s.WriteByte(ZIP_SYSTEM);        // System
1061     WriteInt(s, UInt16(0));         // Flags
1062     WriteInt(s, UInt16(comp));      // Compression method
1063     WriteInt(s, UInt32(0));         // Modification time/date
1064     WriteInt(s, UInt32(crc));       // CRC-32
1065     WriteInt(s, UInt32(csize));     // Compressed size
1066     WriteInt(s, UInt32(usize));     // Decompressed size
1067     WriteInt(s, UInt16(fnlen));     // Name field length
1068     WriteInt(s, UInt16(0));         // Extra field length
1069     s.WriteBuffer(fname[0], fnlen); // File Name
1070   end;
1071
1072   procedure TZIPEditor.WriteCDR(s: TStream; comp, crc, csize, usize, eattr, offset: UInt32; const afname: AnsiString; cdrid: Integer);
1073     var fname: PChar; fnlen: UInt16; mypos: UInt64;
1074   begin
1075     mypos := s.Position;
1076     fname := PChar(afname);
1077     fnlen := Length(fname);
1078     if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
1079     begin
1080       e_WriteLog('==============================================', MSG_NOTIFY);
1081       e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Writer Version    : ' + IntToStr(ZIP_MAXVERSION), MSG_NOTIFY);
1082       e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Writer System     : ' + IntToStr(ZIP_SYSTEM), MSG_NOTIFY);
1083       e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Min Version       : ' + IntToStr(ZIP_VERSION), MSG_NOTIFY);
1084       e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Min System        : ' + IntToStr(ZIP_SYSTEM), MSG_NOTIFY);
1085       e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Flags             : $' + IntToHex(0, 4), MSG_NOTIFY);
1086       e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Compression       : ' + IntToStr(comp), MSG_NOTIFY);
1087       e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Modification Time : $' + IntToHex(0, 8), MSG_NOTIFY);
1088       e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': CRC-32            : $' + IntToHex(crc, 8), MSG_NOTIFY);
1089       e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Compressed size   : ' + IntToStr(csize), MSG_NOTIFY);
1090       e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Decompressed size : ' + IntToStr(usize), MSG_NOTIFY);
1091       e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Name Length       : ' + IntToStr(fnlen), MSG_NOTIFY);
1092       e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Extension Length  : ' + IntToStr(0), MSG_NOTIFY);
1093       e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Comment Length    : ' + IntToStr(0), MSG_NOTIFY);
1094       e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Disk              : ' + IntToStr(0), MSG_NOTIFY);
1095       e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Internal Attrib   : $' + IntToHex(0, 4), MSG_NOTIFY);
1096       e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': External Attrib   : $' + IntToHex(eattr, 8), MSG_NOTIFY);
1097       e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': LFH Offset        : $' + IntToHex(offset, 8), MSG_NOTIFY);
1098       e_WriteLog('CDR#' + IntToStr(cdrid) + ' @' + IntToHex(mypos, 8) + ': Name              : "' + fname + '"', MSG_NOTIFY);
1099     end;
1100     s.WriteBuffer(ZIP_SIGN_CDR, 4); // CDR Signature
1101     s.WriteByte(ZIP_MAXVERSION);    // Used version
1102     s.WriteByte(ZIP_SYSTEM);        // Used system
1103     s.WriteByte(ZIP_VERSION);       // Min version
1104     s.WriteByte(ZIP_SYSTEM);        // Min system
1105     WriteInt(s, UInt16(0));         // Flags
1106     WriteInt(s, UInt16(comp));      // Compression method
1107     WriteInt(s, UInt32(0));         // Modification time/date
1108     WriteInt(s, UInt32(crc));       // CRC-32
1109     WriteInt(s, UInt32(csize));     // Compressed size
1110     WriteInt(s, UInt32(usize));     // Decompressed size
1111     WriteInt(s, UInt16(fnlen));     // Name field length
1112     WriteInt(s, UInt16(0));         // Extra field length
1113     WriteInt(s, UInt16(0));         // Comment field length
1114     WriteInt(s, UInt16(0));         // Disk
1115     WriteInt(s, UInt16(0));         // Internal attributes
1116     WriteInt(s, UInt32(eattr));     // External attributes
1117     WriteInt(s, UInt32(offset));    // LFH offset
1118     s.WriteBuffer(fname[0], fnlen); // File Name
1119   end;
1120
1121   procedure TZIPEditor.SaveToStream(s: TStream);
1122     var i, j: Integer;
1123     var start, offset, loffset, size, zcrc, count: UInt32;
1124     var p: PResource;
1125     var afname: AnsiString;
1126     var mypos: UInt64;
1127   begin
1128     // Write LFH headers and data
1129     start := s.Position;
1130     zcrc := crc32(0, nil, 0);
1131     if FSection <> nil then
1132     begin
1133       for i := 0 to High(FSection) do
1134       begin
1135         if FSection[i].list <> nil then
1136         begin
1137           for j := 0 to High(FSection[i].list) do
1138           begin
1139             p := @FSection[i].list[j];
1140             afname := GetFileName(FSection[i].name, p.name);
1141             WriteLFH(s, p.comp, p.chksum, p.csize, p.usize, afname);
1142             if p.stream <> nil then
1143             begin
1144               Assert(p.stream.Size = p.csize);
1145               p.stream.SaveToStream(s);
1146             end
1147             else if FStream <> nil then
1148             begin
1149               FStream.Seek(p.pos, TSeekOrigin.soBeginning);
1150               s.CopyFrom(FStream, p.csize);
1151             end
1152             else
1153             begin
1154               raise Exception.Create('No data source available (somethig very wrong)');
1155             end;
1156           end;
1157         end
1158         else
1159         begin
1160           afname := GetFileName(FSection[i].name, '');
1161           WriteLFH(s, ZIP_COMP_STORE, zcrc, 0, 0, afname);
1162         end;
1163       end;
1164     end;
1165     // Write CDR headers
1166     count := 0;
1167     loffset := 0;
1168     offset := s.Position - start;
1169     if FSection <> nil then
1170     begin
1171       for i := 0 to High(FSection) do
1172       begin
1173         if FSection[i].list <> nil then
1174         begin
1175           for j := 0 to High(FSection[i].list) do
1176           begin
1177             p := @FSection[i].list[j];
1178             afname := GetFileName(FSection[i].name, p.name);
1179             WriteCDR(s, p.comp, p.chksum, p.csize, p.usize, $00, loffset, afname, i);
1180             loffset := loffset + 30 + Length(afname) + p.csize;
1181             Inc(count);
1182           end;
1183         end
1184         else
1185         begin
1186           afname := GetFileName(FSection[i].name, '');
1187           WriteCDR(s, ZIP_COMP_STORE, zcrc, 0, 0, $10, loffset, afname, i);
1188           loffset := loffset + 30 + Length(afname) + 0;
1189           Inc(count);
1190         end;
1191       end;
1192     end;
1193     Assert(loffset = offset);
1194     Assert(count < $ffff);
1195     size := s.Position - start - offset;
1196     // Write EOCD header
1197     mypos := s.Position;
1198     if gWADEditorLogLevel >= DFWAD_LOG_DEBUG then
1199     begin
1200       e_WriteLog('==============================================', MSG_NOTIFY);
1201       e_WriteLog('EOCD  @' + IntToHex(mypos, 8) + ': Disk ID           : ' + IntToStr(0), MSG_NOTIFY);
1202       e_WriteLog('EOCD  @' + IntToHex(mypos, 8) + ': Disk ID with CD   : ' + IntToStr(0), MSG_NOTIFY);
1203       e_WriteLog('EOCD  @' + IntToHex(mypos, 8) + ': Available CDR''s   : ' + IntToStr(count), MSG_NOTIFY);
1204       e_WriteLog('EOCD  @' + IntToHex(mypos, 8) + ': Total CDR''s       : ' + IntToStr(count), MSG_NOTIFY);
1205       e_WriteLog('EOCD  @' + IntToHex(mypos, 8) + ': CD Length         : ' + IntToStr(size), MSG_NOTIFY);
1206       e_WriteLog('EOCD  @' + IntToHex(mypos, 8) + ': CD Offset         : $' + IntToHex(offset, 8), MSG_NOTIFY);
1207       e_WriteLog('EOCD  @' + IntToHex(mypos, 8) + ': Comment Length    : ' + IntToStr(0), MSG_NOTIFY);
1208       e_WriteLog('==============================================', MSG_NOTIFY);
1209     end;
1210     s.WriteBuffer(ZIP_SIGN_EOCD, 4); // EOCD Signature
1211     WriteInt(s, UInt16(0));          // Disk
1212     WriteInt(s, UInt16(0));          // Num of Disks
1213     WriteInt(s, UInt16(count));      // Num of CDRs
1214     WriteInt(s, UInt16(count));      // Total CDR entries
1215     WriteInt(s, UInt32(size));       // Central Directory size
1216     WriteInt(s, UInt32(offset));     // Central Directory offset
1217     WriteInt(s, UInt16(0));          // Comment field length
1218   end;
1219
1220   procedure TZIPEditor.SaveTo(FileName: String);
1221     var s: TFileStream;
1222   begin
1223     try
1224       s := TFileStream.Create(FileName, fmCreate);
1225       try
1226         SaveToStream(s);
1227       finally
1228         s.Free();
1229       end;
1230     except
1231       on e: Exception do
1232       begin
1233         if gWADEditorLogLevel >= DFWAD_LOG_INFO then
1234           e_WriteLog('ZIP: Failed to create file ' + FileName + ', reason: ' + e.Message, MSG_WARNING);
1235         raise e;
1236       end;
1237     end;
1238   end;
1239
1240   function TZIPEditor.GetLastError: Integer;
1241   begin
1242     Result := FLastError;
1243   end;
1244
1245   function TZIPEditor.GetLastErrorStr: String;
1246   begin
1247     case FLastError of
1248       DFWAD_NOERROR: Result := '';
1249       DFWAD_ERROR_WADNOTFOUND: Result := 'DFZIP file not found';
1250       DFWAD_ERROR_CANTOPENWAD: Result := 'Can''t open DFZIP file';
1251       DFWAD_ERROR_RESOURCENOTFOUND: Result := 'Resource not found';
1252       DFWAD_ERROR_FILENOTWAD: Result := 'File is not DFZIP';
1253       DFWAD_ERROR_WADNOTLOADED: Result := 'DFZIP file is not loaded';
1254       DFWAD_ERROR_READRESOURCE: Result := 'Read resource error';
1255       DFWAD_ERROR_READWAD: Result := 'Read DFZIP error';
1256       otherwise Result := IntToStr(FLastError);
1257     end;
1258   end;
1259
1260   function TZIPEditor.GetResourcesCount: Word;
1261     var i: Integer;
1262   begin
1263     Result := 0;
1264     if FSection <> nil then
1265     begin
1266       Result := Result + Length(FSection);
1267       for i := 0 to High(FSection) do
1268         if FSection[i].list <> nil then
1269           Result := Result + Length(FSection[i].list);
1270     end;
1271   end;
1272
1273   function TZIPEditor.GetVersion: Byte;
1274   begin
1275     Result := FVersion;
1276   end;
1277
1278 begin
1279   gWADEditorFactory.RegisterEditor('DFZIP', TZIPEditor);
1280 end.