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