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