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