src/shared/WADEDITOR_dfzip.pas

   1 {$INCLUDE ../shared/a_modes.inc}
   2
   3 unit WADEDITOR_dfzip;
   4
   5 // Implementation restrictions:
   6 // - File must start with LFH or EOCD signature
   7 // - EOCD must be located strictly at the end of file
   8 // - Multi-disk ZIP files are not supported
   9 // - UTF-8 not supported yet, expected WIN1251 encoding
  10 // - ZIP64 not supported
  11 // - Encryption not supported
  12 // - Zero-length file names not supported
  13 // - CDR holds most actual data about file, LFH mostly ignored
  14 // - Attributes, comments and extra data are ignored and not saved
  15 // - Store and Deflate compression supported
  16
  17 interface
  18
  19   uses Classes, WADEDITOR;
  20
  21   type
  22     TResource = record
  23       name: AnsiString;
  24       pos: UInt32;
  25       csize: UInt32;
  26       usize: UInt32;
  27       comp: UInt32;
  28       chksum: UInt32;
  29       stream: TMemoryStream;
  30     end;
  31
  32     TSection = record
  33       name: AnsiString;
  34       list: array of TResource;
  35     end;
  36
  37     PResource = ^TResource;
  38     PSection = ^TSection;
  39
  40     TZIPEditor = class sealed(WADEDITOR.TWADEditor)
  41       private
  42         FSection: array of TSection;
  43         FStream: TStream;
  44         FLastError: Integer;
  45         FVersion: Byte;
  46
  47         function FindSectionIDRAW(name: AnsiString; caseSensitive: Boolean): Integer;
  48         function FindSectionRAW(name: AnsiString; caseSensitive: Boolean): PSection;
  49         function InsertSectionRAW(name: AnsiString): PSection;
  50
  51         function FindSectionID(name: AnsiString): Integer;
  52         function FindSection(name: AnsiString): PSection;
  53         function InsertSection(name: AnsiString): PSection;
  54
  55         function InsertFileInfo(const section, name: AnsiString; pos, csize, usize, comp, crc: UInt32): PResource;
  56         function Preload(p: PResource): Boolean;
  57         function GetSourceStream(p: PResource): TStream;
  58
  59         function ReadLFH(s: TStream; fname: AnsiString; xcsize, xusize, xcomp, xcrc: UInt32): Boolean;
  60         function ReadCDR(s: TStream): Boolean;
  61         function FindEOCD(s: TStream): Boolean;
  62         function ReadEOCD(s: TStream): Boolean;
  63
  64         procedure WriteLFH(s: TStream; comp, crc, csize, usize: UInt32; const afname: AnsiString);
  65         procedure WriteCDR(s: TStream; comp, crc, csize, usize, attr, offset: UInt32; const afname: AnsiString);
  66         procedure SaveToStream(s: TStream);
  67
  68       public
  69         constructor Create();
  70         destructor Destroy(); override;
  71         procedure FreeWAD(); override;
  72         function  ReadFile2(FileName: string): Boolean; override;
  73         function  ReadMemory(Data: Pointer; Len: LongWord): Boolean; override;
  74         procedure CreateImage(); override;
  75         function AddResource(Data: Pointer; Len: LongWord; Name, Section: String): Boolean; override; overload;
  76         function AddResource(FileName, Name, Section: String): Boolean; override; overload;
  77         function AddAlias(Res, Alias: String): Boolean; override;
  78         procedure AddSection(Name: String); override;
  79         procedure RemoveResource(Section, Resource: String); override;
  80         procedure SaveTo(FileName: String); override;
  81         function HaveResource(Section, Resource: String): Boolean; override;
  82         function HaveSection(Section: string): Boolean; override;
  83         function GetResource(Section, Resource: String; var pData: Pointer; var Len: Integer): Boolean; override;
  84         function GetSectionList(): SArray; override;
  85         function GetResourcesList(Section: String): SArray; override;
  86
  87         function GetLastError: Integer; override;
  88         function GetLastErrorStr: String; override;
  89         function GetResourcesCount: Word; override;
  90         function GetVersion: Byte; override;
  91     end;
  92
  93 implementation
  94
  95   uses SysUtils, StrUtils, zstream, crc, e_log;
  96
  97   const
  98     ZIP_SIGN_CDR  = 'PK'#1#2;
  99     ZIP_SIGN_LFH  = 'PK'#3#4;
 100     ZIP_SIGN_EOCD = 'PK'#5#6;
 101
 102   const
 103     ZIP_COMP_STORE   = 0;
 104     ZIP_COMP_DEFLATE = 8;
 105
 106   const
 107     ZIP_SYSTEM     = 0;  // DOS / FAT
 108     ZIP_VERSION    = 20; // Min version
 109     ZIP_MAXVERSION = 63; // Max supported version
 110
 111   procedure ToSectionFile(fname: AnsiString; out section, name: AnsiString); inline;
 112     var i: SizeInt;
 113   begin
 114     i := LastDelimiter('/', fname);
 115     section := Copy(fname, 1, i - 1);
 116     name := Copy(fname, i + 1)
 117   end;
 118
 119   function GetFileName(const Section, Name: AnsiString): AnsiString; inline;
 120   begin
 121     if Section = '' then
 122       Result := Name
 123     else
 124       Result := Section + '/' + Name;
 125   end;
 126
 127   function PrepString(const s: AnsiString; caseSensitive, extSensitive: Boolean): AnsiString; inline;
 128     var i: Integer;
 129   begin
 130     Result := s;
 131     if caseSensitive = False then
 132     begin
 133       Result := UpperCase(Result);
 134     end;
 135     if extSensitive = False then
 136     begin
 137       i := Pos('.', Result); // fix dotfiles
 138       if i > 1 then
 139         SetLength(Result, i - 1);
 140     end;
 141   end;
 142
 143   function FindResourceIDRAW(p: PSection; name: AnsiString; caseSensitive, extSensitive: Boolean): Integer;
 144     var i: Integer; pname: AnsiString;
 145   begin
 146     if p <> nil then
 147     begin
 148       pname := PrepString(name, caseSensitive, extSensitive);
 149       for i := 0 to High(p.list) do
 150       begin
 151         if PrepString(p.list[i].name, caseSensitive, extSensitive) = pname then
 152         begin
 153           Result := i;
 154           exit;
 155         end;
 156       end;
 157     end;
 158     Result := -1;
 159   end;
 160
 161   function FindResourceID(p: PSection; name: AnsiString): Integer;
 162     var i: Integer;
 163   begin
 164     i := FindResourceIDRAW(p, name, True, True); // CaSeNaMe.Ext
 165     if i < 0 then
 166     begin
 167       i := FindResourceIDRAW(p, name, False, True); // CASENAME.EXT
 168       if i < 0 then
 169       begin
 170         i := FindResourceIDRAW(p, name, True, False); // CaSeNaMe
 171         if i < 0 then
 172         begin
 173           i := FindResourceIDRAW(p, name, False, False); // CASENAME
 174         end;
 175       end;
 176     end;
 177     Result := i;
 178   end;
 179
 180   function FindResource(p: PSection; name: AnsiString): PResource;
 181     var i: Integer;
 182   begin
 183     i := FindResourceID(p, name);
 184     if i >= 0 then
 185       Result := @p.list[i]
 186     else
 187       Result := nil;
 188   end;
 189
 190
 191
 192   function TZIPEditor.FindSectionIDRAW(name: AnsiString; caseSensitive: Boolean): Integer;
 193     var i: Integer; pname: AnsiString;
 194   begin
 195     if FSection <> nil then
 196     begin
 197       pname := PrepString(name, caseSensitive, True);
 198       for i := 0 to High(FSection) do
 199       begin
 200         if PrepString(FSection[i].name, caseSensitive, True) = pname then
 201         begin
 202           Result := i;
 203           exit;
 204         end;
 205       end;
 206     end;
 207     Result := -1;
 208   end;
 209
 210   function TZIPEditor.FindSectionRAW(name: AnsiString; caseSensitive: Boolean): PSection;
 211     var i: Integer;
 212   begin
 213     i := FindSectionIDRAW(name, caseSensitive);
 214     if i >= 0 then
 215       Result := @FSection[i]
 216     else
 217       Result := nil;
 218   end;
 219
 220   function TZIPEditor.InsertSectionRAW(name: AnsiString): PSection;
 221     var i: Integer;
 222   begin
 223     if FSection = nil then i := 0 else i := Length(FSection);
 224     SetLength(FSection, i + 1);
 225     FSection[i] := Default(TSection);
 226     FSection[i].name := name;
 227     Result := @FSection[i];
 228   end;
 229
 230
 231
 232   function TZIPEditor.FindSectionID(name: AnsiString): Integer;
 233     var fixName: AnsiString;
 234   begin
 235     fixName := StringReplace(name, '\', '/', [rfReplaceAll], TStringReplaceAlgorithm.sraManySmall);
 236     Result := FindSectionIDRAW(fixName, True); // CaSeNaMe
 237     if Result < 0 then
 238       Result := FindSectionIDRAW(fixName, False); // CASENAME
 239   end;
 240
 241   function TZIPEditor.FindSection(name: AnsiString): PSection;
 242     var fixName: AnsiString;
 243   begin
 244     fixName := StringReplace(name, '\', '/', [rfReplaceAll], TStringReplaceAlgorithm.sraManySmall);
 245     Result := FindSectionRAW(fixName, True); // CaSeNaMe
 246     if Result = nil then
 247       Result := FindSectionRAW(fixName, False); // CASENAME
 248   end;
 249
 250   function TZIPEditor.InsertSection(name: AnsiString): PSection;
 251   begin
 252     Result := FindSection(name);
 253     if Result = nil then
 254       Result := InsertSectionRAW(name);
 255   end;
 256
 257
 258
 259   function TZIPEditor.InsertFileInfo(const section, name: AnsiString; pos, csize, usize, comp, crc: UInt32): PResource;
 260     var p: PSection; i: Integer;
 261   begin
 262     p := FindSectionRAW(section, True);
 263     if p = nil then
 264       p := InsertSectionRAW(section);
 265     if p.list = nil then i := 0 else i := Length(p.list);
 266     SetLength(p.list, i + 1);
 267     p.list[i] := Default(TResource);
 268     p.list[i].name := name;
 269     p.list[i].pos := pos;
 270     p.list[i].csize := csize;
 271     p.list[i].usize := usize;
 272     p.list[i].comp := comp;
 273     p.list[i].chksum := crc;
 274     p.list[i].stream := nil;
 275     Result := @p.list[i];
 276   end;
 277
 278
 279
 280   function TZIPEditor.AddAlias(Res, Alias: String): Boolean;
 281   begin
 282     // Hard-links not supported in ZIP
 283     // However, they never created by editor
 284     Result := False;
 285   end;
 286
 287   function TZIPEditor.AddResource(Data: Pointer; Len: LongWord; Name, Section: String): Boolean;
 288     const compress: Boolean = True;
 289     const level: TCompressionLevel = TCompressionLevel.clMax;
 290     var s: TMemoryStream; cs: TCompressionStream; p: PResource;
 291     var comp, crc: UInt32;
 292   begin
 293     Result := False;
 294     if Name <> '' then
 295     begin
 296       s := TMemoryStream.Create();
 297       try
 298         if compress and (Len > 0) then
 299         begin
 300           cs := TCompressionStream.Create(level, s, True);
 301           try
 302             cs.WriteBuffer(PByte(Data)[0], Len);
 303             cs.Flush();
 304             comp := ZIP_COMP_DEFLATE;
 305           finally
 306             cs.Free();
 307           end;
 308         end;
 309         if (Len = 0) or (compress = False) or (s.Size >= Len) then
 310         begin
 311           s.Seek(0, TSeekOrigin.soBeginning);
 312           s.SetSize(Len);
 313           s.WriteBuffer(PByte(Data)[0], Len);
 314           comp := ZIP_COMP_STORE;
 315           Assert(s.Size = Len);
 316         end;
 317         crc := crc32(0, nil, 0);
 318         crc := crc32(crc, data, len);
 319         p := InsertFileInfo(Section, Name, $ffffffff, s.Size, Len, comp, crc);
 320         p.stream := s;
 321         Result := True;
 322       except
 323         s.Free();
 324         raise;
 325       end;
 326     end;
 327   end;
 328
 329   function TZIPEditor.AddResource(FileName, Name, Section: String): Boolean;
 330     var s: TFileStream; ptr: PByte;
 331   begin
 332     Result := False;
 333     FLastError := DFWAD_ERROR_READWAD;
 334     try
 335       s := TFileStream.Create(FileName, fmOpenRead, fmShareDenyWrite);
 336       try
 337         GetMem(ptr, s.Size);
 338         try
 339           s.ReadBuffer(ptr[0], s.Size);
 340           Result := AddResource(ptr, s.Size, Name, Section);
 341           if Result = True then FLastError := DFWAD_NOERROR;
 342         finally
 343           FreeMem(ptr);
 344         end;
 345       finally
 346         s.Free();
 347       end;
 348     except on e: EFOpenError do
 349       FLastError := DFWAD_ERROR_CANTOPENWAD;
 350     end;
 351   end;
 352
 353   constructor TZIPEditor.Create();
 354   begin
 355     FSection := nil;
 356     FStream := nil;
 357     FLastError := DFWAD_NOERROR;
 358     FVersion := ZIP_VERSION;
 359     FreeWAD();
 360   end;
 361
 362   destructor TZIPEditor.Destroy();
 363   begin
 364     FreeWAD();
 365     inherited;
 366   end;
 367
 368   procedure TZIPEditor.FreeWAD();
 369     var i, j: Integer;
 370   begin
 371     if FSection <> nil then
 372     begin
 373       for i := 0 to High(FSection) do
 374       begin
 375         if FSection[i].list <> nil then
 376         begin
 377           for j := 0 to High(FSection[i].list) do
 378           begin
 379             if FSection[i].list[j].stream <> nil then
 380             begin
 381               FreeAndNil(FSection[i].list[j].stream);
 382             end;
 383           end;
 384           SetLength(FSection[i].list, 0);
 385         end;
 386       end;
 387       SetLength(FSection, 0);
 388     end;
 389     if FStream <> nil then
 390     begin
 391       FreeAndNil(FStream);
 392     end;
 393     FLastError := DFWAD_NOERROR;
 394     FVersion := ZIP_VERSION;
 395   end;
 396
 397   function TZIPEditor.Preload(p: PResource): Boolean;
 398     var s: TMemoryStream;
 399   begin
 400     Result := False;
 401     if p <> nil then
 402     begin
 403       Result := p.stream <> nil;
 404       if (p.stream = nil) and (FStream <> nil) then
 405       begin
 406         s := TMemoryStream.Create();
 407         try
 408           if p.csize > 0 then
 409           begin
 410             FStream.Seek(p.pos, TSeekOrigin.soBeginning);
 411             s.CopyFrom(FStream, p.csize);
 412           end;
 413           Assert(s.Size = p.csize); // wtf, random size if copied zero bytes!
 414           p.stream := s;
 415           Result := True;
 416         except
 417           s.Free();
 418           raise;
 419         end;
 420       end;
 421     end;
 422   end;
 423
 424   procedure TZIPEditor.CreateImage();
 425     var i, j: Integer;
 426   begin
 427     if FStream = nil then
 428     begin
 429       FLastError := DFWAD_ERROR_WADNOTLOADED;
 430     end
 431     else if FStream is TMemoryStream then
 432     begin
 433       FLastError := DFWAD_NOERROR;
 434     end
 435     else
 436     begin
 437       if FSection <> nil then
 438       begin
 439         for i := 0 to High(FSection) do
 440         begin
 441           if FSection[i].list <> nil then
 442           begin
 443             for j := 0 to High(FSection[i].list) do
 444             begin
 445               if Preload(@FSection[i].list[j]) = False then
 446               begin
 447                 FLastError := DFWAD_ERROR_CANTOPENWAD;
 448                 exit;
 449               end;
 450             end;
 451           end;
 452         end;
 453       end;
 454       FreeAndNil(FStream);
 455       FLastError := DFWAD_NOERROR;
 456     end;
 457   end;
 458
 459   procedure TZIPEditor.AddSection(Name: String);
 460   begin
 461     if InsertSection(Name) = nil then
 462       raise Exception.Create('ZIP: AddSection: failed to add section');
 463   end;
 464
 465   function TZIPEditor.HaveResource(Section, Resource: String): Boolean;
 466   begin
 467     Result := FindResource(FindSection(Section), Resource) <> nil;
 468   end;
 469
 470   function TZIPEditor.HaveSection(Section: String): Boolean;
 471   begin
 472     Result := FindSection(Section) <> nil;
 473   end;
 474
 475   function TZIPEditor.GetSourceStream(p: PResource): TStream;
 476     var src: TStream;
 477   begin
 478     src := nil;
 479     if p.stream <> nil then
 480     begin
 481       src := p.stream;
 482       src.Seek(0, TSeekOrigin.soBeginning);
 483     end
 484     else if FStream <> nil then
 485     begin
 486       src := FStream;
 487       src.Seek(p.pos, TSeekOrigin.soBeginning);
 488     end;
 489     Result := src;
 490   end;
 491
 492   function TZIPEditor.GetResource(Section, Resource: String; var pData: Pointer; var Len: Integer): Boolean;
 493     var p: PResource; ptr: PByte; src: TStream; tmp: TDecompressionStream; crc: UInt32;
 494   begin
 495     FLastError := DFWAD_ERROR_CANTOPENWAD;
 496     Result := False;
 497     pData := nil;
 498     Len := 0;
 499     p := FindResource(FindSection(Section), Resource);
 500     if p <> nil then
 501     begin
 502       src := GetSourceStream(p);
 503       if src <> nil then
 504       begin
 505         case p.comp of
 506           ZIP_COMP_STORE:
 507             if p.csize = p.usize then
 508             begin
 509               GetMem(ptr, p.usize);
 510               try
 511                 src.ReadBuffer(ptr[0], p.usize);
 512                 Result := True;
 513               except
 514                 FreeMem(ptr);
 515               end;
 516             end;
 517           ZIP_COMP_DEFLATE:
 518             begin
 519               tmp := TDecompressionStream.Create(src, True);
 520               try
 521                 GetMem(ptr, p.usize);
 522                 try
 523                   tmp.ReadBuffer(ptr[0], p.usize);
 524                   Result := True;
 525                 except
 526                   FreeMem(ptr);
 527                 end;
 528               finally
 529                 tmp.Free();
 530               end;
 531             end;
 532         end;
 533       end
 534       else
 535       begin
 536         FLastError := DFWAD_ERROR_WADNOTLOADED;
 537       end;
 538       if Result = True then
 539       begin
 540         crc := crc32(0, nil, 0);
 541         crc := crc32(crc, ptr, p.usize);
 542         Result := crc = p.chksum;
 543         if Result = True then
 544         begin
 545           pData := ptr;
 546           Len := p.usize;
 547           FLastError := DFWAD_NOERROR;
 548         end
 549         else
 550         begin
 551           FreeMem(ptr);
 552         end;
 553       end;
 554     end
 555     else
 556     begin
 557       FLastError := DFWAD_ERROR_RESOURCENOTFOUND;
 558     end;
 559   end;
 560
 561   function TZIPEditor.GetResourcesList(Section: String): SArray;
 562     var p: PSection; i: Integer;
 563   begin
 564     Result := nil;
 565     p := FindSection(Section);
 566     if (p <> nil) and (p.list <> nil) then
 567     begin
 568       SetLength(Result, Length(p.list));
 569       for i := 0 to High(p.list) do
 570       begin
 571         Result[i] := p.list[i].name;
 572       end;
 573     end;
 574   end;
 575
 576   function TZIPEditor.GetSectionList(): SArray;
 577     var i: Integer;
 578   begin
 579     Result := nil;
 580     if FSection <> nil then
 581     begin
 582       SetLength(Result, Length(FSection));
 583       for i := 0 to High(FSection) do
 584       begin
 585         Result[i] := FSection[i].name;
 586       end;
 587     end;
 588   end;
 589
 590   function TZIPEditor.ReadLFH(s: TStream; fname: AnsiString; xcsize, xusize, xcomp, xcrc: UInt32): Boolean;
 591     var sig: packed array [0..3] of Char;
 592     var v, flags, comp: UInt16;
 593     var mtime, crc, csize, usize: UInt32;
 594     var fnlen, extlen: UInt16;
 595     var datapos: UInt64;
 596     var section, name: AnsiString;
 597   begin
 598     Result := False;
 599     if s.Position + 30 <= s.Size then
 600     begin
 601       s.ReadBuffer(sig[0], 4);
 602       if sig = ZIP_SIGN_LFH then
 603       begin
 604         v := LEtoN(s.ReadWord());
 605         flags := LEtoN(s.ReadWord());
 606         comp := LEtoN(s.ReadWord());
 607         mtime := LEtoN(s.ReadDWord());
 608         crc := LEtoN(s.ReadDWord());
 609         csize := LEtoN(s.ReadDWord());
 610         usize := LEtoN(s.ReadDWord());
 611         fnlen := LEtoN(s.ReadWord());
 612         extlen := LEtoN(s.ReadWord());
 613         datapos := s.Position + fnlen + extlen;
 614         if datapos + xcsize <= s.Size then
 615         begin
 616           // Valid Record Size
 617           ToSectionFile(fname, section, name);
 618           if name = '' then
 619             Result := InsertSection(section) <> nil
 620           else
 621             Result := InsertFileInfo(section, name, datapos, xcsize, xusize, xcomp, xcrc) <> nil;
 622         end;
 623       end;
 624     end;
 625   end;
 626
 627   function TZIPEditor.ReadCDR(s: TStream): Boolean;
 628     var sig: packed array [0..3] of Char;
 629     var v, va, vb, flags, comp: UInt16;
 630     var mtime, crc, csize, usize: UInt32;
 631     var fnlen, extlen, comlen, disk, iattr: UInt16;
 632     var eattr, offset: UInt32;
 633     var next: UInt64;
 634     var name: PChar;
 635   begin
 636     Result := False;
 637     s.ReadBuffer(sig[0], 4);
 638     if sig = ZIP_SIGN_CDR then
 639     begin
 640       // Valid Central Directory Signature
 641       v := LEtoN(s.ReadWord());
 642       va := s.ReadByte(); // Min Version
 643       vb := s.ReadByte(); // Min System
 644       flags := LEtoN(s.ReadWord());
 645       comp := LEtoN(s.ReadWord());
 646       mtime := LEtoN(s.ReadDWord());
 647       crc := LEtoN(s.ReadDWord());
 648       csize := LEtoN(s.ReadDWord());
 649       usize := LEtoN(s.ReadDWord());
 650       fnlen := LEtoN(s.ReadWord());
 651       extlen := LEtoN(s.ReadWord());
 652       comlen := LEtoN(s.ReadWord());
 653       disk := LEtoN(s.ReadWord());
 654       iattr := LEtoN(s.ReadWord());
 655       eattr := LEtoN(s.ReadDWord());
 656       offset := LEtoN(s.ReadDWord());
 657       next := s.Position + fnlen + extlen + comlen;
 658       FVersion := va;
 659       if va <= ZIP_MAXVERSION then
 660       begin
 661         if (flags and ((1 << 0) or (1 << 6) or (1 << 13))) = 0 then
 662         begin
 663           // TODO: check bit 11 (UTF8 name and comment)
 664           if (csize <> $ffffffff) and (usize <> $ffffffff) and (disk <> $ffff) and (offset <> $ffffffff) then
 665           begin
 666             // Old Style ZIP
 667             if disk = 0 then
 668             begin
 669               // Single Volume ZIP
 670               if (next <= s.Size) and (fnlen > 0) then
 671               begin
 672                 // Valid Central Directory Entry
 673                 GetMem(name, UInt32(fnlen) + 1);
 674                 try
 675                   s.ReadBuffer(name[0], fnlen);
 676                   name[fnlen] := #0;
 677                   s.Seek(offset, TSeekOrigin.soBeginning);
 678                   Result := ReadLFH(s, name, csize, usize, comp, crc);
 679                 finally
 680                   s.Seek(next, TSeekOrigin.soBeginning);
 681                   FreeMem(name);
 682                 end;
 683               end;
 684             end;
 685           end
 686           else
 687           begin
 688             // ZIP64
 689             FLastError := DFWAD_ERROR_WRONGVERSION;
 690           end;
 691         end
 692         else
 693         begin
 694           // Encrypted file
 695           FLastError := DFWAD_ERROR_READWAD;
 696         end;
 697       end
 698       else
 699       begin
 700         // Unsupported version
 701         FLastError := DFWAD_ERROR_WRONGVERSION;
 702       end;
 703     end;
 704   end;
 705
 706   function TZIPEditor.FindEOCD(s: TStream): Boolean;
 707     const maxedir = 20; // end of central directory entry
 708     const maxecdir = maxedir + 65536; // + comment
 709     var sig: packed array [0..3] of Char; off, lim: Int64;
 710   begin
 711     Result := False;
 712     if s.Size >= maxedir then
 713     begin
 714       if s.Size < maxecdir then lim := s.Size else lim := maxecdir;
 715       lim := lim - maxedir;
 716       off := maxedir;
 717       while (off <= lim) and (Result = False) do
 718       begin
 719         s.Seek(s.Size - off, TSeekOrigin.soBeginning);
 720         s.ReadBuffer(sig[0], 4);
 721         Result := sig = ZIP_SIGN_EOCD;
 722         Inc(off);
 723       end;
 724     end;
 725   end;
 726
 727   function TZIPEditor.ReadEOCD(s: TStream): Boolean;
 728     var sig: packed array [0..3] of Char;
 729     var idisk, ndisk, nrec, total, comlen: UInt16;
 730     var csize, cpos, i: UInt32;
 731   begin
 732     Result := False;
 733     FLastError := DFWAD_ERROR_FILENOTWAD;
 734     FVersion := 0;
 735     s.ReadBuffer(sig[0], 4);
 736     if (sig = ZIP_SIGN_LFH) or (sig = ZIP_SIGN_EOCD) then
 737     begin
 738       if FindEOCD(s) then
 739       begin
 740         // End of Central Directory found
 741         FLastError := DFWAD_ERROR_READWAD;
 742         idisk := LEtoN(s.ReadWord());
 743         ndisk := LEtoN(s.ReadWord());
 744         nrec := LEtoN(s.ReadWord());
 745         total := LEtoN(s.ReadWord());
 746         csize := LEtoN(s.ReadDWord());
 747         cpos := LEtoN(s.ReadDWord());
 748         comlen := LEtoN(s.ReadWord());
 749         if (idisk <> $ffff) and (ndisk <> $ffff) and (nrec <> $ffff) and (total <> $ffff) and (csize <> $ffffffff) and (cpos <> $ffffffff) then
 750         begin
 751           // Old Style ZIP
 752           if s.Position + comlen = s.Size then
 753           begin
 754             // Valid End of Central Directory size (located exactly at the end of file)
 755             if (idisk = 0) and (ndisk = 0) and (nrec = total) then
 756             begin
 757               // Single volume ZIP
 758               if (UInt64(cpos) + csize <= s.Size) then
 759               begin
 760                 // Valid Cental Directry Record position and size
 761                 Result := True;
 762                 if total > 0 then
 763                 begin
 764                   // At least one Central Directry present
 765                   i := 0;
 766                   s.Seek(cpos, TSeekOrigin.soBeginning);
 767                   while (i < nrec) and (Result = True) do
 768                   begin
 769                     Result := ReadCDR(s);
 770                     Inc(i);
 771                   end;
 772                   // if Result = False then
 773                   //   writeln('Invalid Central Directory #', i - 1);
 774                 end;
 775               end;
 776             end;
 777           end;
 778         end
 779         else
 780         begin
 781           // ZIP64
 782           FLastError := DFWAD_ERROR_WRONGVERSION;
 783         end;
 784       end;
 785     end;
 786   end;
 787
 788   function TZIPEditor.ReadFile2(FileName: String): Boolean;
 789     var s: TFileStream;
 790   begin
 791     FreeWAD();
 792     Result := False;
 793     try
 794       s := TFileStream.Create(FileName, fmOpenRead, fmShareDenyWrite);
 795       try
 796         Result := ReadEOCD(s);
 797         if Result = True then
 798         begin
 799           FStream := s;
 800           FLastError := DFWAD_NOERROR;
 801         end
 802         else
 803         begin
 804           FStream := nil;
 805           s.Free();
 806         end;
 807       except
 808         s.Free();
 809       end;
 810     except on e: EFOpenError do
 811       if FileExists(FileName) then
 812         FLastError := DFWAD_ERROR_CANTOPENWAD
 813       else
 814         FLastError := DFWAD_ERROR_WADNOTFOUND;
 815     end;
 816   end;
 817
 818   function TZIPEditor.ReadMemory(Data: Pointer; Len: LongWord): Boolean;
 819     var s: TMemoryStream;
 820   begin
 821     FreeWAD();
 822     Result := False;
 823     s := TMemoryStream.Create;
 824     try
 825       s.SetSize(Len);
 826       s.WriteBuffer(PByte(Data)[0], Len);
 827       s.Seek(0, soBeginning);
 828       Result := ReadEOCD(s);
 829       if Result = True then
 830       begin
 831         FStream := s;
 832         FLastError := DFWAD_NOERROR;
 833       end
 834       else
 835       begin
 836         FStream := nil;
 837         s.Free();
 838       end;
 839     except
 840       s.Free();
 841       raise;
 842     end;
 843   end;
 844
 845   procedure TZIPEditor.RemoveResource(Section, Resource: String);
 846     var p: PSection; i: Integer;
 847   begin
 848     p := FindSection(Section);
 849     i := FindResourceID(p, Resource);
 850     if i >= 0 then
 851     begin
 852       if p.list[i].stream <> nil then
 853         FreeAndNil(p.list[i].stream);
 854       for i := i + 1 to High(p.list) do
 855       begin
 856         p.list[i - 1] := p.list[i];
 857       end;
 858       SetLength(p.list, High(p.list));
 859     end;
 860   end;
 861
 862   procedure TZIPEditor.WriteLFH(s: TStream; comp, crc, csize, usize: UInt32; const afname: AnsiString);
 863     var fname: PChar; flen: UInt16;
 864   begin
 865     fname := PChar(afname);
 866     flen := Length(fname);
 867     s.WriteBuffer(ZIP_SIGN_LFH, 4); // LFH Signature
 868     s.WriteByte(ZIP_VERSION);       // Min version
 869     s.WriteByte(ZIP_SYSTEM);        // System
 870     s.WriteWord(NtoLE(0));          // Flags
 871     s.WriteWord(NtoLE(comp));       // Compression method
 872     s.WriteDWord(NtoLE(0));         // Modification time/date
 873     s.WriteDWord(NtoLE(crc));       // CRC-32
 874     s.WriteDWord(NtoLE(csize));     // Compressed size
 875     s.WriteDWord(NtoLE(usize));     // Decompressed size
 876     s.WriteWord(NtoLE(flen));       // Name field length
 877     s.WriteWord(NtoLE(0));          // Extra field length
 878     s.WriteBuffer(fname[0], flen);  // File Name
 879   end;
 880
 881   procedure TZIPEditor.WriteCDR(s: TStream; comp, crc, csize, usize, attr, offset: UInt32; const afname: AnsiString);
 882     var fname: PChar; flen: UInt16;
 883   begin
 884     fname := PChar(afname);
 885     flen := Length(fname);
 886     s.WriteBuffer(ZIP_SIGN_CDR, 4); // CDR Signature
 887     s.WriteByte(ZIP_MAXVERSION);    // Used version
 888     s.WriteByte(ZIP_SYSTEM);        // Used system
 889     s.WriteByte(ZIP_VERSION);       // Min version
 890     s.WriteByte(ZIP_SYSTEM);        // Min system
 891     s.WriteWord(NtoLE(0));          // Flags
 892     s.WriteWord(NtoLE(comp));       // Compression method
 893     s.WriteDWord(NtoLE(0));         // Modification time/date
 894     s.WriteDWord(NtoLE(crc));       // CRC-32
 895     s.WriteDWord(NtoLE(csize));     // Compressed size
 896     s.WriteDWord(NtoLE(usize));     // Decompressed size
 897     s.WriteWord(NtoLE(flen));       // Name field length
 898     s.WriteWord(NtoLE(0));          // Extra field length
 899     s.WriteWord(NtoLE(0));          // Comment field length
 900     s.WriteWord(NtoLE(0));          // Disk
 901     s.WriteWord(NtoLE(0));          // Internal attributes
 902     s.WriteDWord(NtoLE(attr));      // External attributes
 903     s.WriteDWord(NtoLE(offset));    // LFH offset
 904     s.WriteBuffer(fname[0], flen);  // File Name
 905   end;
 906
 907   procedure TZIPEditor.SaveToStream(s: TStream);
 908     var i, j: Integer;
 909     var start, offset, loffset, size, zcrc, count: UInt32;
 910     var p: PResource;
 911     var afname: AnsiString;
 912   begin
 913     // Write LFH headers and data
 914     start := s.Position;
 915     zcrc := crc32(0, nil, 0);
 916     if FSection <> nil then
 917     begin
 918       for i := 0 to High(FSection) do
 919       begin
 920         if FSection[i].list <> nil then
 921         begin
 922           for j := 0 to High(FSection[i].list) do
 923           begin
 924             p := @FSection[i].list[j];
 925             afname := GetFileName(FSection[i].name, p.name);
 926             WriteLFH(s, p.comp, p.chksum, p.csize, p.usize, afname);
 927             if p.stream <> nil then
 928             begin
 929               Assert(p.stream.Size = p.csize);
 930               p.stream.SaveToStream(s);
 931             end
 932             else if FStream <> nil then
 933             begin
 934               FStream.Seek(p.pos, TSeekOrigin.soBeginning);
 935               s.CopyFrom(FStream, p.csize);
 936             end
 937             else
 938             begin
 939               raise Exception.Create('ZIP: SaveToStream: No data source available');
 940             end;
 941           end;
 942         end
 943         else
 944         begin
 945           afname := GetFileName(FSection[i].name, '');
 946           WriteLFH(s, ZIP_COMP_STORE, zcrc, 0, 0, afname);
 947         end;
 948       end;
 949     end;
 950     // Write CDR headers
 951     count := 0;
 952     loffset := start;
 953     offset := s.Position - start;
 954     if FSection <> nil then
 955     begin
 956       for i := 0 to High(FSection) do
 957       begin
 958         if FSection[i].list <> nil then
 959         begin
 960           for j := 0 to High(FSection[i].list) do
 961           begin
 962             p := @FSection[i].list[j];
 963             afname := GetFileName(FSection[i].name, p.name);
 964             WriteCDR(s, p.comp, p.chksum, p.csize, p.usize, 0, loffset - start, afname);
 965             loffset := loffset + 30 + Length(afname) + p.csize;
 966             Inc(count);
 967           end;
 968         end
 969         else
 970         begin
 971           afname := GetFileName(FSection[i].name, '');
 972           WriteCDR(s, ZIP_COMP_STORE, zcrc, 0, 0, $10, loffset - start, afname);
 973           loffset := loffset + 30 + Length(afname) + 0;
 974           Inc(count);
 975         end;
 976       end;
 977     end;
 978     Assert(loffset = offset);
 979     Assert(count < $ffff);
 980     size := s.Position - start - offset;
 981     // Write EOCD header
 982     s.WriteBuffer(ZIP_SIGN_EOCD, 4); // EOCD Signature
 983     s.WriteWord(NtoLE(0));           // Disk
 984     s.WriteWord(NtoLE(0));           // Num of Disks
 985     s.WriteWord(NtoLE(count));       // Num of CDRs
 986     s.WriteWord(NtoLE(count));       // Total CDR entries
 987     s.WriteDWord(NtoLE(size));       // Central Directory size
 988     s.WriteDWord(NtoLE(offset));     // Central Directory offset
 989     s.WriteWord(NtoLE(0));           // Comment field length
 990   end;
 991
 992   procedure TZIPEditor.SaveTo(FileName: String);
 993     var s: TFileStream;
 994   begin
 995     s := TFileStream.Create(FileName, fmCreate);
 996     try
 997       SaveToStream(s);
 998     finally
 999       s.Free();
1000     end;
1001   end;
1002
1003   function TZIPEditor.GetLastError: Integer;
1004   begin
1005     Result := FLastError;
1006   end;
1007
1008   function TZIPEditor.GetLastErrorStr: String;
1009   begin
1010     case FLastError of
1011       DFWAD_NOERROR: Result := '';
1012       DFWAD_ERROR_WADNOTFOUND: Result := 'DFZIP file not found';
1013       DFWAD_ERROR_CANTOPENWAD: Result := 'Can''t open DFZIP file';
1014       DFWAD_ERROR_RESOURCENOTFOUND: Result := 'Resource not found';
1015       DFWAD_ERROR_FILENOTWAD: Result := 'File is not DFZIP';
1016       DFWAD_ERROR_WADNOTLOADED: Result := 'DFZIP file is not loaded';
1017       DFWAD_ERROR_READRESOURCE: Result := 'Read resource error';
1018       DFWAD_ERROR_READWAD: Result := 'Read DFZIP error';
1019       otherwise Result := '';
1020     end;
1021   end;
1022
1023   function TZIPEditor.GetResourcesCount: Word;
1024     var i: Integer;
1025   begin
1026     Result := 0;
1027     if FSection <> nil then
1028     begin
1029       Result := Result + Length(FSection);
1030       for i := 0 to High(FSection) do
1031         if FSection[i].list <> nil then
1032           Result := Result + Length(FSection[i].list);
1033     end;
1034   end;
1035
1036   function TZIPEditor.GetVersion: Byte;
1037   begin
1038     Result := FVersion;
1039   end;
1040
1041 begin
1042   gWADEditorFactory.RegisterEditor('DFZIP', TZIPEditor);
1043 end.