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