Advertisement
filhotecmail

SendMail

Aug 17th, 2017
564
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 67.55 KB | None | 0 0
  1. unit System.Zip2;
  2.  
  3. interface
  4.  
  5. uses
  6.   System.SysUtils,
  7.   System.IOUtils,
  8.   System.Generics.Collections,
  9.   System.Classes;
  10.  
  11. type
  12.   /// <summary> Zip Compression Method Enumeration </summary>
  13.   TZipCompression = (
  14.     zcStored    = 0,
  15.     zcShrunk,
  16.     zcReduce1,
  17.     zcReduce2,
  18.     zcReduce3,
  19.     zcReduce4,
  20.     zcImplode,
  21.     zcTokenize,
  22.     zcDeflate,
  23.     zcDeflate64,
  24.     zcPKImplode,
  25.     {11 RESERVED}
  26.     zcBZIP2    = 12,
  27.     {13 RESERVED}
  28.     zcLZMA     = 14,
  29.     {15-17 RESERVED}
  30.     zcTERSE    = 18,
  31.     zcLZ77,
  32.     zcWavePack = 97,
  33.     zcPPMdI1
  34.   );
  35.  
  36. /// <summary> Converts ZIP compression method value to string </summary>
  37. function TZipCompressionToString(Compression: TZipCompression): string;
  38.  
  39. const
  40.   SIGNATURE_ZIPENDOFHEADER: UInt32 = $06054B50;
  41.   SIGNATURE_CENTRALHEADER:  UInt32 = $02014B50;
  42.   SIGNATURE_LOCALHEADER:    UInt32 = $04034B50;
  43.   SIGNATURE_ZIP64_ENDOFCENTRALDIRECTORY: UInt32 = $06064B50;
  44.   SIGNATURE_ZIP64_ENDOFCENTRALDIRECTORYLOCATOR: UInt32 = $07064B50;
  45.  
  46.   LOCALHEADERSIZE = 26;
  47.   CENTRALHEADERSIZE = 42;
  48.  
  49.   MADEBY_MSDOS = 0;
  50.   MADEBY_UNIX = 3;
  51.  
  52.   ZIP_Version20 = 20;
  53.  
  54.   EXTRAFIELD_ID_ZIP64: UInt16 = $0001;
  55.   EXTRAFIELD_ID_NTFS: UInt16  = $000A;
  56.  
  57.   ZIP64 = $FFFFFFFF;
  58.  
  59. type
  60.   /// <summary> Final block written to zip file</summary>
  61.   TZipEndOfCentralHeader = packed record
  62.     DiskNumber:          UInt16;
  63.     CentralDirStartDisk: UInt16;
  64.     NumEntriesThisDisk:  UInt16;
  65.     CentralDirEntries:   UInt16;
  66.     CentralDirSize:      UInt32;
  67.     CentralDirOffset:    UInt32;
  68.     CommentLength:       UInt16;
  69.     {Comment: RawByteString}
  70.   end;
  71.   /// <summary> TZipHeader contains information about a file in a zip archive.
  72.   /// </summary>
  73.   /// <remarks>
  74.   /// <para>
  75.   /// This record is overloaded for use in reading/writing ZIP
  76.   /// [Local file header] and the Central Directory's [file header].
  77.   /// </para>
  78.   /// <para> See PKZIP Application Note section V. General Format of a .ZIP file
  79.   ///  sub section J. Explanation of fields for more detailed description
  80.   //   of each field's usage.
  81.   /// </para>
  82.   /// </remarks>
  83.   TZipHeader = packed record
  84.     MadeByVersion:      UInt16; // Start of Central Header
  85.     RequiredVersion:    UInt16; // Start of Local Header
  86.     Flag:               UInt16;
  87.     CompressionMethod:  UInt16;
  88.     ModifiedDateTime:   UInt32;
  89.     CRC32:              UInt32;
  90.     CompressedSize:     UInt32;
  91.     UncompressedSize:   UInt32;
  92.     FileNameLength:     UInt16;
  93.     ExtraFieldLength:   UInt16; // End of Local Header
  94.     FileCommentLength:  UInt16;
  95.     DiskNumberStart:    UInt16;
  96.     InternalAttributes: UInt16;
  97.     ExternalAttributes: UInt32;
  98.     LocalHeaderOffset:  UInt32; // End of Central Header
  99.     FileName: TBytes;
  100.     ExtraField: TBytes;
  101.     FileComment: TBytes;
  102.     function IsZIP64: Boolean;
  103.     function GetZIP64_CompressedSize: UInt64;
  104.     procedure SetZIP64_CompressedSize(const Value: UInt64);
  105.     function GetZIP64_UncompressedSize: UInt64;
  106.     procedure SetZIP64_UncompressedSize(const Value: UInt64);
  107.     procedure SetExtraField_NTFS(const aFileName: string);
  108.     property ZIP64_CompressedSize: UInt64 read GetZIP64_CompressedSize write
  109.         SetZIP64_CompressedSize;
  110.     property ZIP64_UncompressedSize: UInt64 read GetZIP64_UncompressedSize write
  111.         SetZIP64_UncompressedSize;
  112.   end;
  113.  
  114.   PZipHeader = ^TZipHeader;
  115.  
  116.   TZipExtraField = packed record
  117.     HeaderID: UInt16;
  118.     DataSize: UInt16;
  119.     Data: TBytes;
  120.     constructor Create(const aRawData: TBytes); overload;
  121.     constructor Create(const aHeaderID: UInt16; const aData: TBytes); overload;
  122.     procedure SetData(const A: TBytes);
  123.     class operator Implicit(const A: TZipExtraField): TBytes;
  124.   end;
  125.  
  126.   TZipExtraField_ZIP64 = packed record
  127.     UncompressedSize : UInt64;
  128.     CompressedSize   : UInt64;
  129.     class operator Implicit(const aBytes: TBytes): TZipExtraField_ZIP64;
  130.     class operator Implicit(const A: TZipExtraField_ZIP64): TZipExtraField;
  131.     class operator Implicit(const A: TZipExtraField_ZIP64): TBytes;
  132.     class operator Implicit(const A: TZipExtraField): TZipExtraField_ZIP64;
  133.   end;
  134.  
  135.   {$ifdef MSWINDOWS}
  136.   TZipExtraField_NTFS = packed record
  137.     Reserved : UInt32;
  138.     Tag1     : UInt16; // 0x0001
  139.     Size1    : UInt16;
  140.     MTime    : UInt64;
  141.     ATime    : UInt64;
  142.     CTime    : UInt64;
  143.     constructor Create(const aFileName: string);
  144.     class operator Implicit(const aBytes: TBytes): TZipExtraField_NTFS;
  145.     class operator Implicit(const A: TZipExtraField_NTFS): TBytes;
  146.     class operator Implicit(const A: TZipExtraField_NTFS): TZipExtraField;
  147.     class operator Implicit(const A: TZipExtraField): TZipExtraField_NTFS;
  148.   end;
  149.   {$endif}
  150.  
  151.   TZipExtraFields = packed record
  152.     Items: TArray<TZipExtraField>;
  153.     function Get(const aHeaderID: UInt16; out aItem: TZipExtraField; out Index:
  154.         NativeInt): Boolean;
  155.     function New: NativeInt; overload;
  156.     procedure Add(const A: TZipExtraField);
  157.     class operator Implicit(const aBytes: TBytes): TZipExtraFields;
  158.     class operator Implicit(const A: TZipExtraFields): TBytes;
  159.     class operator Implicit(const A: TZipExtraFields): TZipExtraField_ZIP64;
  160.   end;
  161.  
  162.   TZip64_EndOfCentralDirectory = packed record
  163.     Signature               : UInt32; // $06064b50
  164.     RecordSize              : UInt64;
  165.     VersionMadeBy           : UInt16;
  166.     VersionNeededToExtract  : UInt16;
  167.     DiskNumber              : UInt32;
  168.     StartDiskNumber         : UInt32;
  169.     EntriesOnDisk           : UInt64;
  170.     TotalEntries            : UInt64;
  171.     DirectorySize           : UInt64;
  172.     DirectoryOffset         : UInt64;
  173.     class operator Implicit(const A: TZip64_EndOfCentralDirectory): TBytes;
  174.     procedure Init;
  175.   end;
  176.  
  177.   TZip64_EndOfCentralDirectoryLocator = packed record
  178.     Signature               : UInt32; // $07064b50
  179.     StartDiskNumber         : UInt32;
  180.     RelativeOffset          : UInt64;
  181.     TotalDisks              : UInt32;
  182.     class operator Implicit(const A: TZip64_EndOfCentralDirectoryLocator): TBytes;
  183.     procedure Init;
  184.   end;
  185.  
  186.   /// <summary> Exception type for all Zip errors. </summary>
  187.   EZipException = class( Exception );
  188.  
  189.   TZipMode = (zmClosed, zmRead, zmReadWrite, zmWrite);
  190.  
  191.   /// <summary> On progress event</summary>
  192.   TZipProgressEvent = procedure(Sender: TObject; FileName: string; Header: TZipHeader; Position: Int64) of object;
  193.  
  194.   TZipFile = class;
  195.   /// <summary> Function to Create a Compression/Decompression stream </summary>
  196.   /// <remarks>
  197.   ///  Call <c>RegisterCompressionHandler</c> to register a compression type that
  198.   ///  can Compress/Decompress a stream. The output stream reads/write from/to InStream.
  199.   /// </remarks>
  200.   TStreamConstructor = reference to function(InStream: TStream; const ZipFile: TZipFile; const Item: TZipHeader): TStream;
  201.  
  202.   /// <summary>   Callback to create a custom stream  based on the original</summary>
  203.   TCreateCustomStreamCallBack = reference to function(const InStream: TStream; const ZipFile: TZipFile; const Item: TZipHeader; IsEncrypted: Boolean): TStream;
  204.   TOnCreateCustomStream = function(const InStream: TStream; const ZipFile: TZipFile; const Item: TZipHeader; IsEncrypted: Boolean): TStream of object;
  205.   /// <summary> Class for creating and reading .ZIP files.
  206.   /// </summary>
  207.   TZipFile = class
  208.   private type
  209.     TCompressionDict = TDictionary< TZipCompression , TPair<TStreamConstructor, TStreamConstructor > >;
  210.   private class var
  211.     FCompressionHandler: TCompressionDict;
  212.     FOnCreateDecompressStream: TOnCreateCustomStream;
  213.     FCreateDecompressStreamCallBack: TCreateCustomStreamCallBack;
  214.   private
  215.     FMode: TZipMode;
  216.     FStream: TStream;
  217.     FFileStream: TFileStream;
  218.     FStartFileData: Int64;
  219.     FEndFileData: Int64;
  220.     FFiles: TList<TZipHeader>;
  221.     FComment: TBytes;
  222.     FUTF8Support: Boolean;
  223.     FOnProgress: TZipProgressEvent;
  224.     FCurrentFile: string;
  225.     FCurrentHeader: TZipHeader;
  226.     function TBytesToString(B: TBytes): string;
  227.     function StringToTBytes(S: string): TBytes;
  228.     function GetFileComment(Index: Integer): string;
  229.     function GetFileCount: Integer;
  230.     function GetFileInfo(Index: Integer): TZipHeader;
  231.     function GetFileInfos: TArray<TZipHeader>;
  232.     function GetFileName(Index: Integer): string;
  233.     function GetFileNames: TArray<string>;
  234.     function GetComment: string;
  235.     procedure ReadCentralHeader;
  236.     procedure SetFileComment(Index: Integer; Value: string);
  237.     procedure SetComment(Value: string);
  238.     procedure SetUTF8Support(const Value: Boolean);
  239.     function LocateEndOfCentralHeader(var Header: TZipEndOfCentralHeader): Boolean;
  240.     procedure DoZLibProgress(Sender: TObject);
  241.     function ZIP64_LocateEndOfCentralHeader(var Header: TZip64_EndOfCentralDirectory): Boolean;
  242.   protected
  243.     procedure CheckFileName(const ArchiveFileName: string); virtual;
  244.   public
  245.     class constructor Create;
  246.     class destructor Destroy;
  247.  
  248.     /// <remarks>
  249.     ///  Call <c>RegisterCompressionHandler</c> to register a compression type that
  250.     ///  can Compress/Decompress a stream. The output stream reads/write from/to InStream.
  251.     /// </remarks>
  252.     class procedure RegisterCompressionHandler(Compression: TZipCompression;
  253.       CompressStream, DecompressStream: TStreamConstructor);
  254.  
  255.     class procedure UnregisterCompressionHandler(Compression: TZipCompression);
  256.  
  257.     /// <param name="ZipFileName">Path to Zip File</param>
  258.     /// <returns>Is the .ZIP file valid</returns>
  259.     class function IsValid(const ZipFileName: string): Boolean; static;
  260.  
  261.     /// <summary> Extract a ZipFile</summary>
  262.     /// <param name="ZipFileName">File name of the ZIP file</param>
  263.     /// <param name="Path">Path to extract to disk</param>
  264.     /// <param name="ZipProgress">On progress callback.</param>
  265.     class procedure ExtractZipFile(const ZipFileName: string; const Path: string; ZipProgress: TZipProgressEvent = nil); static;
  266.  
  267.     /// <summary> Zip the contents of a directory </summary>
  268.     /// <param name="ZipFileName">File name of the ZIP file</param>
  269.     /// <param name="Path">Path of directory to zip</param>
  270.     /// <param name="Compression">Compression mode.</param>
  271.     /// <param name="ZipProgress">On progress callback.</param>
  272.     class procedure ZipDirectoryContents(const ZipFileName: string; const Path: string; Compression: TZipCompression = zcDeflate; ZipProgress: TZipProgressEvent = nil); static;
  273.  
  274.     /// <summary> Checks if header extra field contains unicode path, if true AFilename contains the unicode path</summary>
  275.     class function GetUTF8PathFromExtraField(const AHeader: TZipHeader; out AFileName: string): Boolean;
  276.  
  277.     /// <summary> Create a TZipFile</summary>
  278.     constructor Create;
  279.  
  280.     /// <remarks> Destroy will close an open zipfile before disposing of it</remarks>
  281.     destructor Destroy; override;
  282.  
  283.     /// <summary> Opens a ZIP file for reading or writing.</summary>
  284.     /// <param name="ZipFileName">Path to ZipFile</param>
  285.     /// <param name="OpenMode"> File Mode to open file.
  286.     ///   <c>zmWrite</c> Creates a new ZIP file for writing.
  287.     ///   <c>zmReadWrite</c> Opens the file for reading and allows adding
  288.     ///      additional new files.
  289.     ///   <c>zmRead</c> Opens the file for reading.
  290.     ///</param>
  291.     procedure Open(const ZipFileName: string; OpenMode: TZipMode); overload;
  292.     procedure Open(ZipFileStream: TStream; OpenMode: TZipMode); overload;
  293.  
  294.     /// <remarks>
  295.     ///   Closing is required to write the ZipFile's
  296.     ///   Central Directory to disk. Closing a file that is open for writing
  297.     ///   writes additonal metadata that is required for reading the file.
  298.     /// </remarks>
  299.     procedure Close;
  300.  
  301.     /// <summary> Extract a single file </summary>
  302.     /// <remarks>
  303.     ///  <c>FileName</c> specifies a file in the ZIP file. All slashes
  304.     ///  in ZIP file names should be '/'.
  305.     ///   The overload that takes an Integer may be useful when a ZIP file
  306.     ///   has duplicate filenames.
  307.     /// </remarks>
  308.     /// <param name="FileName">File name in the archive</param>
  309.     /// <param name="Path">Path to extract to disk</param>
  310.     /// <param name="CreateSubdirs">The output should create sub directories specified in the ZIP file</param>
  311.     procedure Extract(const FileName: string; const Path: string = ''; CreateSubdirs: Boolean = True); overload;
  312.     procedure Extract(Index: Integer; const Path: string = ''; CreateSubdirs: Boolean = True); overload;
  313.     /// <summary> Extract All files </summary>
  314.     /// <param name="Path">Path to extract to.</param>
  315.     procedure ExtractAll(const Path: string = '');
  316.  
  317.     /// <summary> Read a file from arcive to an array of Bytes </summary>
  318.     /// <remarks>
  319.     ///   The overload that takes an Integer may be useful when a ZIP file
  320.     ///   has duplicate filenames.
  321.     /// </remarks>
  322.     /// <param name="FileName">ZIP file FileName</param>
  323.     /// <param name="Bytes">Output bytes</param>
  324.     ///
  325.     procedure Read(const FileName: string; out Bytes: TBytes); overload;
  326.     procedure Read(Index: Integer; out Bytes: TBytes); overload;
  327.     /// <summary> Get a stream to read a file from disk </summary>
  328.     /// <remarks>
  329.     ///   The Stream returned by this function is a decomression stream
  330.     ///   wrapper around the interal Stream reading the zip file. You must
  331.     ///   Free this stream before using other TZipFile methods that change the
  332.     ///   contents of the ZipFile, such as Read or Add.
  333.     ///   The overload that takes an Integer may be useful when a ZIP file
  334.     ///   has duplicate filenames.
  335.     /// </remarks>
  336.     /// <param name="FileName">ZIP file FileName</param>
  337.     /// <param name="Stream">Output Stream</param>
  338.     /// <param name="LocalHeader">Local File header</param>
  339.     procedure Read(const FileName: string; out Stream: TStream; out LocalHeader: TZipHeader); overload;
  340.     procedure Read(Index: Integer; out Stream: TStream; out LocalHeader: TZipHeader); overload;
  341.  
  342.     /// <summary> Add a file to the ZIP file </summary>
  343.     /// <param name="FileName">FileName to be added</param>
  344.     /// <param name="ArchiveFileName">Path + Name of file in the arcive.
  345.     ///   If Ommitted, <C>ExtractFileName(FileName)</C> will be used.</param>
  346.     /// <param name="Compression">Compression mode.</param>
  347.     procedure Add(const FileName: string; const ArchiveFileName: string = '';
  348.       Compression: TZipCompression = zcDeflate); overload;
  349.     /// <summary> Add a memory file to the ZIP file </summary>
  350.     /// <param name="Data">Bytes to be added</param>
  351.     /// <param name="ArchiveFileName">Path + Name of file in the arcive.</param>
  352.     /// <param name="Compression">Compression mode.</param>
  353.     ///
  354.     procedure Add(Data: TBytes; const ArchiveFileName: string; Compression: TZipCompression = zcDeflate); overload;
  355.     /// <summary> Add a memory file to the ZIP file </summary>
  356.     /// <param name="Data">Stream of file to be added</param>
  357.     /// <param name="ArchiveFileName">Path + Name of file in the arcive.</param>
  358.     /// <param name="Compression">Compression mode.</param>
  359.     /// <param name="AExternalAttributes">External attributes for this file.</param>
  360.     procedure Add(Data: TStream; const ArchiveFileName: string; Compression: TZipCompression = zcDeflate;
  361.       AExternalAttributes: TFileAttributes = []); overload;
  362.     /// <summary> Add a memory file to the ZIP file. Allows programmer to specify
  363.     ///  the Local and Central Header data for more flexibility on what gets written.
  364.     ///  Minimal vailidation is done on the Header parameters; speficying bad options
  365.     ///  could result in a corrupted zip file. </summary>
  366.     /// <param name="Data">Stream of file to be added</param>
  367.     /// <param name="LocalHeader">The local header data</param>
  368.     /// <param name="CentralHeader">A Pointer to an optional central header. If no
  369.     /// central Header is provided, the Local Header information is used. </param>
  370.     procedure Add(Data: TStream; LocalHeader: TZipHeader; CentralHeader: PZipHeader = nil); overload;
  371.  
  372.  
  373.     /// <summary>
  374.     /// Event fired before a file inside a zip file is decompressed, allows access to the raw stream for decrypt purposes
  375.     /// </summary>
  376.     class property OnCreateDecompressStream: TOnCreateCustomStream read FOnCreateDecompressStream write FOnCreateDecompressStream;
  377.     /// <summary>
  378.     /// Callback called before a file inside a zip file is decompressed, allows access to the raw stream for decrypt purposes
  379.     /// </summary>
  380.     class property CreateDecompressStreamCallBack: TCreateCustomStreamCallBack read FCreateDecompressStreamCallBack write FCreateDecompressStreamCallBack;
  381.  
  382.     /// <summary> Translate from FileName to index in ZIP Central Header
  383.     /// </summary>
  384.     /// <remarks>
  385.     ///  A ZIP file may have dupicate entries with the same name. This
  386.     ///  function will return the index of the first.
  387.     /// </remarks>
  388.     /// <param name="FileName">Path + Name of file in the arcive.</param>
  389.     /// <returns>The index of the file in the archive, or -1 on failure.
  390.     /// </returns>
  391.     function IndexOf(const FileName: string): Integer;
  392.  
  393.     /// <returns> The mode the TZipFile is opened to</returns>
  394.     property Mode: TZipMode read FMode;
  395.  
  396.     /// <returns>Total files in ZIP File</returns>
  397.     property FileCount: Integer read GetFileCount;
  398.  
  399.     /// <returns>An array of FileNames in the ZIP file</returns>
  400.     property FileNames: TArray<string> read GetFileNames;
  401.     /// <returns>An array of the TZipHeader of the files in the ZIP file</returns>
  402.     property FileInfos: TArray<TZipHeader> read GetFileInfos;
  403.  
  404.     /// <returns>FileName of a File in the ZipFile</returns>
  405.     property FileName[Index: Integer]: string read GetFileName;
  406.     /// <returns>TZipHeader of a File in the ZipFile</returns>
  407.     property FileInfo[Index: Integer]: TZipHeader read GetFileInfo;
  408.     /// <remarks>
  409.     ///  File Comments can be changed for files opened in write mode at any point.
  410.     ///  The comment is written when the Central Directory is written to disk.
  411.     ///  Comments can be a maximum of 65535 bytes long. If a longer comment is supplied,
  412.     ///  It is truncated before writing to the ZIP File.
  413.     /// </remarks>
  414.     property FileComment[Index: Integer]: string read GetFileComment write SetFileComment;
  415.     /// <remarks>
  416.     ///  Comments can be a maximum of 65535 bytes long. If a longer comment is supplied,
  417.     ///  It is truncated before writing to the ZIP File.
  418.     /// </remarks>
  419.     property Comment: string read GetComment write SetComment;
  420.     property UTF8Support: Boolean read FUTF8Support write SetUTF8Support default True;
  421.     /// <summary> On progress event. </summary>
  422.     property OnProgress: TZipProgressEvent read FOnProgress write FOnProgress;
  423.   end;
  424.  
  425. implementation
  426.  
  427. uses
  428.   System.RTLConsts,
  429.   System.ZLib,
  430.   System.Types
  431. {$ifdef MSWINDOWS}, Winapi.Windows{$endif}
  432.   ;
  433.  
  434. function DateTimeToWinFileDate(DateTime: TDateTime): UInt32;
  435. var
  436.   Year, Month, Day, Hour, Min, Sec, MSec: Word;
  437. begin
  438.   DecodeDate(DateTime, Year, Month, Day);
  439.   if (Year < 1980) or (Year > 2107)
  440.     then Result := 0
  441.   else
  442.   begin
  443.     DecodeTime(DateTime, Hour, Min, Sec, MSec);
  444.     LongRec(Result).Lo := (Sec shr 1) or (Min shl 5) or (Hour shl 11);
  445.     LongRec(Result).Hi := Day or (Month shl 5) or ((Year - 1980) shl 9);
  446.   end;
  447. end;
  448.  
  449. function WinFileDateToDateTime(FileDate: UInt32; out DateTime: TDateTime): Boolean;
  450. var
  451.   LDate: TDateTime;
  452.   LTime: TDateTime;
  453. begin
  454.   Result := TryEncodeDate(
  455.     LongRec(FileDate).Hi shr 9 + 1980,
  456.     LongRec(FileDate).Hi shr 5 and 15,
  457.     LongRec(FileDate).Hi and 31,
  458.     LDate);
  459.  
  460.   if Result then
  461.   begin
  462.     Result := TryEncodeTime(
  463.       LongRec(FileDate).Lo shr 11,
  464.       LongRec(FileDate).Lo shr 5 and 63,
  465.       LongRec(FileDate).Lo and 31 shl 1, 0, LTime);
  466.  
  467.     if Result then
  468.       DateTime := LDate + LTime;
  469.   end;
  470. end;
  471.  
  472. function TZipHeader.GetZIP64_CompressedSize: UInt64;
  473. var Z64: TZipExtraField_ZIP64;
  474.     Ex: TZipExtraFields;
  475. begin
  476.   Result := 0;
  477.   if Length(ExtraField) > 0 then begin
  478.     Ex := ExtraField;
  479.     Z64 := Ex;
  480.     Result := Z64.CompressedSize;
  481.   end;
  482.   if Result = 0 then
  483.     Result := CompressedSize;
  484. end;
  485.  
  486. function TZipHeader.GetZIP64_UncompressedSize: UInt64;
  487. var Z64: TZipExtraField_ZIP64;
  488.     Ex: TZipExtraFields;
  489. begin
  490.   Result := 0;
  491.   if Length(ExtraField) > 0 then begin
  492.     Ex := ExtraField;
  493.     Z64 := Ex;
  494.     Result := Z64.UncompressedSize;
  495.   end;
  496.   if Result = 0 then
  497.     Result := UncompressedSize;
  498. end;
  499.  
  500. function TZipHeader.IsZIP64: Boolean;
  501. begin
  502.   Result := (ZIP64_CompressedSize > ZIP64) or (ZIP64_UncompressedSize > ZIP64);
  503. end;
  504.  
  505. procedure TZipHeader.SetExtraField_NTFS(const aFileName: string);
  506. var Ex: TZipExtraFields;
  507.     NTFS: TZipExtraField_NTFS;
  508. begin
  509.   if not FileExists(aFileName) then Exit;
  510.  
  511.   Ex := ExtraField;
  512.   NTFS := TZipExtraField_NTFS.Create(aFileName);
  513.   Ex.Add(NTFS);
  514.   ExtraField := Ex;
  515. end;
  516.  
  517. procedure TZipHeader.SetZIP64_CompressedSize(const Value: UInt64);
  518. var Z64: TZipExtraField_ZIP64;
  519.     Ex: TZipExtraFields;
  520. begin
  521.   if Value > ZIP64 then begin
  522.     Ex := ExtraField;
  523.     Z64 := Ex;
  524.     Z64.CompressedSize := Value;
  525.     Ex.Add(Z64);
  526.     ExtraField := Ex;
  527.  
  528.     CompressedSize := ZIP64;
  529.   end else
  530.     CompressedSize := Value;
  531.   ExtraFieldLength := Length(ExtraField);
  532. end;
  533.  
  534. procedure TZipHeader.SetZIP64_UncompressedSize(const Value: UInt64);
  535. var Z64: TZipExtraField_ZIP64;
  536.     Ex: TZipExtraFields;
  537. begin
  538.   if Value > ZIP64 then begin
  539.     Ex := ExtraField;
  540.     Z64 := Ex;
  541.     Z64.UncompressedSize := Value;
  542.     Ex.Add(Z64);
  543.     ExtraField := Ex;
  544.  
  545.     UncompressedSize := ZIP64;
  546.   end else
  547.     UncompressedSize := Value;
  548.   ExtraFieldLength := Length(ExtraField);
  549. end;
  550.  
  551. class operator TZip64_EndOfCentralDirectory.Implicit(
  552.   const A: TZip64_EndOfCentralDirectory): TBytes;
  553. begin
  554.   SetLength(Result, SizeOf(A));
  555.   Move(A, Result[0], SizeOf(A));
  556. end;
  557.  
  558. procedure TZip64_EndOfCentralDirectory.Init;
  559. begin
  560.   FillChar(Self, SizeOf(Self), 0);
  561.   Signature := SIGNATURE_ZIP64_ENDOFCENTRALDIRECTORY;
  562.   RecordSize := $2C;
  563.   VersionMadeBy := ZIP_Version20;
  564.   VersionNeededToExtract := ZIP_Version20;
  565. end;
  566.  
  567. class operator TZip64_EndOfCentralDirectoryLocator.Implicit(
  568.   const A: TZip64_EndOfCentralDirectoryLocator): TBytes;
  569. begin
  570.   SetLength(Result, SizeOf(A));
  571.   Move(A, Result[0], SizeOf(A));
  572. end;
  573.  
  574. procedure TZip64_EndOfCentralDirectoryLocator.Init;
  575. begin
  576.   FillChar(Self, SizeOf(Self), 0);
  577.   Signature := SIGNATURE_ZIP64_ENDOFCENTRALDIRECTORYLOCATOR;
  578. end;
  579.  
  580. constructor TZipExtraField.Create(const aHeaderID: UInt16; const aData: TBytes);
  581. begin
  582.   HeaderID := aHeaderID;
  583.   SetData(aData);
  584. end;
  585.  
  586. constructor TZipExtraField.Create(const aRawData: TBytes);
  587. var iHeadSize: Integer;
  588. begin
  589.   iHeadSize := SizeOf(HeaderID) + SizeOf(DataSize);
  590.  
  591.   if Length(aRawData) < iHeadSize then
  592.     raise EZipException.Create('Invalid Zip ExtraField');
  593.  
  594.   Move(aRawData[0], Self, iHeadSize);
  595.  
  596.   SetLength(Data, Length(aRawData) - iHeadSize);
  597.   Move(aRawData[iHeadSize], Data[0], Length(Data));
  598.  
  599.   if DataSize <> Length(Data) then
  600.     raise EZipException.Create('Invalid Zip ExtraField');
  601. end;
  602.  
  603. class operator TZipExtraField.Implicit(const A: TZipExtraField): TBytes;
  604. var iHeaderID, iDataSize, iData: NativeUInt;
  605. begin
  606.   iData := Length(A.Data);
  607.   iHeaderID := SizeOf(A.HeaderID);
  608.   iDataSize := SizeOf(A.DataSize);
  609.  
  610.   SetLength(Result, iHeaderID + iDataSize + iData);
  611.   Move(A.HeaderID, Result[0], iHeaderID);
  612.   Move(A.DataSize, Result[iHeaderID], iDataSize);
  613.   if iData > 0 then
  614.     Move(A.Data[0], Result[iHeaderID + iDataSize], iData);
  615. end;
  616.  
  617. procedure TZipExtraField.SetData(const A: TBytes);
  618. begin
  619.   Data := Copy(A, 0, Length(A));
  620.   DataSize := Length(Data);
  621. end;
  622.  
  623. class operator TZipExtraField_ZIP64.Implicit(const aBytes: TBytes): TZipExtraField_ZIP64;
  624. begin
  625.   FillChar(Result, SizeOf(Result), 0);
  626.   if Length(aBytes) > 0 then
  627.     Move(aBytes[0], Result, Length(aBytes));
  628. end;
  629.  
  630. class operator TZipExtraField_ZIP64.Implicit(const A: TZipExtraField_ZIP64): TZipExtraField;
  631. begin
  632.   Result := TZipExtraField.Create(EXTRAFIELD_ID_ZIP64, A);
  633. end;
  634.  
  635. class operator TZipExtraField_ZIP64.Implicit(const A: TZipExtraField_ZIP64): TBytes;
  636. begin
  637.   SetLength(Result, SizeOf(A));
  638.   Move(A, Result[0], SizeOf(A));
  639. end;
  640.  
  641. class operator TZipExtraField_ZIP64.Implicit(const A: TZipExtraField): TZipExtraField_ZIP64;
  642. begin
  643.   if A.DataSize > 0 then
  644.     Result := A.Data
  645.   else
  646.     Result := nil;
  647. end;
  648.  
  649. {$ifdef MSWINDOWS}
  650. constructor TZipExtraField_NTFS.Create(const aFileName: string);
  651. var F: TWin32FileAttributeData;
  652. begin
  653.   FillChar(Self, SizeOf(Self), 0);
  654.  
  655.   Tag1 := $0001;
  656.  
  657.   Size1 := SizeOf(MTime) + SizeOf(ATime) + SizeOf(CTime);
  658.   {$WARN SYMBOL_PLATFORM OFF}Win32Check(GetFileAttributesEx(PChar(aFileName), GetFileExInfoStandard, @F));{$WARN SYMBOL_PLATFORM ON}
  659.   Move(F.ftCreationTime, CTime, SizeOf(CTime));
  660.   Move(F.ftLastAccessTime, ATime, SizeOf(ATime));
  661.   Move(F.ftLastWriteTime, MTime, SizeOf(MTime));
  662. end;
  663.  
  664. class operator TZipExtraField_NTFS.Implicit(const A: TZipExtraField_NTFS):
  665.     TBytes;
  666. begin
  667.   SetLength(Result, SizeOf(A));
  668.   Move(A, Result[0], SizeOf(A));
  669. end;
  670.  
  671. class operator TZipExtraField_NTFS.Implicit(
  672.   const A: TZipExtraField_NTFS): TZipExtraField;
  673. begin
  674.   Result := TZipExtraField.Create(EXTRAFIELD_ID_NTFS, A);
  675. end;
  676.  
  677. class operator TZipExtraField_NTFS.Implicit(
  678.   const A: TZipExtraField): TZipExtraField_NTFS;
  679. begin
  680.   if A.DataSize > 0 then
  681.     Result := A.Data
  682.   else
  683.     Result := nil;
  684. end;
  685.  
  686. class operator TZipExtraField_NTFS.Implicit(const aBytes: TBytes):
  687.     TZipExtraField_NTFS;
  688. begin
  689.   FillChar(Result, SizeOf(Result), 0);
  690.   if Length(aBytes) > 0 then
  691.     Move(aBytes[0], Result, Length(aBytes));
  692. end;
  693. {$endif}
  694.  
  695. class operator TZipExtraFields.Implicit(
  696.   const A: TZipExtraFields): TBytes;
  697. var F: TZipExtraField;
  698.     B: TBytes;
  699.     i: Integer;
  700. begin
  701.   SetLength(Result, 0);
  702.   for F in A.Items do begin
  703.     B := F;
  704.     i := Length(Result);
  705.     SetLength(Result, i + Length(B));
  706.     Move(B[0], Result[i], Length(B));
  707.   end;
  708. end;
  709.  
  710. class operator TZipExtraFields.Implicit(
  711.   const aBytes: TBytes): TZipExtraFields;
  712. var iOffSet: Integer;
  713.     pSize: ^UInt16;
  714.     B: TBytes;
  715. begin
  716.   iOffSet := 0;
  717.   SetLength(Result.Items, 0);
  718.   while iOffSet < Length(aBytes) do begin
  719.     pSize := @aBytes[iOffSet + 2];
  720.     B := Copy(aBytes, iOffSet, 2{HeaderID} + 2{DataSize} + pSize^);
  721.     Result.Items[Result.New] := TZipExtraField.Create(B);
  722.     Inc(iOffSet, Length(B));
  723.   end;
  724. end;
  725.  
  726. procedure TZipExtraFields.Add(const A: TZipExtraField);
  727. var F: TZipExtraField;
  728.     i: NativeInt;
  729. begin
  730.   if not Get(A.HeaderID, F, i) then
  731.     i := New;
  732.   Items[i] := A;
  733. end;
  734.  
  735. function TZipExtraFields.Get(const aHeaderID: UInt16; out aItem:
  736.     TZipExtraField; out Index: NativeInt): Boolean;
  737. var i: NativeInt;
  738. begin
  739.   Index := -1;
  740.   for i := 0 to Length(Items) - 1 do begin
  741.     if Items[i].HeaderID = aHeaderID then begin
  742.       aItem := Items[i];
  743.       Index := i;
  744.       Break;
  745.     end;
  746.   end;
  747.   Result := Index <> -1;
  748. end;
  749.  
  750. class operator TZipExtraFields.Implicit(
  751.   const A: TZipExtraFields): TZipExtraField_ZIP64;
  752. var F: TZipExtraField;
  753.     i: NativeInt;
  754. begin
  755.   if not A.Get(EXTRAFIELD_ID_ZIP64, F, i) then
  756.     F := TZipExtraField.Create(EXTRAFIELD_ID_ZIP64, nil);
  757.   Result := F;
  758. end;
  759.  
  760. function TZipExtraFields.New: NativeInt;
  761. begin
  762.   Result := Length(Items) + 1;
  763.   SetLength(Items, Result);
  764.   Dec(Result);
  765. end;
  766.  
  767. procedure VerifyRead(Stream: TStream; Buffer: TBytes; Count: Integer); overload;
  768. begin
  769.   if Stream.Read(Buffer, Count) <> Count then
  770.   raise EZipException.CreateRes(@SZipErrorRead) at ReturnAddress;
  771. end;
  772.  
  773. procedure VerifyRead(Stream: TStream; var Buffer: UInt8; Count: Integer); overload;
  774. begin
  775.   if Stream.Read(Buffer, Count) <> Count then
  776.   raise EZipException.CreateRes(@SZipErrorRead) at ReturnAddress;
  777. end;
  778.  
  779. procedure VerifyRead(Stream: TStream; var Buffer: UInt16; Count: Integer); overload;
  780. begin
  781.   if Stream.Read(Buffer, Count) <> Count then
  782.   raise EZipException.CreateRes(@SZipErrorRead) at ReturnAddress;
  783. end;
  784.  
  785. procedure VerifyRead(Stream: TStream; var Buffer: UInt32; Count: Integer); overload;
  786. begin
  787.   if Stream.Read(Buffer, Count) <> Count then
  788.   raise EZipException.CreateRes(@SZipErrorRead) at ReturnAddress;
  789. end;
  790.  
  791. procedure VerifyWrite(Stream: TStream; Buffer: TBytes; Count: Integer); overload;
  792. begin
  793.   if Stream.Write(Buffer, 0, Count) <> Count then
  794.     raise EZipException.CreateRes(@SZipErrorWrite) at ReturnAddress;
  795. end;
  796.  
  797. procedure VerifyWrite(Stream: TStream; Buffer: UInt8; Count: Integer); overload;
  798. begin
  799.   if Stream.Write(Buffer, Count) <> Count then
  800.     raise EZipException.CreateRes(@SZipErrorWrite) at ReturnAddress;
  801. end;
  802.  
  803. procedure VerifyWrite(Stream: TStream; Buffer: UInt16; Count: Integer); overload;
  804. begin
  805.   if Stream.Write(Buffer, Count) <> Count then
  806.     raise EZipException.CreateRes(@SZipErrorWrite) at ReturnAddress;
  807. end;
  808.  
  809. procedure VerifyWrite(Stream: TStream; Buffer: UInt32; Count: Integer); overload;
  810. begin
  811.   if Stream.Write(Buffer, Count) <> Count then
  812.     raise EZipException.CreateRes(@SZipErrorWrite) at ReturnAddress;
  813. end;
  814.  
  815. type
  816.   /// <summary> Helper class for reading a segment of another stream.</summary>
  817.   TStoredStream = class(TStream)
  818.   private
  819.     FStream: TStream;
  820.     FPos: Int64;
  821.   protected
  822.     function GetSize: Int64; override;
  823.   public
  824.     constructor Create(Stream: TStream);
  825.  
  826.     function Read(var Buffer; Count: Longint): Longint; overload; override;
  827.     function Write(const Buffer; Count: Longint): Longint; overload; override;
  828.     function Read(Buffer: TBytes; Offset, Count: Longint): Longint; overload; override;
  829.     function Write(const Buffer: TBytes; Offset, Count: Longint): Longint; overload; override;
  830.     function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
  831.   end;
  832.  
  833. { TStoredStream }
  834.  
  835. constructor TStoredStream.Create(Stream: TStream);
  836. begin
  837.   FStream := Stream;
  838.   FPos := FStream.Position;
  839. end;
  840.  
  841. function TStoredStream.GetSize: Int64;
  842. begin
  843.   Result := FStream.Size;
  844. end;
  845.  
  846. function TStoredStream.Read(var Buffer; Count: Longint): Longint;
  847. begin
  848.   Result := FStream.Read(Buffer, Count);
  849. end;
  850.  
  851. function TStoredStream.Read(Buffer: TBytes; Offset, Count: Longint): Longint;
  852. begin
  853.   Result := FStream.Read(Buffer, Offset, Count);
  854. end;
  855.  
  856. function TStoredStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
  857. begin
  858.   Result := FStream.Seek(Offset, Origin)
  859. end;
  860.  
  861. function TStoredStream.Write(const Buffer; Count: Longint): Longint;
  862. begin
  863.   Result := FStream.Write(Buffer, Count);
  864. end;
  865.  
  866. function TStoredStream.Write(const Buffer: TBytes; Offset, Count: Longint): Longint;
  867. begin
  868.   Result := FStream.Write(Buffer, Offset, Count);
  869. end;
  870.  
  871. function TZipCompressionToString(Compression: TZipCompression): string;
  872. begin
  873.   case Compression of
  874.     zcStored:    Result := 'Stored';                // do not localize
  875.     zcShrunk:    Result := 'Shrunk';                // do not localize
  876.     zcReduce1:   Result := 'Reduced1';              // do not localize
  877.     zcReduce2:   Result := 'Reduced2';              // do not localize
  878.     zcReduce3:   Result := 'Reduced3';              // do not localize
  879.     zcReduce4:   Result := 'Reduced4';              // do not localize
  880.     zcImplode:   Result := 'Imploded';              // do not localize
  881.     zcTokenize:  Result := 'Tokenized';             // do not localize
  882.     zcDeflate:   Result := 'Deflated';              // do not localize
  883.     zcDeflate64: Result := 'Deflated64';            // do not localize
  884.     zcPKImplode: Result := 'Imploded(TERSE)';       // do not localize
  885.     zcBZIP2:     Result := 'BZIP2';                 // do not localize
  886.     zcLZMA:      Result := 'LZMA';                  // do not localize
  887.     zcTERSE:     Result := 'TERSE';                 // do not localize
  888.     zcLZ77:      Result := 'LZ77';                  // do not localize
  889.     zcWavePack:  Result := 'WavPack';               // do not localize
  890.     zcPPMdI1:    Result := 'PPMd version I, Rev 1'; // do not localize
  891.     else
  892.       Result := 'Unknown';
  893.   end;
  894. end;
  895.  
  896. { TZipFile }
  897.  
  898. function TZipFile.TBytesToString(B: TBytes): string;
  899. var
  900.   E: TEncoding;
  901. begin
  902.   if FUTF8Support then
  903.     E := TEncoding.GetEncoding(65001)
  904.   else
  905.     E := TEncoding.GetEncoding(437);
  906.   try
  907.     Result := E.GetString(B);
  908.   finally
  909.     E.Free;
  910.   end;
  911. end;
  912.  
  913. class procedure TZipFile.UnregisterCompressionHandler(
  914.   Compression: TZipCompression);
  915. begin
  916.   FCompressionHandler.Remove(Compression);
  917. end;
  918.  
  919. function TZipFile.StringToTBytes(S: string): TBytes;
  920. var
  921.   E: TEncoding;
  922. begin
  923.   if FUTF8Support then
  924.     E := TEncoding.GetEncoding(65001)
  925.   else
  926.     E := TEncoding.GetEncoding(437);
  927.   try
  928.     Result := E.GetBytes(S);
  929.   finally
  930.     E.Free;
  931.   end;
  932. end;
  933.  
  934. function TZipFile.GetComment: string;
  935. begin
  936.   if FMode = zmClosed then
  937.     raise EZipException.CreateRes(@SZipNotOpen);
  938.   Result := TBytesToString(FComment);
  939. end;
  940.  
  941. function TZipFile.GetFileComment(Index: Integer): string;
  942. begin
  943.   if FMode = zmClosed then
  944.     raise EZipException.CreateRes(@SZipNotOpen);
  945.   Result := TBytesToString(FFiles[Index].FileComment);
  946. end;
  947.  
  948. function TZipFile.GetFileCount: Integer;
  949. begin
  950.   if FMode = zmClosed then
  951.     raise EZipException.CreateRes(@SZipNotOpen);
  952.   Result := FFiles.Count;
  953. end;
  954.  
  955. function TZipFile.GetFileInfo(Index: Integer): TZipHeader;
  956. begin
  957.   if FMode = zmClosed then
  958.     raise EZipException.CreateRes(@SZipNotOpen);
  959.   Result := FFiles[Index];
  960. end;
  961.  
  962. function TZipFile.GetFileInfos: TArray<TZipHeader>;
  963. begin
  964.   if FMode = zmClosed then
  965.     raise EZipException.CreateRes(@SZipNotOpen);
  966.   Result := FFiles.ToArray;
  967. end;
  968.  
  969. function TZipFile.GetFileName(Index: Integer): string;
  970. begin
  971.   if FMode = zmClosed then
  972.     raise EZipException.CreateRes(@SZipNotOpen);
  973.   Result := TBytesToString(FFiles[Index].FileName);
  974. end;
  975.  
  976. function TZipFile.GetFileNames: TArray<string>;
  977. var
  978.   I: Integer;
  979. begin
  980.   if FMode = zmClosed then
  981.     raise EZipException.CreateRes(@SZipNotOpen);
  982.   SetLength(Result, FFiles.Count);
  983.   for I := 0 to High(Result) do
  984.     Result[I] := TBytesToString(FFiles[I].FileName);
  985. end;
  986.  
  987. procedure TZipFile.ReadCentralHeader;
  988. var
  989.   I: Integer;
  990.   Signature: UInt32;
  991.   LEndHeader: TZipEndOfCentralHeader;
  992.   LHeader: TZipHeader;
  993.   Z64: TZip64_EndOfCentralDirectory;
  994. begin
  995.   FFiles.Clear;
  996.   if FStream.Size = 0 then
  997.     Exit;
  998.   // Read End Of Centeral Direcotry Header
  999.   if not LocateEndOfCentralHeader(LEndHeader) then
  1000.     raise EZipException.CreateRes(@SZipErrorRead);
  1001.   // Move to the beginning of the CentralDirectory
  1002.   FStream.Position := LEndHeader.CentralDirOffset;
  1003.   if LEndHeader.CentralDirOffset = ZIP64 then begin
  1004.     if ZIP64_LocateEndOfCentralHeader(Z64) then
  1005.       FStream.Position := Z64.DirectoryOffset;
  1006.   end;
  1007.   // Save Begginning of Central Directory. This is where new files
  1008.   // get written to, and where the new central directory gets written when
  1009.   // closing.
  1010.   FEndFileData := LEndHeader.CentralDirOffset;
  1011.   // Read File Headers
  1012.   for I := 0 to LEndHeader.CentralDirEntries - 1 do
  1013.   begin
  1014.     // Verify Central Header signature
  1015.     FStream.Read(Signature, Sizeof(Signature));
  1016.     if Signature <> SIGNATURE_CENTRALHEADER then
  1017.       raise EZipException.CreateRes(@SZipInvalidCentralHeader);
  1018.     // Read Central Header
  1019.     VerifyRead(FStream, LHeader.MadeByVersion,      Sizeof(UInt16));
  1020.     VerifyRead(FStream, LHeader.RequiredVersion,    Sizeof(UInt16));
  1021.     VerifyRead(FStream, LHeader.Flag,               Sizeof(UInt16));
  1022.     VerifyRead(FStream, LHeader.CompressionMethod,  Sizeof(UInt16));
  1023.     VerifyRead(FStream, LHeader.ModifiedDateTime,   Sizeof(UInt32));
  1024.     VerifyRead(FStream, LHeader.CRC32,              Sizeof(UInt32));
  1025.     VerifyRead(FStream, LHeader.CompressedSize,     Sizeof(UInt32));
  1026.     VerifyRead(FStream, LHeader.UncompressedSize,   Sizeof(UInt32));
  1027.     VerifyRead(FStream, LHeader.FileNameLength,     Sizeof(UInt16));
  1028.     VerifyRead(FStream, LHeader.ExtraFieldLength,   Sizeof(UInt16));
  1029.     VerifyRead(FStream, LHeader.FileCommentLength,  Sizeof(UInt16));
  1030.     VerifyRead(FStream, LHeader.DiskNumberStart,    Sizeof(UInt16));
  1031.     VerifyRead(FStream, LHeader.InternalAttributes, Sizeof(UInt16));
  1032.     VerifyRead(FStream, LHeader.ExternalAttributes, Sizeof(UInt32));
  1033.     VerifyRead(FStream, LHeader.LocalHeaderOffset,  Sizeof(UInt32));
  1034.  
  1035.     // Read Dynamic length fields (FileName, ExtraField, FileComment)
  1036.     if LHeader.FileNameLength > 0 then
  1037.     begin
  1038.       SetLength(LHeader.FileName, LHeader.FileNameLength);
  1039.       VerifyRead(FStream, LHeader.FileName, LHeader.FileNameLength);
  1040.     end;
  1041.     if LHeader.ExtraFieldLength > 0 then
  1042.     begin
  1043.       SetLength(LHeader.ExtraField, LHeader.ExtraFieldLength);
  1044.       VerifyRead(FStream, LHeader.ExtraField, LHeader.ExtraFieldLength);
  1045.     end;
  1046.     if LHeader.FileCommentLength > 0 then
  1047.     begin
  1048.       SetLength(LHeader.FileComment, LHeader.FileCommentLength);
  1049.       VerifyRead(FStream, LHeader.FileComment, LHeader.FileCommentLength);
  1050.     end;
  1051.     if (LHeader.Flag and (1 shl 11)) = 0 then
  1052.       FUTF8Support := False;
  1053.  
  1054.     // Save File Header in interal list
  1055.     FFiles.Add(LHeader);
  1056.   end;
  1057. end;
  1058.  
  1059. procedure TZipFile.SetComment(Value: string);
  1060. begin
  1061.   FComment := StringToTBytes(Value);
  1062.   if not (FMode in [zmReadWrite, zmWrite]) then
  1063.     raise EZipException.CreateRes(@SZipNoWrite);
  1064.   if Length(FComment) > $FFFF then
  1065.     SetLength(FComment, $FFFF);
  1066. end;
  1067.  
  1068. procedure TZipFile.SetFileComment(Index: Integer; Value: string);
  1069. var
  1070.   LFile: TZipHeader;
  1071. begin
  1072.   if not (FMode in [zmReadWrite, zmWrite]) then
  1073.     raise EZipException.CreateRes(@SZipNoWrite);
  1074.   LFile := FFiles[Index];
  1075.  
  1076.   LFile.FileComment := StringToTBytes(Value);
  1077.   if Length(LFile.FileComment) > $FFFF then
  1078.     SetLength(LFile.FileComment, $FFFF);
  1079.   LFile.FileCommentLength := Length(LFile.FileComment);
  1080.   FFiles[Index] := LFile;
  1081. end;
  1082.  
  1083. procedure TZipFile.SetUTF8Support(const Value: Boolean);
  1084. begin
  1085.   if Value = FUTF8Support then Exit;
  1086.   if not (FMode in [zmReadWrite, zmWrite]) then
  1087.     raise EZipException.CreateRes(@SZipNoWrite);
  1088.   // Resetting this flag would require re-writing all the local headers with the
  1089.   // new strings and flag, and adjusting the offsets.
  1090.   if FFiles.Count <> 0 then
  1091.     raise EZipException.CreateRes(@SZipNotEmpty);
  1092.  
  1093.  
  1094.   FUTF8Support := Value;
  1095. end;
  1096.  
  1097. class constructor TZipFile.Create;
  1098. begin
  1099.   FCompressionHandler := TCompressionDict.Create;
  1100.  
  1101.   RegisterCompressionHandler(zcStored,
  1102.     function(InStream: TStream; const ZipFile: TZipFile; const Item: TZipHeader): TStream
  1103.     begin
  1104.       Result := TStoredStream.Create(InStream);
  1105.     end,
  1106.     function(InStream: TStream; const ZipFile: TZipFile; const Item: TZipHeader): TStream
  1107.     begin
  1108.       Result := TStoredStream.Create(InStream);
  1109.     end);
  1110.  
  1111.   RegisterCompressionHandler(zcDeflate,
  1112.     function(InStream: TStream; const ZipFile: TZipFile; const Item: TZipHeader): TStream
  1113.     begin
  1114.       Result := TZCompressionStream.Create(InStream, zcDefault, -15);
  1115.     end,
  1116.     function(InStream: TStream; const ZipFile: TZipFile; const Item: TZipHeader): TStream
  1117.     var
  1118.       LStream : TStream;
  1119.       LIsEncrypted: Boolean;
  1120.     begin
  1121.       // From https://pkware.cachefly.net/webdocs/casestudies/APPNOTE.TXT
  1122.       // Section 4.4.4 general purpose bit flag: (2 bytes)
  1123.       // Bit 0: If set, indicates that the file is encrypted.
  1124.       LIsEncrypted := (Item.Flag and 1) = 1;
  1125.  
  1126.       if Assigned(TZipFile.FOnCreateDecompressStream) then
  1127.         LStream := TZipFile.FOnCreateDecompressStream(InStream, ZipFile, Item, LIsEncrypted)
  1128.       else if Assigned(TZipFile.FCreateDecompressStreamCallBack) then
  1129.         LStream := TZipFile.FCreateDecompressStreamCallBack(InStream, ZipFile, Item, LIsEncrypted)
  1130.       else
  1131.         LStream := InStream;
  1132.       Result := TZDecompressionStream.Create(LStream, -15, LStream <> InStream);
  1133.     end);
  1134. end;
  1135.  
  1136. class destructor TZipFile.Destroy;
  1137. begin
  1138.   FCompressionHandler.Free;
  1139. end;
  1140.  
  1141. class procedure TZipFile.RegisterCompressionHandler(
  1142.   Compression: TZipCompression; CompressStream, DecompressStream: TStreamConstructor);
  1143. begin
  1144.   FCompressionHandler.AddOrSetValue(Compression,
  1145.     TPair<TStreamConstructor, TStreamConstructor>.Create(CompressStream, DecompressStream));
  1146. end;
  1147.  
  1148. class function TZipFile.IsValid(const ZipFileName: string): Boolean;
  1149. var
  1150.   Z: TZipFile;
  1151.   Header: TZipEndOfCentralHeader;
  1152. begin
  1153.   Result := False;
  1154.   try
  1155.     Z := TZipFile.Create;
  1156.     try
  1157.       Z.FStream := TFileStream.Create(ZipFileName, fmOpenRead);
  1158.       try
  1159.         Result := Z.LocateEndOfCentralHeader(Header);
  1160.       finally
  1161.         Z.FStream.Free;
  1162.       end;
  1163.     finally
  1164.       Z.Free;
  1165.     end;
  1166.   except on E: EStreamError do
  1167.     // Swallow only Stream exceptions and return False
  1168.   end;
  1169. end;
  1170.  
  1171. function TZipFile.LocateEndOfCentralHeader(var Header: TZipEndOfCentralHeader): Boolean;
  1172. var
  1173.   I: Integer;
  1174.   LBackRead, LReadSize, LMaxBack: UInt32;
  1175.   LBackBuf: TBytes;
  1176. begin
  1177.   if FStream.Size < $FFFF then
  1178.     LMaxBack := FStream.Size
  1179.   else
  1180.     LMaxBack := $FFFF;
  1181.   LBackRead := 4;
  1182.   SetLength(LBackBuf, $404 - 1);
  1183.   while LBackRead < LMaxBack do
  1184.   begin
  1185.     if LBackRead + Cardinal(Length(LBackBuf) - 4) > LMaxBack then
  1186.       LBackRead := LMaxBack
  1187.     else
  1188.       Inc(LBackRead, Length(LBackBuf) -4);
  1189.     FStream.Position := FStream.Size - LBackRead;
  1190.     if Length(LBackBuf) < (FStream.Size - FStream.Position) then
  1191.       LReadSize := Length(LBackBuf)
  1192.     else
  1193.       LReadSize := FStream.Size - FStream.Position;
  1194.     VerifyRead(FStream, LBackBuf, LReadSize);
  1195.  
  1196.     for I := LReadSize - 4 downto 0 do
  1197.     begin
  1198.       if (LBackBuf[I]   = ((SIGNATURE_ZIPENDOFHEADER       ) and $FF)) and
  1199.          (LBackBuf[I+1] = ((SIGNATURE_ZIPENDOFHEADER shr  8) and $FF)) and
  1200.          (LBackBuf[I+2] = ((SIGNATURE_ZIPENDOFHEADER shr 16) and $FF)) and
  1201.          (LBackBuf[I+3] = ((SIGNATURE_ZIPENDOFHEADER shr 24) and $FF)) then
  1202.       begin
  1203.         Move(LBackBuf[I+4], Header, SizeOf(Header));
  1204.         if Header.CommentLength > 0 then
  1205.         begin
  1206.           FStream.Position := FStream.Size - LBackRead + I + 4 + SizeOf(Header);
  1207.           SetLength(FComment, Header.CommentLength);
  1208.           FStream.Read(FComment, Header.CommentLength);
  1209.         end
  1210.         else
  1211.           SetLength(FComment, 0);
  1212.         Exit(True);
  1213.       end;
  1214.     end;
  1215.   end;
  1216.   Result := False;
  1217. end;
  1218.  
  1219. class procedure TZipFile.ExtractZipFile(const ZipFileName: string; const Path: string; ZipProgress: TZipProgressEvent);
  1220. var
  1221.   LZip: TZipFile;
  1222. begin
  1223.   LZip := TZipFile.Create;
  1224.   try
  1225.     if Assigned(ZipProgress) then
  1226.       LZip.OnProgress := ZipProgress;
  1227.     LZip.Open(ZipFileName, zmRead);
  1228.     LZip.ExtractAll(Path);
  1229.     LZip.Close;
  1230.   finally
  1231.     LZip.Free;
  1232.   end;
  1233. end;
  1234.  
  1235. function TZipFile.ZIP64_LocateEndOfCentralHeader(
  1236.   var Header: TZip64_EndOfCentralDirectory): Boolean;
  1237. var B: TBytes;
  1238.     i, iSize: Integer;
  1239. begin
  1240.   Result := False;
  1241.  
  1242.   iSize := $FFFF;
  1243.   if FStream.Size < iSize then
  1244.     iSize := FStream.Size;
  1245.   SetLength(B, iSize);
  1246.  
  1247.   FStream.Seek(-iSize, soFromEnd);
  1248.  
  1249.   i := FStream.Read(B, iSize) - 1 - SizeOf(Header);
  1250.   while i >= 0 do begin
  1251.     if PCardinal(@B[i])^ = SIGNATURE_ZIP64_ENDOFCENTRALDIRECTORY then begin
  1252.       Move(B[i], Header, SizeOf(Header));
  1253.       Result := True;
  1254.       Break;
  1255.     end;
  1256.     Dec(i);
  1257.   end;
  1258. end;
  1259.  
  1260. class procedure TZipFile.ZipDirectoryContents(const ZipFileName: string; const Path: string;
  1261.   Compression: TZipCompression; ZipProgress: TZipProgressEvent);
  1262. var
  1263.   LZipFile: TZipFile;
  1264.   LFile: string;
  1265.   LZFile: string;
  1266.   LPath: string;
  1267.   LFiles: TStringDynArray;
  1268. begin
  1269.   LZipFile := TZipFile.Create;
  1270.   try
  1271.     if Assigned(ZipProgress) then
  1272.       LZipFile.OnProgress := ZipProgress;
  1273.     if TFile.Exists(ZipFileName) then
  1274.       TFile.Delete(ZipFileName);
  1275.     LFiles := TDirectory.GetFiles(Path, '*', TSearchOption.soAllDirectories);
  1276.     LZipFile.Open(ZipFileName, zmWrite);
  1277.     LPath := System.SysUtils.IncludeTrailingPathDelimiter(Path);
  1278.     for LFile in LFiles do
  1279.     begin
  1280.       // Strip off root path
  1281. {$IFDEF MSWINDOWS}
  1282.       LZFile := StringReplace(Copy(LFile, Length(LPath) + 1, Length(LFile)), '\', '/', [rfReplaceAll]);
  1283. {$ELSE}
  1284.       LZFile := Copy(LFile, Length(LPath) + 1, Length(LFile));
  1285. {$ENDIF MSWINDOWS}
  1286.       LZipFile.Add(LFile, LZFile, Compression);
  1287.     end;
  1288.   finally
  1289.     LZipFile.Free;
  1290.   end;
  1291. end;
  1292.  
  1293. // Extract Unicode Path
  1294. // Based on section 4.6.9 -Info-ZIP Unicode Path Extra Field (0x7075) from
  1295. // https://pkware.cachefly.net/webdocs/casestudies/APPNOTE.TXT
  1296. // Stores the UTF-8 version of the file name field as stored in the
  1297. //       local header and central directory header. (Last Revision 20070912)
  1298. //
  1299. //         Value         Size        Description
  1300. //         -----         ----        -----------
  1301. // (UPath) 0x7075        Short       tag for this extra block type ("up")
  1302. //         TSize         Short       total data size for this block
  1303. //         Version       1 byte      version of this extra field, currently 1
  1304. //         NameCRC32     4 bytes     File Name Field CRC32 Checksum
  1305. //         UnicodeName   Variable    UTF-8 version of the entry File Name
  1306. class function TZipFile.GetUTF8PathFromExtraField(const AHeader: TZipHeader; out AFileName: string): Boolean;
  1307. const
  1308.   UPATH = $7075;
  1309.   SIZEPOS = 2;
  1310.   CRCPOS = 5;
  1311.   PATHPOS = 9;
  1312.   PATHSIZESUB = 5;
  1313. var
  1314.   I: Integer;
  1315.   LTotalSize: Word;
  1316.   LCRC: Cardinal;
  1317.   LPathCRC: Cardinal;
  1318. begin
  1319.   Result := False;
  1320.   for I := 0 to AHeader.ExtraFieldLength - 2 do
  1321.   begin
  1322.     if PWord(@AHeader.ExtraField[I])^ = UPATH then
  1323.     begin
  1324.       LTotalSize := PWord(@AHeader.ExtraField[I + SIZEPOS])^;
  1325.       LCRC := PCardinal(@AHeader.ExtraField[I + CRCPOS])^;
  1326.       LPathCRC := crc32(0, nil, 0);
  1327.       LPathCRC := crc32(LPathCRC, @AHeader.FileName[0], Length(AHeader.FileName));
  1328.       if LPathCRC = LCRC then
  1329.       begin
  1330.         AFileName := TEncoding.UTF8.GetString(AHeader.ExtraField, I + PATHPOS, LTotalSize - PATHSIZESUB);
  1331.         Result := True;
  1332.       end;
  1333.       Break;
  1334.     end;
  1335.   end;
  1336. end;
  1337.  
  1338. constructor TZipFile.Create;
  1339. begin
  1340.   inherited Create;
  1341.   FFiles := TList<TZipHeader>.Create;
  1342.   FMode := zmClosed;
  1343.   FUTF8Support := True;
  1344. end;
  1345.  
  1346. destructor TZipFile.Destroy;
  1347. begin
  1348.   Close; // In case a file is open for writing currently
  1349.  
  1350.   FFiles.Free;
  1351.   inherited;
  1352. end;
  1353.  
  1354. procedure TZipFile.DoZLibProgress(Sender: TObject);
  1355. begin
  1356.   if Assigned(FOnProgress) then
  1357.     FOnProgress(Self, FCurrentFile, FCurrentHeader, (Sender as TStream).Position);
  1358. end;
  1359.  
  1360. procedure TZipFile.Open(const ZipFileName: string; OpenMode: TZipMode);
  1361. var
  1362.   LMode: LongInt;
  1363.   LFileStream: TFileStream;
  1364. begin
  1365.   Close; // In case the user had a file open
  1366.   case OpenMode of
  1367.     zmRead:      LMode := fmOpenRead;
  1368.     zmReadWrite: LMode := fmOpenReadWrite;
  1369.     zmWrite:     LMode := fmCreate;
  1370.     else
  1371.       raise EZipException.CreateRes(@sArgumentInvalid);
  1372.   end;
  1373.   LFileStream := TFileStream.Create(ZipFileName, LMode);
  1374.   try
  1375.     Open(LFileStream, OpenMode);
  1376.     FFileStream := LFileStream;
  1377.   except
  1378.     FreeAndNil(LFileStream);
  1379.     raise;
  1380.   end;
  1381. end;
  1382.  
  1383. procedure TZipFile.Open(ZipFileStream: TStream; OpenMode: TZipMode);
  1384. begin
  1385.   Close; // In case the user had a file open
  1386.   if OpenMode = zmClosed then
  1387.     raise EZipException.CreateRes(@sArgumentInvalid);
  1388.   if (OpenMode = zmRead) and (ZipFileStream.Size = 0) then
  1389.     raise EZipException.CreateRes(@SReadError);
  1390.  
  1391.   FStream := ZipFileStream;
  1392.   FStartFileData := FStream.Position;
  1393.   if OpenMode in [zmRead, zmReadWrite] then
  1394.   try
  1395.     // Read the Central Header to verify it's a valid zipfile
  1396.     ReadCentralHeader;
  1397.   except
  1398.     // If it's an invalid zipfile, cleanup
  1399.     FStream := nil;
  1400.     raise;
  1401.   end;
  1402.   FMode := OpenMode;
  1403. end;
  1404.  
  1405. procedure TZipFile.Close;
  1406. var
  1407.   LHeader: TZipHeader;
  1408.   LEndOfHeader: TZipEndOfCentralHeader;
  1409.   I: Integer;
  1410.   Signature: UInt32;
  1411.   iCentralDirSize: UInt32;
  1412.   Z64_End: TZip64_EndOfCentralDirectory;
  1413.   Z64_EndLocator: TZip64_EndOfCentralDirectoryLocator;
  1414.   bIsZIP64: Boolean;
  1415. begin
  1416.   try
  1417.     // Only need to write Central Directory and End Of Central Directory if writing
  1418.     if (FMode = zmReadWrite) or (FMode = zmWrite) then
  1419.     begin
  1420.       bIsZIP64 := False;
  1421.       FStream.Position := FEndFileData;
  1422.       Signature := SIGNATURE_CENTRALHEADER;
  1423.       // Write File Signatures
  1424.       for I := 0 to FFiles.Count - 1 do
  1425.       begin
  1426.         LHeader := FFiles[I];
  1427.  
  1428.         if not bIsZip64 then
  1429.           bIsZip64 := LHeader.IsZIP64;
  1430.  
  1431.         VerifyWrite(FStream, Signature, SizeOf(Signature));
  1432. //        VerifyWrite(FStream, LHeader.MadeByVersion,  CENTRALHEADERSIZE);
  1433.         VerifyWrite(FStream, LHeader.MadeByVersion,      Sizeof(UInt16));
  1434.         VerifyWrite(FStream, LHeader.RequiredVersion,    Sizeof(UInt16));
  1435.         VerifyWrite(FStream, LHeader.Flag,               Sizeof(UInt16));
  1436.         VerifyWrite(FStream, LHeader.CompressionMethod,  Sizeof(UInt16));
  1437.         VerifyWrite(FStream, LHeader.ModifiedDateTime,   Sizeof(UInt32));
  1438.         VerifyWrite(FStream, LHeader.CRC32,              Sizeof(UInt32));
  1439.         VerifyWrite(FStream, LHeader.CompressedSize,     Sizeof(UInt32));
  1440.         VerifyWrite(FStream, LHeader.UncompressedSize,   Sizeof(UInt32));
  1441.         VerifyWrite(FStream, LHeader.FileNameLength,     Sizeof(UInt16));
  1442.         VerifyWrite(FStream, LHeader.ExtraFieldLength,   Sizeof(UInt16));
  1443.         VerifyWrite(FStream, LHeader.FileCommentLength,  Sizeof(UInt16));
  1444.         VerifyWrite(FStream, LHeader.DiskNumberStart,    Sizeof(UInt16));
  1445.         VerifyWrite(FStream, LHeader.InternalAttributes, Sizeof(UInt16));
  1446.         VerifyWrite(FStream, LHeader.ExternalAttributes, Sizeof(UInt32));
  1447.         VerifyWrite(FStream, LHeader.LocalHeaderOffset,  Sizeof(UInt32));
  1448.  
  1449.         if LHeader.FileNameLength <> 0 then
  1450.           VerifyWrite(FStream, LHeader.FileName, LHeader.FileNameLength);
  1451.         if LHeader.ExtraFieldLength <> 0 then
  1452.           VerifyWrite(FStream, LHeader.ExtraField, LHeader.ExtraFieldLength);
  1453.         if LHeader.FileCommentLength <> 0 then
  1454.           VerifyWrite(FStream, LHeader.FileComment, LHeader.FileCommentLength);
  1455.       end;
  1456.  
  1457.       if not bIsZip64 then
  1458.         bIsZip64 := FStream.Position > ZIP64;
  1459.  
  1460.       iCentralDirSize := FStream.Position - FEndFileData;
  1461.  
  1462.       if bIsZip64 then begin
  1463.         Z64_EndLocator.Init;
  1464.         Z64_EndLocator.StartDiskNumber := 0;
  1465.         Z64_EndLocator.RelativeOffset := FStream.Position;
  1466.         Z64_EndLocator.TotalDisks := 1;
  1467.  
  1468.         Z64_End.Init;
  1469.         Z64_End.EntriesOnDisk := FFiles.Count;
  1470.         Z64_End.TotalEntries := FFiles.Count;
  1471.         Z64_End.DirectorySize := iCentralDirSize;
  1472.         Z64_End.DirectoryOffset := FEndFileData;
  1473.  
  1474.         VerifyWrite(FStream, Z64_End, SizeOf(Z64_End));
  1475.         VerifyWrite(FStream, Z64_EndLocator, SizeOf(Z64_EndLocator));
  1476.       end;
  1477.  
  1478.       // Only support writing single disk .ZIP files
  1479.       FillChar(LEndOfHeader, Sizeof(LEndOfHeader), 0);
  1480.       LEndOfHeader.CentralDirEntries := FFiles.Count;
  1481.       LEndOfHeader.NumEntriesThisDisk := FFiles.Count;
  1482.       LEndOfHeader.CentralDirSize := iCentralDirSize;
  1483.       LEndOfHeader.CentralDirOffset := FEndFileData;
  1484.       if FEndFileData > ZIP64 then
  1485.         LEndOfHeader.CentralDirOffset := ZIP64;
  1486.       // Truncate comment if it's too long
  1487.       if Length(FComment) > $FFFF then
  1488.         SetLength(FComment, $FFFF);
  1489.       LEndofHeader.CommentLength := Length(FComment);
  1490.       // Write End Of Centeral Directory
  1491.       Signature := SIGNATURE_ZIPENDOFHEADER;
  1492.       VerifyWrite(FStream, Signature, SizeOf(Signature));
  1493. //      VerifyWrite(FStream, LEndOfHeader, SizeOf(LEndOfHeader));
  1494.       VerifyWrite(FStream, LEndOfHeader.DiskNumber,          SizeOf(UInt16));
  1495.       VerifyWrite(FStream, LEndOfHeader.CentralDirStartDisk, SizeOf(UInt16));
  1496.       VerifyWrite(FStream, LEndOfHeader.NumEntriesThisDisk,  SizeOf(UInt16));
  1497.       VerifyWrite(FStream, LEndOfHeader.CentralDirEntries,   SizeOf(UInt16));
  1498.       VerifyWrite(FStream, LEndOfHeader.CentralDirSize,      SizeOf(UInt32));
  1499.       VerifyWrite(FStream, LEndOfHeader.CentralDirOffset,    SizeOf(UInt32));
  1500.       VerifyWrite(FStream, LEndOfHeader.CommentLength,       SizeOf(UInt16));
  1501.  
  1502.       if LEndOfHeader.CommentLength > 0 then
  1503.         VerifyWrite(FStream, FComment, LEndOfHeader.CommentLength);
  1504.     end;
  1505.   finally
  1506.     FMode := zmClosed;
  1507.     FFiles.Clear;
  1508.     FStream := nil;
  1509.     if Assigned(FFileStream) then
  1510.       FreeAndNil(FFileStream);
  1511.   end;
  1512. end;
  1513.  
  1514. procedure TZipFile.Extract(const FileName: string; const Path: string; CreateSubDirs: Boolean);
  1515. begin
  1516.   Extract(IndexOf(FileName), Path, CreateSubdirs);
  1517. end;
  1518.  
  1519. procedure TZipFile.Extract(Index: Integer; const Path: string; CreateSubdirs: Boolean);
  1520. var
  1521.   LInStream, LOutStream: TStream;
  1522.   LHeader: TZipHeader;
  1523.   LDir, LFileName: string;
  1524.   LModifiedDateTime: TDateTime;
  1525. begin
  1526.   // Get decompression stream for file
  1527.   Read(Index, LInStream, LHeader);
  1528.   FCurrentHeader := LHeader;
  1529.   try
  1530.     if not GetUTF8PathFromExtraField(LHeader, LFileName) then
  1531.       LFileName := TBytesToString(FFiles[Index].FileName);
  1532. {$IFDEF MSWINDOWS} // ZIP stores files with '/', so translate to a relative Windows path.
  1533.     LFileName := StringReplace(LFileName, '/', '\', [rfReplaceAll]);
  1534. {$ENDIF}
  1535.     // CreateSubDirs = False assumes the user passed in the path where they want the file to end up
  1536.     if CreateSubdirs then
  1537.       LFileName := TPath.Combine(Path, LFileName)
  1538.     else
  1539.       LFileName := TPath.Combine(Path, ExtractFileName(LFileName));
  1540.     // Force directory creation
  1541.     LDir := ExtractFileDir(LFileName);
  1542.     if CreateSubdirs and (LDir <> '') then
  1543.       TDirectory.CreateDirectory(ExtractFileDir(LFileName));
  1544.     // Open the File For output
  1545.     if LFileName.Chars[LFileName.Length-1] = PathDelim then
  1546.       Exit; // Central Directory Entry points at a directory, not a file.
  1547.     LOutStream := TFileStream.Create(LFileName, fmCreate);
  1548.     try // And Copy from the decompression stream.
  1549.       FCurrentFile := LFileName;
  1550.       // See Bit 3 at http://www.pkware.com/documents/casestudies/APPNOTE.TXT
  1551.       if (LHeader.Flag and (1 shl 3)) = 0 then
  1552.       begin
  1553.         // Empty files should not be read
  1554.         if FFiles[Index].ZIP64_UncompressedSize > 0 then
  1555.           LOutStream.CopyFrom(LInStream, FFiles[Index].ZIP64_UncompressedSize);
  1556.       end
  1557.       else
  1558.       begin
  1559.         LOutStream.CopyFrom(LInStream, FFiles[Index].ZIP64_UncompressedSize);
  1560.       end;
  1561.       if Assigned(FOnProgress) then
  1562.         FOnProgress(Self, FCurrentFile, FCurrentHeader, LOutStream.Position);
  1563.     finally
  1564.       LOutStream.Free;
  1565.       FCurrentFile := '';
  1566.     end;
  1567.     if FileExists(LFileName) then
  1568.     begin
  1569.       if WinFileDateToDateTime(LHeader.ModifiedDateTime, LModifiedDateTime) then
  1570.       begin
  1571.         TFile.SetCreationTime(LFileName, LModifiedDateTime);
  1572.         TFile.SetLastWriteTime(LFileName, LModifiedDateTime);
  1573.       end;
  1574. {$IFDEF MSWINDOWS}
  1575.       if (Hi(FFiles[Index].MadeByVersion) = MADEBY_MSDOS) then
  1576.         TFile.SetAttributes(LFileName, TFile.IntegerToFileAttributes(FFiles[Index].ExternalAttributes and $000000FF));
  1577. {$ENDIF}
  1578. {$IFDEF POSIX}
  1579.       if (Hi(FFiles[Index].MadeByVersion) = MADEBY_UNIX) and (FFiles[Index].ExternalAttributes shr 16 <> 0) then
  1580.         TFile.SetAttributes(LFileName, TFile.IntegerToFileAttributes(FFiles[Index].ExternalAttributes shr 16));
  1581. {$ENDIF}
  1582.     end;
  1583.   finally
  1584.     FCurrentHeader := Default(TZipHeader);
  1585.     LInStream.Free;
  1586.   end;
  1587. end;
  1588.  
  1589. procedure TZipFile.ExtractAll(const Path: string);
  1590. var
  1591.   I: Integer;
  1592. begin
  1593.   if not (FMode in [zmReadWrite, zmRead]) then
  1594.     raise EZipException.CreateRes(@SZipNoRead);
  1595.   for I := 0 to FFiles.Count - 1 do
  1596.     Extract(I, Path);
  1597. end;
  1598.  
  1599. procedure TZipFile.Read(const FileName: string; out Bytes: TBytes);
  1600. begin
  1601.   Read(IndexOf(FileName), Bytes);
  1602. end;
  1603.  
  1604. procedure TZipFile.Read(Index: Integer; out Bytes: TBytes);
  1605. var
  1606.   LStream: TStream;
  1607.   LHeader: TZipHeader;
  1608.   ReadStart, ReadBytes: Int64;
  1609. begin
  1610.   Read(Index, LStream, LHeader);
  1611.   try
  1612.     if (LHeader.Flag and (1 shl 3)) = 0 then
  1613.     begin
  1614.       SetLength(Bytes, FFiles[Index].UncompressedSize);
  1615.       if FFiles[Index].UncompressedSize > 0 then // Special case for empty files.
  1616.         VerifyRead(LStream, Bytes, LHeader.UncompressedSize);
  1617.     end
  1618.     else
  1619.     begin
  1620.       //CRC, Uncompressed, and Compressed Size follow the compressed data.
  1621.       SetLength(Bytes, 4096);
  1622.       ReadStart := 0;
  1623.       ReadBytes := 0; // Supress warning
  1624.       while True do
  1625.       begin
  1626.         ReadBytes := LStream.Read(Bytes[ReadStart], Length(Bytes)-ReadStart);
  1627.         if ReadBytes < (Length(Bytes) - ReadStart) then
  1628.           break;
  1629.         ReadStart := ReadStart + ReadBytes;
  1630.         SetLength(Bytes, Length(Bytes)*2);
  1631.       end;
  1632.       SetLength(Bytes, ReadStart + ReadBytes);
  1633.     end;
  1634.   finally
  1635.     LStream.Free;
  1636.   end;
  1637. end;
  1638. //{$ENDIF}
  1639.  
  1640. procedure TZipFile.Read(const FileName: string; out Stream: TStream; out LocalHeader: TZipHeader);
  1641. begin
  1642.   Read(IndexOf(FileName), Stream, LocalHeader);
  1643. end;
  1644.  
  1645. procedure TZipFile.Read(Index: Integer; out Stream: TStream; out LocalHeader: TZipHeader);
  1646. var
  1647.   Signature: UInt32;
  1648. begin
  1649.   if not (FMode in [zmReadWrite, zmRead]) then
  1650.     raise EZipException.CreateRes(@SZipNoRead);
  1651.  
  1652.   if (Index < 0) or (Index > FFiles.Count) then
  1653.     raise EZipException.CreateRes(@SFileNotFound);
  1654.  
  1655.   // Local Header doesn't have thse fields
  1656.   LocalHeader.MadeByVersion := 0;
  1657.   SetLength(LocalHeader.FileComment, 0);
  1658.   LocalHeader.FileCommentLength  := 0;
  1659.   LocalHeader.DiskNumberStart    := 0;
  1660.   LocalHeader.InternalAttributes := 0;
  1661.   LocalHeader.ExternalAttributes := 0;
  1662.   LocalHeader.LocalHeaderOffset  := 0;
  1663.  
  1664.   // Move to beginning of Local Header
  1665.   FStream.Position := FFiles[Index].LocalHeaderOffset + FStartFileData;
  1666.   // Verify local header signature
  1667.   FStream.Read(Signature, Sizeof(Signature));
  1668.   if Signature <> SIGNATURE_LOCALHEADER then
  1669.     raise EZipException.CreateRes(@SZipInvalidLocalHeader);
  1670.   // Read local header
  1671. //  FStream.Read(LocalHeader.RequiredVersion, LOCALHEADERSIZE);
  1672.     FStream.Read(LocalHeader.RequiredVersion,    Sizeof(UInt16));
  1673.     FStream.Read(LocalHeader.Flag,               Sizeof(UInt16));
  1674.     FStream.Read(LocalHeader.CompressionMethod,  Sizeof(UInt16));
  1675.     FStream.Read(LocalHeader.ModifiedDateTime,   Sizeof(UInt32));
  1676.     FStream.Read(LocalHeader.CRC32,              Sizeof(UInt32));
  1677.     FStream.Read(LocalHeader.CompressedSize,     Sizeof(UInt32));
  1678.     FStream.Read(LocalHeader.UncompressedSize,   Sizeof(UInt32));
  1679.     FStream.Read(LocalHeader.FileNameLength,     Sizeof(UInt16));
  1680.     FStream.Read(LocalHeader.ExtraFieldLength,   Sizeof(UInt16));
  1681.   // Read Name and extra fields
  1682.   SetLength(LocalHeader.FileName, LocalHeader.FileNameLength);
  1683.   FStream.Read(LocalHeader.FileName, LocalHeader.FileNameLength);
  1684.   if LocalHeader.ExtraFieldLength > 0 then
  1685.   begin
  1686.     SetLength(LocalHeader.ExtraField, LocalHeader.ExtraFieldLength);
  1687.     FStream.Read(LocalHeader.ExtraField, LocalHeader.ExtraFieldLength);
  1688.   end;
  1689.   // Create Decompression stream.
  1690.   Stream := FCompressionHandler[TZipCompression(FFiles[Index].CompressionMethod)].Value(FStream, Self, LocalHeader);
  1691.   if Stream is TZDecompressionStream then
  1692.     (Stream as TZDecompressionStream).OnProgress := DoZLibProgress;
  1693. end;
  1694.  
  1695. procedure TZipFile.Add(Data: TStream; LocalHeader: TZipHeader; CentralHeader: PZipHeader);
  1696. var
  1697.   DataStart: Int64;
  1698.   LCompressStream: TStream;
  1699.   Signature: UInt32;
  1700.   LStartPos: Int64;
  1701.   LBuffer: TBytes;
  1702. begin
  1703.   // Seek to End of zipped data
  1704.   FStream.Position := FEndFileData;
  1705.   LocalHeader.LocalHeaderOffset := FEndFileData;
  1706.   // Require at least version 2.0
  1707.   if Lo(LocalHeader.MadeByVersion) < ZIP_Version20 then
  1708.     LocalHeader.MadeByVersion := Word(LocalHeader.MadeByVersion and $FF00) + ZIP_Version20;
  1709.   if LocalHeader.RequiredVersion < ZIP_Version20 then
  1710.     LocalHeader.RequiredVersion := ZIP_Version20;
  1711.  
  1712.   // Trust the length of the strings over the Length members
  1713.   LocalHeader.FileNameLength   := Length(LocalHeader.FileName);
  1714.   LocalHeader.ExtraFieldLength := Length(LocalHeader.ExtraField);
  1715.   if CentralHeader = nil then
  1716.     CentralHeader := @LocalHeader
  1717.   else
  1718.   begin // Trust the length of the strings over the Length members
  1719.     CentralHeader^.FileNameLength   := Length(CentralHeader^.FileName);
  1720.     CentralHeader^.ExtraFieldLength := Length(CentralHeader^.ExtraField);
  1721.   end;
  1722.   CentralHeader^.FileCommentLength  := Length(CentralHeader^.FileComment);
  1723.  
  1724.   // Write Signature, Header, and FileName
  1725.   Signature := SIGNATURE_LOCALHEADER;
  1726.   VerifyWrite(FStream, Signature, SizeOf(Signature));
  1727. //  VerifyWrite(FStream, LocalHeader.RequiredVersion, LOCALHEADERSIZE);
  1728.     VerifyWrite(FStream, LocalHeader.RequiredVersion,    Sizeof(UInt16));
  1729.     VerifyWrite(FStream, LocalHeader.Flag,               Sizeof(UInt16));
  1730.     VerifyWrite(FStream, LocalHeader.CompressionMethod,  Sizeof(UInt16));
  1731.     VerifyWrite(FStream, LocalHeader.ModifiedDateTime,   Sizeof(UInt32));
  1732.     VerifyWrite(FStream, LocalHeader.CRC32,              Sizeof(UInt32));
  1733.     VerifyWrite(FStream, LocalHeader.CompressedSize,     Sizeof(UInt32));
  1734.     VerifyWrite(FStream, LocalHeader.UncompressedSize,   Sizeof(UInt32));
  1735.     VerifyWrite(FStream, LocalHeader.FileNameLength,     Sizeof(UInt16));
  1736.     VerifyWrite(FStream, LocalHeader.ExtraFieldLength,   Sizeof(UInt16));
  1737.  
  1738.   VerifyWrite(FStream, LocalHeader.FileName, LocalHeader.FileNameLength);
  1739.   if LocalHeader.ExtraFieldLength > 0 then
  1740.     VerifyWrite(FStream, LocalHeader.ExtraField, LocalHeader.ExtraFieldLength);
  1741.   // Save position to calcuate Compressed Size
  1742.   LStartPos := FStream.Position;
  1743.   DataStart := Data.Position;
  1744.   LocalHeader.ZIP64_UncompressedSize := Data.Size - DataStart;
  1745.   // Write Compressed data
  1746.   FCurrentHeader := LocalHeader;
  1747.   LCompressStream := FCompressionHandler[TZipCompression(LocalHeader.CompressionMethod)].Key(FStream, self, LocalHeader);
  1748.   if LCompressStream is TZCompressionStream then
  1749.     (LCompressStream as TZCompressionStream).OnProgress := DoZLibProgress;
  1750.   try
  1751.     if TZipCompression(LocalHeader.CompressionMethod) = zcLZMA then
  1752.       LCompressStream.Write(Data, 0)
  1753.     else
  1754.       LCompressStream.CopyFrom(Data, LocalHeader.ZIP64_UncompressedSize);
  1755.     if Assigned(FOnProgress) then
  1756.       FOnProgress(Self, FCurrentFile, FCurrentHeader, LCompressStream.Position);
  1757.   finally
  1758.     LCompressStream.Free;
  1759.     FCurrentHeader := Default(TZipHeader);
  1760.   end;
  1761.  
  1762.   // Calcuate CompressedSize
  1763.   LocalHeader.ZIP64_CompressedSize := FStream.Position - LStartPos;
  1764.   Data.Position := DataStart;
  1765.   SetLength(LBuffer, $4000);
  1766.   // Calcuate Uncompressed data's CRC
  1767.   while Data.Position < LocalHeader.ZIP64_UncompressedSize do
  1768.     LocalHeader.CRC32 := crc32(LocalHeader.CRC32, @LBuffer[0],
  1769.       Data.Read(LBuffer, Length(LBuffer)));
  1770.   CentralHeader.ZIP64_UncompressedSize := LocalHeader.ZIP64_UncompressedSize;
  1771.   CentralHeader.ZIP64_CompressedSize := LocalHeader.ZIP64_CompressedSize;
  1772.   CentralHeader.CRC32 := LocalHeader.CRC32;
  1773.   // Save new End of zipped data mark
  1774.   FEndFileData := FStream.Position;
  1775.   // Move to beginning of Local Header offset and rewrite header
  1776.   // with correct CompressedSize and CRC32
  1777.   FStream.Position := LocalHeader.LocalHeaderOffset + SizeOf(UInt32);
  1778. //  FStream.Write(LocalHeader.RequiredVersion, LOCALHEADERSIZE);
  1779.   FStream.Write(LocalHeader.RequiredVersion,    Sizeof(UInt16));
  1780.   FStream.Write(LocalHeader.Flag,               Sizeof(UInt16));
  1781.   FStream.Write(LocalHeader.CompressionMethod,  Sizeof(UInt16));
  1782.   FStream.Write(LocalHeader.ModifiedDateTime,   Sizeof(UInt32));
  1783.   FStream.Write(LocalHeader.CRC32,              Sizeof(UInt32));
  1784.   FStream.Write(LocalHeader.CompressedSize,     Sizeof(UInt32));
  1785.   FStream.Write(LocalHeader.UncompressedSize,   Sizeof(UInt32));
  1786.   FStream.Write(LocalHeader.FileNameLength,     Sizeof(UInt16));
  1787.   FStream.Write(LocalHeader.ExtraFieldLength,   Sizeof(UInt16));
  1788.   FStream.Write(LocalHeader.FileName, LocalHeader.FileNameLength);
  1789.   if LocalHeader.ExtraFieldLength > 0 then
  1790.     FStream.Write(LocalHeader.ExtraField, LocalHeader.ExtraFieldLength);
  1791.  
  1792.   FFiles.Add(CentralHeader^);
  1793. end;
  1794.  
  1795. procedure TZipFile.CheckFileName(const ArchiveFileName: string);
  1796. begin
  1797.   if ArchiveFileName = '' then
  1798.     raise EZipException.CreateRes(@SZipFileNameEmpty);
  1799. end;
  1800.  
  1801. procedure TZipFile.Add(const FileName: string; const ArchiveFileName: string;
  1802.   Compression: TZipCompression);
  1803. var
  1804.   LInStream: TStream;
  1805.   LHeader: TZipHeader;
  1806.   LArchiveFileName: string;
  1807. begin
  1808.   CheckFileName(FileName);
  1809.   if not (FMode in [zmReadWrite, zmWrite]) then
  1810.     raise EZipException.CreateRes(@SZipNoWrite);
  1811.  
  1812.   if not FCompressionHandler.ContainsKey(Compression) then
  1813.     raise EZipException.CreateResFmt(@SZipNotSupported, [
  1814.       TZipCompressionToString(Compression) ]);
  1815.  
  1816.   // Setup Header
  1817.   FillChar(LHeader, sizeof(LHeader), 0);
  1818.   LHeader.Flag := 0;
  1819.   FCurrentFile := FileName;
  1820.   LInStream := TFileStream.Create(FileName, fmOpenRead);
  1821.   try
  1822.     {$IFDEF MSWINDOWS}
  1823.     LHeader.MadeByVersion := Word(MADEBY_MSDOS shl 8);
  1824.     {$ENDIF}
  1825.     {$IFDEF POSIX}
  1826.     LHeader.MadeByVersion := Word(MADEBY_UNIX shl 8);
  1827.     {$ENDIF}
  1828.     LHeader.Flag := 0;
  1829.     LHeader.CompressionMethod := UInt16(Compression);
  1830.     LHeader.ModifiedDateTime := DateTimeToWinFileDate(TFile.GetLastWriteTime(FileName));
  1831.     LHeader.ZIP64_UncompressedSize := LInStream.Size;
  1832.     LHeader.InternalAttributes := 0;
  1833.     LHeader.ExternalAttributes := TFile.FileAttributesToInteger(TFile.GetAttributes(FileName));
  1834.     if Hi(LHeader.MadeByVersion) = MADEBY_UNIX then
  1835.       LHeader.ExternalAttributes := LHeader.ExternalAttributes shl 16;
  1836.     if ArchiveFileName <> '' then
  1837.         LArchiveFileName := ArchiveFileName
  1838.       else
  1839.       LArchiveFileName := ExtractFileName(FileName);
  1840.     if FUTF8Support then
  1841.       LHeader.Flag := LHeader.Flag or (1 shl 11); // Language encoding flag, UTF8
  1842.     LHeader.FileName := StringToTBytes(LArchiveFileName);
  1843.     LHeader.FileNameLength := Length(LHeader.FileName);
  1844.  
  1845.     LHeader.ExtraFieldLength := 0;
  1846.     Add(LInStream, LHeader);
  1847.   finally
  1848.     LInStream.Free;
  1849.     FCurrentFile := '';
  1850.   end;
  1851. end;
  1852.  
  1853. procedure TZipFile.Add(Data: TBytes; const ArchiveFileName: string;
  1854.   Compression: TZipCompression);
  1855. var
  1856.   LInStream: TStream;
  1857. begin
  1858.   CheckFileName(ArchiveFileName);
  1859.   if not (FMode in [zmReadWrite, zmWrite]) then
  1860.     raise EZipException.CreateRes(@SZipNoWrite);
  1861.  
  1862.   if not FCompressionHandler.ContainsKey(Compression) then
  1863.     raise EZipException.CreateResFmt(@SZipNotSupported, [
  1864.       TZipCompressionToString(Compression) ]);
  1865.  
  1866.   LInStream := TBytesStream.Create(Data);
  1867.   try
  1868.     Add(LInStream, ArchiveFileName, Compression);
  1869.   finally
  1870.     LInStream.Free;
  1871.   end;
  1872. end;
  1873.  
  1874. procedure TZipFile.Add(Data: TStream; const ArchiveFileName: string;
  1875.   Compression: TZipCompression; AExternalAttributes: TFileAttributes);
  1876. var
  1877.   LHeader: TZipHeader;
  1878. begin
  1879.   CheckFileName(ArchiveFileName);
  1880.   if not (FMode in [zmReadWrite, zmWrite]) then
  1881.     raise EZipException.CreateRes(@SZipNoWrite);
  1882.  
  1883.   if not FCompressionHandler.ContainsKey(Compression) then
  1884.     raise EZipException.CreateResFmt(@SZipNotSupported, [
  1885.       TZipCompressionToString(Compression) ]);
  1886.  
  1887.   // Setup Header
  1888.   FillChar(LHeader, sizeof(LHeader), 0);
  1889.   {$IFDEF MSWINDOWS}
  1890.   LHeader.MadeByVersion := Word(MADEBY_MSDOS shl 8);
  1891.   {$ENDIF}
  1892.   {$IFDEF POSIX}
  1893.   LHeader.MadeByVersion := Word(MADEBY_UNIX shl 8);
  1894.   {$ENDIF}
  1895.   LHeader.Flag := 0;
  1896.   LHeader.CompressionMethod := UInt16(Compression);
  1897.   LHeader.ModifiedDateTime := DateTimeToWinFileDate(Now);
  1898.   LHeader.InternalAttributes := 0;
  1899.   LHeader.ExternalAttributes := TFile.FileAttributesToInteger(AExternalAttributes);
  1900.   if Hi(LHeader.MadeByVersion) = MADEBY_UNIX then
  1901.     LHeader.ExternalAttributes := LHeader.ExternalAttributes shl 16;
  1902.  
  1903.   if FUTF8Support then
  1904.     LHeader.Flag := LHeader.Flag or (1 shl 11); // Language encoding flag, UTF8
  1905.   LHeader.FileName := StringToTBytes(ArchiveFileName);
  1906.   LHeader.FileNameLength := Length(LHeader.FileName);
  1907.  
  1908.   LHeader.ExtraFieldLength := 0;
  1909.   Add(Data, LHeader);
  1910. end;
  1911.  
  1912.  
  1913. function TZipFile.IndexOf(const FileName: string): Integer;
  1914. var
  1915.   I: Integer;
  1916. begin
  1917.   Result := -1;
  1918.   for I := 0 to FFiles.Count - 1 do
  1919.     if SameText(TBytesToString(FFiles[I].FileName), FileName) then
  1920.       Exit(I);
  1921. end;
  1922.  
  1923. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement