lasarus_compotents/fwzip/delphi7/FWZipWriter.pas

////////////////////////////////////////////////////////////////////////////////
//
//  ****************************************************************************
//  * Project   : FWZip
//  * Unit Name : FWZipWriter
//  * Purpose   : Êëàññ äëÿ ñîçäàíèÿ ZIP àðõèâà
//  * Author    : Àëåêñàíäð (Rouse_) Áàãåëü
//  * Copyright : © Fangorn Wizards Lab 1998 - 2023.
//  * Version   : 2.0.1
//  * Home Page : http://rouse.drkb.ru
//  * Home Blog : http://alexander-bagel.blogspot.ru
//  ****************************************************************************
//  * Stable Release : http://rouse.drkb.ru/components.php#fwzip
//  * Latest Source  : https://github.com/AlexanderBagel/FWZip
//  ****************************************************************************
//
//  Èñïîëüçóåìûå èñòî÷íèêè:
//  ftp://ftp.info-zip.org/pub/infozip/doc/appnote-iz-latest.zip
//  https://zlib.net/zlib-1.2.13.tar.gz
//  http://www.base2ti.com/
//

unit FWZipWriter;

{$IFDEF FPC}
  {$MODE Delphi}
  {$H+}
{$ENDIF}

interface

{$I fwzip.inc}

uses
  SysUtils,
  Classes,
  Contnrs,
  Masks,
  FWZipConsts,
  FWZipCrc32,
  FWZipCrypt,
  FWZipStream,
  FWZipZLib,
  FWZipUtils;

type
  TFWZipWriter = class;

  TFWZipWriterItem = class
  private
    FOwner: TFWZipWriter;
    FComment: string;                // êîìåíòàðèé ê ýëåìåíòó
    FFilePath: string;               // ïóòü ê âíåøíåìó ôàéëó (èëè ñì. TFWZipWriterItemEx.Data)
    FFileName: string;               // èìÿ ýëåìåíòà â àðõèâå - íå ìîæåò áûòü ïóñòûì
    FPassword: string;               // ïàðîëü
    FCmpLevel: TCompressionLevel;    // óðîâåíü ñæàòèÿ
    FNeedDescriptor: Boolean;        // ôëàã îïðåäåëÿåò ñïîñîá õðàíåíèÿ äàííûõ
                                     // î ýëåìåíòå, (äåñêðèïòîð èëè ëîêàëüíûé çàãîëîâîê)
    FSize: Int64;
    FData: TStream;                  // Äàííûå ýëåìåíòà â ñëó÷àå åñëè ôàéë
                                     // îòñóòñòâóåò íà äèñêå
    FAttributes: TFileAttributeData; // Âíåøíèå àòòðèáóòû ôàéëà

    FTag: Integer;
    FUseUTF8String: Boolean;
    FUseExternalData: Boolean;       // Ôëàã óêàçûâàþùèé íà òî ÷òî äàííûå áóäóò ïåðåäàâàòüñÿ ñíàðóæè
    procedure SetBool(const Value: Boolean);
    procedure SetCmpLevel(const Value: TCompressionLevel);
    procedure SetString(const Index: Integer; const Value: string);
  protected
    property Data: TStream read FData;
    property UseExternalData: Boolean read FUseExternalData write FUseExternalData;
  public
    constructor Create(Owner: TFWZipWriter;
      const InitFilePath: string;
      InitAttributes: TFileAttributeData;
      const InitFileName: string = ''); virtual;
    destructor Destroy; override;
    procedure ChangeDataStream(Value: TStream;
      AOwnerShip: TStreamOwnership = soReference);
    procedure ChangeAttributes(Value: TFileAttributeData);
    function IsFolder: Boolean;
    property Comment: string index 0 read FComment write SetString;
    property FilePath: string index 1 read FFilePath write SetString;
    property FileName: string index 2 read FFileName write SetString;
    property Password: string index 3 read FPassword write SetString;
    property CompressionLevel: TCompressionLevel read FCmpLevel write SetCmpLevel;
    property NeedDescriptor: Boolean read FNeedDescriptor write SetBool;
    property Size: Int64 read FSize;
    property Attributes: TFileAttributeData read FAttributes;
    property Tag: Integer read FTag write FTag;
    property UseUTF8String: Boolean read FUseUTF8String write FUseUTF8String;
  end;

  TFWZipWriterItemClass = class of TFWZipWriterItem;

  // Ðåçóëüòàò ñîçäàíèÿ àðõèâà
  TBuildZipResult = 
  (
    brDone,         // àðõèâ ñîçäàí óñïåøíî
    brFailed,       // îøèáêà ñîçäàíèÿ àðõèâà
    brAborted,      // ñîçäàíèå àðõèâà îòìåíåíî ïîëüçîâàòåëåì
    brPartialBuild  // íåêîòîðûå ýëåìåíòû ïðîïóùåíû èç-çà âîçíèêøèõ îøèáîê
  );

  { TFWZipWriter }

  TFWZipWriter = class
  private
    FDefaultDescryptorState: Boolean;
    FDefaultCompressionLevel: TCompressionLevel;
    FDefaultPassword: string;
    FItems: TObjectList;
    FCD: array of TCentralDirectoryFileHeaderEx;
    FVersionToExtract: Word;
    FcdfhOffset, FTotalProgress, FTotalSizeCount,
      FTotalProcessedCount, FSizeOfCentralDir: Int64;
    FCompressedStream: TStream;
    FProcessedItemIndex, FcdfhDiskNumber, FcdfhRecordOnDisk: Integer;
    FComment: string;
    FOnProgress: TZipProgressEvent;
    FBuildState: Boolean;
    FSaveExData: TZipSaveExDataEvent;
    FExceptionCount: Integer;
    FBuidException: TZipBuildExceptionEvent;
    FTrimPackedStreamSize: Boolean;
    FAlwaysAddEmptyFolder: Boolean;
    FUseUTF8String: Boolean;
    function GetItem(Index: Integer): TFWZipWriterItem;
  protected
    function GetItemClass: TFWZipWriterItemClass; virtual;
    function AddNewItem(Value: TFWZipWriterItem): Integer;
    function IsMultiPartZip(AStream: TStream): Boolean;
    procedure FillItemCDFHeader(CurrentItem: TFWZipWriterItem;
      var Value: TCentralDirectoryFileHeaderEx); virtual;
    procedure CompressItem(CurrentItem: TFWZipWriterItem;
      Index: Integer; StreamSizeBeforeCompress: Int64; Stream: TStream); virtual;
    procedure FillExData(Stream: TStream; Index: Integer); virtual;
  protected
    procedure DoProgress(ProgressState: TProgressState);
    procedure CompressorOnProcess(Sender: TObject);
  protected
    function CheckFileNameSlashes(const Value: string): string;
    function CreateItemFromStream(const FileName: string;
      Value: TStream; AOwnerShip: TStreamOwnership): TFWZipWriterItem;
    function GetVersionToExtract(Index: Integer): Word;
    function GetCurrentFileTime: TFileTime;
    procedure SaveItemToStream(Stream: TStream; Index: Integer); virtual;
    procedure SaveCentralDirectory(Stream: TStream);
    procedure SaveEndOfCentralDirectory(Stream: TStream);
    procedure SaveString(Stream: TStream; const Value: string;
      AUseUTF8String: Boolean);
    procedure UpdateLocalHeaders(Stream: TStream);
    property BuildState: Boolean read FBuildState;
    function StringLength(const Value: string; AUseUTF8String: Boolean): Integer;
  public
    constructor Create; overload;
    constructor Create(CompressionLevel: TCompressionLevel); overload;
    constructor Create(UseDescryptors: Boolean;
      CompressionLevel: TCompressionLevel;
      const DefaultPassword: string); overload;
    destructor Destroy; override;
    function AddEmptyFolder(const FolderRelativeName: string): Integer; overload;
    function AddEmptyFolder(const FolderRelativeName: string;
      Attributes: TFileAttributeData): Integer; overload;
    function AddFile(const FilePath: string;
      const FileName: string = ''): Integer; overload;
    function AddFile(const FilePath: string;
      Attributes: TFileAttributeData;
      const FileName: string = ''): Integer; overload;
    function AddStream(const FileName: string; Value: TStream;
      AOwnerShip: TStreamOwnership = soReference): Integer;
    function AddFiles(Value: TStringList): Integer;
    function AddFilesAndFolders(Value: TStringList; SubFolders: Boolean = True): Integer;
    function AddFolder(const Path: string;
      SubFolders: Boolean = True): Integer; overload;
    function AddFolder(const RelativePath, Path, Mask: string;
      SubFolders: Boolean = True): Integer; overload;
    function BuildZip(ZipFilePath: string): TBuildZipResult; overload;
    function BuildZip(Stream: TStream): TBuildZipResult; overload;
    function Count: Integer;
    procedure Clear;
    procedure DeleteItem(Index: Integer);

    /// <summary>
    ///  Ôóíêöèÿ èùåò çàïèñü îá ýëåìåíòå ïî èìåíè
    /// </summary>
    function Find(const Value: string; out AItem: TFWZipWriterItem;
      IgnoreCase: Boolean = True): Boolean; overload;

    function InsertStream(const FileName: string; Index: Integer;
      Value: TStream; AOwnerShip: TStreamOwnership = soReference): Integer;

    // Ñâîéñòâî îòâå÷àåò çà äîáàâëåíèå ïàïêè â âèäå TFWZipWriterItem
    // íåïîñðåäñòâåííî ïåðåä äîáàâëåíèåì äàííûõ èç óêàçàíîé ïàïêè
    property AlwaysAddEmptyFolder: Boolean read FAlwaysAddEmptyFolder
      write FAlwaysAddEmptyFolder;

    property Item[Index: Integer]: TFWZipWriterItem read GetItem; default;
    property Comment: string read FComment write FComment;

    // Ñâîéñòâî ðàáîòàåò òîëüêî ïðè âêëþ÷åííîé äèðåêòèâå USE_AUTOGENERATED_ZLIB_HEADER
    //  îñòàëüíûõ ñëó÷àÿõ íå âëèÿåò íà àðõèâ è îñòàâëåíî äëÿ ñîâìåñòèìîñòè
    property TrimPackedStreamSize: Boolean read FTrimPackedStreamSize
      write FTrimPackedStreamSize; // deprecated;

    property OnException: TZipBuildExceptionEvent read FBuidException write FBuidException;
    property OnProgress: TZipProgressEvent read FOnProgress write FOnProgress;
    property OnSaveExData: TZipSaveExDataEvent read FSaveExData write FSaveExData;
    // Ñâîéñòâî äëÿ àâòîìàòè÷åñêîãî âûñòàâëåíèÿ êîäèðîâêè ó äîáàâëÿåìûõ ýëåìåíòîâ
    // Íå âëèÿåò íà êîäèðîâêó êîìåíòàðèÿ ê àðõèâó (îí âñåãäà Ansi)
    property UseUTF8String: Boolean read FUseUTF8String write FUseUTF8String;
  end;

  EZipWriterItem = class(Exception);
  EZipWriter = class(Exception);
  EZipWriterWrite = class(Exception);

implementation

{ TFWZipWriterItem }

//
//  Ïðîöåäóðà èçìåíÿåò àòòðèáóòû ýëåìåíòà àðõèâà
// =============================================================================
procedure TFWZipWriterItem.ChangeAttributes(Value: TFileAttributeData);
begin
  if not FOwner.BuildState then
    FAttributes := Value;
end;

//
//  Ïðîöåäóðà èçìåíÿåò áëîê äàííûõ îá ýëåìåíòå. Àâòîìàòè÷åñêè ÷èñòèòñÿ èìÿ ê ôàéëó.
//  Äàííûå ïðè ñæàòèè áóäóò áðàòüñÿ èç ïîëÿ FData
// =============================================================================
procedure TFWZipWriterItem.ChangeDataStream(Value: TStream;
  AOwnership: TStreamOwnership);
begin
  if not FOwner.BuildState then
    if Value.Size <> 0 then
    begin
      FreeAndNil(FData);
      if AOwnership = soOwned then
        FData := Value
      else
      begin
        FData := TMemoryStream.Create;
        FData.CopyFrom(Value, 0);
      end;
      FSize := FData.Size;
      FFilePath := '';
    end;
end;

//
//  Ñòàíäàðòíûé êîíñòðóêòîð êëàññà
// =============================================================================
constructor TFWZipWriterItem.Create(Owner: TFWZipWriter;
  const InitFilePath: string;
  InitAttributes: TFileAttributeData; const InitFileName: string);
begin
  inherited Create;
  FData := nil;
  FOwner := Owner;
  FFilePath := InitFilePath;
  FAttributes := InitAttributes;
  FSize :=
    FileSizeToInt64(FAttributes.nFileSizeLow, FAttributes.nFileSizeHigh);  
  FFileName := InitFileName;
  UseUTF8String := Owner.UseUTF8String;
end;

//
//  Ñòàíäàðòíûé äåñòðóêòîð êëàññà
// =============================================================================
destructor TFWZipWriterItem.Destroy;
begin
  FData.Free;
  inherited;
end;

//
//  Ôóíêöèÿ ïðîâåðÿåò - ÿâëÿåòñÿ ëè ýëåìåíò ïàïêîé?
// =============================================================================
function TFWZipWriterItem.IsFolder: Boolean;
begin
  Result := Attributes.dwFileAttributes and faDirectory <> 0;
  if not Result then
    Result := FileName[Length(FileName)] = ZIP_SLASH;
end;

//
//  Ïðîöåäóðà èçìåíÿåò ôëàã äåñêðèïòîðà ýëåìåíòà
// =============================================================================
procedure TFWZipWriterItem.SetBool(const Value: Boolean);
begin
  if not FOwner.BuildState then
    FNeedDescriptor := Value;
end;

//
//  Ïðîöåäóðà èçìåíÿåò ñòåïåíü ñæàòèÿ ýëåìåíòà
// =============================================================================
procedure TFWZipWriterItem.SetCmpLevel(const Value: TCompressionLevel);
begin
  if not FOwner.BuildState then
    FCmpLevel := Value;
end;

//
//  Ïðîöåäóðà èçìåíÿåò ñòðîêîâûå ñâîéñòâà ýëåìåíòà.
//  Ïðè èçìåíåíèè ïóòè ê ôàéëó, àâòîìàòè÷åñêè ðàññ÷èòûâàþòñÿ
//  íîâûå àòòðèáóòû ôàéëà è î÷èøàåòñÿ ñòðèì FData çà íåíàäîáíîñòüþ
// =============================================================================
procedure TFWZipWriterItem.SetString(const Index: Integer;
  const Value: string);
var
  Attributes: TFileAttributeData;
begin
  if not FOwner.BuildState then
    case Index of
      0: FComment := Value;
      1:
      begin
        if FileExists(Value) then
        begin
          // Èçìåíÿåì òîëüêî â òîì ñëó÷àå åñëè îáúåêò äîñòóïåí
          // è ìû ñìîãëè ñíÿòü åãî àòòðèáóòû
          if GetFileAttributes(Value, Attributes) then
          begin
            FAttributes := Attributes;
            FSize :=
              FileSizeToInt64(Attributes.nFileSizeLow, Attributes.nFileSizeHigh);
            FFilePath := Value;
            FreeAndNil(FData);
          end;
        end;
      end;
      2:
      // Rouse_ 20.12.2019
      // Äàåì âîçìîæíîñòü ðàáîòû ñ äëèííûìè ïóòÿìè
//        if Length(Value) >= MAX_PATH then
//          raise EZipWriterItem.Create('Ñëèøêîì äëèííûé ïóòü.')
//        else
          FFileName := Value;
      3: FPassword := Value;
    end;
end;

{ TFWZipWriter }

//
//  Ôóíêöèÿ äîáàâëÿåò î÷åðåäíîé ôàéë â ñïèñîê.
//   êà÷åñòâå ðåçóëüòàòà âîçâðàùàåò èíäåêñ ýëåìåíòà â ñïèñêå.
//  Ïàðàìåòðû:
//  FilePath - ïóòü ê ôàéëó
//  FileName - íàèìåíîâàíèå ôàéëà â àðõèâå
//    (âêëþ÷àÿ îòíîñèòåëüíûé ïóòü îò êîðíÿ àðõèâà)
// =============================================================================
function TFWZipWriter.AddFile(const FilePath: string; const FileName: string
  ): Integer;
var
  Attributes: TFileAttributeData;
  FullFilePath: string;
begin
  Result := -1;
  FullFilePath := PathCanonicalize(FilePath);
  // Äîáàâëÿåì òîëüêî â òîì ñëó÷àå åñëè îáúåêò äîñòóïåí
  // è ìû ñìîãëè ñíÿòü åãî àòòðèáóòû
  if GetFileAttributes(FullFilePath, Attributes) then
    Result := AddFile(FullFilePath, Attributes, FileName);
end;

//
//  Ôóíêöèÿ äîáàâëÿåò ïóñòóþ ïàïêó â ñïèñîê.
//   êà÷åñòâå ðåçóëüòàòà âîçâðàùàåò èíäåêñ ýëåìåíòà â ñïèñêå.
//  Ïàðàìåòðû:
//  FolderRelativeName - íàèìåíîâàíèå ïàïêè â àðõèâå
//    (âêëþ÷àÿ îòíîñèòåëüíûé ïóòü îò êîðíÿ àðõèâà)
// =============================================================================
function TFWZipWriter.AddEmptyFolder(const FolderRelativeName: string): Integer;
var
  Attributes: TFileAttributeData;
begin
  ZeroMemory(@Attributes, SizeOf(TFileAttributeData));
  Attributes.dwFileAttributes := faDirectory;
  Result := AddEmptyFolder(FolderRelativeName, Attributes);
end;

//
//  Ôóíêöèÿ äîáàâëÿåò ïóñòóþ ïàïêó â ñïèñîê.
//   êà÷åñòâå ðåçóëüòàòà âîçâðàùàåò èíäåêñ ýëåìåíòà â ñïèñêå.
//  Ïàðàìåòðû:
//  FolderRelativeName - íàèìåíîâàíèå ïàïêè â àðõèâå
//    (âêëþ÷àÿ îòíîñèòåëüíûé ïóòü îò êîðíÿ àðõèâà)
//  Attributes - àòòðèáóòû ïàïêè
// =============================================================================
function TFWZipWriter.AddEmptyFolder(const FolderRelativeName: string;
  Attributes: TFileAttributeData): Integer;
var
  FolderPath: string;
  Item: TFWZipWriterItem;
begin
  Result := -1;
  if FolderRelativeName = '' then Exit;
  FolderPath := CheckFileNameSlashes(FolderRelativeName);
  if FolderPath[Length(FolderPath)] <> ZIP_SLASH then
    FolderPath := FolderPath + ZIP_SLASH;
  Item := GetItemClass.Create(Self, FolderPath, Attributes, FolderPath);
  Result := AddNewItem(Item);
end;

//
//  Ôóíêöèÿ äîáàâëÿåò î÷åðåäíîé ôàéë â ñïèñîê.
//   êà÷åñòâå ðåçóëüòàòà âîçâðàùàåò èíäåêñ ýëåìåíòà â ñïèñêå.
//  Ïàðàìåòðû:
//  FilePath - ïóòü ê ôàéëó
//  Attributes - àòòðèáóòû ôàéëà
//  FileName - íàèìåíîâàíèå ôàéëà â àðõèâå
//    (âêëþ÷àÿ îòíîñèòåëüíûé ïóòü îò êîðíÿ àðõèâà)
// =============================================================================
function TFWZipWriter.AddFile(const FilePath: string;
  Attributes: TFileAttributeData; const FileName: string): Integer;
var
  Item: TFWZipWriterItem;
  InitFileName, FullFilePath: string;
begin
  // Ïðîâåðêà ÷òî íàì ïåðåäàëè. ïàïêó èëè ôàéë?
  Result := -1;
  FullFilePath := PathCanonicalize(FilePath);
  if not FileExists(FullFilePath) then Exit;
  if FileName = '' then
    InitFileName := ExtractFileName(ExcludeTrailingPathDelimiter(FullFilePath))
  else
    InitFileName := CheckFileNameSlashes(FileName);

  Item := GetItemClass.Create(Self, FullFilePath, Attributes, InitFileName);
  Item.CompressionLevel := FDefaultCompressionLevel;
  Item.Password := FDefaultPassword;

  // â ñëó÷àå íàëè÷èÿ äåñêðèïòîðà ìû ìîæåì
  // ïðîèçâîäèòü ðàñ÷åò êîíòðîëüíîé ñóììû íà ëåòó, ò.ê. ïðè âêëþ÷åííîì
  // ðåæèìå øèôðîâàíèÿ îíà íå ó÷àñòâóåò â ãåíåðàöèè çàãîëîâêà èíèöèàëèçàöèè
  Item.NeedDescriptor := FDefaultDescryptorState;

  Result := AddNewItem(Item);
end;

//
//  Ôóíêöèÿ äîáàâëÿåò íàáîð ôàéëîâ â ñïèñîê.
//   êà÷åñòâå ðåçóëüòàòà âîçâðàùàåò êîëè÷åñòâî óñïåøíî äîáàâëåííûõ ýëåìåíòîâ.
//  Ïàðàìåòðû:
//  Value - ïóòè ê ôàéëàì
//  Value.ValueFromIndex[I] ñîäåðæèò ïîëíûé ïóòü ê ôàéëó
//  Value.Names[I] ñîäåðæèò èìÿ ôàéëà ñ êîòîðûì îí áóäåò
//  ïîìåùåí â àðõèâ (íåîáÿçàòåëüíûé ïàðàìåòð)
// =============================================================================
function TFWZipWriter.AddFiles(Value: TStringList): Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to Value.Count - 1 do
    if AddFile(Value.ValueFromIndex[I], Value.Names[I]) >= 0 then
      Inc(Result);
end;

//
//  Ôóíêöèÿ äîáàâëÿåò íàáîð ôàéëîâ è ïàïîê â ñïèñîê.
//   êà÷åñòâå ðåçóëüòàòà âîçâðàùàåò êîëè÷åñòâî óñïåøíî äîáàâëåííûõ ýëåìåíòîâ.
//  Ïàðàìåòðû:
//  Value - ïóòè ê ôàéëàì è ïàïêàì èç êîòîðûõ áóäóò äîáàâëÿòüñÿ äàííûå
//    Value.ValueFromIndex[I] äëÿ ïàïêè ñîäåðæèò ïîëíûé ïóòü ê ïàïêå
//    Value.Names[I] äëÿ ïàïêè ñîäåðæèò ïóòü îòíîñèòåëüíî êîðíÿ àðõèâà
//      (íåîáÿçàòåëüíûé ïàðàìåòð)
//    Value.ValueFromIndex[I] äëÿ ôàéëà ñîäåðæèò ïîëíûé ïóòü ê ôàéëó
//    Value.Names[I] äëÿ ôàéëà ñîäåðæèò èìÿ ôàéëà ñ êîòîðûì îí áóäåò
//      ïîìåùåí â àðõèâ (íåîáÿçàòåëüíûé ïàðàìåòð)
//  SubFolders - äîáàâëÿòü äàííûå èç ïîäïàïîê èëè íåò.
// =============================================================================
function TFWZipWriter.AddFilesAndFolders(Value: TStringList;
  SubFolders: Boolean): Integer;
var
  I: Integer;
  Path: string;
begin
  Result := 0;
  for I := 0 to Value.Count - 1 do
  begin
    Path := PathCanonicalize(Value.ValueFromIndex[I]);
    if DirectoryExists(Path) then
      Inc(Result, AddFolder(Value.Names[I], Path, '', SubFolders))
    else
      if AddFile(Path, Value.Names[I]) >= 0 then
        Inc(Result);
  end;
end;

//
//  Ôóíêöèÿ äîáàâëÿåò ôàéëû èç óêàçàíîé ïàïêè
//   êà÷åñòâå ðåçóëüòàòà âîçâðàùàåò êîëè÷åñòâî óñïåøíî äîáàâëåííûõ ýëåìåíòîâ.
//  Ïàðàìåòðû:
//  Path - ïóòü ê ïàïêå èç êîòîðîé áóäóò äîáàâëÿòüñÿ äàííûå
//  SubFolders - äîáàâëÿòü äàííûå èç ïîäïàïîê èëè íåò.
// =============================================================================
function TFWZipWriter.AddFolder(const Path: string; SubFolders: Boolean): Integer;
begin
  Result := AddFolder(ExtractFileName(
    ExcludeTrailingPathDelimiter(PathCanonicalize(Path))),
    Path, EmptyStr, SubFolders);
end;

//
//  Ðàñøèðåííûé âàðèàíò AddFolder
//  Ôóíêöèÿ äîáàâëÿåò ôàéëû èç óêàçàíîé ïàïêè
//   êà÷åñòâå ðåçóëüòàòà âîçâðàùàåò êîëè÷åñòâî óñïåøíî äîáàâëåííûõ ýëåìåíòîâ.
//  Ïàðàìåòðû:
//  RelativePath - ïóòü ê ýëåìåíòó â àðõèâå îòíîñèòåëüíî êîðíÿ.
//  Path - ïóòü ê ïàïêå èç êîòîðîé áóäóò äîáàâëÿòüñÿ äàííûå
//  Mask - ìàñêà îòáîðà ôàéëîâ (÷åðåç òî÷êó ñ çàïÿòîé). Íàïðèìåð "*.txt;*.bin;12???6.dat"
//  SubFolders - äîáàâëÿòü äàííûå èç ïîäïàïîê èëè íåò.
// =============================================================================
function TFWZipWriter.AddFolder(const RelativePath, Path, Mask: string;
  SubFolders: Boolean): Integer;
const
  AllDataMask = '*';
var
  SR: TSearchRec;
  TrailingPath, TrailingRelativePath, ResultMask: string;
  Attributes: TFileAttributeData;
  Masks: TStringList;
  I: Integer;
  Matched: Boolean;
begin
  Result := 0;
  // îáû÷íîå ðåêóðñèâíîå ñêàíèðîâàíèå ïàïêè
  // åäèíñòâåííûé íþàíñ - ïàðàìåòð RelativePath
  // â êîòîðîì ïåðåäàåòñÿ ïóòü ê ôàéëó èëè ïàïêå îòíîñèòåëüíî êîðíåâîé ïàïêè
  if RelativePath = '' then
    TrailingRelativePath := ''
  else
    TrailingRelativePath := IncludeTrailingPathDelimiter(RelativePath);
  TrailingPath := IncludeTrailingPathDelimiter(PathCanonicalize(Path));

  Masks := nil;
  if Mask = EmptyStr then
    ResultMask := AllDataMask
  else
    ResultMask := AnsiLowerCase(Mask);

  if ResultMask <> AllDataMask then
  begin
    Masks := TStringList.Create;
    Masks.Delimiter := ';';
    Masks.DelimitedText := ResultMask;
  end;

  try
    if FindFirst(TrailingPath + AllDataMask, faAnyFile, SR) = 0 then
    try
      repeat

        if SR.Name = '..' then Continue;

        {$IFDEF LINUX}
        GetFileAttributes(TrailingPath + SR.Name, Attributes);
        {$ELSE}
        {$WARN SYMBOL_PLATFORM OFF}
        Attributes.dwFileAttributes := SR.FindData.dwFileAttributes;
        Attributes.ftCreationTime := SR.FindData.ftCreationTime;
        Attributes.ftLastAccessTime := SR.FindData.ftLastAccessTime;
        Attributes.ftLastWriteTime := SR.FindData.ftLastWriteTime;
        Attributes.nFileSizeHigh := SR.FindData.nFileSizeHigh;
        Attributes.nFileSizeLow := SR.FindData.nFileSizeLow;
        {$WARN SYMBOL_PLATFORM ON}
        {$ENDIF}

        if SR.Name = '.' then
        begin
          // Rouse_ 14.02.2013
          // Åñëè âêëþ÷åíî äîáàâëåíèå ïóñòûõ ïàïîê, òî äîáàâëÿåì ñíà÷àëà òðåáóåìóþ çàïèñü
          if AlwaysAddEmptyFolder then
            AddEmptyFolder(TrailingRelativePath, Attributes);
          Continue;
        end;

        if SR.Attr and faDirectory <> 0 then
        begin
          if SubFolders then
            Inc(Result, AddFolder(TrailingRelativePath + SR.Name,
              TrailingPath + SR.Name, ResultMask, SubFolders));
        end
        else
        begin
          if Assigned(Masks) then
          begin
            Matched := False;
            for I := 0 to Masks.Count - 1 do
              if MatchesMask(SR.Name, Masks[I]) then
              begin
                Matched := True;
                Break;
              end;
          end
          else
            Matched := True;

          if not Matched then Continue;

          if AddFile(TrailingPath + SR.Name, Attributes,
            TrailingRelativePath + SR.Name) >= 0 then
            Inc(Result);
        end;
      until FindNext(SR) <> 0;
    finally
      FindClose(SR);
    end;
  finally
    Masks.Free;
  end;
end;

//
//  Ôóíêöèÿ äîáàâëÿåò â àðõèâ äàííûå èç ïåðåäàííîãî ñòðèìà.
//   êà÷åñòâå ðåçóëüòàòà âîçâðàùàåò èíäåêñ ýëåìåíòà â ñïèñêå
// =============================================================================
function TFWZipWriter.AddStream(const FileName: string;
  Value: TStream; AOwnerShip: TStreamOwnership): Integer;
var
  Item: TFWZipWriterItem;
begin
  Item := CreateItemFromStream(FileName, Value, AOwnerShip);
  Result := AddNewItem(Item);
end;

//
//  Âñïîìîãàòåëüíàÿ ôóíêöèÿ äëÿ äîñòóïà ê ëèñòó èç íàñëåäíèêîâ
// =============================================================================
function TFWZipWriter.AddNewItem(Value: TFWZipWriterItem): Integer;
begin
  Result := FItems.Add(Value);
end;

//
//  Ïðîöåäóðà ôîðìèðóåò àðõèâ è ñîõðàíÿåò åãî â óêàçàííûé ñòðèì.
// =============================================================================
function TFWZipWriter.BuildZip(Stream: TStream): TBuildZipResult;
var
  I, TotalCount: Integer;
  BeforeExceptPosition: Int64;
  ExceptAction: TExceptionAction;
  OldPathName, NewFilePath: string;
  NewFileData: TMemoryStream;
  DeletePackedFile: Boolean;
begin
  FVersionToExtract := 0;
  FTotalProgress := 0;
  FBuildState := True;
  try
    Result := brFailed;
    if Count > 0 then
    begin

      // Ñîãëàñòíî ñïåöèôèêàöèè â ñàìûé ïåðâûé òîì ìíîãîòîìíîãî àðõèâà
      // ïåðâîé äîáàâëÿåòñÿ SPAN_DESCRIPTOR_SIGNATURE
      // ñì. zip_format.txt 8.5.4
      if IsMultiPartZip(Stream) then
      begin
        I := SPAN_DESCRIPTOR_SIGNATURE;
        Stream.WriteBuffer(I, 4);
      end;

      // Âûñòàâëÿåì ðàçìåðû CentralDirectory
      SetLength(FCD, Count);

      // Ðàññ÷èòûâàåì îáùèé ðàçìåð ýëåìåíòîâ äëÿ îòîáðàæåíèÿ ïðîãðåññà
      FTotalSizeCount := 0;
      FTotalProcessedCount := 0;
      for I := 0 to Count - 1 do
      begin
        Inc(FTotalSizeCount, Item[I].Size);
        // Rouse_ 12.05.2020
        // Íå çàáûâàåì ñêèíóòü ôëàã îøèáêè ñ ïðåäûäóùåé ñáîðêè àðõèâà
        FCD[I].ExceptOnWrite := False;
      end;

      // Ñæèìàåì âñå ôàéëû àðõèâà è ïîìåùàåì èõ â ôèíàëüíûé ñòðèì
      // ïðè ýòîì ðåçåðâèðóåòñÿ ìåñòî ïîä LocalHeader è DataDescryptor
      // ò.ê. ðàçìåð çàïàêîâàííîãî ôàéëà áóäåò èçâåñòåí òîëüêî ïîñëå ýòàïà
      // àðõèâàöèè è íå ïîíÿòíî êóäà ïîìåùàòü çíà÷åíèå:
      // â LocalHeader, DataDescryptor èëè â ZIP64 áëîê äàííûõ â CentralDirectory
      FExceptionCount := 0;
      BeforeExceptPosition := 0;
      TotalCount := 0;
      Result := brDone;
      I := 0;
      DeletePackedFile := False;
      OldPathName := '';
      while I < Count do      
      begin
        try

          BeforeExceptPosition := Stream.Position;
          SaveItemToStream(Stream, I);
          Inc(TotalCount);
          Inc(I);

          // â ñëó÷àå åñëè ýòî ïîâòîðíàÿ ïîïûòêà ñæàòèÿ è áûë ïðèìåíåí
          // àòòðèáóò acUseNewFilePathAndDel, òî íåîáõîäèìî óäàëèòü ôàéë.
          if DeletePackedFile then
          begin
            DeletePackedFile := False;
            NewFilePath := Item[I - 1].FilePath;
            SetNormalFileAttributes(NewFilePath);
            DeleteFile(NewFilePath);
          end;

          // åñëè ïóòü ê ôàéëó áûë âðåìåííî èçìåíåí èç-çà ïðèìåíåíèÿ àòòðèáóòîâ
          // acUseNewFilePath èëè acUseNewFilePathAndDel,
          // íåîáõîäèìî âîññòàíîâèòü ñòàðîå çíà÷åíèå
          if OldPathName <> '' then
          begin
            FBuildState := False;
            try
              Item[I - 1].FilePath := OldPathName;
            finally
              OldPathName := '';
              FBuildState := True;
            end;
          end;

        except

          // Åñëè ïîëüçîâàòåëü îòìåíèë ñîçäàíèå àðõèâà, âûõîäèì èç öèêëà
          on E: EAbort do
          begin
            Result := brAborted;
            Exit;
          end;

          on E: Exception do
          begin
            // âîçâðàùàåì ïîçèöèþ â ñòðèìå íà ñòàðîå ìåñòî
            Stream.Position := BeforeExceptPosition;

            // åñëè ýëåìåíò èñïîëüçîâàë êàñòîìíûå äàííûå,
            // òî ñíèìàåì ýòîò âàðèàíò çàïîëíåíèÿ è ïóñòü èçâíå ðåøàþò
            // ÷òî äåëàòü â ýòîì ñëó÷àå
            Item[I].UseExternalData := False;

            // çàïðàøèâàåì ïîëüçîâàòåëÿ, ÷òî äåëàòü ñ èñêëþ÷åíèåì?         
            ExceptAction := eaSkip;
            NewFilePath := ''; 
            
            NewFileData := TMemoryStream.Create;
            try
            
              if Assigned(FBuidException) then
                FBuidException(Self, E, I, ExceptAction, 
                  NewFilePath, NewFileData);
                  
              // îáðàáàòûâàåì âûáîð ïîëüòçîâàòåëÿ
              case ExceptAction of

                // ïîâòîðèòü ïîïûòêó
                eaRetry:
                  Continue;

                // ïðîïóñòèòü ýëåìåíò
                eaSkip:
                begin
                  // òî ïîìå÷àåì ýëåìåíò öåíòðàëüíîé äèðåêòîðèè.
                  // Îí íå áóäåò îáðàáàòûâàòüñÿ ïðè ñîõðàíåíèèè.
                  FCD[I].ExceptOnWrite := True;
                  // Òàêæå óâåëè÷èì ÷èñëî èñêëþ÷åíèé, äëÿ ïðàâèëüíîé çàïèñè
                  // êîëè÷åñòâà ýëåìåíòîâ àðõèâà â êîðíåâîé äèðåêòîðèè
                  Inc(FExceptionCount); 
                  Inc(I);
                  Result := brPartialBuild;                                
                end;

                // îñòàíîâèòü ñîçäàíèå àðõèâà
                eaAbort:
                begin
                  Result := brAborted;
                  Exit;                  
                end;

                // èñïîëüçîâàòü äàííûå èç äðóãîãî ôàéëà
                eaUseNewFilePath, eaUseNewFilePathAndDel:
                begin
                  // çàïîìèíàåì òåêóùèé ïóòü ê ôàéëó,
                  // äëÿ ïîñëåäóþùåãî âîññòàíîâëåíèÿ
                  OldPathName := Item[I].FilePath;
                  FBuildState := False;
                  try
                    Item[I].FilePath := NewFilePath;
                  finally
                    FBuildState := True;
                  end;
                  // âûñòàâëÿåì ôëàã, ÷òî ïðè çàâåðøåíè ñæàòèÿ,
                  // ôàéë ñëóäåò óäàëèòü
                  DeletePackedFile := ExceptAction = eaUseNewFilePathAndDel;
                  Continue;
                end;
                
                // èñïîëüçîâàòü äàííûå èç ñòðèìà
                eaUseNewFileData:
                begin
                  FBuildState := False;
                  try
                    Item[I].ChangeDataStream(NewFileData);                    
                  finally
                    FBuildState := True;
                  end;                
                  Continue;
                end;
              end;

            finally
              NewFileData.Free;
            end;                      
          end;
          
        end;
      end;

      // Åñëè â àðõèâ íå äîáàâëåí íè îäèí èç ýëåìåíòîâ,
      // òî âîçâðàùàåì ðàçìåð ñòðèìà íà ïðåæíåå çíà÷åíèå è âûõîäèì ñ îøèáêîé
      if TotalCount = 0 then
      begin
        Stream.Size := Stream.Position;
        Result := brFailed;
        Exit;
      end;

      // Òåïåðü ðàçìåðû ñæàòûõ ôàéëîâ èçâåñòíû,
      // îáíîâëÿåì LocalHeader è DataDescryptor
      UpdateLocalHeaders(Stream);

      // Çàïèñûâàåì CentralDirectory
      SaveCentralDirectory(Stream);

      // Ïèøåì ñòðóêòóðó EndOfCentralDirectory ïðè ýòîì ïðè íåîáõîäèìîñòè
      // ôîðìèðóþòñÿ è ïèøóòñÿ òàêæå ñòðóêòóðû Zip64EOFCentralDirectoryRecord
      // è Zip64EOFCentralDirectoryLocator
      SaveEndOfCentralDirectory(Stream);
    end;
  finally
    FBuildState := False;
  end;
end;

//
//  Ïðîöåäóðà ôîðìèðóåò àðõèâ è ñîõðàíÿåò åãî â óêàçàííûé ôàéë.
// =============================================================================
function TFWZipWriter.BuildZip(ZipFilePath: string): TBuildZipResult;
var
  ZIP: TFileStream;
begin
  Result := brFailed;
  if Count = 0 then Exit;
  ZipFilePath := PathCanonicalize(ZipFilePath);
  ForceDirectoriesEx(ExtractFilePath(ZipFilePath));
  ZIP := TFileStream.Create(ZipFilepath, fmCreate);
  try
    Result := BuildZip(ZIP);
    FinallyFileBuffers(ZIP.Handle);
  finally
    ZIP.Free;
  end;
  if Result in [brFailed, brAborted] then
    DeleteFile(ZipFilePath);
end;

//
//  Ôóíêöèÿ ïðîâîäèò ïðîâåðêó ïðàâèëüíîñòè íàèìåíîâàíèÿ ôàéëà â àðõèâå
// =============================================================================
function TFWZipWriter.CheckFileNameSlashes(const Value: string): string;
begin
  {
        The name of the file, with optional relative path.
          The path stored should not contain a drive or
          device letter, or a leading slash.  All slashes
          should be forward slashes '/' as opposed to
          backwards slashes '\' for compatibility with Amiga
          and Unix file systems etc.
  }

  Result := StringReplace(Value, '\', ZIP_SLASH, [rfReplaceAll]);
end;

//
//  Î÷èùàåì âñå äîáàâëåííûå â àðõèâ ýëåìåíòû
// =============================================================================
procedure TFWZipWriter.Clear;
begin
  FItems.Clear;
end;

//
//  Ïðîöåäóðà ñæèìåò äàííûå
// =============================================================================
procedure TFWZipWriter.CompressItem(CurrentItem: TFWZipWriterItem;
  Index: Integer; StreamSizeBeforeCompress: Int64; Stream: TStream);


  function CopyWithProgress(Src, Dst: TStream;
    Cryptor: TFWZipCryptor): Cardinal;
  var
    Buff: Pointer;
    Size, TotalSize: Integer;
  begin
    Result := $FFFFFFFF;
    GetMem(Buff, MAXWORD);
    try
      Src.Position := 0;
      FCompressedStream := Src;
      DoProgress(psInitialization);
      try
        TotalSize := 0;
        while True do
        begin
          Size := Src.Read(Buff^, MAXWORD);
          Result := CRC32Calc(Result, Buff, Size);
          if Size <> 0 then
          begin
            Inc(TotalSize, Size);
            if Cryptor <> nil then
              Cryptor.EncryptBuffer(Buff, Size);
            Dst.WriteBuffer(Buff^, Size);
            DoProgress(psInProgress);
          end
          else
            Break;
        end;
        if TotalSize <> Src.Size then
          raise EZipWriterWrite.CreateFmt(
            'Îøèáêà çàïèñè äàííûõ ýëåìåíòà ¹%d "%s".', [Index, Item[Index].FileName]);
      except
        DoProgress(psException);
        raise;
      end;
      DoProgress(psFinalization);
    finally
      FreeMem(Buff);
    end;
    Result := Result xor $FFFFFFFF;
  end;

var
  F: TFileStream;
  Compressor: TZCompressionStream;
  Cryptor: TFWZipCryptor;
  ZipItemStream: TFWZipItemStream;
  CRC32Stream: TFWZipCRC32Stream;
  EncryptedHeaderStream: TMemoryStream;
begin
  Cryptor := nil;
  try
    EncryptedHeaderStream := TMemoryStream.Create;
    try
      if CurrentItem.Password <> '' then
      begin
        Cryptor := TFWZipCryptor.Create(AnsiString(CurrentItem.Password));
        Cryptor.GenerateEncryptionHeader(EncryptedHeaderStream,
          CurrentItem.NeedDescriptor,
          FCD[Index].Header.Crc32,
          FCD[Index].Header.LastModFileTimeTime +
          FCD[Index].Header.LastModFileTimeDate shl 16);
        // ðåçåðâèðóåì ìåñòî ïîä EncryptedHeaderStream
        Stream.Size := StreamSizeBeforeCompress + EncryptedHeaderSize;
        Stream.Position := Stream.Size;
      end;

      // ïèøåì ñàì ñæàòûé ôàéë
      case FCD[Index].Header.CompressionMethod of
        Z_NO_COMPRESSION:
        begin
          if CurrentItem.Data <> nil then
            FCD[Index].Header.Crc32 :=
              CopyWithProgress(CurrentItem.Data, Stream, Cryptor)
          else
          begin
            try
              F := TFileStream.Create(CurrentItem.FilePath,
                fmOpenRead or fmShareDenyWrite);
              try
                FCD[Index].Header.Crc32 :=
                  CopyWithProgress(F, Stream, Cryptor)
              finally
                F.Free;
              end;
            except
              on E: Exception do
                raise EZipWriterWrite.CreateFmt(string(
                  'Îøèáêà äîñòóïà ê äàííûì ýëåìåíòà ¹%d "%s".' +
                  sLineBreak) + ExceptionMessage(E),
                  [Index, CurrentItem.FileName]);
            end;
          end;
          // Ïîëó÷àåì ðàçìåð ñæàòûõ äàííûõ
          //  ñëó÷àå åñëè èñïîëüçîâàëîñü øèôðîâàíèå â ðàçìåðå ñðóçó áóäåò
          // ó÷òåí 12-òè áàéòíûé çàãîëîâîê èíèöèàëèçàöèè êëþ÷à ðàñøèôðîâêè
          FCD[Index].CompressedSize := Stream.Size - StreamSizeBeforeCompress;
        end;
        Z_DEFLATED:
        begin
          {$IFDEF USE_AUTOGENERATED_ZLIB_HEADER}
          // ïîçèöèþ ñäâèãàåì íà äâà áàéòà âëåâî,
          // òàêèì îáðàçîì ìû çàòðåì íåíóæíûé íàì çàãîëîâîê ZLib
          Stream.Position := Stream.Position - 2;
          {$ENDIF}
          if CurrentItem.Data <> nil then
          begin
            // ñîõðàíÿåì ññûëêó íà ñòðèì ñ äàííûìè äëÿ ðàññ÷åòà ïðîãðåññà
            FCompressedStream := CurrentItem.Data;
            ZipItemStream := TFWZipItemStream.Create(Stream, Cryptor, nil,
              0, CurrentItem.Size);
            try
              Compressor := TZCompressionStream.Create(
                ZipItemStream, CurrentItem.CompressionLevel,
                defaultWindowBits, 8, zsDefault);
              try
                Compressor.OnProgress := CompressorOnProcess;
                DoProgress(psInitialization);
                try
                  CRC32Stream := TFWZipCRC32Stream.Create(CurrentItem.Data);
                  try
                    Compressor.CopyFrom(CRC32Stream, 0);
                    FCD[Index].Header.Crc32 := CRC32Stream.CRC32;
                  finally
                    CRC32Stream.Free;
                  end;
                except
                  DoProgress(psException);
                  raise;
                end;
                DoProgress(psFinalization);
              finally
                Compressor.Free;
              end;
            finally
              ZipItemStream.Free;
            end;
          end
          else
          begin
            // TFWZipItemStream âûñòóïàåò êàê ïîñðåäíèê ìåæäó ðåçóëüòèðóþùèì
            // ñòðèìîì è TCompressionStream.
            // Åãî çàäà÷à çàøèôðîâàòü âñå ïðîõîäÿùèå ÷åðåç íåøãî äàííûå
            ZipItemStream := TFWZipItemStream.Create(Stream, Cryptor, nil,
              0, CurrentItem.Size);
            try
              Compressor := TZCompressionStream.Create(
                ZipItemStream, CurrentItem.CompressionLevel,
                defaultWindowBits, 8, zsDefault);
              try
                try
                  F := TFileStream.Create(CurrentItem.FilePath,
                    fmOpenRead or fmShareDenyWrite);
                  try
                    // ñîõðàíÿåì ññûëêó íà ñòðèì ñ äàííûìè äëÿ ðàññ÷åòà ïðîãðåññà
                    FCompressedStream := F;
                    F.Position := 0;
                    Compressor.OnProgress := CompressorOnProcess;
                    // TFWZipCRC32Stream âûñòóïàåò êàê ïîñðåäíèê ìåæäó
                    // íåðàñïàêîâàííûìè äàííûìè è TCompressionStream,
                    // â êîòîðîì ïðîèñõîäèò ñæàòèå äàííûõ.
                    // Åãî çàäà÷à îòñëåäèòü âñå ïåðåäàííûå ÷åðåç íåãî
                    // áëîêè äàííûõ è ðàññ÷èòàòü èõ êîíòðîëüíóþ ñóììó
                    // äî òîãî êàê îíè áóäóò ñæàòû
                    DoProgress(psInitialization);
                    try
                      CRC32Stream := TFWZipCRC32Stream.Create(F);
                      try
                        Compressor.CopyFrom(CRC32Stream, 0);
                        FCD[Index].Header.Crc32 := CRC32Stream.CRC32;
                      finally
                        CRC32Stream.Free;
                      end;
                    except
                      DoProgress(psException);
                      raise;
                    end;
                    DoProgress(psFinalization);
                  finally
                    F.Free;
                  end;
                except
                  on E: Exception do
                    raise EZipWriterWrite.CreateFmt(string(
                      'Îøèáêà äîñòóïà ê äàííûì ýëåìåíòà ¹%d "%s".' +
                      sLineBreak) + ExceptionMessage(E),
                      [Index, CurrentItem.FileName]);
                end;
              finally
                Compressor.Free;
              end;
            finally
              ZipItemStream.Free;
            end;
          end;

          {$IFDEF USE_AUTOGENERATED_ZLIB_HEADER}
          // Rouse_ 14.02.2013
          // Íå çíàþ ïî÷åìó, íî îïûòíûì ïóòåì óñòàíîâëåíî,
          // ÷òî ðàçìåð çàïàêîâàíûõ äàííûõ äîëæåí áûòü ìåíüøå íà 4 áàéòà
          // ïðè èñïîëüçîâàíèè àâòîãåíåðèðóåìîãî çàãîëîâêà.
          // Ýòîò ìîìåíò ó÷èòûâàåòñÿ â ICSharpCode.SharpZipLibrary
          // Ðàñïàêîâêà â ëþáîì ñëó÷àå ïðîèñõîäèò íîðìàëüíî
          if TrimPackedStreamSize then
            Stream.Size := Stream.Size - 4;
          {$ENDIF}

          // Ïîëó÷àåì ðàçìåð ñæàòûõ äàííûõ
          //  ñëó÷àå åñëè èñïîëüçîâàëîñü øèôðîâàíèå â ðàçìåðå ñðóçó áóäåò
          // ó÷òåí 12-òè áàéòíûé çàãîëîâîê èíèöèàëèçàöèè êëþ÷à ðàñøèôðîâêè
          FCD[Index].CompressedSize := Stream.Size - StreamSizeBeforeCompress;

        end;
      end;

      // åñëè ôàéë çàøèôðîâàí,
      // çàïèñûâàåì çàãîëîâîê èíèöèàëèçàöèè êëþ÷à ðàñøèôðîâêè
      if EncryptedHeaderStream.Size > 0 then
      begin
        Stream.Position := StreamSizeBeforeCompress;
        Stream.CopyFrom(EncryptedHeaderStream, 0);
      end;
    finally
      EncryptedHeaderStream.Free;
    end;

  finally
    Cryptor.Free;
  end;
end;

//
//  Ïðîöåäóðà âûçûâàåò ñîáûòèå OnProcess
// =============================================================================
procedure TFWZipWriter.CompressorOnProcess(Sender: TObject);
begin
  DoProgress(psInProgress);
end;

//
//  Ôóíêöèÿ âîçâðàùàåò êîëè÷åñòâî äîáàâëåííûõ ýëåìåíòîâ àðõèâà
// =============================================================================
function TFWZipWriter.Count: Integer;
begin
  Result := FItems.Count;
end;

//
//  Ñòàíäàðòíûé êîíñòðóêòîð êëàññà
// =============================================================================
constructor TFWZipWriter.Create;
begin
  Create(False, clDefault, '');
end;

//
//  Ðàñøèðåííûé êîíñòðóêòîð êëàññà,
//  â êîòîðîì ìîæíî óêàçàòü ñòåïåíü ñæàòèÿ,
//  èñïîëüçóåìóþ äëÿ âñåõ ýëåìåíòîâ ïî óìîë÷àíèþ.
// =============================================================================
constructor TFWZipWriter.Create(CompressionLevel: TCompressionLevel);
begin
  Create(False, CompressionLevel, '');
end;

//
//  Ðàñøèðåííûé êîíñòðóêòîð êëàññà,
//  â êîòîðîì ìîæíî èçìåíèòü íàñòðîéêè ýëåìåíòîâ áóäóþùåãî àðõèâà ïî óìîë÷íèþ.
// =============================================================================
constructor TFWZipWriter.Create(UseDescryptors: Boolean;
  CompressionLevel: TCompressionLevel; const DefaultPassword: string);
begin
  inherited Create;
  FDefaultDescryptorState := UseDescryptors;
  FDefaultCompressionLevel := CompressionLevel;
  FDefaultPassword := DefaultPassword;
  FItems := TObjectList.Create;
  FItems.Capacity := 100000;
  FTrimPackedStreamSize := True;
end;

//
//  Ôóíêöèÿ ñîçäàåò íî íå äîáàâëÿåò â ìàñèâ çàïèñåé íîâûé ýëåìåíò
// =============================================================================
function TFWZipWriter.CreateItemFromStream(const FileName: string;
  Value: TStream; AOwnerShip: TStreamOwnership): TFWZipWriterItem;
var
  Size: Int64;
  InitFileName: string;
  Attributes: TFileAttributeData;
begin
  // ïðîâåðêà íà äóáëè
  InitFileName := CheckFileNameSlashes(FileName);

  Size := Value.Size;
  ZeroMemory(@Attributes, SizeOf(TFileAttributeData));
  Attributes.ftCreationTime := GetCurrentFileTime;
  Attributes.ftLastAccessTime := Attributes.ftCreationTime;
  Attributes.ftLastWriteTime := Attributes.ftCreationTime;
  Attributes.nFileSizeLow := Size and MAXDWORD;
  Attributes.nFileSizeHigh := Size shr 32;
  Result := GetItemClass.Create(Self, '', Attributes, InitFileName);
  Result.CompressionLevel := FDefaultCompressionLevel;
  Result.Password := FDefaultPassword;

  // â ñëó÷àå íàëè÷èÿ äåñêðèïòîðà ìû ìîæåì
  // ïðîèçâîäèòü ðàñ÷åò êîíòðîëüíîé ñóììû íà ëåòó, ò.ê. ïðè âêëþ÷åííîì
  // ðåæèìå øèôðîâàíèÿ îíà íå ó÷àñòâóåò â ãåíåðàöèè çàãîëîâêà èíèöèàëèçàöèè
  Result.NeedDescriptor := FDefaultDescryptorState;

  Result.ChangeDataStream(Value, AOwnerShip);
end;

//
//  Ïðîöåäóðà óäàëÿåò íåíóæíûé ýëåìåíò àðõèâà
// =============================================================================
procedure TFWZipWriter.DeleteItem(Index: Integer);
begin
  FItems.Delete(Index);
end;

//
//  Ñòàíäàðòíûé äåñòðóêòîð êëàññà
// =============================================================================
destructor TFWZipWriter.Destroy;
begin
  FItems.Free;
  inherited;
end;

//
//  Âûçîâ âíåøíåãî ñîáûòèÿ î ïðîãðåññå ñæàòèÿ
// =============================================================================
procedure TFWZipWriter.DoProgress(ProgressState: TProgressState);
var
  CurrentProgress: Byte;
  Cancel: Boolean;
begin
  if Assigned(FOnProgress) then
  begin
    case ProgressState of
      psInProgress:
      begin
        if FCompressedStream.Size = 0 then
          CurrentProgress := 100
        else
          CurrentProgress :=
            Round(FCompressedStream.Position / (FCompressedStream.Size / 100));
        if FTotalSizeCount = 0 then
          FTotalProgress := 100
        else
          FTotalProgress :=
            Round((FTotalProcessedCount + FCompressedStream.Position) /
              (FTotalSizeCount / 100));
      end;
      psFinalization, psEnd: CurrentProgress := 100;
    else
      CurrentProgress := 0;
    end;
    Cancel := False;
    FOnProgress(Self, Item[FProcessedItemIndex].FileName,
      CurrentProgress, FTotalProgress, Cancel, ProgressState);
    if Cancel then Abort;
  end;
end;

//
//  Ðàññ÷èòûâàåì äëèíó ñòðîêè ñ ó÷åòîì UTF8
// =============================================================================
function TFWZipWriter.StringLength(const Value: string; AUseUTF8String: Boolean): Integer;
begin
  if AUseUTF8String then
    Result := Length(UTF8Encode(Value))
  else
    Result := Length(ConvertToOemString(AnsiString(Value)));
end;

//
//  Ôóíêöèÿ âîçâðàùàåò òåêóùåå âðåìÿ â ôîðìàòå TFileTime
// =============================================================================
function TFWZipWriter.GetCurrentFileTime: TFileTime;
begin
  Result := DateTimeToFileTime(Now);
end;

//
//  Îáðàáîò÷èê ñâîéñòâà Items
// =============================================================================
function TFWZipWriter.GetItem(Index: Integer): TFWZipWriterItem;
begin
  Result := TFWZipWriterItem(FItems[Index]);
end;

//
//  Çàïðàøèâàåì äàííûå î ðàñøèðåííûõ áëîêàõ äàííûõ äëÿ êàæäîé çàïèñè
// =============================================================================
procedure TFWZipWriter.FillExData(Stream: TStream; Index: Integer);
var
  ExDataStream: TMemoryStream;
  EmptyExData: Boolean;
  UserExDataBlockCount, {%H-}ExDataSize: Integer;
  ExDataHeaderTag: Word;
begin
  if Assigned(FSaveExData) then
  begin
    ExDataStream := TMemoryStream.Create;
    try
      EmptyExData := False;
      UserExDataBlockCount := 0;
      while not EmptyExData do
      begin
        ExDataHeaderTag := 0;
        ExDataStream.Clear;
        FSaveExData(Self, Index, UserExDataBlockCount,
          ExDataHeaderTag, ExDataStream);
        Inc(UserExDataBlockCount);
        EmptyExData := ExDataStream.Size = 0;
        if not EmptyExData then
        begin
          // Rouse_ 18.05.2020
          // Ôèêñ îøèáêè. Îáùèé ðàçìåð áëîêà EXDATA îãðàíè÷åí MAXWORD
          // À íå êàæäàÿ çàïèñü â íåì!
          if Stream.Size + ExDataStream.Size + 4 > MAXWORD then
            raise EZipWriter.Create(
              'Ðàçìåð áëîêà ðàñøèðåííûõ äàííûõ' +
              ' íå ìîæåò ïðåâûøàòü 65535 áàéò.')
          else
            ExDataSize := ExDataStream.Size;
          if ExDataHeaderTag in
            [0, SUPPORTED_EXDATA_ZIP64, SUPPORTED_EXDATA_NTFSTIME] then
            raise EZipWriter.Create(
              'Íåëüçÿ èñïîëüçîâàòü çàðåçåðâèðîâàííûå òýãè' +
              ' áëîêà ðàñøèðåííûõ äàííûõ.');
          Stream.WriteBuffer(ExDataHeaderTag, 2);
          Stream.WriteBuffer(ExDataSize, 2);
          Stream.CopyFrom(ExDataStream, 0);
        end;
      end;
    finally
      ExDataStream.Free;
    end;
  end;
end;

//
//  Èíèöèàëèçèðóåì CentralDirectoryFileHeader ýëåìåíòà
// =============================================================================
procedure TFWZipWriter.FillItemCDFHeader(CurrentItem: TFWZipWriterItem;
  var Value: TCentralDirectoryFileHeaderEx);
var
  FileDate: Cardinal;
  Buff: array of Byte;
begin
  Value.Header.CentralFileHeaderSignature := CENTRAL_FILE_HEADER_SIGNATURE;
  Value.Header.VersionMadeBy := CurrentVersionMadeBy;
  Value.Header.VersionNeededToExtract := 0; // Ðàññ÷èòûâàåòñÿ ïîçäíåå

  Value.Header.GeneralPurposeBitFlag := 0;
  if CurrentItem.Password <> '' then
    Value.Header.GeneralPurposeBitFlag :=
      Value.Header.GeneralPurposeBitFlag or PBF_CRYPTED;

  {%H-}case CurrentItem.CompressionLevel of
    clNone:; // äàííûé ðåæèì êîìïðåññèè íå ïîääåðæèâàåòñÿ, ñðàçó ìåíÿåì íà Store
    clFastest:
      Value.Header.GeneralPurposeBitFlag :=
        Value.Header.GeneralPurposeBitFlag or PBF_COMPRESS_SUPERFAST;
    clDefault:
      Value.Header.GeneralPurposeBitFlag :=
        Value.Header.GeneralPurposeBitFlag or PBF_COMPRESS_NORMAL;
    clMax:
      Value.Header.GeneralPurposeBitFlag :=
        Value.Header.GeneralPurposeBitFlag or PBF_COMPRESS_MAXIMUM;
  end;
  if CurrentItem.NeedDescriptor then
    Value.Header.GeneralPurposeBitFlag :=
      Value.Header.GeneralPurposeBitFlag or PBF_DESCRIPTOR;

  if CurrentItem.CompressionLevel = clNone then
    Value.Header.CompressionMethod := Z_NO_COMPRESSION
  else
    Value.Header.CompressionMethod := Z_DEFLATED;

  if not CurrentItem.IsFolder then
    if not CurrentItem.NeedDescriptor then
      if CurrentItem.Password <> '' then
      begin
        // â ñëó÷àå åñëè äåñêðèïòîðû îòêëþ÷åíû è âêëþ÷åíî øèôðîâàíèå ýëåìåíòà
        // òî íåîáõîäèìî ðàññ÷èòàòü åãî êîíòðîëüíóþ ñóììó ïåðåä
        // ãåíåðàöèåé çàãîëîâêà èíèöèàëèçàöèè êëþ÷à øèôðîâàíèÿ
        if CurrentItem.Data = nil then
          Value.Header.Crc32 := FileCRC32(CurrentItem.FilePath)
        else
        begin
          CurrentItem.Data.Position := 0;
          SetLength(Buff{%H-}, CurrentItem.Data.Size);
          CurrentItem.Data.Read(Buff[0], CurrentItem.Data.Size);
          Value.Header.Crc32 :=
            CRC32Calc(@Buff[0], CurrentItem.Data.Size);
        end;
      end;
  Value.UncompressedSize := CurrentItem.Size;

  FileDate := FileTimeToLocalFileDate(CurrentItem.Attributes.ftLastWriteTime);

  Value.Header.LastModFileTimeTime := FileDate and $FFFF;
  Value.Header.LastModFileTimeDate := FileDate shr 16;

  Value.Filename := CurrentItem.FileName;
  Value.Header.FilenameLength :=
    StringLength(CurrentItem.Filename, CurrentItem.UseUTF8String);
  Value.Header.ExtraFieldLength := 0;
  Value.FileComment := CurrentItem.Comment;
  Value.Header.FileCommentLength :=
    StringLength(CurrentItem.Comment, CurrentItem.UseUTF8String);

  Value.Header.InternalFileAttributes := 0;
  Value.Header.ExternalFileAttributes :=
    CurrentItem.Attributes.dwFileAttributes;
  Value.Attributes := CurrentItem.Attributes;

  if CurrentItem.UseUTF8String then
    Value.Header.GeneralPurposeBitFlag :=
      Value.Header.GeneralPurposeBitFlag or PBF_UTF8;
end;

function TFWZipWriter.Find(const Value: string; out AItem: TFWZipWriterItem;
  IgnoreCase: Boolean): Boolean;
var
  I: Integer;
  AItemText: string;
begin
  Result := False;
  AItem := nil;
  for I := 0 to Count - 1 do
  begin
    AItemText := Item[I].FileName;
    if IgnoreCase then
      Result := AnsiSameText(Value, AItemText)
    else
      Result := AnsiSameStr(Value, AItemText);
    if Result then
    begin
      AItem := Item[I];
      Break;
    end;
  end;
end;

//
//  Äîáàâëÿåì âîçìîæíîñòü ñîçäàâàòü íàñëåäíèêîâ îò áàçîâîãî êëàññà
// =============================================================================
function TFWZipWriter.GetItemClass: TFWZipWriterItemClass;
begin
  Result := TFWZipWriterItem;
end;

//
//  Ôóíêöèÿ ðàññ÷èòûâàåò ìèíèìàëüíóþ âåðñèþ äëÿ èçâëå÷åíèÿ
//  óêàçàííîãî ýëåìåíòà àðõèâà
// =============================================================================
function TFWZipWriter.GetVersionToExtract(Index: Integer): Word;
begin
{
          Current minimum feature versions are as defined below:

          1.0 - Default value
          1.1 - File is a volume label
          2.0 - File is a folder (directory)
          2.0 - File is compressed using Deflate compression
          2.0 - File is encrypted using traditional PKWARE encryption
          2.1 - File is compressed using Deflate64(tm)
          2.5 - File is compressed using PKWARE DCL Implode
          2.7 - File is a patch data set
          4.5 - File uses ZIP64 format extensions
          4.6 - File is compressed using BZIP2 compression*
          5.0 - File is encrypted using DES
          5.0 - File is encrypted using 3DES
          5.0 - File is encrypted using original RC2 encryption
          5.0 - File is encrypted using RC4 encryption
          5.1 - File is encrypted using AES encryption
          5.1 - File is encrypted using corrected RC2 encryption**
          5.2 - File is encrypted using corrected RC2-64 encryption**
          6.1 - File is encrypted using non-OAEP key wrapping***
          6.2 - Central directory encryption
}

  // TFWZIPWriter ïîääåðæèâàåò ñëåäóþùèå ðàñøèðåíèÿ ñòàíäàðòà:
  // 1. èñïîëüçîâàíèå äèðåêòîðèé (âåðñèÿ äëÿ èçâëå÷åíèÿ - 2.0)
  // 2. èñïîëüçîâàíèå ZIP64 ðàñøèðåíèÿ (âåðñèÿ äëÿ èçâëå÷åíèÿ - 4.5)

  // Äëÿ îïðåäåëåíèÿ, íóæíî ëè íàì èñïîëüçîâàòü ZIP64 íåîáõîäèìî ïðîâåðèòü
  // ñëåäóþùèå ïàðàìåòðû:
  // ðàçìåð êàæäîãî ýëåìåíòà àðõèâà ñæàòîãî è íå ñæàòîãî,
  // îôôñåò íà íà÷àëî áëîêà äàííûõ äëÿ êàæäîãî ýëåìåíòà
  // åñëè ëþáîå èç ýòèõ çíà÷åíèé âûõîäèò çà çíà÷åíèå MAXDWORD,
  // èëè êîëè÷åñòâî ýëåìåíòîâ àðõèâà âûõîäèò çà çíà÷åíèå MAXWORD,
  // íàì íåîáõîäèìî ïðèìåíÿòü ZIP64

  Result := 20;
  if (FCD[Index].UncompressedSize >= MAXDWORD) or
    (FCD[Index].CompressedSize >= MAXDWORD) or
    (FCD[Index].RelativeOffsetOfLocalHeader >= MAXDWORD) or
    (FCD[Index].DiskNumberStart >= MAXWORD) then
    Result := 45;
end;

//
//  Ôóíêöèÿ äîáàâëÿåò â àðõèâ äàííûå èç ïåðåäàííîãî ñòðèìà.
//   êà÷åñòâå ðåçóëüòàòà âîçâðàùàåò èíäåêñ ýëåìåíòà â ñïèñêå
// =============================================================================
function TFWZipWriter.InsertStream(const FileName: string; Index: Integer;
  Value: TStream; AOwnerShip: TStreamOwnership): Integer;
var
  Item: TFWZipWriterItem;
begin
  Item := CreateItemFromStream(FileName, Value, AOwnerShip);
  FItems.Insert(Index, Item);
  Result := Index;
end;

//
//  Ôóíêöèÿ äëÿ ïåðåêëþ÷åíèÿ ëîãèêè ðàáîòû ñ ìíîãîòîìíûìè ìàñèâàìè
// =============================================================================
function TFWZipWriter.IsMultiPartZip(AStream: TStream): Boolean;
begin
  Result := AStream is TFWAbstractMultiStream;
end;

//
//  Ïðîöåäóðà ïðîâîäèò ñîõðàíåíèå ñåêöèè CentralDirectory
// =============================================================================
procedure TFWZipWriter.SaveCentralDirectory(Stream: TStream);
var
  I, DiskNumber: Integer;
  RealtiveOffset, VolumeSize: Int64;
  {%H-}ExDataHeader: TExDataHeaderAndSize;
  ExDataNTFS: TExDataNTFS;
  ZIP64Data: TMemoryStream;
  TotalExDataStream: TMemoryStream;
  FirstDisk: Boolean;
begin
  FirstDisk := True;
  FcdfhRecordOnDisk := 0;
  FSizeOfCentralDir := FcdfhOffset;
  if IsMultiPartZip(Stream) then
    TFWAbstractMultiStream(Stream).GetRelativeInfo(FcdfhDiskNumber, FcdfhOffset)
  else
    FcdfhDiskNumber := 0;

  for I := 0 to Count - 1 do
  begin

    // ïðîïóñêàåì ýëåìåíòû ïðè çàïèñè êîòîðûõ ïðîèçîøëî èñêëþ÷åíèå
    if FCD[I].ExceptOnWrite then Continue;

    // ïåðåä çàïèñüþ êàæäîãî ýëåìåíòà CentralDirectory
    // íåîáõîäèìî ïîäãîòîâèòü áóôôåðû ñ ðàñøèðåííûìè äàííûìè
    // è óêàçàòü èõ ðàñìåð
    ZIP64Data := TMemoryStream.Create;
    try
      // ïîäãîòàâèâàåì áóôôåð ñ ZIP64 äàííûìè

      {
          The order of the fields in the ZIP64 extended
          information record is fixed, but the fields will
          only appear if the corresponding Local or Central
          directory record field is set to 0xFFFF or 0xFFFFFFFF.
      }

      if FCD[I].UncompressedSize >= MAXDWORD then
        ZIP64Data.WriteBuffer(FCD[I].UncompressedSize, 8);
      if FCD[I].CompressedSize >= MAXDWORD then
        ZIP64Data.WriteBuffer(FCD[I].CompressedSize, 8);
      if FCD[I].RelativeOffsetOfLocalHeader >= MAXDWORD then
        ZIP64Data.WriteBuffer(FCD[I].RelativeOffsetOfLocalHeader, 8);
      if FCD[I].DiskNumberStart >= MAXWORD then
        ZIP64Data.WriteBuffer(FCD[I].DiskNumberStart, 4);

      ZeroMemory(@ExDataNTFS, SizeOf(TExDataNTFS));
      if IsAttributesPresent(FCD[I].Attributes) then
      begin
        // ïîäãîòàâëèâàåì áóôôåð ñ NTFS âðåìåíåì
        FCD[I].Header.ExtraFieldLength := SizeOf(TExDataNTFS);

        //   (NTFS)  0x000a        Short       Tag for this "extra" block type
        ExDataNTFS.HS.Header := SUPPORTED_EXDATA_NTFSTIME;
        {
          In the current implementations, this field has
          a fixed total data size of 32 bytes and is only stored as local
          extra field
        }
        ExDataNTFS.HS.Size := 32;
        // Reserved      Long        for future use
        ExDataNTFS.Reserved := 0;
        // Tag1          Short       NTFS attribute tag value #1
        ExDataNTFS.Tag := 1;
        //Size1      2 bytes    Size of attribute #1, in bytes (24)
        ExDataNTFS.RecordSize := 24;
        ExDataNTFS.Data.Mtime := FCD[I].Attributes.ftLastWriteTime;
        ExDataNTFS.Data.Atime := FCD[I].Attributes.ftLastAccessTime;
        ExDataNTFS.Data.Ctime := FCD[I].Attributes.ftCreationTime;
      end;
      if ZIP64Data.Size > 0 then
        Inc(FCD[I].Header.ExtraFieldLength,
          ZIP64Data.Size + SizeOf(TExDataHeaderAndSize));

      TotalExDataStream := TMemoryStream.Create;
      try
        // Çàïðàøèâàåì áëîêè ExData îò ïîëüçîâàòåëÿ
        FillExData(TotalExDataStream, I);

        // ïðàâèì îáùèé ðàçìåð ðàñøèðåííûõ áëîêîâ
        Inc(FCD[I].Header.ExtraFieldLength, TotalExDataStream.Size);

        // Äëÿ MultiPart àðõèâà íàäî ñëåäèòü ÷òîáû CentralDirectoryFileHeader
        // öåëèêîì âëàçèëî â òîì è íåáûëî ðàçáèòèÿ ìåæäó ãðàíèö äâóõ òîìîâ
        if IsMultiPartZip(Stream) then
        begin
          VolumeSize := TFWAbstractMultiStream(Stream).GetWriteVolumeSize;
          TFWAbstractMultiStream(Stream).GetRelativeInfo(
            DiskNumber, RealtiveOffset);
          if VolumeSize < RealtiveOffset + SizeOf(TCentralDirectoryFileHeader) +
            FCD[I].Header.FilenameLength + FCD[I].Header.FileCommentLength +
            FCD[I].Header.ExtraFieldLength then
          begin
            TFWAbstractMultiStream(Stream).StartNewVolume;
            if FcdfhRecordOnDisk = 0 then
            begin
              Inc(FcdfhDiskNumber);
              FcdfhOffset := 0;
            end
            else
              FirstDisk := False;
          end;
        end;

        // Ïèøåì ñòðóêòóðó TCentralDirectoryFileHeader, îïèñûâàþùóþ ýëåìåíò
        Stream.WriteBuffer(FCD[I].Header, SizeOf(TCentralDirectoryFileHeader));

        // Ïèøåì íàèìåíîâàíèå ýëåìåíòà
        SaveString(Stream, FCD[I].FileName,
          FCD[I].Header.GeneralPurposeBitFlag and PBF_UTF8 = PBF_UTF8);

        // åñëè íóæíî -  äîï èíôîðìàöèþ â ôîðìàòå ZIP64
        if ZIP64Data.Size > 0 then
        begin
          ExDataHeader.Header := SUPPORTED_EXDATA_ZIP64;
          ExDataHeader.Size := ZIP64Data.Size;
          Stream.WriteBuffer(ExDataHeader, SizeOf(TExDataHeaderAndSize));
          Stream.CopyFrom(ZIP64Data, 0);
        end;

        // ïîòîì èíôîðìàöèþ î NTFSTime
        if ExDataNTFS.HS.Header = SUPPORTED_EXDATA_NTFSTIME then
          Stream.WriteBuffer(ExDataNTFS, SizeOf(TExDataNTFS));

        // è ðàñøèðåííóþ èíôîðìàöèþ ïîëó÷åííóþ îò ïîëüçîâàòåëÿ
        if TotalExDataStream.Size > 0 then
          Stream.CopyFrom(TotalExDataStream, 0);

      finally
         TotalExDataStream.Free;
      end;

      // â çàâåðøåíèå, ïèøåì êîìåíòàðèé ê ýëåìåíòó
      SaveString(Stream, FCD[I].FileComment,
        FCD[I].Header.GeneralPurposeBitFlag and PBF_UTF8 = PBF_UTF8);

      if FirstDisk then
        Inc(FcdfhRecordOnDisk);

    finally
      ZIP64Data.Free;
    end;
  end;
  FSizeOfCentralDir := Stream.Position - FSizeOfCentralDir;
end;

//
//  Ïðîöåäóðà ïðîâîäèò ñîõðàíåíèå ñåêöèè EndOfCentralDirectory
// =============================================================================
procedure TFWZipWriter.SaveEndOfCentralDirectory(Stream: TStream);
var
  eo64cd: TZip64EOFCentralDirectoryRecord;
  {%H-}locator: TZip64EOFCentralDirectoryLocator;
  eocd: TEndOfCentralDir;
  eo64cdOffset: Int64;
  DiskNumber: Integer;
  VolumeSize: Int64;
begin
  eocd.ZipfileCommentLength := StringLength(FComment, False);
  if IsMultiPartZip(Stream) then
  begin
    VolumeSize := TFWAbstractMultiStream(Stream).GetWriteVolumeSize;
    TFWAbstractMultiStream(Stream).GetRelativeInfo(DiskNumber, eo64cdOffset);
    if VolumeSize < eo64cdOffset + SizeOf(TZip64EOFCentralDirectoryRecord) +
      SizeOf(TZip64EOFCentralDirectoryLocator) + SizeOf(TEndOfCentralDir) +
      eocd.ZipfileCommentLength then
    begin
      TFWAbstractMultiStream(Stream).StartNewVolume;
      Inc(DiskNumber);
      eo64cdOffset := 0;
    end;
    locator.TotalNumberOfDisks := TFWAbstractMultiStream(Stream).GetDiskCount;
  end
  else
  begin
    DiskNumber := 0;
    eo64cdOffset := Stream.Position;
    locator.TotalNumberOfDisks := 1;
  end;

  // êîëè÷åñòâî çàïèñåé â êîíêðåòíîì òîìå
  eo64cd.TotalNumberOfEntriesOnThisDisk := FcdfhRecordOnDisk;
  // Èñêëþ÷àåì èç îáùåãî êîëè÷åñòâà ýëåìåíòîâ àðõèâà êîëè÷åñòâî èñêëþ÷åíèé
  eo64cd.TotalNumberOfEntries {%H-}:= Count - FExceptionCount;

  // ôîðìàò ZIP64 èñïîëüçóåòñÿ â ñëó÷àå åñëè êîëè÷åñòâî ýëåìåíòîâ
  // àðõèâà ïðåâûøàåò MAXWORD, èëè ñìåùåíèå íà íà÷àëî öåíòðàëüíîé äèðåêòîðèè
  // ïðåâûøàåò MAXDWORD èëè åå ðàçìåð ïðåâûøàåò MAXDWORD
  if (FcdfhOffset > MAXDWORD) or (FSizeOfCentralDir > MAXDWORD) or
    (eo64cd.TotalNumberOfEntriesOnThisDisk > MAXWORD) or
    (eo64cd.TotalNumberOfEntries > MAXWORD) or (DiskNumber > MAXWORD) or
    (FcdfhDiskNumber > MAXWORD) then
  begin
    //  ñëó÷àå èñïîëüçîâàíèÿ ôîðìàòà ZIP64
    // íåîáõîäèìî çàïèñàòü äîïîëíèòåëüíûå ñòðóêòóðû

    // TZip64EOFCentralDirectoryRecord
    eo64cd.Zip64EndOfCentralDirSignature := ZIP64_END_OF_CENTRAL_DIR_SIGNATURE;


    // Rouse_ 20.07.2013
    // â ñïåöèôèêàöèè 6.3.0 îò September 29, 2006 îãîâîðåíî
    {
        The value stored into the "size of zip64 end of central
        directory record" should be the size of the remaining
        record and should not include the leading 12 bytes.

        Size = SizeOfFixedFields + SizeOfVariableData - 12.
    }
    // FWZip ðàçðàáàòûâàëñÿ íà îñíîâå áîëåå ðàííèõ ñïåöèôèêàöèé
    // (èçíà÷àëüíî íà 6.0 ïîòîì íà 6.2) è íå ó÷èòûâàë ýòîò ìîìåíò

    // Ïîýòîìó âìåñòî
    // oe64cd.SizeOfZip64EOFCentralDirectoryRecord :=
    //   SizeOf(TZip64EOFCentralDirectoryRecord);
    // ïèøåì:

    eo64cd.SizeOfZip64EOFCentralDirectoryRecord :=
      SizeOf(TZip64EOFCentralDirectoryRecord) - 12;


    eo64cd.VersionMadeBy := CurrentVersionMadeBy;
    eo64cd.VersionNeededToExtract := FVersionToExtract;
    eo64cd.NumberOfThisDisk := DiskNumber;
    eo64cd.DiskNumberStart := FcdfhDiskNumber;
    eo64cd.SizeOfTheCentralDirectory := FSizeOfCentralDir;
    eo64cd.RelativeOffsetOfCentralDirectory := FcdfhOffset;
    Stream.WriteBuffer(eo64cd, SizeOf(TZip64EOFCentralDirectoryRecord));

    // TZip64EOFCentralDirectoryLocator
    locator.Signature := ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIGNATURE;
    locator.DiskNumberStart := DiskNumber;
    locator.RelativeOffset := eo64cdOffset;
    Stream.WriteBuffer(locator, SizeOf(TZip64EOFCentralDirectoryLocator));

  end;
  eocd.EndOfCentralDirSignature := END_OF_CENTRAL_DIR_SIGNATURE;
  if DiskNumber > MAXWORD then
    eocd.NumberOfThisDisk := MAXWORD
  else
    eocd.NumberOfThisDisk := DiskNumber;
  if FcdfhDiskNumber > MAXWORD then
    eocd.DiskNumberStart := MAXWORD
  else
    eocd.DiskNumberStart := FcdfhDiskNumber;
  if eo64cd.TotalNumberOfEntriesOnThisDisk > MAXWORD then
    eocd.TotalNumberOfEntriesOnThisDisk := MAXWORD
  else
    eocd.TotalNumberOfEntriesOnThisDisk := eo64cd.TotalNumberOfEntriesOnThisDisk;
  if eo64cd.TotalNumberOfEntries > MAXWORD then
    eocd.TotalNumberOfEntries := MAXWORD
  else
    eocd.TotalNumberOfEntries := eo64cd.TotalNumberOfEntries;
  if FSizeOfCentralDir > MAXDWORD then
    eocd.SizeOfTheCentralDirectory := MAXDWORD
  else
    eocd.SizeOfTheCentralDirectory := FSizeOfCentralDir;
  if FcdfhOffset > MAXDWORD then
    eocd.RelativeOffsetOfCentralDirectory := MAXDWORD
  else
    eocd.RelativeOffsetOfCentralDirectory := FcdfhOffset;
  Stream.WriteBuffer(eocd, SizeOf(TEndOfCentralDir));
  if eocd.ZipfileCommentLength > 0 then
    // Rouse_ 26.06.2023
    //  ñïåöèôèêàöèè âîîáùå íè÷åãî íå ñêàçàíî ïðî ôîðìàò êîìåíòàðèÿ
    // è íåò ïîëÿ ãäå õðàíèëñÿ áû ôëàã êîäèðîâêè îáùåãî êîìåíòàðèÿ ê àðõèâó
  	// ïîýòîìó êîìåíòàðèé äîëæåí ñîõðàíÿòüñÿ ÒÎËÜÊÎ êàê Ansi ñòðîêà
    SaveString(Stream, FComment, False);
end;

//
//  Ïðîöåäóðà ïðîâîäèò âñå ïðîöåäóðû ïîäãîòîâêè, ñæàòèÿ è ñîõðàíåíèÿ óêàçàííîãî ýëåìåíòà àðõèâà
// =============================================================================
procedure TFWZipWriter.SaveItemToStream(Stream: TStream; Index: Integer);
var
  CurrentItem: TFWZipWriterItem;
  FileNameOffset, StreamSizeBeforeCompress, RealtiveOffset: Int64;
  DiskNumber: Integer;
begin
  CurrentItem := Item[Index];

  // ïðîâåðêà íà äóðàêîóñòîé÷èâîñòü
  if not CurrentItem.UseExternalData then
    if (CurrentItem.FilePath = '') and (CurrentItem.Data = nil) then
      raise EZipWriter.CreateFmt('Äàííûå ýëåìåíòà ¹%d "%s" îòñóòñòâóþò',
        [Index, CurrentItem.FileName]);

  FProcessedItemIndex := Index;

  // Rouse_ 25.10.2013
  // Ãåíåðèðóåì ñîáûòèå íà÷àëà ðàñïàêîâêè ïåðåä òåì êàê ðåçóëüòèðóþùèé ôàéë áóäåò çàëî÷åí
  DoProgress(psStart);
  try

    // Çàïîëíÿåì èíôîðìàöèþ â CentralDirectory
    // ===========================================================================
    FillItemCDFHeader(CurrentItem, FCD[Index]);

    if IsMultiPartZip(Stream) then
    begin
      TFWAbstractMultiStream(Stream).GetRelativeInfo(DiskNumber, RealtiveOffset);
      FCD[Index].DiskNumberStart := DiskNumber;
      FCD[Index].RelativeOffsetOfLocalHeader := RealtiveOffset;
    end
    else
    begin
      FCD[Index].DiskNumberStart := 0;
      FCD[Index].RelativeOffsetOfLocalHeader := Stream.Position;
    end;

    // Ïîìåùàåì äàííûå â ðåçóëüòèðóþùèé ôàéë
    // ===========================================================================

    // Çàïîìèíàåì îôôñåò ïî êîòîðîìó íåîáõîäèìî áóäåò ïèñàòü èìÿ ôàéëà
    FileNameOffset := Stream.Position + SizeOf(TLocalFileHeader);

    // ðàññ÷èòûâàåì ðàçìåð ðåçåðâèðóåìîãî ìåñòà ïîä
    // LocalFileHeader è èìÿ ôàéëà
    StreamSizeBeforeCompress := FileNameOffset +
      FCD[Index].Header.FilenameLength;

    // ðåçåðâèðóåì ìåñòî ïîä ZIP64
    if FCD[Index].UncompressedSize >= MAXDWORD then
      Inc(StreamSizeBeforeCompress, SizeOf(TExDataInfo64));

    // âûäåëÿåì áëîê äàííûõ ïîä LocalFileHeader è èìÿ ôàéëà
    Stream.Size := StreamSizeBeforeCompress;
    Stream.Position := Stream.Size;

    // ñæèìàåì äàííûå
    if not CurrentItem.IsFolder then
      CompressItem(CurrentItem, Index, StreamSizeBeforeCompress, Stream);

    Inc(FTotalProcessedCount, CurrentItem.Size);

    // ïèøåì èìÿ ôàéëà
    Stream.Position := FileNameOffset;
    SaveString(Stream, FCD[Index].Filename, CurrentItem.UseUTF8String);

    // ðåçåðâèðóåì ìåñòî ïîä äåñêðèïòîð
    if CurrentItem.NeedDescriptor then
      Stream.Size := Stream.Size + SizeOf(TDataDescriptor);

    Stream.Position := Stream.Size;

  finally
    // Rouse_ 25.10.2013
    // Ðåçóëüòèðóþùèé ôàéë îñâîáîæäåí, ãåíåðèðóåì ñîáûòèå
    DoProgress(psEnd);
  end;
end;

//
//  Ïðîöåäóðà ïðîâîäèò ïðåîáðàçîâàíèå ïåðåäàííîé ñòðîêè â OEM è åå ñîõðàíåíèå
// =============================================================================
procedure TFWZipWriter.SaveString(Stream: TStream; const Value: string;
  AUseUTF8String: Boolean);
var
  OemString: AnsiString;
begin
  if Value <> '' then
  begin
    if AUseUTF8String then
      OemString := UTF8Encode(Value)
    else
      OemString := ConvertToOemString(AnsiString(Value));
    // äëèíà ñòðîêè ïîñëå êîíâåðòàöèè áóäåò ïðàâèëüíîé, ò.å. äëÿ
    // 'Ìîé òåñòîâûé êîììåíòàðèé' ó UTF8 áóäåò ðàâíà 46 è 24 â ïðîòèâíîì ñëó÷àå
    Stream.WriteBuffer(OemString[1], Length(OemString));
  end;
end;

//
//  Ïðîöåäóðà îáíîâëÿåò ñåêöèè LocalFileHeader
// =============================================================================
procedure TFWZipWriter.UpdateLocalHeaders(Stream: TStream);
var
  I: Integer;
  lfh: TLocalFileHeader;
  dd: TDataDescriptor;
  UseDescriptor: Boolean;
  {%H-}Info64: TExDataInfo64;
begin
  FcdfhOffset := Stream.Position;
  for I := 0 to Count - 1 do
  begin

    // ïðîïóñêàåì ýëåìåíòû ïðè çàïèñè êîòîðûõ ïðîèçîøëî èñêëþ÷åíèå
    if FCD[I].ExceptOnWrite then Continue;

    // Èìåÿ íà ðóêàõ âñå äàííûå ïåðåçàïèñûâàåì âñå LocalFileHeader
    // è DataDescriptor (åñëè òðåáóåòñÿ)
    lfh.LocalFileHeaderSignature := LOCAL_FILE_HEADER_SIGNATURE;

    // ðàññ÷èòûâàåì âåðñèþ íåîáõîäèìóþ äëÿ ðàñïàêîâêè ýëåìåíòà àðõèâà
    lfh.VersionNeededToExtract := GetVersionToExtract(I);
    lfh.GeneralPurposeBitFlag := FCD[I].Header.GeneralPurposeBitFlag;
    UseDescriptor := lfh.GeneralPurposeBitFlag and PBF_DESCRIPTOR <> 0;
    lfh.CompressionMethod := FCD[I].Header.CompressionMethod;
    lfh.LastModFileTimeTime := FCD[I].Header.LastModFileTimeTime;
    lfh.LastModFileTimeDate := FCD[I].Header.LastModFileTimeDate;
    if UseDescriptor then
    begin
      dd.DescriptorSignature := DATA_DESCRIPTOR_SIGNATURE;
      // õîòü â ñòàíäàðòå ñêàçàíî ÷òî ïðè èñïîëüçîâàíèè äåñêðèïòîðîâ 
      // ïîëÿ Crc32, CompressedSize è UncompressedSize äîëæíû áûëü óñòàíîâëåíû
      // â íîëü, íî áîëüøèíñòâî àðõèâàòîðîâ ýòîãî íå äåëàþò,
      // ïîýòîìó óïîäîáèìñÿ èì :)
      lfh.Crc32 := FCD[I].Header.Crc32;
      dd.Crc32 := lfh.Crc32;
      if FCD[I].CompressedSize > MAXDWORD then
        dd.CompressedSize := MAXDWORD
      else
        dd.CompressedSize := FCD[I].CompressedSize;
      lfh.CompressedSize := dd.CompressedSize;
      if FCD[I].UncompressedSize > MAXDWORD then
        dd.UncompressedSize := MAXDWORD
      else
        dd.UncompressedSize := FCD[I].UncompressedSize;
      lfh.UncompressedSize := dd.UncompressedSize;
    end
    else
    begin
      lfh.Crc32 := FCD[I].Header.Crc32;
      if FCD[I].CompressedSize > MAXDWORD then
        lfh.CompressedSize := MAXDWORD
      else
        lfh.CompressedSize := FCD[I].CompressedSize;
      if FCD[I].UncompressedSize > MAXDWORD then
        lfh.UncompressedSize := MAXDWORD
      else
        lfh.UncompressedSize := FCD[I].UncompressedSize;
    end;
    lfh.FilenameLength := FCD[I].Header.FilenameLength;

    if (FCD[I].UncompressedSize >= MAXDWORD) or
      (FCD[I].CompressedSize >= MAXDWORD) then
      lfh.ExtraFieldLength := SizeOf(TExDataInfo64)
    else
      lfh.ExtraFieldLength := 0;

    if IsMultiPartZip(Stream) then
      TFWAbstractMultiStream(Stream).Seek(
        FCD[I].DiskNumberStart, FCD[I].RelativeOffsetOfLocalHeader)
    else
      Stream.Position := FCD[I].RelativeOffsetOfLocalHeader;

    Stream.WriteBuffer(lfh, SizeOf(TLocalFileHeader));

    // Rouse_ 20.03.2015
    // Ïèøåì äàííûå äëÿ ïîääåðæêè ZIP64
    // à òî WinRar, WinZip è 7Zip íå áóäóò ðàñïàêîâûâàòü òàêîé àðõèâ
    // (íå ïîíÿòíî ïðàâäà, ïî÷åìó îíè íå ÷èòàþò ýòó èíôîðìàöèþ èç CentralDirectory)
    if lfh.ExtraFieldLength > 0 then
    begin
      Stream.Position := Stream.Position + lfh.FilenameLength;
      Info64.HS.Header := SUPPORTED_EXDATA_ZIP64;
      Info64.HS.Size := SizeOf(TExDataInfo64) - SizeOf(TExDataHeaderAndSize);
      Info64.UncompressedSize := FCD[I].UncompressedSize;
      // åñëè CompressedSize ìåíüøå MAXDWORD åãî ïèñàòü íå íàäî ïî ñòàíäàðòó,
      // íî ìåñòî ïîä íåãî óæå çàðåçåðâèðîâàííî, ïîýòîìó ïðèäåòñÿ ïèñàòü åãî â ëþáîì ñëó÷àå
      // êàê îáîéòè ýòî ðàñõîæäåíèå ñî ñòàíäàðòîì õîðîøèì ñïîñîáîì - ÿ ïîêà íå çíàþ
      Info64.CompressedSize := FCD[I].CompressedSize;
      Stream.WriteBuffer(Info64, SizeOf(TExDataInfo64));
    end;

    if UseDescriptor then
    begin
      // äåñêðèïòîð ïèøåòñÿ ïîñëå ñæàòîãî áëîêà äàííûõ
      if IsMultiPartZip(Stream) then
      begin
        TFWAbstractMultiStream(Stream).Seek(
          FCD[I].DiskNumberStart, FCD[I].RelativeOffsetOfLocalHeader);
        Stream.Seek(SizeOf(TLocalFileHeader) + lfh.FilenameLength +
          lfh.ExtraFieldLength {%H-}+ FCD[I].CompressedSize, soCurrent);
      end
      else
        Stream.Position := FCD[I].RelativeOffsetOfLocalHeader +
          SizeOf(TLocalFileHeader) + lfh.FilenameLength +
          lfh.ExtraFieldLength + FCD[I].CompressedSize;
      Stream.WriteBuffer(dd, SizeOf(TDataDescriptor));
    end;

    // îáíîâëÿåì èíôîðìàöèþ â ìàññèâå CentralDirectoryFileHeader

    // Rouse_ 14.02.2013
    // Íåâåðíî âûñòàâëÿëàñü âåðñèÿ äëÿ ðàñïàêîâêè â CentralDirectoryFileHeader
    //FCD[I].Header.VersionNeededToExtract := FVersionToExtract;
    FCD[I].Header.VersionNeededToExtract := lfh.VersionNeededToExtract;

    if UseDescriptor then
      FCD[I].Header.CompressedSize := dd.CompressedSize
    else
      FCD[I].Header.CompressedSize := lfh.CompressedSize;
    if UseDescriptor then
      FCD[I].Header.UncompressedSize := dd.UncompressedSize
    else
      FCD[I].Header.UncompressedSize := lfh.UncompressedSize;
    if FCD[I].RelativeOffsetOfLocalHeader > MAXDWORD then
      FCD[I].Header.RelativeOffsetOfLocalHeader := MAXDWORD
    else
      FCD[I].Header.RelativeOffsetOfLocalHeader :=
        FCD[I].RelativeOffsetOfLocalHeader;
    if FCD[I].DiskNumberStart > MAXWORD then
      FCD[I].Header.DiskNumberStart := MAXWORD
    else
      FCD[I].Header.DiskNumberStart := FCD[I].DiskNumberStart;

    // Rouse_ 14.02.2013
    // îáíîâëÿåì ãëîáàëüíóþ ìåòêó âåðñèè
    if FVersionToExtract < lfh.VersionNeededToExtract then
      FVersionToExtract := lfh.VersionNeededToExtract;
  end;
  Stream.Position := FcdfhOffset;
end;

end.