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