freepascal
/
virtualfilesystem
1
0
派生 0
代码 工单 0 合并请求 0 版本发布 0 百科 动态
您最多选择25个主题 主题必须以字母或数字开头，可以包含连字符 (-)，并且长度不得超过35个字符
3 提交
1 分支
76 KiB
 
分支: master
分支列表 标签列表
${ item.name }
创建分支 ${ searchTerm }
从 'master'
${ noResults }
virtualfilesystem/KAZip/KAZip.pas

3344 行
116 KiB
原始文件 永久链接 Blame 文件历史 

  1. {

  2. KAZip (C) Kiril Antonov, http://kadao.dir.bg/

  3. Slightly modified.

  4. }

  5. 

  6. {$WARNINGS OFF}

  7. {$HINTS OFF}

  8. {$NOTES OFF}

  9. 

  10. unit KAZip;

  11. interface

  12. {$IFDEF FPC}

  13. {$mode delphi}

  14. {$ENDIF}

  15. {.$DEFINE USE_BZIP2}

  16. {$DEFINE USE_BUFFERED_IO}

  17. uses

  18.   Windows,

  19.   SysUtils,

  20.   Classes,

  21.   Masks,

  22.   TypInfo,

  23.   {$IFDEF USE_BZIP2}

  24.   BZip2,

  25.   {$ENDIF}

  26.   ZLib

  27.   {$IFDEF FPC},

  28.   dzlib

  29.   {$ENDIF}

  30.   {$IFDEF USE_BUFFERED_IO},

  31.   uutlStreamHelper

  32.   {$ENDIF};

  33. 

  34. type

  35.   TKAZipEntries         = class;

  36.   TKAZip                = class;

  37.   TBytes                = Array of Byte;

  38.   TZipSaveMethod        = (FastSave, RebuildAll);

  39.   TZipCompressionType   = (ctNormal, ctMaximum, ctFast, ctSuperFast, ctNone, ctUnknown);

  40.   TZipCompressionMethod = (cmStored, cmShrunk, cmReduced1, cmReduced2, cmReduced3, cmReduced4, cmImploded, cmTokenizingReserved, cmDeflated, cmDeflated64, cmDCLImploding, cmPKWAREReserved);

  41.   TOverwriteAction      = (oaSkip,oaSkipAll,oaOverwrite,oaOverwriteAll);

  42. 

  43.   TOnDecompressFile=Procedure(Sender:TObject; Current, Total : Integer) of Object;

  44.   TOnCompressFile=Procedure(Sender:TObject; Current, Total : Integer) of Object;

  45.   TOnZipOpen=Procedure(Sender:TObject; Current, Total : Integer) of Object;

  46.   TOnZipChange=Procedure(Sender:TObject; ChangeType : Integer) of Object;

  47.   TOnAddItem=Procedure(Sender:TObject; ItemName : String) of Object;

  48.   TOnRebuildZip=Procedure(Sender:TObject; Current, Total : Integer) of Object;

  49.   TOnRemoveItems=Procedure(Sender:TObject; Current, Total : Integer) of Object;

  50.   TOnOverwriteFile=Procedure(Sender:TObject; Var FileName : String; Var Action : TOverwriteAction) of Object;

  51. 

  52.   {

  53.           0 - The file is stored (no compression)

  54.           1 - The file is Shrunk

  55.           2 - The file is Reduced with compression factor 1

  56.           3 - The file is Reduced with compression factor 2

  57.           4 - The file is Reduced with compression factor 3

  58.           5 - The file is Reduced with compression factor 4

  59.           6 - The file is Imploded

  60.           7 - Reserved for Tokenizing compression algorithm

  61.           8 - The file is Deflated

  62.           9 - Enhanced Deflating using Deflate64(tm)

  63.          10 - PKWARE Data Compression Library Imploding

  64.          11 - Reserved by PKWARE

  65.          12 - File is compressed using BZIP2 algorithm

  66.    }

  67. 

  68.   {DoChange Events

  69.     0 - Zip is Closed;

  70.     1 - Zip is Opened;

  71.     2 - Item is added to the zip

  72.     3 - Item is removed from the Zip

  73.     4 - Item comment changed

  74.     5 - Item name changed

  75.     6 - Item name changed

  76.   }

  77. 

  78.   TZLibStreamHeader = packed record

  79.      CMF : Byte;

  80.      FLG : Byte;

  81.   end;

  82. 

  83.   TLocalFile = packed record

  84.     LocalFileHeaderSignature       : Cardinal;   //    4 bytes  (0x04034b50)

  85.     VersionNeededToExtract         : WORD;       //    2 bytes

  86.     GeneralPurposeBitFlag          : WORD;       //    2 bytes

  87.     CompressionMethod              : WORD;       //    2 bytes

  88.     LastModFileTimeDate            : Cardinal;   //    4 bytes

  89.     Crc32                          : Cardinal;   //    4 bytes

  90.     CompressedSize                 : Cardinal;   //    4 bytes

  91.     UncompressedSize               : Cardinal;   //    4 bytes

  92.     FilenameLength                 : WORD;       //    2 bytes

  93.     ExtraFieldLength               : WORD;       //    2 bytes

  94.     FileName                       : AnsiString; //    variable size

  95.     ExtraField                     : AnsiString; //    variable size

  96.     CompressedData                 : AnsiString; //    variable size

  97.   end;

  98. 

  99.   TDataDescriptor = packed record

  100.     DescriptorSignature            : Cardinal;   //    4 bytes UNDOCUMENTED 0x08074B50

  101.     Crc32                          : Cardinal;   //    4 bytes

  102.     CompressedSize                 : Cardinal;   //    4 bytes

  103.     UncompressedSize               : Cardinal;   //    4 bytes

  104.   End;

  105. 

  106.   TCentralDirectoryFile = packed record

  107.     CentralFileHeaderSignature     : Cardinal;   //    4 bytes  (0x02014b50)

  108.     VersionMadeBy                  : WORD;       //    2 bytes

  109.     VersionNeededToExtract         : WORD;       //    2 bytes

  110.     GeneralPurposeBitFlag          : WORD;       //    2 bytes

  111.     CompressionMethod              : WORD;       //    2 bytes

  112.     LastModFileTimeDate            : Cardinal;   //    4 bytes

  113.     Crc32                          : Cardinal;   //    4 bytes

  114.     CompressedSize                 : Cardinal;   //    4 bytes

  115.     UncompressedSize               : Cardinal;   //    4 bytes

  116.     FilenameLength                 : WORD;       //    2 bytes

  117.     ExtraFieldLength               : WORD;       //    2 bytes

  118.     FileCommentLength              : WORD;       //    2 bytes

  119.     DiskNumberStart                : WORD;       //    2 bytes

  120.     InternalFileAttributes         : WORD;       //    2 bytes

  121.     ExternalFileAttributes         : Cardinal;   //    4 bytes

  122.     RelativeOffsetOfLocalHeader    : Cardinal;   //    4 bytes

  123.     FileName                       : AnsiString; //    variable size

  124.     ExtraField                     : AnsiString; //    variable size

  125.     FileComment                    : AnsiString; //    variable size

  126.   end;

  127. 

  128.   TEndOfCentralDir = packed record

  129.     EndOfCentralDirSignature        : Cardinal;  //    4 bytes  (0x06054b50)

  130.     NumberOfThisDisk                : WORD;      //    2 bytes

  131.     NumberOfTheDiskWithTheStart     : WORD;      //    2 bytes

  132.     TotalNumberOfEntriesOnThisDisk  : WORD;      //    2 bytes

  133.     TotalNumberOfEntries            : WORD;      //    2 bytes

  134.     SizeOfTheCentralDirectory       : Cardinal;  //    4 bytes

  135.     OffsetOfStartOfCentralDirectory : Cardinal;  //    4 bytes

  136.     ZipfileCommentLength            : WORD;      //    2 bytes

  137.   end;

  138. 

  139. 

  140. 

  141.   TKAZipEntriesEntry = Class(TCollectionItem)

  142.   private

  143.     { Private declarations }

  144.     FParent               : TKAZipEntries;

  145.     FCentralDirectoryFile : TCentralDirectoryFile;

  146.     FLocalFile            : TLocalFile;

  147.     FIsEncrypted          : Boolean;

  148.     FIsFolder             : Boolean;

  149.     FDate                 : TDateTime;

  150.     FCompressionType      : TZipCompressionType;

  151.     FSelected             : Boolean;

  152. 

  153.     procedure  SetSelected(const Value: Boolean);

  154.     function   GetLocalEntrySize: Cardinal;

  155.     function   GetCentralEntrySize: Cardinal;

  156.     procedure  SetComment(const Value: String);

  157.     procedure  SetFileName(const Value: String);

  158.   protected

  159.     { Protected declarations }

  160.   public

  161.     { Public declarations }

  162.     constructor Create(aCollection: TCollection); override;

  163.     destructor  Destroy; override;

  164.     Function    GetCompressedData : String;Overload;

  165.     Function    GetCompressedData(Stream : TStream) : Integer;Overload;

  166.     procedure   ExtractToFile(FileName: String);

  167.     procedure   ExtractToStream(Stream: TStream);

  168.     procedure   SaveToFile(FileName: String);

  169.     procedure   SaveToStream(Stream: TStream);

  170.     Function    Test:Boolean;

  171. 

  172.     Property    FileName          : String               Read FCentralDirectoryFile.FileName                     Write SetFileName;

  173.     Property    Comment           : String               Read FCentralDirectoryFile.FileComment                  Write SetComment;

  174.     Property    SizeUncompressed  : Cardinal             Read FCentralDirectoryFile.UncompressedSize;

  175.     Property    SizeCompressed    : Cardinal             Read FCentralDirectoryFile.CompressedSize;

  176.     Property    Date              : TDateTime            Read FDate;

  177.     Property    CRC32             : Cardinal             Read FCentralDirectoryFile.CRC32;

  178.     Property    Attributes        : Cardinal             Read FCentralDirectoryFile.ExternalFileAttributes;

  179.     Property    LocalOffset       : Cardinal             Read FCentralDirectoryFile.RelativeOffsetOfLocalHeader;

  180.     Property    IsEncrypted       : Boolean              Read FIsEncrypted;

  181.     Property    IsFolder          : Boolean              Read FIsFolder;

  182.     Property    BitFlag           : Word                 Read FCentralDirectoryFile.GeneralPurposeBitFlag;

  183.     Property    CompressionMethod : Word                 Read FCentralDirectoryFile.CompressionMethod;

  184.     Property    CompressionType   : TZipCompressionType  Read FCompressionType;

  185.     Property    LocalEntrySize    : Cardinal             Read GetLocalEntrySize;

  186.     Property    CentralEntrySize  : Cardinal             Read GetCentralEntrySize;

  187.     Property    Selected          : Boolean              Read FSelected                                          Write  SetSelected;

  188.   End;

  189. 

  190.   TKAZipEntries = class(TCollection)

  191.   private

  192.     { Private declarations }

  193.     FParent              : TKAZip;

  194.     FIsZipFile           : Boolean;

  195.     FLocalHeaderNumFiles : Integer;

  196. 

  197.     function    GetHeaderEntry(Index: Integer): TKAZipEntriesEntry;

  198.     procedure   SetHeaderEntry(Index: Integer; const Value: TKAZipEntriesEntry);

  199.   protected

  200.     { Protected declarations }

  201.     Function    ReadBA(MS: TStream;Sz,Poz:Integer): TBytes;

  202.     function    Adler32(adler : uLong; buf : pByte; len : uInt) : uLong;

  203.     function    CalcCRC32(const UncompressedData : string): Cardinal;

  204.     function    CalculateCRCFromStream(Stream: TStream): Cardinal;

  205.     Function    RemoveRootName(Const FileName, RootName : String):String;

  206.     Procedure   SortList(List : TList);

  207.     function    FileTime2DateTime(FileTime: TFileTime): TDateTime;

  208.     //**************************************************************************

  209.     Function    FindCentralDirectory(MS:TStream):Boolean;

  210.     function    ParseCentralHeaders(MS: TStream): Boolean;

  211.     function    GetLocalEntry(MS: TStream; Offset : Integer; HeaderOnly : Boolean): TLocalFile;

  212.     Procedure   LoadLocalHeaders(MS: TStream);

  213.     Function    ParseLocalHeaders(MS:TStream):Boolean;

  214. 

  215.     //**************************************************************************

  216.     procedure   Remove(ItemIndex: Integer; Flush : Boolean);Overload;

  217.     procedure   RemoveBatch(Files : TList);

  218.     procedure   InternalExtractToFile(Item: TKAZipEntriesEntry; FileName: String);

  219.     //**************************************************************************

  220.     Function    AddStreamFast(ItemName:String; FileAttr : Word; FileDate : TDateTime; Stream:TStream):TKAZipEntriesEntry;Overload;

  221.     Function    AddStreamRebuild(ItemName:String; FileAttr : Word; FileDate : TDateTime; Stream:TStream):TKAZipEntriesEntry;

  222.     Function    AddFolderChain(ItemName:String):Boolean;Overload;

  223.     Function    AddFolderChain(ItemName:String; FileAttr : Word; FileDate : TDateTime):Boolean;Overload;

  224.     Function    AddFolderEx(FolderName:String; RootFolder:String; WildCard:String; WithSubFolders : Boolean):Boolean;

  225.     //**************************************************************************

  226.   public

  227.     { Public declarations }

  228.     Procedure   ParseZip(MS:TStream);

  229.     Constructor Create(AOwner : TKAZip; MS : TStream);Overload;

  230.     Constructor Create(AOwner : TKAZip);Overload;

  231.     Destructor  Destroy; Override;

  232.     //**************************************************************************

  233.     Function    IndexOf(Const FileName:String):Integer;

  234.     //**************************************************************************

  235.     Function    AddFile(FileName, NewFileName: String):TKAZipEntriesEntry;Overload;

  236.     Function    AddFile(FileName:String):TKAZipEntriesEntry;Overload;

  237.     Function    AddFiles(FileNames:TStrings):Boolean;

  238.     Function    AddFolder(FolderName:String; RootFolder:String; WildCard:String; WithSubFolders : Boolean):Boolean;

  239.     Function    AddFilesAndFolders(FileNames:TStrings; RootFolder:String; WithSubFolders : Boolean):Boolean;

  240.     Function    AddStream(FileName:String; FileAttr : Word; FileDate : TDateTime; Stream:TStream):TKAZipEntriesEntry;Overload;

  241.     Function    AddStream(FileName: String; Stream : TStream):TKAZipEntriesEntry;Overload;

  242.     //**************************************************************************

  243.     Procedure   Remove(ItemIndex:Integer);Overload;

  244.     Procedure   Remove(Item:TKAZipEntriesEntry);Overload;

  245.     Procedure   Remove(FileName:String);Overload;

  246.     Procedure   RemoveFiles(List : TList);

  247.     Procedure   RemoveSelected;

  248.     Procedure   Rebuild;

  249.    //**************************************************************************

  250.     Procedure   Select(WildCard : String);

  251.     Procedure   SelectAll;

  252.     Procedure   DeSelectAll;

  253.     Procedure   InvertSelection;

  254.     //**************************************************************************

  255.     Procedure   Rename(Item : TKAZipEntriesEntry; NewFileName: String);Overload;

  256.     Procedure   Rename(ItemIndex : Integer; NewFileName: String);Overload;

  257.     Procedure   Rename(FileName: String; NewFileName: String);Overload;

  258.     procedure   CreateFolder(FolderName: String; FolderDate: TDateTime);

  259.     procedure   RenameFolder(FolderName : String; NewFolderName : String);

  260.     procedure   RenameMultiple(Names : TStringList; NewNames : TStringList);

  261. 

  262.     //**************************************************************************

  263.     procedure   ExtractToFile  (Item : TKAZipEntriesEntry; FileName: String);Overload;

  264.     procedure   ExtractToFile  (ItemIndex : Integer; FileName: String);Overload;

  265.     procedure   ExtractToFile  (FileName, DestinationFileName:String);Overload;

  266.     procedure   ExtractToStream(Item : TKAZipEntriesEntry; Stream: TStream);

  267.     procedure   ExtractAll(TargetDirectory:String);

  268.     procedure   ExtractSelected(TargetDirectory:String);

  269.     //**************************************************************************

  270.     Property    Items[Index : Integer] : TKAZipEntriesEntry read GetHeaderEntry write SetHeaderEntry;

  271.   end;

  272. 

  273.   TKAZip = class(TComponent)

  274.   private

  275.     { Private declarations }

  276.     FZipHeader            : TKAZipEntries;

  277.     FIsDirty              : Boolean;

  278.     FEndOfCentralDirPos   : Cardinal;

  279.     FEndOfCentralDir      : TEndOfCentralDir;

  280. 

  281.     FZipCommentPos        : Cardinal;

  282.     FZipComment           : TStringList;

  283. 

  284.     FRebuildECDP          : Cardinal;

  285.     FRebuildCP            : Cardinal;

  286. 

  287.     FIsZipFile            : Boolean;

  288.     FHasBadEntries        : Boolean;

  289.     FFileName             : String;

  290.     FFileNames            : TStringList;

  291.     FZipSaveMethod        : TZipSaveMethod;

  292. 

  293.     FExternalStream       : Boolean;

  294.     FStoreRelativePath    : Boolean;

  295.     FZipCompressionType   : TZipCompressionType;

  296. 

  297.     FCurrentDFS           : Cardinal;

  298.     FOnDecompressFile     : TOnDecompressFile;

  299.     FOnCompressFile       : TOnCompressFile;

  300.     FOnZipChange          : TOnZipChange;

  301.     FBatchMode            : Boolean;

  302. 

  303.     NewLHOffsets          : Array of Cardinal;

  304.     NewEndOfCentralDir    : TEndOfCentralDir;

  305.     FOnZipOpen            : TOnZipOpen;

  306.     FUseTempFiles         : Boolean;

  307.     FStoreFolders         : Boolean;

  308.     FOnAddItem            : TOnAddItem;

  309.     FComponentVersion     : String;

  310.     FOnRebuildZip         : TOnRebuildZip;

  311.     FOnRemoveItems        : TOnRemoveItems;

  312.     FOverwriteAction      : TOverwriteAction;

  313.     FOnOverwriteFile      : TOnOverwriteFile;

  314.     FReadOnly             : Boolean;

  315.     FApplyAttributes      : Boolean;

  316. 

  317.     procedure   SetFileName(const Value: String);

  318.     procedure   SetIsZipFile(const Value: Boolean);

  319.     function    GetComment: TStrings;

  320.     procedure   SetComment(const Value: TStrings);

  321.     procedure   SetZipSaveMethod(const Value: TZipSaveMethod);

  322.     procedure   SetActive(const Value: Boolean);

  323.     procedure   SetZipCompressionType(const Value: TZipCompressionType);

  324.     function    GetFileNames: TStrings;

  325.     procedure   SetFileNames(const Value: TStrings);

  326.     procedure   SetUseTempFiles(const Value: Boolean);

  327.     procedure   SetStoreFolders(const Value: Boolean);

  328.     procedure   SetOnAddItem(const Value: TOnAddItem);

  329.     procedure   SetComponentVersion(const Value: String);

  330.     procedure   SetOnRebuildZip(const Value: TOnRebuildZip);

  331.     procedure   SetOnRemoveItems(const Value: TOnRemoveItems);

  332.     procedure   SetOverwriteAction(const Value: TOverwriteAction);

  333.     procedure   SetOnOverwriteFile(const Value: TOnOverwriteFile);

  334.     procedure SetReadOnly(const Value: Boolean);

  335.     procedure SetApplyAtributes(const Value: Boolean);

  336.   protected

  337.     { Protected declarations }

  338.     FZipStream  : TStream;

  339.     //**************************************************************************

  340.     Procedure   LoadFromFile(FileName:String);

  341.     Procedure   LoadFromStream(MS : TStream);

  342.     //**************************************************************************

  343.     Procedure   RebuildLocalFiles(MS : TStream);

  344.     Procedure   RebuildCentralDirectory(MS : TStream);

  345.     Procedure   RebuildEndOfCentralDirectory(MS : TStream);

  346.     //**************************************************************************

  347.     procedure   OnDecompress(Sender:TObject);

  348.     procedure   OnCompress(Sender:TObject);

  349.     Procedure   DoChange(Sender:TObject; Const ChangeType : Integer);Virtual;

  350.     //**************************************************************************

  351.   public

  352.     { Public declarations }

  353.     Constructor Create(AOwner:TComponent);Override;

  354.     Destructor  Destroy; Override;

  355.     //**************************************************************************

  356.     function    GetDelphiTempFileName: String;

  357.     function    GetFileName(S: String): String;

  358.     function    GetFilePath(S: String): String;

  359.     //**************************************************************************

  360.     Procedure   CreateZip(Stream:TStream);Overload;

  361.     Procedure   CreateZip(FileName:String);Overload;

  362.     Procedure   Open(FileName:String);Overload;

  363.     Procedure   Open(MS : TStream);Overload;

  364.     Procedure   SaveToStream(Stream:TStream);

  365.     Procedure   Rebuild;

  366.     Procedure   FixZip(MS : TStream);

  367.     Procedure   Close;

  368.     //**************************************************************************

  369.     Function    AddFile(FileName, NewFileName: String):TKAZipEntriesEntry;Overload;

  370.     Function    AddFile(FileName:String):TKAZipEntriesEntry;Overload;

  371.     Function    AddFiles(FileNames:TStrings):Boolean;

  372.     Function    AddFolder(FolderName:String; RootFolder:String; WildCard:String; WithSubFolders : Boolean):Boolean;

  373.     Function    AddFilesAndFolders(FileNames:TStrings; RootFolder:String; WithSubFolders : Boolean):Boolean;

  374.     Function    AddStream(FileName:String; FileAttr : Word; FileDate : TDateTime; Stream:TStream):TKAZipEntriesEntry;Overload;

  375.     Function    AddStream(FileName: String; Stream : TStream):TKAZipEntriesEntry;Overload;

  376.     //**************************************************************************

  377.     Procedure   Remove(ItemIndex:Integer);Overload;

  378.     Procedure   Remove(Item:TKAZipEntriesEntry);Overload;

  379.     Procedure   Remove(FileName:String);Overload;

  380.     Procedure   RemoveFiles(List : TList);

  381.     Procedure   RemoveSelected;

  382.     //**************************************************************************

  383.     Procedure   Select(WildCard : String);

  384.     Procedure   SelectAll;

  385.     Procedure   DeSelectAll;

  386.     Procedure   InvertSelection;

  387.     //**************************************************************************

  388.     Procedure   Rename(Item : TKAZipEntriesEntry; NewFileName: String);Overload;

  389.     Procedure   Rename(ItemIndex : Integer; NewFileName: String);Overload;

  390.     Procedure   Rename(FileName : String; NewFileName: String);Overload;

  391.     Procedure   CreateFolder(FolderName : String; FolderDate : TDateTime);

  392.     Procedure   RenameFolder(FolderName : String; NewFolderName : String);

  393.     procedure   RenameMultiple(Names : TStringList; NewNames : TStringList);

  394.     //**************************************************************************

  395.     procedure   ExtractToFile  (Item      : TKAZipEntriesEntry; FileName: String);Overload;

  396.     procedure   ExtractToFile  (ItemIndex : Integer; FileName: String);Overload;

  397.     procedure   ExtractToFile  (FileName, DestinationFileName:String);Overload;

  398.     procedure   ExtractToStream(Item      : TKAZipEntriesEntry; Stream: TStream);

  399.     procedure   ExtractAll(TargetDirectory: String);

  400.     procedure   ExtractSelected(TargetDirectory: String);

  401.     //**************************************************************************

  402.     Property    Entries         : TKAZipEntries Read FZipHeader;

  403.     Property    HasBadEntries   : Boolean       Read FHasBadEntries;

  404.   published

  405.     { Published declarations }

  406.     Property    FileName          : String              Read FFileName           Write SetFileName;

  407.     Property    IsZipFile         : Boolean             Read FIsZipFile          Write SetIsZipFile;

  408.     Property    SaveMethod        : TZipSaveMethod      Read FZipSaveMethod      Write SetZipSaveMethod;

  409.     Property    StoreRelativePath : Boolean             Read FStoreRelativePath  Write FStoreRelativePath;

  410.     Property    StoreFolders      : Boolean             read FStoreFolders       write SetStoreFolders;

  411.     Property    CompressionType   : TZipCompressionType Read FZipCompressionType Write SetZipCompressionType;

  412.     Property    Comment           : TStrings            Read GetComment          Write SetComment;

  413.     Property    FileNames         : TStrings            Read GetFileNames        Write SetFileNames;

  414.     Property    UseTempFiles      : Boolean             read FUseTempFiles       write SetUseTempFiles;

  415.     Property    OverwriteAction   : TOverwriteAction    read FOverwriteAction    write SetOverwriteAction;

  416.     Property    ComponentVersion  : String              read FComponentVersion   write SetComponentVersion;

  417.     Property    ReadOnly          : Boolean             read FReadOnly           write SetReadOnly;

  418.     Property    ApplyAtributes    : Boolean             read FApplyAttributes    write SetApplyAtributes;

  419.     Property    OnDecompressFile  : TOnDecompressFile   Read FOnDecompressFile   Write FOnDecompressFile;

  420.     Property    OnCompressFile    : TOnCompressFile     Read FOnCompressFile     Write FOnCompressFile;

  421.     Property    OnZipChange       : TOnZipChange        Read FOnZipChange        Write FOnZipChange;

  422.     Property    OnZipOpen         : TOnZipOpen          Read FOnZipOpen          Write FOnZipOpen;

  423.     Property    OnAddItem         : TOnAddItem          read FOnAddItem          write SetOnAddItem;

  424.     Property    OnRebuildZip      : TOnRebuildZip       read FOnRebuildZip       write SetOnRebuildZip;

  425.     Property    OnRemoveItems     : TOnRemoveItems      read FOnRemoveItems      write SetOnRemoveItems;

  426.     Property    OnOverwriteFile   : TOnOverwriteFile    read FOnOverwriteFile    write SetOnOverwriteFile;

  427.     Property    Active            : Boolean             Read FIsZipFile          Write SetActive;

  428.   end;

  429. 

  430. procedure Register;

  431. Function ToZipName(FileName:String):String;

  432. Function ToDosName(FileName:String):String;

  433. 

  434. implementation

  435. 

  436. Const

  437.   ZL_DEF_COMPRESSIONMETHOD  = $8;  { Deflate }

  438.   ZL_ENCH_COMPRESSIONMETHOD = $9;  { Enchanced Deflate }

  439.   ZL_DEF_COMPRESSIONINFO    = $7;  { 32k window for Deflate }

  440.   ZL_PRESET_DICT            = $20;

  441. 

  442.   ZL_FASTEST_COMPRESSION    = $0;

  443.   ZL_FAST_COMPRESSION       = $1;

  444.   ZL_DEFAULT_COMPRESSION    = $2;

  445.   ZL_MAXIMUM_COMPRESSION    = $3;

  446. 

  447.   ZL_FCHECK_MASK            = $1F;

  448.   ZL_CINFO_MASK             = $F0; { mask out leftmost 4 bits }

  449.   ZL_FLEVEL_MASK            = $C0; { mask out leftmost 2 bits }

  450.   ZL_CM_MASK                = $0F; { mask out rightmost 4 bits }

  451. 

  452. 

  453.   ZL_MULTIPLE_DISK_SIG      = $08074b50; // 'PK'#7#8

  454.   ZL_DATA_DESCRIPT_SIG      = $08074b50; // 'PK'#7#8

  455.   ZL_LOCAL_HEADERSIG        = $04034b50; // 'PK'#3#4

  456.   ZL_CENTRAL_HEADERSIG      = $02014b50; // 'PK'#1#2

  457.   ZL_EOC_HEADERSIG          = $06054b50; // 'PK'#5#6

  458. 

  459.   const

  460.   CRCTable: array[0..255] of Cardinal = (

  461.     $00000000, $77073096, $EE0E612C, $990951BA, $076DC419, $706AF48F, $E963A535,

  462.     $9E6495A3, $0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988, $09B64C2B, $7EB17CBD,

  463.     $E7B82D07, $90BF1D91, $1DB71064, $6AB020F2, $F3B97148, $84BE41DE, $1ADAD47D,

  464.     $6DDDE4EB, $F4D4B551, $83D385C7, $136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,

  465.     $14015C4F, $63066CD9, $FA0F3D63, $8D080DF5, $3B6E20C8, $4C69105E, $D56041E4,

  466.     $A2677172, $3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B, $35B5A8FA, $42B2986C,

  467.     $DBBBC9D6, $ACBCF940, $32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59, $26D930AC,

  468.     $51DE003A, $C8D75180, $BFD06116, $21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,

  469.     $2802B89E, $5F058808, $C60CD9B2, $B10BE924, $2F6F7C87, $58684C11, $C1611DAB,

  470.     $B6662D3D, $76DC4190, $01DB7106, $98D220BC, $EFD5102A, $71B18589, $06B6B51F,

  471.     $9FBFE4A5, $E8B8D433, $7807C9A2, $0F00F934, $9609A88E, $E10E9818, $7F6A0DBB,

  472.     $086D3D2D, $91646C97, $E6635C01, $6B6B51F4, $1C6C6162, $856530D8, $F262004E,

  473.     $6C0695ED, $1B01A57B, $8208F4C1, $F50FC457, $65B0D9C6, $12B7E950, $8BBEB8EA,

  474.     $FCB9887C, $62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65, $4DB26158, $3AB551CE,

  475.     $A3BC0074, $D4BB30E2, $4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB, $4369E96A,

  476.     $346ED9FC, $AD678846, $DA60B8D0, $44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,

  477.     $5005713C, $270241AA, $BE0B1010, $C90C2086, $5768B525, $206F85B3, $B966D409,

  478.     $CE61E49F, $5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4, $59B33D17, $2EB40D81,

  479.     $B7BD5C3B, $C0BA6CAD, $EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A, $EAD54739,

  480.     $9DD277AF, $04DB2615, $73DC1683, $E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,

  481.     $E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1, $F00F9344, $8708A3D2, $1E01F268,

  482.     $6906C2FE, $F762575D, $806567CB, $196C3671, $6E6B06E7, $FED41B76, $89D32BE0,

  483.     $10DA7A5A, $67DD4ACC, $F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5, $D6D6A3E8,

  484.     $A1D1937E, $38D8C2C4, $4FDFF252, $D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,

  485.     $D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60, $DF60EFC3, $A867DF55, $316E8EEF,

  486.     $4669BE79, $CB61B38C, $BC66831A, $256FD2A0, $5268E236, $CC0C7795, $BB0B4703,

  487.     $220216B9, $5505262F, $C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04, $C2D7FFA7,

  488.     $B5D0CF31, $2CD99E8B, $5BDEAE1D, $9B64C2B0, $EC63F226, $756AA39C, $026D930A,

  489.     $9C0906A9, $EB0E363F, $72076785, $05005713, $95BF4A82, $E2B87A14, $7BB12BAE,

  490.     $0CB61B38, $92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21, $86D3D2D4, $F1D4E242,

  491.     $68DDB3F8, $1FDA836E, $81BE16CD, $F6B9265B, $6FB077E1, $18B74777, $88085AE6,

  492.     $FF0F6A70, $66063BCA, $11010B5C, $8F659EFF, $F862AE69, $616BFFD3, $166CCF45,

  493.     $A00AE278, $D70DD2EE, $4E048354, $3903B3C2, $A7672661, $D06016F7, $4969474D,

  494.     $3E6E77DB, $AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0, $A9BCAE53, $DEBB9EC5,

  495.     $47B2CF7F, $30B5FFE9, $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6, $BAD03605,

  496.     $CDD70693, $54DE5729, $23D967BF, $B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,

  497.     $B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D);

  498. 

  499. 

  500. 

  501. procedure Register;

  502. begin

  503.   RegisterComponents('KA', [TKAZip]);

  504. end;

  505. 

  506. Function ToZipName(FileName:String):String;

  507. Var

  508.  P : Integer;

  509. Begin

  510.   Result := FileName;

  511.   Result := StringReplace(Result,'\','/',[rfReplaceAll]);

  512.   P := Pos(':/',Result);

  513.   if P > 0 Then

  514.      Begin

  515.        System.Delete(Result,1,P+1);

  516.      End;

  517.   P := Pos('//',Result);

  518.   if P > 0 Then

  519.      Begin

  520.        System.Delete(Result,1,P+1);

  521.        P := Pos('/',Result);

  522.        if P > 0 Then

  523.           Begin

  524.              System.Delete(Result,1,P);

  525.              P := Pos('/',Result);

  526.              if P > 0 Then System.Delete(Result,1,P);

  527.           End;

  528.      End;

  529. End;

  530. 

  531. 

  532. Function ToDosName(FileName:String):String;

  533. Var

  534.  P : Integer;

  535. Begin

  536.   Result := FileName;

  537.   Result := StringReplace(Result,'\','/',[rfReplaceAll]);

  538.   P := Pos(':/',Result);

  539.   if P > 0 Then

  540.      Begin

  541.        System.Delete(Result,1,P+1);

  542.      End;

  543.   P := Pos('//',Result);

  544.   if P > 0 Then

  545.      Begin

  546.        System.Delete(Result,1,P+1);

  547.        P := Pos('/',Result);

  548.        if P > 0 Then

  549.           Begin

  550.              System.Delete(Result,1,P);

  551.              P := Pos('/',Result);

  552.              if P > 0 Then System.Delete(Result,1,P);

  553.           End;

  554.      End;

  555.   Result := StringReplace(Result,'/','\',[rfReplaceAll]);

  556. End;

  557. 

  558. { TKAZipEntriesEntry }

  559. 

  560. constructor TKAZipEntriesEntry.Create(aCollection: TCollection);

  561. begin

  562.   inherited Create(aCollection);

  563.   FParent   := TKAZipEntries(aCollection);

  564.   FSelected := False;

  565. end;

  566. 

  567. destructor TKAZipEntriesEntry.Destroy;

  568. begin

  569. 

  570.   inherited Destroy;

  571. end;

  572. 

  573. procedure TKAZipEntriesEntry.ExtractToFile(FileName: String);

  574. begin

  575.   FParent.ExtractToFile(Self,FileName);

  576. end;

  577. 

  578. procedure TKAZipEntriesEntry.ExtractToStream(Stream: TStream);

  579. begin

  580.   FParent.ExtractToStream(Self,Stream);

  581. end;

  582. 

  583. procedure TKAZipEntriesEntry.SaveToFile(FileName: String);

  584. begin

  585.   ExtractToFile(FileName);

  586. end;

  587. 

  588. procedure TKAZipEntriesEntry.SaveToStream(Stream: TStream);

  589. begin

  590.   ExtractToStream(Stream);

  591. end;

  592. 

  593. 

  594. function TKAZipEntriesEntry.GetCompressedData(Stream: TStream): Integer;

  595. Var

  596.   FZLHeader : TZLibStreamHeader;

  597.   BA        : TLocalFile;

  598.   ZLH       : Word;

  599.   Compress  : Byte;

  600. begin

  601.   Result := 0;

  602.   if (CompressionMethod=8) Then

  603.      Begin

  604.        FZLHeader.CMF := (ZL_DEF_COMPRESSIONINFO shl 4);               { 32k Window size }

  605.        FZLHeader.CMF := FZLHeader.CMF or ZL_DEF_COMPRESSIONMETHOD;    { Deflate }

  606.        Compress := ZL_DEFAULT_COMPRESSION;

  607.        Case BitFlag AND 6 of

  608.             0 : Compress := ZL_DEFAULT_COMPRESSION;

  609.             2 : Compress := ZL_MAXIMUM_COMPRESSION;

  610.             4 : Compress := ZL_FAST_COMPRESSION;

  611.             6 : Compress := ZL_FASTEST_COMPRESSION;

  612.        End;

  613.        FZLHeader.FLG := FZLHeader.FLG or (Compress shl 6);

  614.        FZLHeader.FLG := FZLHeader.FLG and not ZL_PRESET_DICT;         { no preset dictionary}

  615.        FZLHeader.FLG := FZLHeader.FLG and not ZL_FCHECK_MASK;

  616.        ZLH           := (FZLHeader.CMF * 256) + FZLHeader.FLG;

  617.        Inc(FZLHeader.FLG, 31 - (ZLH mod 31));

  618.        Result := Result + Stream.Write(FZLHeader,SizeOf(FZLHeader));

  619.      End;

  620.   BA     := FParent.GetLocalEntry(FParent.FParent.FZipStream,LocalOffset,False);

  621.   if BA.LocalFileHeaderSignature<>$04034b50 Then

  622.      Begin

  623.         Result := 0;

  624.         Exit;

  625.      End;

  626.   if SizeCompressed > 0 Then

  627.      Result := Result + Stream.Write(BA.CompressedData[1],SizeCompressed);

  628. end;

  629. 

  630. function TKAZipEntriesEntry.GetCompressedData: String;

  631. Var

  632.   BA        : TLocalFile;

  633.   FZLHeader : TZLibStreamHeader;

  634.   ZLH       : Word;

  635.   Compress  : Byte;

  636. begin

  637.   Result := '';

  638.   if (CompressionMethod=0) or (CompressionMethod=8) Then

  639.      Begin

  640.        BA     := FParent.GetLocalEntry(FParent.FParent.FZipStream,LocalOffset,False);

  641.        if BA.LocalFileHeaderSignature<>$04034b50 Then Exit;

  642.        if (CompressionMethod=8) Then

  643.           Begin

  644.             FZLHeader.CMF := (ZL_DEF_COMPRESSIONINFO shl 4);               { 32k Window size }

  645.             FZLHeader.CMF := FZLHeader.CMF or ZL_DEF_COMPRESSIONMETHOD;    { Deflate }

  646.             Compress := ZL_DEFAULT_COMPRESSION;

  647.             Case BitFlag AND 6 of

  648.                  0 : Compress := ZL_DEFAULT_COMPRESSION;

  649.                  2 : Compress := ZL_MAXIMUM_COMPRESSION;

  650.                  4 : Compress := ZL_FAST_COMPRESSION;

  651.                  6 : Compress := ZL_FASTEST_COMPRESSION;

  652.             End;

  653.             FZLHeader.FLG := FZLHeader.FLG or (Compress shl 6);

  654.             FZLHeader.FLG := FZLHeader.FLG and not ZL_PRESET_DICT;         { no preset dictionary}

  655.             FZLHeader.FLG := FZLHeader.FLG and not ZL_FCHECK_MASK;

  656.             ZLH           := (FZLHeader.CMF * 256) + FZLHeader.FLG;

  657.             Inc(FZLHeader.FLG, 31 - (ZLH mod 31));

  658.             SetLength(Result,SizeOf(FZLHeader));

  659.             SetString(Result,PChar(@FZLHeader),SizeOf(FZLHeader));

  660.           End;

  661.        Result := Result + BA.CompressedData;

  662.      End

  663.   Else

  664.      Begin

  665.        SetLength(Result,0);

  666.      End;

  667. End;

  668. 

  669. procedure TKAZipEntriesEntry.SetSelected(const Value: Boolean);

  670. begin

  671.   FSelected := Value;

  672. end;

  673. 

  674. function TKAZipEntriesEntry.GetLocalEntrySize: Cardinal;

  675. begin

  676.  Result := SizeOf(TLocalFile) - 3*SizeOf(String)+

  677.            FCentralDirectoryFile.CompressedSize+

  678.            FCentralDirectoryFile.FilenameLength+

  679.            FCentralDirectoryFile.ExtraFieldLength;

  680.  if (FCentralDirectoryFile.GeneralPurposeBitFlag And (1 SHL 3)) > 0 Then

  681.     Begin

  682.       Result := Result + SizeOf(TDataDescriptor);

  683.     End;

  684. end;

  685. 

  686. function TKAZipEntriesEntry.GetCentralEntrySize: Cardinal;

  687. begin

  688.   Result := SizeOf(TCentralDirectoryFile) - 3*SizeOf(String)+

  689.                    FCentralDirectoryFile.FilenameLength+

  690.                    FCentralDirectoryFile.ExtraFieldLength+

  691.                    FCentralDirectoryFile.FileCommentLength;

  692. end;

  693. 

  694. function TKAZipEntriesEntry.Test: Boolean;

  695. Var

  696.   FS : TFileStream;

  697.   MS : TMemoryStream;

  698.   FN : String;

  699. begin

  700.   Result  := True;

  701.   Try

  702.     if NOT FIsEncrypted Then

  703.        Begin

  704.          if FParent.FParent.FUseTempFiles  Then

  705.             Begin

  706.               FN := FParent.FParent.GetDelphiTempFileName;

  707.               FS := TFileStream.Create(FN,fmOpenReadWrite or FmCreate);

  708.               Try

  709.                 ExtractToStream(FS);

  710.                 FS.Position := 0;

  711.                 Result      := FParent.CalculateCRCFromStream(FS) = CRC32;

  712.               Finally

  713.                 FS.Free;

  714.                 DeleteFile(FN);

  715.               End;

  716.             End

  717.          Else

  718.             Begin

  719.               MS := TMemoryStream.Create;

  720.               Try

  721.                 ExtractToStream(MS);

  722.                 MS.Position := 0;

  723.                 Result      := FParent.CalculateCRCFromStream(MS) = CRC32;

  724.               Finally

  725.                 MS.Free;

  726.               End;

  727.             End;

  728.        End;

  729.   Except

  730.     Result  := False;

  731.   End;

  732. end;

  733. 

  734. procedure TKAZipEntriesEntry.SetComment(const Value: String);

  735. begin

  736.   FCentralDirectoryFile.FileComment := Value;

  737.   FCentralDirectoryFile.FileCommentLength := Length(FCentralDirectoryFile.FileComment);

  738.   FParent.Rebuild;

  739.   if NOT FParent.FParent.FBatchMode Then

  740.      Begin

  741.        FParent.FParent.DoChange(FParent,4);

  742.      End;

  743. end;

  744. 

  745. procedure TKAZipEntriesEntry.SetFileName(const Value: String);

  746. Var

  747.   FN : String;

  748. begin

  749.   FN := ToZipName(Value);

  750.   if FParent.IndexOf(FN) > -1 Then Raise Exception.Create('File with same name already exists in Archive!');

  751.   FCentralDirectoryFile.FileName         := ToZipName(Value);

  752.   FCentralDirectoryFile.FilenameLength   := Length(FCentralDirectoryFile.FileName);

  753.   if NOT FParent.FParent.FBatchMode Then

  754.      Begin

  755.        FParent.Rebuild;

  756.        FParent.FParent.DoChange(FParent,5);

  757.      End;

  758. end;

  759. 

  760. { TKAZipEntries }

  761. constructor TKAZipEntries.Create(AOwner : TKAZip);

  762. begin

  763.   Inherited Create(TKAZipEntriesEntry);

  764.   FParent    := AOwner;

  765.   FIsZipFile := False;

  766. end;

  767. 

  768. constructor TKAZipEntries.Create(AOwner : TKAZip; MS : TStream);

  769. begin

  770.   Inherited Create(TKAZipEntriesEntry);

  771.   FParent               := AOwner;

  772.   FIsZipFile            := False;

  773.   FLocalHeaderNumFiles  := 0;

  774.   ParseZip(MS);

  775. end;

  776. 

  777. destructor TKAZipEntries.Destroy;

  778. begin

  779. 

  780.   inherited Destroy;

  781. end;

  782. 

  783. function TKAZipEntries.Adler32(adler : uLong; buf : pByte; len : uInt) : uLong;

  784. const

  785.   BASE = uLong(65521);

  786.   NMAX = 3854;

  787. var

  788.   s1, s2 : uLong;

  789.   k      : Integer;

  790. begin

  791.   s1 := adler and $ffff;

  792.   s2 := (adler shr 16) and $ffff;

  793. 

  794.   if not Assigned(buf) then

  795.   begin

  796.     adler32 := uLong(1);

  797.     exit;

  798.   end;

  799. 

  800.   while (len > 0) do

  801.   begin

  802.     if len < NMAX then

  803.       k := len

  804.     else

  805.       k := NMAX;

  806.     Dec(len, k);

  807.     while (k > 0) do

  808.     begin

  809.       Inc(s1, buf^);

  810.       Inc(s2, s1);

  811.       Inc(buf);

  812.       Dec(k);

  813.     end;

  814.     s1 := s1 mod BASE;

  815.     s2 := s2 mod BASE;

  816.   end;

  817.   adler32 := (s2 shl 16) or s1;

  818. end;

  819. 

  820. function TKAZipEntries.CalcCRC32(const UncompressedData : string): Cardinal;

  821. var

  822.   X : Integer;

  823. begin

  824.   Result := $FFFFFFFF;

  825.   for X := 0 to Length(UncompressedData) - 1 do

  826.       Begin

  827.         Result := (Result SHR 8) XOR (CRCTable[Byte(Result) XOR Ord(UncompressedData[X+1])]);

  828.       End;

  829.   Result := Result XOR $FFFFFFFF;

  830. end;

  831. 

  832. 

  833. function TKAZipEntries.CalculateCRCFromStream(Stream: TStream): Cardinal;

  834. var

  835.   Buffer: array[1..8192] of Byte;

  836.   I, ReadCount: Integer;

  837.   TempResult: Longword;

  838. begin

  839.   TempResult := $FFFFFFFF;

  840.   while (Stream.Position <> Stream.Size) do begin

  841.     ReadCount := Stream.Read(Buffer, SizeOf(Buffer));

  842.     for I := 1 to ReadCount do

  843.       TempResult := ((TempResult shr 8) and $FFFFFF) xor CRCTable[(TempResult xor Longword(Buffer[I])) and $FF];

  844.   end;

  845.   Result := not TempResult;

  846. end;

  847. 

  848. Function TKAZipEntries.RemoveRootName(Const FileName, RootName : String):String;

  849. Var

  850.   P : Integer;

  851.   S : String;

  852. Begin

  853.   Result := FileName;

  854.   P      := Pos(AnsiLowerCase(RootName),AnsiLowerCase(FileName));

  855.   if P=1 Then

  856.      Begin

  857.        System.Delete(Result,1,Length(RootName));

  858.        S := Result;

  859.        if (Length(S) > 0) AND (S[1]='\') Then

  860.           Begin

  861.              System.Delete(S,1,1);

  862.              Result := S;

  863.           End;

  864.      End;

  865. End;

  866. 

  867. Procedure TKAZipEntries.SortList(List : TList);

  868. Var

  869.   X        : Integer;

  870.   I1       : Cardinal;

  871.   I2       : Cardinal;

  872.   NoChange : Boolean;

  873. Begin

  874.   if List.Count=1 Then Exit;

  875.   Repeat

  876.     NoChange := True;

  877.     For X := 0 To List.Count-2 Do

  878.       Begin

  879.         I1 := Integer(List.Items[X]);

  880.         I2 := Integer(List.Items[X+1]);

  881.         if I1 > I2 Then

  882.            Begin

  883.              List.Exchange(X,X+1);

  884.              NoChange := False;

  885.            End;

  886.       End;

  887.   Until NoChange;

  888. End;

  889. 

  890. 

  891. 

  892. 

  893. function TKAZipEntries.FileTime2DateTime(FileTime: TFileTime): TDateTime;

  894. var

  895.    LocalFileTime: TFileTime;

  896.    SystemTime: TSystemTime;

  897. begin

  898.    FileTimeToLocalFileTime(FileTime, LocalFileTime) ;

  899.    FileTimeToSystemTime(LocalFileTime, SystemTime) ;

  900.    Result := SystemTimeToDateTime(SystemTime) ;

  901. end;

  902. 

  903. function TKAZipEntries.GetHeaderEntry(Index: Integer): TKAZipEntriesEntry;

  904. begin

  905.   Result := TKAZipEntriesEntry(Inherited Items[Index]);

  906. end;

  907. 

  908. procedure TKAZipEntries.SetHeaderEntry(Index: Integer; const Value: TKAZipEntriesEntry);

  909. begin

  910.   Inherited Items[Index] := TCollectionItem(Value);

  911. end;

  912. 

  913. Function TKAZipEntries.ReadBA(MS: TStream; Sz, Poz:Integer): TBytes;

  914. Begin

  915.   SetLength(Result,SZ);

  916.   MS.Position := Poz;

  917.   MS.Read(Result[0],SZ);

  918. End;

  919. 

  920. function TKAZipEntries.FindCentralDirectory(MS: TStream): Boolean;

  921. Var

  922.   SeekStart : Integer;

  923.   Poz       : Integer;

  924.   BR        : Integer;

  925.   Byte_     : Array[0..3] of Byte;

  926. 

  927. begin

  928.   Result     := False;

  929.   if MS.Size < 22 Then Exit;

  930.   if MS.Size < 256 Then

  931.      SeekStart := MS.Size

  932.   Else

  933.      SeekStart := 256;

  934.   Poz       := MS.Size-22;

  935.   BR        := SeekStart;

  936.   Repeat

  937.     MS.Position := Poz;

  938.     MS.Read(Byte_,4);

  939.     If Byte_[0]=$50 Then

  940.        Begin

  941.          if  (Byte_[1]=$4B)

  942.          And (Byte_[2]=$05)

  943.          And (Byte_[3]=$06) Then

  944.              Begin

  945.                MS.Position                  := Poz;

  946.                FParent.FEndOfCentralDirPos  := MS.Position;

  947.                MS.Read(FParent.FEndOfCentralDir,SizeOf(FParent.FEndOfCentralDir));

  948.                FParent.FZipCommentPos       := MS.Position;

  949.                FParent.FZipComment.Clear;

  950.                Result  := True;

  951.              End

  952.          Else

  953.              Begin

  954.                Dec(Poz,4);

  955.                Dec(BR ,4);

  956.              End;

  957.        End

  958.     Else

  959.        Begin

  960.          Dec(Poz);

  961.          Dec(BR)

  962.        End;

  963.     if BR < 0 Then

  964.        Begin

  965.          Case SeekStart of

  966.                256   : Begin

  967.                         SeekStart := 1024;

  968.                         Poz       := MS.Size-(256+22);

  969.                         BR        := SeekStart;

  970.                       End;

  971.               1024  : Begin

  972.                         SeekStart := 65536;

  973.                         Poz       := MS.Size-(1024+22);

  974.                         BR        := SeekStart;

  975.                       End;

  976.               65536 : Begin

  977.                         SeekStart := -1;

  978.                       End;

  979.          End;

  980.        End;

  981.     if BR < 0              Then SeekStart := -1;

  982.     if MS.Size < SeekStart Then SeekStart := -1;

  983.   Until (Result) or (SeekStart=-1);

  984. end;

  985. 

  986. 

  987. function TKAZipEntries.ParseCentralHeaders(MS: TStream): Boolean;

  988. Var

  989.   X                 : Integer;

  990.   Entry             : TKAZipEntriesEntry;

  991.   CDFile            : TCentralDirectoryFile;

  992. begin

  993.   Result            := False;

  994.   Try

  995.     MS.Position     := FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory;

  996.     For X := 0 To FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk-1 do

  997.         Begin

  998.           FillChar(CDFile,SizeOf(TCentralDirectoryFile)-3*SizeOf(String),0);

  999.           MS.Read(CDFile,SizeOf(TCentralDirectoryFile)-3*SizeOf(String));

  1000.           Entry                       := TKAZipEntriesEntry.Create(Self);

  1001.           Entry.FDate                 := FileDateToDateTime(CDFile.LastModFileTimeDate);

  1002.           if (CDFile.GeneralPurposeBitFlag And 1) > 0 Then

  1003.               Entry.FIsEncrypted := True

  1004.           Else

  1005.               Entry.FIsEncrypted := False;

  1006.           If CDFile.FilenameLength > 0 Then

  1007.              Begin

  1008.                SetLength(CDFile.FileName,CDFile.FilenameLength);

  1009.                MS.Read(CDFile.FileName[1],   CDFile.FilenameLength)

  1010.              End;

  1011.           If CDFile.ExtraFieldLength > 0 Then

  1012.              Begin

  1013.                SetLength(CDFile.ExtraField,CDFile.ExtraFieldLength);

  1014.                MS.Read(CDFile.ExtraField[1], CDFile.ExtraFieldLength);

  1015.              End;

  1016.           If CDFile.FileCommentLength > 0 Then

  1017.              Begin

  1018.                SetLength(CDFile.FileComment,CDFile.FileCommentLength);

  1019.                MS.Read(CDFile.FileComment[1],CDFile.FileCommentLength);

  1020.              End;

  1021.           Entry.FIsFolder          := (CDFile.ExternalFileAttributes and faDirectory) > 0;

  1022. 

  1023.           Entry.FCompressionType   := ctUnknown;

  1024.           if (CDFile.CompressionMethod=8) or (CDFile.CompressionMethod=9) Then

  1025.              Begin

  1026.                Case CDFile.GeneralPurposeBitFlag AND 6 of

  1027.                     0 : Entry.FCompressionType := ctNormal;

  1028.                     2 : Entry.FCompressionType := ctMaximum;

  1029.                     4 : Entry.FCompressionType := ctFast;

  1030.                     6 : Entry.FCompressionType := ctSuperFast

  1031.                End;

  1032.              End;

  1033.           Entry.FCentralDirectoryFile := CDFile;

  1034.           If Assigned(FParent.FOnZipOpen) Then FParent.FOnZipOpen(FParent,X,FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk);

  1035.         End;

  1036.    Except

  1037.      Exit;

  1038.    End;

  1039.    Result := Count=FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk;

  1040. end;

  1041. 

  1042. 

  1043. procedure TKAZipEntries.ParseZip(MS: TStream);

  1044. begin

  1045.   FIsZipFile := False;

  1046.   Clear;

  1047.   if FindCentralDirectory(MS) Then

  1048.     Begin

  1049.       if ParseCentralHeaders(MS) Then

  1050.          Begin

  1051.            FIsZipFile := True;

  1052.            LoadLocalHeaders(MS);

  1053.          End;

  1054.     End

  1055.   Else

  1056.     Begin

  1057.       if ParseLocalHeaders(MS) Then

  1058.          Begin

  1059.            FIsZipFile := Count > 0;

  1060.            if FIsZipFile Then FParent.FHasBadEntries := True;

  1061.          End;

  1062.     End;

  1063. end;

  1064. 

  1065. 

  1066. function TKAZipEntries.GetLocalEntry(MS: TStream; Offset : Integer; HeaderOnly : Boolean): TLocalFile;

  1067. Var

  1068.   Byte_             : Array[0..4] of Byte;

  1069.   DataDescriptor    : TDataDescriptor;

  1070.   ddvalid           : boolean;

  1071.   fp,fp2            : Int64;

  1072. begin

  1073.   FillChar(Result,SizeOf(Result),0);

  1074.   MS.Position := Offset;

  1075.   MS.Read(Byte_,4);

  1076.   if  (Byte_[0]  = $50)

  1077.   And (Byte_[1]  = $4B)

  1078.   And (Byte_[2]  = $03)

  1079.   And (Byte_[3]  = $04) Then

  1080.     Begin

  1081.       MS.Position := Offset;

  1082.       MS.Read(Result,SizeOf(Result)-3*SizeOf(AnsiString));

  1083.       if Result.FilenameLength > 0 Then

  1084.          Begin

  1085.            SetLength(Result.FileName,Result.FilenameLength);

  1086.            MS.Read(Result.FileName[1],Result.FilenameLength);

  1087.          End;

  1088.       if Result.ExtraFieldLength > 0 Then

  1089.          Begin

  1090.            SetLength(Result.ExtraField,Result.ExtraFieldLength);

  1091.            MS.Read(Result.ExtraField[1],Result.ExtraFieldLength);

  1092.          End;

  1093.       if (Result.GeneralPurposeBitFlag And (1 SHL 3)) > 0 Then

  1094.          Begin

  1095.            fp:= MS.Position;

  1096.            ddvalid:= false;

  1097.            repeat

  1098.              MS.Read(Byte_,4);

  1099.              if (Byte_[0]  = $50) And (Byte_[1]  = $4B) And (Byte_[2]  = $07) And (Byte_[3] = $08) then begin

  1100.                MS.Seek(-4, soFromCurrent);

  1101.                fp2:= MS.Position;

  1102.                MS.Read(DataDescriptor,SizeOf(TDataDescriptor));

  1103.                if DataDescriptor.CompressedSize=fp2-fp then begin

  1104.                  ddvalid:= true;

  1105.                  break;

  1106.                end else

  1107.                  MS.Position:= fp2+4;

  1108.              end;

  1109.              MS.Seek(-3,soFromCurrent);

  1110.            until MS.position=MS.Size;

  1111. 

  1112.            MS.Position:= fp;

  1113.            if ddvalid then begin

  1114.              Result.Crc32            := DataDescriptor.Crc32;

  1115.              Result.CompressedSize   := DataDescriptor.CompressedSize;

  1116.              Result.UnCompressedSize := DataDescriptor.UnCompressedSize;

  1117.            end else

  1118.              raise Exception.CreateFmt('Missing data descriptor for file "%s"',[Result.FileName]);

  1119.          End;

  1120.       if Not HeaderOnly Then

  1121.          Begin

  1122.            if Result.CompressedSize > 0 Then

  1123.               Begin

  1124.                 SetLength(Result.CompressedData,Result.CompressedSize);

  1125.                 MS.Read(Result.CompressedData[1],Result.CompressedSize);

  1126.               End;

  1127.          End;

  1128.     End

  1129.   Else

  1130.     Begin

  1131.     End;

  1132. end;

  1133. 

  1134. procedure TKAZipEntries.LoadLocalHeaders(MS: TStream);

  1135. Var

  1136.   X : Integer;

  1137. begin

  1138.   FParent.FHasBadEntries := False;

  1139.   For X := 0 To Count-1 do

  1140.       Begin

  1141.         If Assigned(FParent.FOnZipOpen) Then FParent.FOnZipOpen(FParent,X,FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk);

  1142.         Items[X].FLocalFile := GetLocalEntry(MS,Items[X].FCentralDirectoryFile.RelativeOffsetOfLocalHeader,True);

  1143.         if Items[X].FLocalFile.LocalFileHeaderSignature<>$04034b50 Then FParent.FHasBadEntries := True;

  1144.       End;

  1145. end;

  1146. 

  1147. function TKAZipEntries.ParseLocalHeaders(MS: TStream): Boolean;

  1148. Var

  1149.   Poz                 : Integer;

  1150.   NLE                 : Integer;

  1151.   Byte_               : Array[0..4] of Byte;

  1152.   LocalFile           : TLocalFile;

  1153.   DataDescriptor      : TDataDescriptor;

  1154.   Entry               : TKAZipEntriesEntry;

  1155.   CDFile              : TCentralDirectoryFile;

  1156.   CDSize              : Cardinal;

  1157.   L                   : Integer;

  1158.   NoMore              : Boolean;

  1159.   fp, fp2             : Int64;

  1160.   ddvalid             : boolean;

  1161. begin

  1162.   Result               := False;

  1163.   FLocalHeaderNumFiles := 0;

  1164.   Clear;

  1165.   Try

  1166.       Poz    := 0;

  1167.       NLE    := 0;

  1168.       CDSize := 0;

  1169.       Repeat

  1170.         NoMore      := True;

  1171.         MS.Position := Poz;

  1172.         MS.Read(Byte_,4);

  1173.         if  (Byte_[0]  = $50)

  1174.         And (Byte_[1]  = $4B)

  1175.         And (Byte_[2]  = $03)

  1176.         And (Byte_[3]  = $04) Then

  1177.             Begin

  1178.               Result := True;

  1179.               Inc(FLocalHeaderNumFiles);

  1180.               NoMore      := False;

  1181.               MS.Position := Poz;

  1182.               MS.Read(LocalFile,SizeOf(TLocalFile)-3*SizeOf(String));

  1183.               if LocalFile.FilenameLength > 0 Then

  1184.                  Begin

  1185.                    SetLength(LocalFile.FileName,LocalFile.FilenameLength);

  1186.                    MS.Read(LocalFile.FileName[1],LocalFile.FilenameLength);

  1187.                  End;

  1188.               if LocalFile.ExtraFieldLength > 0 Then

  1189.                  Begin

  1190.                    SetLength(LocalFile.ExtraField,LocalFile.ExtraFieldLength);

  1191.                    MS.Read(LocalFile.ExtraField[1],LocalFile.ExtraFieldLength);

  1192.                  End;

  1193.               if (LocalFile.GeneralPurposeBitFlag And (1 SHL 3)) > 0 Then

  1194.                  Begin

  1195.                    fp:= MS.Position;

  1196.                    ddvalid:= false;

  1197.                    repeat

  1198.                      MS.Read(Byte_,4);

  1199.                      if (Byte_[0]  = $50) And (Byte_[1]  = $4B) And (Byte_[2]  = $07) And (Byte_[3] = $08) then begin

  1200.                        MS.Seek(-4, soFromCurrent);

  1201.                        fp2:= MS.Position;

  1202.                        MS.Read(DataDescriptor,SizeOf(TDataDescriptor));

  1203.                        if DataDescriptor.CompressedSize=fp2-fp then begin

  1204.                          ddvalid:= true;

  1205.                          break;

  1206.                        end else

  1207.                          MS.Position:= fp2+4;

  1208.                      end;

  1209.                      MS.Seek(-3,soFromCurrent);

  1210.                    until MS.position=MS.Size;

  1211. 

  1212.                    MS.Position:= fp;

  1213.                    if ddvalid then begin

  1214.                      LocalFile.Crc32            := DataDescriptor.Crc32;

  1215.                      LocalFile.CompressedSize   := DataDescriptor.CompressedSize;

  1216.                      LocalFile.UnCompressedSize := DataDescriptor.UnCompressedSize;

  1217.                    end else

  1218.                      raise Exception.CreateFmt('Missing data descriptor for file "%s"',[LocalFile.FileName]);

  1219.                  End;

  1220.               MS.Position := MS.Position+LocalFile.CompressedSize;

  1221. 

  1222.               FillChar(CDFile,SizeOf(TCentralDirectoryFile)-3*Sizeof(String),0);

  1223.               CDFile.CentralFileHeaderSignature     := $02014B50;

  1224.               CDFile.VersionMadeBy                  := 20;

  1225.               CDFile.VersionNeededToExtract         := LocalFile.VersionNeededToExtract;

  1226.               CDFile.GeneralPurposeBitFlag          := LocalFile.GeneralPurposeBitFlag;

  1227.               CDFile.CompressionMethod              := LocalFile.CompressionMethod;

  1228.               CDFile.LastModFileTimeDate            := LocalFile.LastModFileTimeDate;

  1229.               CDFile.Crc32                          := LocalFile.Crc32;

  1230.               CDFile.CompressedSize                 := LocalFile.CompressedSize;

  1231.               CDFile.UncompressedSize               := LocalFile.UncompressedSize;

  1232.               CDFile.FilenameLength                 := LocalFile.FilenameLength;

  1233.               CDFile.ExtraFieldLength               := LocalFile.ExtraFieldLength;

  1234.               CDFile.FileCommentLength              := 0;

  1235.               CDFile.DiskNumberStart                := 0;

  1236.               CDFile.InternalFileAttributes         := LocalFile.VersionNeededToExtract;

  1237.               CDFile.ExternalFileAttributes         := faArchive;

  1238.               CDFile.RelativeOffsetOfLocalHeader    := Poz;

  1239.               CDFile.FileName                       := LocalFile.FileName;

  1240.               L := Length(CDFile.FileName);

  1241.               if L > 0 Then

  1242.                  Begin

  1243.                    if CDFile.FileName[L]='/' Then CDFile.ExternalFileAttributes := faDirectory;

  1244.                  End;

  1245.               CDFile.ExtraField                     := LocalFile.ExtraField;

  1246.               CDFile.FileComment                    := '';

  1247. 

  1248.               Entry                                 := TKAZipEntriesEntry.Create(Self);

  1249.               Entry.FDate                           := FileDateToDateTime(CDFile.LastModFileTimeDate);

  1250.               if (CDFile.GeneralPurposeBitFlag And 1) > 0 Then

  1251.                  Entry.FIsEncrypted    := True

  1252.               Else

  1253.                  Entry.FIsEncrypted    := False;

  1254.               Entry.FIsFolder          := (CDFile.ExternalFileAttributes and faDirectory) > 0;

  1255.               Entry.FCompressionType   := ctUnknown;

  1256.               if (CDFile.CompressionMethod=8) or (CDFile.CompressionMethod=9) Then

  1257.                  Begin

  1258.                    Case CDFile.GeneralPurposeBitFlag AND 6 of

  1259.                         0 : Entry.FCompressionType := ctNormal;

  1260.                         2 : Entry.FCompressionType := ctMaximum;

  1261.                         4 : Entry.FCompressionType := ctFast;

  1262.                         6 : Entry.FCompressionType := ctSuperFast

  1263.                    End;

  1264.                  End;

  1265.               Entry.FCentralDirectoryFile := CDFile;

  1266.               Poz         := MS.Position;

  1267.               Inc(NLE);

  1268.               CDSize      := CDSize+Entry.CentralEntrySize;

  1269.             End;

  1270.       Until NoMore;

  1271. 

  1272.       FParent.FEndOfCentralDir.EndOfCentralDirSignature        := $06054b50;

  1273.       FParent.FEndOfCentralDir.NumberOfThisDisk                := 0;

  1274.       FParent.FEndOfCentralDir.NumberOfTheDiskWithTheStart     := 0;

  1275.       FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk  := NLE;

  1276.       FParent.FEndOfCentralDir.SizeOfTheCentralDirectory       := CDSize;

  1277.       FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory := MS.Position;

  1278.       FParent.FEndOfCentralDir.ZipfileCommentLength            := 0;

  1279.   Except

  1280.     Exit;

  1281.   End;

  1282. end;

  1283. 

  1284. procedure TKAZipEntries.Remove(ItemIndex: Integer; Flush : Boolean);

  1285. Var

  1286.   TempStream          : TFileStream;

  1287.   TempMSStream        : TMemoryStream;

  1288.   TempFileName        : String;

  1289.   BUF                 : String;

  1290.   ZipComment          : String;

  1291.   OSL                 : Cardinal;

  1292.   //*********************************************

  1293.   X                   : Integer;

  1294.   TargetPos           : Cardinal;

  1295.   Border              : Cardinal;

  1296. 

  1297.   NR                  : Integer;

  1298.   NW                  : Integer;

  1299.   BufStart            : Integer;

  1300.   BufLen              : Integer;

  1301.   ShiftSize           : Cardinal;

  1302.   NewSize             : Cardinal;

  1303. begin

  1304.  TargetPos          := Items[ItemIndex].FCentralDirectoryFile.RelativeOffsetOfLocalHeader;

  1305.  ShiftSize          := Items[ItemIndex].LocalEntrySize;

  1306.  BufStart           := TargetPos+ShiftSize;

  1307.  BufLen             := FParent.FZipStream.Size-BufStart;

  1308.  Border             := TargetPos;

  1309.  Delete(ItemIndex);

  1310.  if (FParent.FZipSaveMethod=FastSave) AND (Count > 0) Then

  1311.     Begin

  1312.        ZipComment := FParent.Comment.Text;

  1313. 

  1314.        SetLength(BUF,BufLen);

  1315.        FParent.FZipStream.Position := BufStart;

  1316.        NR := FParent.FZipStream.Read(BUF[1],BufLen);

  1317. 

  1318.        FParent.FZipStream.Position := TargetPos;

  1319.        NW := FParent.FZipStream.Write(BUF[1],BufLen);

  1320.        SetLength(BUF,0);

  1321. 

  1322.        For X := 0 to Count-1 do

  1323.            Begin

  1324.              if Items[X].FCentralDirectoryFile.RelativeOffsetOfLocalHeader > Border Then

  1325.                 Begin

  1326.                   Dec(Items[X].FCentralDirectoryFile.RelativeOffsetOfLocalHeader, ShiftSize);

  1327.                   TargetPos := TargetPos+Items[X].LocalEntrySize;

  1328.                 End

  1329.            End;

  1330. 

  1331.        FParent.FZipStream.Position := TargetPos;

  1332.        //************************************ MARK START OF CENTRAL DIRECTORY

  1333.        FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory := FParent.FZipStream.Position;

  1334.        //************************************ SAVE CENTRAL DIRECTORY

  1335.        For X := 0 To Count-1 do

  1336.            Begin

  1337.              FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile,SizeOf(Self.Items[X].FCentralDirectoryFile)-3*SizeOf(String));

  1338.              if Self.Items[X].FCentralDirectoryFile.FilenameLength > 0 Then

  1339.                 FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile.FileName[1],Self.Items[X].FCentralDirectoryFile.FilenameLength);

  1340.              if Self.Items[X].FCentralDirectoryFile.ExtraFieldLength > 0 Then

  1341.                 FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile.ExtraField[1],Self.Items[X].FCentralDirectoryFile.ExtraFieldLength);

  1342.              if Self.Items[X].FCentralDirectoryFile.FileCommentLength > 0 Then

  1343.                 FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile.FileComment[1],Self.Items[X].FCentralDirectoryFile.FileCommentLength);

  1344.            End;

  1345.      //************************************ SAVE END CENTRAL DIRECTORY RECORD

  1346.      FParent.FEndOfCentralDirPos := FParent.FZipStream.Position;

  1347.      FParent.FEndOfCentralDir.SizeOfTheCentralDirectory := FParent.FEndOfCentralDirPos-FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory;

  1348.      Dec(FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk);

  1349.      Dec(FParent.FEndOfCentralDir.TotalNumberOfEntries);

  1350.      FParent.FZipStream.Write(FParent.FEndOfCentralDir, SizeOf(TEndOfCentralDir));

  1351.      //************************************ SAVE ZIP COMMENT IF ANY

  1352.      FParent.FZipCommentPos := FParent.FZipStream.Position;

  1353.      if Length(ZipComment) > 0 Then

  1354.         Begin

  1355.           FParent.FZipStream.Write(ZipComment[1],Length(ZipComment));

  1356.         End;

  1357.      FParent.FZipStream.Size     := FParent.FZipStream.Position;

  1358.     End

  1359.  Else

  1360.     Begin

  1361.        if FParent.FUseTempFiles Then

  1362.           Begin

  1363.              TempFileName := FParent.GetDelphiTempFileName;

  1364.              TempStream   := TFileStream.Create(TempFileName,fmOpenReadWrite or FmCreate);

  1365.              Try

  1366.                FParent.SaveToStream(TempStream);

  1367.                TempStream.Position := 0;

  1368.                OSL                 := FParent.FZipStream.Size;

  1369.                Try

  1370.                  FParent.FZipStream.Size := TempStream.Size;

  1371.                Except

  1372.                  FParent.FZipStream.Size := OSL;

  1373.                  Raise;

  1374.                End;

  1375.                FParent.FZipStream.Position := 0;

  1376.                FParent.FZipStream.CopyFrom(TempStream,TempStream.Size);

  1377.                //*********************************************************************

  1378.                FParent.FZipHeader.ParseZip(FParent.FZipStream);

  1379.                //*********************************************************************

  1380.              Finally

  1381.                TempStream.Free;

  1382.                DeleteFile(TempFileName)

  1383.              End;

  1384.           End

  1385.        Else

  1386.           Begin

  1387.             NewSize := 0;

  1388.             For X := 0 To Count-1 do

  1389.                 Begin

  1390.                   NewSize := NewSize+Items[X].LocalEntrySize+Items[X].CentralEntrySize;

  1391.                   if Assigned(FParent.FOnRemoveItems) Then FParent.FOnRemoveItems(FParent,X,Count-1);

  1392.                 End;

  1393.             NewSize := NewSize+SizeOf(FParent.FEndOfCentralDir)+FParent.FEndOfCentralDir.ZipfileCommentLength;

  1394.             TempMSStream := TMemoryStream.Create;

  1395.             Try

  1396.                TempMSStream.SetSize(NewSize);

  1397.                TempMSStream.Position := 0;

  1398.                FParent.SaveToStream(TempMSStream);

  1399.                TempMSStream.Position := 0;

  1400.                OSL                   := FParent.FZipStream.Size;

  1401.                Try

  1402.                  FParent.FZipStream.Size := TempMSStream.Size;

  1403.                Except

  1404.                  FParent.FZipStream.Size := OSL;

  1405.                  Raise;

  1406.                End;

  1407.                FParent.FZipStream.Position := 0;

  1408.                FParent.FZipStream.CopyFrom(TempMSStream,TempMSStream.Size);

  1409.                //*********************************************************************

  1410.                FParent.FZipHeader.ParseZip(FParent.FZipStream);

  1411.                //*********************************************************************

  1412.              Finally

  1413.                TempMSStream.Free;

  1414.              End;

  1415.           End;

  1416.     End;

  1417.  FParent.FIsDirty := True;

  1418.  if NOT FParent.FBatchMode Then

  1419.     Begin

  1420.        FParent.DoChange(FParent,3);

  1421.     End;

  1422. end;

  1423. 

  1424. procedure TKAZipEntries.Remove(ItemIndex: Integer);

  1425. Begin

  1426.   Remove(ItemIndex,True);

  1427. End;

  1428. 

  1429. procedure TKAZipEntries.Remove(Item: TKAZipEntriesEntry);

  1430. Var

  1431.  X : Integer;

  1432. begin

  1433.  For X := 0 To Count-1 do

  1434.      Begin

  1435.        if Self.Items[X]=Item Then

  1436.           Begin

  1437.             Remove(X);

  1438.             Exit;

  1439.           End;

  1440.      End;

  1441. end;

  1442. 

  1443. procedure TKAZipEntries.Remove(FileName: String);

  1444. Var

  1445.   I : Integer;

  1446. begin

  1447.   I := IndexOf(FileName);

  1448.   if I <> -1 Then Remove(I);

  1449. end;

  1450. 

  1451. procedure TKAZipEntries.RemoveBatch(Files:TList);

  1452. Var

  1453.   X             : Integer;

  1454.   OSL           : Integer;

  1455.   NewSize       : Cardinal;

  1456.   TempStream    : TFileStream;

  1457.   TempMSStream  : TMemoryStream;

  1458.   TempFileName  : String;

  1459. Begin

  1460.   For X := Files.Count-1 DownTo 0 do

  1461.       Begin

  1462.         Delete(Integer(Files.Items[X]));

  1463.         if Assigned(FParent.FOnRemoveItems) Then FParent.FOnRemoveItems(FParent,Files.Count-X,Files.Count);

  1464.       End;

  1465.   NewSize := 0;

  1466.   if FParent.FUseTempFiles Then

  1467.       Begin

  1468.          TempFileName := FParent.GetDelphiTempFileName;

  1469.          TempStream   := TFileStream.Create(TempFileName,fmOpenReadWrite or FmCreate);

  1470.          Try

  1471.            FParent.SaveToStream(TempStream);

  1472.            TempStream.Position := 0;

  1473.            OSL                 := FParent.FZipStream.Size;

  1474.            Try

  1475.              FParent.FZipStream.Size := TempStream.Size;

  1476.            Except

  1477.              FParent.FZipStream.Size := OSL;

  1478.              Raise;

  1479.            End;

  1480.            FParent.FZipStream.Position := 0;

  1481.            FParent.FZipStream.CopyFrom(TempStream,TempStream.Size);

  1482.            //*********************************************************************

  1483.            FParent.FZipHeader.ParseZip(FParent.FZipStream);

  1484.            //*********************************************************************

  1485.          Finally

  1486.            TempStream.Free;

  1487.            DeleteFile(TempFileName)

  1488.          End;

  1489.       End

  1490.    Else

  1491.       Begin

  1492.         For X := 0 To Count-1 do

  1493.             Begin

  1494.               NewSize := NewSize+Items[X].LocalEntrySize+Items[X].CentralEntrySize;

  1495.               if Assigned(FParent.FOnRemoveItems) Then FParent.FOnRemoveItems(FParent,X,Count-1);

  1496.             End;

  1497.         NewSize := NewSize+SizeOf(FParent.FEndOfCentralDir)+FParent.FEndOfCentralDir.ZipfileCommentLength;

  1498.         TempMSStream := TMemoryStream.Create;

  1499.         Try

  1500.            TempMSStream.SetSize(NewSize);

  1501.            TempMSStream.Position := 0;

  1502.            FParent.SaveToStream(TempMSStream);

  1503.            TempMSStream.Position := 0;

  1504.            OSL                   := FParent.FZipStream.Size;

  1505.            Try

  1506.              FParent.FZipStream.Size := TempMSStream.Size;

  1507.            Except

  1508.              FParent.FZipStream.Size := OSL;

  1509.              Raise;

  1510.            End;

  1511.            FParent.FZipStream.Position := 0;

  1512.            FParent.FZipStream.CopyFrom(TempMSStream,TempMSStream.Size);

  1513.            //*********************************************************************

  1514.            FParent.FZipHeader.ParseZip(FParent.FZipStream);

  1515.            //*********************************************************************

  1516.          Finally

  1517.            TempMSStream.Free;

  1518.          End;

  1519.       End;

  1520. End;

  1521. 

  1522. Function TKAZipEntries.IndexOf(Const FileName:String):Integer;

  1523. Var

  1524.   X   : Integer;

  1525.   FN  : String;

  1526. Begin

  1527.   Result := -1;

  1528.   FN     := ToZipName(FileName);

  1529.   For X := 0 To Count-1 do

  1530.       Begin

  1531.         if AnsiCompareText(FN,ToZipName(Items[X].FCentralDirectoryFile.FileName))=0 Then

  1532.            Begin

  1533.              Result := X;

  1534.              Exit;

  1535.            End;

  1536.       End;

  1537. End;

  1538. 

  1539. 

  1540. Function TKAZipEntries.AddStreamFast( ItemName  : String;

  1541.                                       FileAttr  : Word;

  1542.                                       FileDate  : TDateTime;

  1543.                                       Stream    : TStream):TKAZipEntriesEntry;

  1544. Var

  1545.   Compressor   : TCompressionStream;

  1546.   CS           : TStringStream;

  1547.   CM           : WORD;

  1548.   S            : String;

  1549.   X            : Integer;

  1550.   I            : Integer;

  1551.   UL           : Integer;

  1552.   CL           : Integer;

  1553.   FCRC32       : Cardinal;

  1554.   SizeToAppend : Integer;

  1555.   ZipComment   : String;

  1556.   Level        : TCompressionLevel;

  1557.   OBM          : Boolean;

  1558. begin

  1559.   //*********************************** COMPRESS DATA

  1560.   ZipComment              := FParent.Comment.Text;

  1561. 

  1562.   if NOT FParent.FStoreRelativePath Then

  1563.      ItemName             := ExtractFileName(ItemName);

  1564. 

  1565.   ItemName                := ToZipName(ItemName);

  1566.   I   := IndexOf(ItemName);

  1567.   if I > -1 Then

  1568.      Begin

  1569.        OBM := FParent.FBatchMode;

  1570.        Try

  1571.          if OBM=False Then FParent.FBatchMode := True;

  1572.          Remove(I);

  1573.        Finally

  1574.          FParent.FBatchMode := OBM;

  1575.        End;

  1576.      End;

  1577. 

  1578.   CS                      := TStringStream.Create('');

  1579.   CS.Position             := 0;

  1580.   Try

  1581.     UL                    := Stream.Size-Stream.Position;

  1582.     SetLength(S,UL);

  1583.     CM                    := 0;

  1584.     if UL > 0 Then

  1585.        Begin

  1586.          Stream.Read(S[1],UL);

  1587.          CM               := 8;

  1588.        End;

  1589.     FCRC32                := CalcCRC32(S);

  1590.     FParent.FCurrentDFS   := UL;

  1591. 

  1592. 

  1593.     Level                 := clDefault;

  1594.     Case FParent.FZipCompressionType of

  1595.          ctNormal    : Level := clDefault;

  1596.          ctMaximum   : Level := clMax;

  1597.          ctFast      : Level := clFastest;

  1598.          ctSuperFast : Level := clFastest;

  1599.          ctNone      : Level := clNone;

  1600.     End;

  1601. 

  1602.     if CM = 8 Then

  1603.        Begin

  1604.          Compressor            := TCompressionStream.Create(Level,CS);

  1605.          Try

  1606.            Compressor.OnProgress := FParent.OnCompress;

  1607.            Compressor.Write(S[1],UL);

  1608.          Finally

  1609.            Compressor.Free;

  1610.          End;

  1611.          S                     := Copy(CS.DataString, 3, Length(CS.DataString)-6);

  1612.        End;

  1613.   Finally

  1614.     CS.Free;

  1615.   End;

  1616.   //***********************************

  1617.   CL  := Length(S);

  1618.   //*********************************** FILL RECORDS

  1619.   Result := TKAZipEntriesEntry(Self.Add);

  1620.   With Result.FLocalFile do

  1621.     Begin

  1622.       LocalFileHeaderSignature := $04034B50;

  1623.       VersionNeededToExtract   := 20;

  1624.       GeneralPurposeBitFlag    := 0;

  1625.       CompressionMethod        := CM;

  1626.       LastModFileTimeDate      := DateTimeToFileDate(FileDate);

  1627.       Crc32                    := FCRC32;

  1628.       CompressedSize           := CL;

  1629.       UncompressedSize         := UL;

  1630.       FilenameLength           := Length(ItemName);

  1631.       ExtraFieldLength         := 0;

  1632.       FileName                 := ItemName;

  1633.       ExtraField               := '';

  1634.       CompressedData           := '';

  1635.     End;

  1636. 

  1637.  With Result.FCentralDirectoryFile Do

  1638.    Begin

  1639.       CentralFileHeaderSignature     := $02014B50;

  1640.       VersionMadeBy                  := 20;

  1641.       VersionNeededToExtract         := 20;

  1642.       GeneralPurposeBitFlag          := 0;

  1643.       CompressionMethod              := CM;

  1644.       LastModFileTimeDate            := DateTimeToFileDate(FileDate);

  1645.       Crc32                          := FCRC32;

  1646.       CompressedSize                 := CL;

  1647.       UncompressedSize               := UL;

  1648.       FilenameLength                 := Length(ItemName);

  1649.       ExtraFieldLength               := 0;

  1650.       FileCommentLength              := 0;

  1651.       DiskNumberStart                := 0;

  1652.       InternalFileAttributes         := 0;

  1653.       ExternalFileAttributes         := FileAttr;

  1654.       RelativeOffsetOfLocalHeader    := FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory;

  1655.       FileName                       := ItemName;

  1656.       ExtraField                     := '';

  1657.       FileComment                    := '';

  1658.    End;

  1659. 

  1660.  //************************************ EXPAND ZIP STREAM SIZE

  1661.  SizeToAppend := 0;

  1662.  SizeToAppend := SizeToAppend+SizeOf(Result.FLocalFile)-3*SizeOf(String);

  1663.  SizeToAppend := SizeToAppend+Result.FLocalFile.FilenameLength;

  1664.  SizeToAppend := SizeToAppend+CL;

  1665.  SizeToAppend := SizeToAppend+SizeOf(Result.FCentralDirectoryFile)-3*SizeOf(String);

  1666.  SizeToAppend := SizeToAppend+Result.FCentralDirectoryFile.FilenameLength;

  1667.  FParent.FZipStream.Size := FParent.FZipStream.Size+SizeToAppend;

  1668. 

  1669.  //************************************ SAVE LOCAL HEADER AND COMPRESSED DATA

  1670.  FParent.FZipStream.Position := Result.FCentralDirectoryFile.RelativeOffsetOfLocalHeader;

  1671.  FParent.FZipStream.Write(Result.FLocalFile,SizeOf(Result.FLocalFile)-3*SizeOf(String));

  1672.  if Result.FLocalFile.FilenameLength > 0 Then FParent.FZipStream.Write(Result.FLocalFile.FileName[1],Result.FLocalFile.FilenameLength);

  1673.  if CL > 0 Then FParent.FZipStream.Write(S[1],CL);

  1674. 

  1675.  //************************************ MARK START OF CENTRAL DIRECTORY

  1676.  FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory := FParent.FZipStream.Position;

  1677. 

  1678.  //************************************ SAVE CENTRAL DIRECTORY

  1679.  For X := 0 To Count-1 do

  1680.      Begin

  1681.        FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile,SizeOf(Self.Items[X].FCentralDirectoryFile)-3*SizeOf(String));

  1682.        if Self.Items[X].FCentralDirectoryFile.FilenameLength > 0 Then

  1683.           FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile.FileName[1],Self.Items[X].FCentralDirectoryFile.FilenameLength);

  1684.        if Self.Items[X].FCentralDirectoryFile.ExtraFieldLength > 0 Then

  1685.           FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile.ExtraField[1],Self.Items[X].FCentralDirectoryFile.ExtraFieldLength);

  1686.        if Self.Items[X].FCentralDirectoryFile.FileCommentLength > 0 Then

  1687.           FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile.FileComment[1],Self.Items[X].FCentralDirectoryFile.FileCommentLength);

  1688.      End;

  1689. 

  1690.  //************************************ SAVE END CENTRAL DIRECTORY RECORD

  1691.  FParent.FEndOfCentralDirPos := FParent.FZipStream.Position;

  1692.  FParent.FEndOfCentralDir.SizeOfTheCentralDirectory := FParent.FEndOfCentralDirPos-FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory;

  1693.  Inc(FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk);

  1694.  Inc(FParent.FEndOfCentralDir.TotalNumberOfEntries);

  1695.  FParent.FZipStream.Write(FParent.FEndOfCentralDir, SizeOf(TEndOfCentralDir));

  1696. 

  1697.  //************************************ SAVE ZIP COMMENT IF ANY

  1698.  FParent.FZipCommentPos := FParent.FZipStream.Position;

  1699.  if Length(ZipComment) > 0 Then

  1700.     Begin

  1701.       FParent.FZipStream.Write(ZipComment[1],Length(ZipComment));

  1702.     End;

  1703. 

  1704.   Result.FDate   := FileDate;

  1705. 

  1706.   if (Result.FCentralDirectoryFile.GeneralPurposeBitFlag And 1) > 0 Then

  1707.       Result.FIsEncrypted := True

  1708.   Else

  1709.       Result.FIsEncrypted := False;

  1710.   Result.FIsFolder          := (Result.FCentralDirectoryFile.ExternalFileAttributes and faDirectory) > 0;

  1711.   Result.FCompressionType   := ctUnknown;

  1712.   if (Result.FCentralDirectoryFile.CompressionMethod=8) or (Result.FCentralDirectoryFile.CompressionMethod=9) Then

  1713.      Begin

  1714.        Case Result.FCentralDirectoryFile.GeneralPurposeBitFlag AND 6 of

  1715.             0 : Result.FCompressionType := ctNormal;

  1716.             2 : Result.FCompressionType := ctMaximum;

  1717.             4 : Result.FCompressionType := ctFast;

  1718.             6 : Result.FCompressionType := ctSuperFast

  1719.        End;

  1720.      End;

  1721.   FParent.FIsDirty := True;

  1722.   if NOT FParent.FBatchMode Then

  1723.     Begin

  1724.       FParent.DoChange(FParent,2);

  1725.     End;

  1726. end;

  1727. 

  1728. Function TKAZipEntries.AddStreamRebuild( ItemName  : String;

  1729.                                          FileAttr  : Word;

  1730.                                          FileDate  : TDateTime;

  1731.                                          Stream    : TStream):TKAZipEntriesEntry;

  1732. Var

  1733.   Compressor   : TCompressionStream;

  1734.   CS           : TStringStream;

  1735.   CM           : Word;

  1736.   S            : String;

  1737.   UL           : Integer;

  1738.   CL           : Integer;

  1739.   I            : Integer;

  1740.   X            : Integer;

  1741.   FCRC32       : Cardinal;

  1742.   OSL          : Cardinal;

  1743.   NewSize      : Cardinal;

  1744.   ZipComment   : String;

  1745.   TempStream   : TFileStream;

  1746.   TempMSStream : TMemoryStream;

  1747.   TempFileName : String;

  1748.   Level        : TCompressionLevel;

  1749.   OBM          : Boolean;

  1750. Begin

  1751.   if FParent.FUseTempFiles Then

  1752.      Begin

  1753.         TempFileName := FParent.GetDelphiTempFileName;

  1754.         TempStream   := TFileStream.Create(TempFileName,fmOpenReadWrite or FmCreate);

  1755.         Try

  1756.             //*********************************** SAVE ALL OLD LOCAL ITEMS

  1757.             FParent.RebuildLocalFiles(TempStream);

  1758.             //*********************************** COMPRESS DATA

  1759.             ZipComment              := FParent.Comment.Text;

  1760.             if NOT FParent.FStoreRelativePath Then

  1761.                ItemName             := ExtractFileName(ItemName);

  1762.             ItemName                := ToZipName(ItemName);

  1763.             I := IndexOf(ItemName);

  1764.             if I > -1 Then

  1765.                Begin

  1766.                  OBM := FParent.FBatchMode;

  1767.                  Try

  1768.                    if OBM=False Then FParent.FBatchMode := True;

  1769.                    Remove(I);

  1770.                  Finally

  1771.                    FParent.FBatchMode := OBM;

  1772.                  End;

  1773.                End;

  1774. 

  1775.             CM                      := 0;

  1776.             CS                      := TStringStream.Create('');

  1777.             CS.Position             := 0;

  1778.             Try

  1779.               UL                    := Stream.Size-Stream.Position;

  1780.               SetLength(S,UL);

  1781.               if UL > 0 Then

  1782.                  Begin

  1783.                    Stream.Read(S[1],UL);

  1784.                    CM               := 8;

  1785.                  End;

  1786.               FCRC32                := CalcCRC32(S);

  1787.               FParent.FCurrentDFS   := UL;

  1788. 

  1789.               Level                 := clDefault;

  1790.               Case FParent.FZipCompressionType of

  1791.                    ctNormal    : Level := clDefault;

  1792.                    ctMaximum   : Level := clMax;

  1793.                    ctFast      : Level := clFastest;

  1794.                    ctSuperFast : Level := clFastest;

  1795.                    ctNone      : Level := clNone;

  1796.               End;

  1797. 

  1798.               if CM=8 Then

  1799.                  Begin

  1800.                     Compressor            := TCompressionStream.Create(Level,CS);

  1801.                     Try

  1802.                        Compressor.OnProgress := FParent.OnCompress;

  1803.                        Compressor.Write(S[1],UL);

  1804.                     Finally

  1805.                        Compressor.Free;

  1806.                     End;

  1807.                     S                     := Copy(CS.DataString, 3, Length(CS.DataString)-6);

  1808.                  End;

  1809.             Finally

  1810.               CS.Free;

  1811.             End;

  1812.             //************************************************************************

  1813.             CL := Length(S);

  1814.             //*********************************** FILL RECORDS

  1815.             Result := TKAZipEntriesEntry(Self.Add);

  1816.             With Result.FLocalFile do

  1817.               Begin

  1818.                 LocalFileHeaderSignature := $04034B50;

  1819.                 VersionNeededToExtract   := 20;

  1820.                 GeneralPurposeBitFlag    := 0;

  1821.                 CompressionMethod        := CM;

  1822.                 LastModFileTimeDate      := DateTimeToFileDate(FileDate);

  1823.                 Crc32                    := FCRC32;

  1824.                 CompressedSize           := CL;

  1825.                 UncompressedSize         := UL;

  1826.                 FilenameLength           := Length(ItemName);

  1827.                 ExtraFieldLength         := 0;

  1828.                 FileName                 := ItemName;

  1829.                 ExtraField               := '';

  1830.                 CompressedData           := '';

  1831.               End;

  1832. 

  1833.             With Result.FCentralDirectoryFile Do

  1834.              Begin

  1835.                 CentralFileHeaderSignature     := $02014B50;

  1836.                 VersionMadeBy                  := 20;

  1837.                 VersionNeededToExtract         := 20;

  1838.                 GeneralPurposeBitFlag          := 0;

  1839.                 CompressionMethod              := CM;

  1840.                 LastModFileTimeDate            := DateTimeToFileDate(FileDate);

  1841.                 Crc32                          := FCRC32;

  1842.                 CompressedSize                 := CL;

  1843.                 UncompressedSize               := UL;

  1844.                 FilenameLength                 := Length(ItemName);

  1845.                 ExtraFieldLength               := 0;

  1846.                 FileCommentLength              := 0;

  1847.                 DiskNumberStart                := 0;

  1848.                 InternalFileAttributes         := 0;

  1849.                 ExternalFileAttributes         := FileAttr;

  1850.                 RelativeOffsetOfLocalHeader    := TempStream.Position;

  1851.                 FileName                       := ItemName;

  1852.                 ExtraField                     := '';

  1853.                 FileComment                    := '';

  1854.              End;

  1855. 

  1856.            //************************************ SAVE LOCAL HEADER AND COMPRESSED DATA

  1857.            TempStream.Write(Result.FLocalFile,SizeOf(Result.FLocalFile)-3*SizeOf(String));

  1858.            if Result.FLocalFile.FilenameLength > 0 Then TempStream.Write(Result.FLocalFile.FileName[1],Result.FLocalFile.FilenameLength);

  1859.            if CL > 0 Then TempStream.Write(S[1],CL);

  1860.            //************************************

  1861.            FParent.NewLHOffsets[Count-1] := Result.FCentralDirectoryFile.RelativeOffsetOfLocalHeader;

  1862.            FParent.RebuildCentralDirectory(TempStream);

  1863.            FParent.RebuildEndOfCentralDirectory(TempStream);

  1864.            //************************************

  1865.            TempStream.Position := 0;

  1866.            OSL                 := FParent.FZipStream.Size;

  1867.            Try

  1868.              FParent.FZipStream.Size := TempStream.Size;

  1869.            Except

  1870.              FParent.FZipStream.Size := OSL;

  1871.              Raise;

  1872.            End;

  1873.            FParent.FZipStream.Position := 0;

  1874.            FParent.FZipStream.CopyFrom(TempStream,TempStream.Size);

  1875.        Finally

  1876.          TempStream.Free;

  1877.          DeleteFile(TempFileName)

  1878.        End;

  1879.      End

  1880.   Else

  1881.      Begin

  1882.         TempMSStream := TMemoryStream.Create;

  1883.         NewSize := 0;

  1884.         For X := 0 To Count-1 do

  1885.             Begin

  1886.               NewSize := NewSize+Items[X].LocalEntrySize+Items[X].CentralEntrySize;

  1887.               if Assigned(FParent.FOnRemoveItems) Then FParent.FOnRemoveItems(FParent,X,Count-1);

  1888.             End;

  1889.         NewSize := NewSize+SizeOf(FParent.FEndOfCentralDir)+FParent.FEndOfCentralDir.ZipfileCommentLength;

  1890.         Try

  1891.             TempMSStream.SetSize(NewSize);

  1892.             TempMSStream.Position := 0;

  1893.             //*********************************** SAVE ALL OLD LOCAL ITEMS

  1894.             FParent.RebuildLocalFiles(TempMSStream);

  1895.             //*********************************** COMPRESS DATA

  1896.             ZipComment              := FParent.Comment.Text;

  1897.             if NOT FParent.FStoreRelativePath Then

  1898.                ItemName             := ExtractFileName(ItemName);

  1899.             ItemName                := ToZipName(ItemName);

  1900.             I := IndexOf(ItemName);

  1901.             if I > -1 Then

  1902.                Begin

  1903.                  OBM := FParent.FBatchMode;

  1904.                  Try

  1905.                    if OBM=False Then FParent.FBatchMode := True;

  1906.                    Remove(I);

  1907.                  Finally

  1908.                    FParent.FBatchMode := OBM;

  1909.                  End;

  1910.                End;

  1911. 

  1912.             CM                      := 0;

  1913.             CS                      := TStringStream.Create('');

  1914.             CS.Position             := 0;

  1915.             Try

  1916.               UL                    := Stream.Size-Stream.Position;

  1917.               SetLength(S,UL);

  1918.               if UL > 0 Then

  1919.                  Begin

  1920.                    Stream.Read(S[1],UL);

  1921.                    CM               := 8;

  1922.                  End;

  1923.               FCRC32                := CalcCRC32(S);

  1924.               FParent.FCurrentDFS   := UL;

  1925. 

  1926.               Level                 := clDefault;

  1927.               Case FParent.FZipCompressionType of

  1928.                    ctNormal    : Level := clDefault;

  1929.                    ctMaximum   : Level := clMax;

  1930.                    ctFast      : Level := clFastest;

  1931.                    ctSuperFast : Level := clFastest;

  1932.                    ctNone      : Level := clNone;

  1933.               End;

  1934. 

  1935.               if CM=8 Then

  1936.                  Begin

  1937.                     Compressor            := TCompressionStream.Create(Level,CS);

  1938.                     Try

  1939.                        Compressor.OnProgress := FParent.OnCompress;

  1940.                        Compressor.Write(S[1],UL);

  1941.                     Finally

  1942.                        Compressor.Free;

  1943.                     End;

  1944.                     S                     := Copy(CS.DataString, 3, Length(CS.DataString)-6);

  1945.                  End;

  1946.             Finally

  1947.               CS.Free;

  1948.             End;

  1949.             //************************************************************************

  1950.             CL := Length(S);

  1951.             //*********************************** FILL RECORDS

  1952.             Result := TKAZipEntriesEntry(Self.Add);

  1953.             With Result.FLocalFile do

  1954.               Begin

  1955.                 LocalFileHeaderSignature := $04034B50;

  1956.                 VersionNeededToExtract   := 20;

  1957.                 GeneralPurposeBitFlag    := 0;

  1958.                 CompressionMethod        := CM;

  1959.                 LastModFileTimeDate      := DateTimeToFileDate(FileDate);

  1960.                 Crc32                    := FCRC32;

  1961.                 CompressedSize           := CL;

  1962.                 UncompressedSize         := UL;

  1963.                 FilenameLength           := Length(ItemName);

  1964.                 ExtraFieldLength         := 0;

  1965.                 FileName                 := ItemName;

  1966.                 ExtraField               := '';

  1967.                 CompressedData           := '';

  1968.               End;

  1969. 

  1970.             With Result.FCentralDirectoryFile Do

  1971.              Begin

  1972.                 CentralFileHeaderSignature     := $02014B50;

  1973.                 VersionMadeBy                  := 20;

  1974.                 VersionNeededToExtract         := 20;

  1975.                 GeneralPurposeBitFlag          := 0;

  1976.                 CompressionMethod              := CM;

  1977.                 LastModFileTimeDate            := DateTimeToFileDate(FileDate);

  1978.                 Crc32                          := FCRC32;

  1979.                 CompressedSize                 := CL;

  1980.                 UncompressedSize               := UL;

  1981.                 FilenameLength                 := Length(ItemName);

  1982.                 ExtraFieldLength               := 0;

  1983.                 FileCommentLength              := 0;

  1984.                 DiskNumberStart                := 0;

  1985.                 InternalFileAttributes         := 0;

  1986.                 ExternalFileAttributes         := FileAttr;

  1987.                 RelativeOffsetOfLocalHeader    := TempMSStream.Position;

  1988.                 FileName                       := ItemName;

  1989.                 ExtraField                     := '';

  1990.                 FileComment                    := '';

  1991.              End;

  1992. 

  1993.            //************************************ SAVE LOCAL HEADER AND COMPRESSED DATA

  1994.            TempMSStream.Write(Result.FLocalFile,SizeOf(Result.FLocalFile)-3*SizeOf(String));

  1995.            if Result.FLocalFile.FilenameLength > 0 Then TempMSStream.Write(Result.FLocalFile.FileName[1],Result.FLocalFile.FilenameLength);

  1996.            if CL > 0 Then TempMSStream.Write(S[1],CL);

  1997.            //************************************

  1998.            FParent.NewLHOffsets[Count-1] := Result.FCentralDirectoryFile.RelativeOffsetOfLocalHeader;

  1999.            FParent.RebuildCentralDirectory(TempMSStream);

  2000.            FParent.RebuildEndOfCentralDirectory(TempMSStream);

  2001.            //************************************

  2002.            TempMSStream.Position := 0;

  2003.            OSL                 := FParent.FZipStream.Size;

  2004.            Try

  2005.              FParent.FZipStream.Size := TempMSStream.Size;

  2006.            Except

  2007.              FParent.FZipStream.Size := OSL;

  2008.              Raise;

  2009.            End;

  2010.            FParent.FZipStream.Position := 0;

  2011.            FParent.FZipStream.CopyFrom(TempMSStream,TempMSStream.Size);

  2012.        Finally

  2013.          TempMSStream.Free;

  2014.        End;

  2015.      End;

  2016. 

  2017.   Result.FDate              := FileDateToDateTime(Result.FCentralDirectoryFile.LastModFileTimeDate);

  2018.   if (Result.FCentralDirectoryFile.GeneralPurposeBitFlag And 1) > 0 Then

  2019.       Result.FIsEncrypted := True

  2020.   Else

  2021.       Result.FIsEncrypted := False;

  2022.   Result.FIsFolder          := (Result.FCentralDirectoryFile.ExternalFileAttributes and faDirectory) > 0;

  2023.   Result.FCompressionType   := ctUnknown;

  2024.   if (Result.FCentralDirectoryFile.CompressionMethod=8) or (Result.FCentralDirectoryFile.CompressionMethod=9) Then

  2025.      Begin

  2026.        Case Result.FCentralDirectoryFile.GeneralPurposeBitFlag AND 6 of

  2027.             0 : Result.FCompressionType := ctNormal;

  2028.             2 : Result.FCompressionType := ctMaximum;

  2029.             4 : Result.FCompressionType := ctFast;

  2030.             6 : Result.FCompressionType := ctSuperFast

  2031.        End;

  2032.      End;

  2033.  FParent.FIsDirty := True;

  2034.  if NOT FParent.FBatchMode Then

  2035.     Begin

  2036.       FParent.DoChange(FParent,2);

  2037.     End;

  2038. End;

  2039. 

  2040. function TKAZipEntries.AddFolderChain(ItemName: String; FileAttr: Word;

  2041.   FileDate: TDateTime): Boolean;

  2042. Var

  2043.  FN     : String;

  2044.  TN     : String;

  2045.  INCN   : String;

  2046.  P      : Integer;

  2047.  MS     : TMemoryStream;

  2048.  NoMore : Boolean;

  2049. Begin

  2050.   Result := False;

  2051.   FN     := ExtractFilePath(ToDosName(ToZipName(ItemName)));

  2052.   TN     := FN;

  2053.   INCN   := '';

  2054.   MS     := TMemoryStream.Create;

  2055.   Try

  2056.     Repeat

  2057.       NoMore := True;

  2058.       P      := Pos('\',TN);

  2059.       if P > 0 Then

  2060.          Begin

  2061.             INCN        := INCN+Copy(TN,1,P);

  2062.             System.Delete(TN,1,P);

  2063.             MS.Position := 0;

  2064.             MS.Size     := 0;

  2065.             If IndexOf(INCN) = -1 Then

  2066.                Begin

  2067.                   if FParent.FZipSaveMethod = FastSave Then

  2068.                      AddStreamFast(INCN,FileAttr,FileDate,MS)

  2069.                   Else

  2070.                   if FParent.FZipSaveMethod = RebuildAll Then

  2071.                      AddStreamRebuild(INCN,FileAttr,FileDate,MS);

  2072.                End;

  2073.             NoMore := False;

  2074.          End;

  2075.     Until NoMore;

  2076.     Result := True;

  2077.   Finally

  2078.     MS.Free;

  2079.   End;

  2080. End;

  2081. 

  2082. Function TKAZipEntries.AddFolderChain(ItemName : String):Boolean;

  2083. begin

  2084.   Result := AddFolderChain(ItemName,faDirectory,Now);

  2085. end;

  2086. 

  2087. function TKAZipEntries.AddStream(FileName : String; FileAttr : Word; FileDate : TDateTime; Stream : TStream):TKAZipEntriesEntry;

  2088. Begin

  2089.   Result := Nil;

  2090.   if (FParent.FStoreFolders) AND (FParent.FStoreRelativePath) Then AddFolderChain(FileName);

  2091.   if FParent.FZipSaveMethod = FastSave Then

  2092.      Result := AddStreamFast(FileName,FileAttr,FileDate,Stream)

  2093.   Else

  2094.   if FParent.FZipSaveMethod = RebuildAll Then

  2095.      Result := AddStreamRebuild(FileName,FileAttr,FileDate,Stream);

  2096.   if Assigned(FParent.FOnAddItem) Then FParent.FOnAddItem(FParent,FileName);

  2097. End;

  2098. 

  2099. Function TKAZipEntries.AddStream(FileName: String; Stream : TStream):TKAZipEntriesEntry;

  2100. begin

  2101.   Result := AddStream(FileName,faArchive,Now,Stream);

  2102. end;

  2103. 

  2104. Function TKAZipEntries.AddFile(FileName, NewFileName: String):TKAZipEntriesEntry;

  2105. Var

  2106.  FS  : TFileStream;

  2107.  Dir : TSearchRec;

  2108.  Res : Integer;

  2109. begin

  2110.  Result := Nil;

  2111.  Res    := FindFirst(FileName,faAnyFile,Dir);

  2112.  if Res=0 Then

  2113.     Begin

  2114.       FS := TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone);

  2115.       Try

  2116.         FS.Position := 0;

  2117.         Result := AddStream(NewFileName,Dir.Attr,FileDateToDateTime(Dir.Time),FS)

  2118.       Finally

  2119.         FS.Free;

  2120.       End;

  2121.     End;

  2122.  FindClose(Dir);

  2123. end;

  2124. 

  2125. Function TKAZipEntries.AddFile(FileName: String):TKAZipEntriesEntry;

  2126. begin

  2127.   Result := AddFile(FileName,FileName);

  2128. end;

  2129. 

  2130. function TKAZipEntries.AddFiles(FileNames: TStrings): Boolean;

  2131. Var

  2132.   X : Integer;

  2133. begin

  2134.   Result     := False;

  2135.   FParent.FBatchMode := True;

  2136.   Try

  2137.     For X := 0 To FileNames.Count-1 do AddFile(FileNames.Strings[X]);

  2138.   Except

  2139.     FParent.FBatchMode := False;

  2140.     FParent.DoChange(FParent,2);

  2141.     Exit;

  2142.   End;

  2143.   FParent.FBatchMode := False;

  2144.   FParent.DoChange(FParent,2);

  2145.   Result     := True;

  2146. end;

  2147. 

  2148. Function  TKAZipEntries.AddFolderEx(FolderName:String; RootFolder:String; WildCard : String; WithSubFolders : Boolean):Boolean;

  2149. Var

  2150.   Res : Integer;

  2151.   Dir : TSearchRec;

  2152.   FN  : String;

  2153. Begin

  2154.   Res := FindFirst(FolderName+'\*.*',faAnyFile,Dir);

  2155.   While Res=0 Do

  2156.      Begin

  2157.         if (Dir.Attr and faDirectory) > 0 Then

  2158.             Begin

  2159.               if (Dir.Name <> '..') And (Dir.Name <> '.') Then

  2160.                  Begin

  2161.                    FN := FolderName+'\'+Dir.Name;

  2162.                    if (FParent.FStoreFolders) AND (FParent.FStoreRelativePath) Then

  2163.                       AddFolderChain(RemoveRootName(FN+'\',RootFolder),Dir.Attr,FileDateToDateTime(Dir.Time));

  2164.                    if WithSubFolders Then

  2165.                       Begin

  2166.                         AddFolderEx(FN, RootFolder, WildCard, WithSubFolders);

  2167.                       End;

  2168.                  End

  2169.               Else

  2170.                  Begin

  2171.                    if (Dir.Name = '.') Then AddFolderChain(RemoveRootName(FolderName+'\',RootFolder),Dir.Attr,FileDateToDateTime(Dir.Time));

  2172.                  End;

  2173.             End

  2174.         Else

  2175.             Begin

  2176.               FN := FolderName+'\'+Dir.Name;

  2177.               if MatchesMask(FN,WildCard) Then

  2178.                  Begin

  2179.                    AddFile(FN,RemoveRootName(FN,RootFolder));

  2180.                  End;

  2181.             End;

  2182.         Res := FindNext(Dir);

  2183.      End;

  2184.   FindClose(Dir);

  2185.   Result := True;

  2186. End;

  2187. 

  2188. Function  TKAZipEntries.AddFolder(FolderName:String; RootFolder:String; WildCard : String; WithSubFolders : Boolean):Boolean;

  2189. Begin

  2190.   FParent.FBatchMode := True;

  2191.   Try

  2192.     Result := AddFolderEx(FolderName,RootFolder,WildCard,WithSubFolders);

  2193.   Finally

  2194.     FParent.FBatchMode := False;

  2195.     FParent.DoChange(FParent,2);

  2196.   End;

  2197. End;

  2198. 

  2199. Function TKAZipEntries.AddFilesAndFolders(FileNames:TStrings; RootFolder:String; WithSubFolders : Boolean):Boolean;

  2200. Var

  2201.   X   : Integer;

  2202.   Res : Integer;

  2203.   Dir : TSearchRec;

  2204. Begin

  2205.   FParent.FBatchMode := True;

  2206.   Try

  2207.     For X := 0 To FileNames.Count-1 do

  2208.         Begin

  2209.            Res := FindFirst(FileNames.Strings[X],faAnyFile,Dir);

  2210.            if Res=0 Then

  2211.               Begin

  2212.                 if (Dir.Attr and faDirectory) > 0 Then

  2213.                    Begin

  2214.                      if (Dir.Name <> '..') And (Dir.Name <> '.') Then

  2215.                         Begin

  2216.                           AddFolderEx(FileNames.Strings[X],RootFolder,'*.*',WithSubFolders);

  2217.                         End;  

  2218.                    End

  2219.                 Else

  2220.                    Begin

  2221.                      AddFile(FileNames.Strings[X],RemoveRootName(FileNames.Strings[X],RootFolder));

  2222.                    End;

  2223.               End;

  2224.            FindClose(Dir);

  2225.         End;

  2226.   Finally

  2227.     FParent.FBatchMode := False;

  2228.     FParent.DoChange(FParent,2);

  2229.   End;

  2230.   Result := True;

  2231. End;

  2232. 

  2233. 

  2234. procedure TKAZipEntries.RemoveFiles(List: TList);

  2235. begin

  2236.   if List.Count=1 Then

  2237.      Begin

  2238.        Remove(Integer(List.Items[0]));

  2239.      End

  2240.   Else

  2241.      Begin

  2242.        SortList(List);

  2243.        FParent.FBatchMode := True;

  2244.        Try

  2245.          RemoveBatch(List);

  2246.        Finally

  2247.          FParent.FBatchMode := False;

  2248.          FParent.DoChange(Self,3);

  2249.        End;

  2250.      End;

  2251. end;

  2252. 

  2253. Procedure TKAZipEntries.RemoveSelected;

  2254. Var

  2255.  X    : Integer;

  2256.  List : TList;

  2257. Begin

  2258.  FParent.FBatchMode := True;

  2259.  List               := TList.Create;

  2260.  Try

  2261.     For X := 0 to Count-1 do

  2262.        Begin

  2263.          if Self.Items[X].Selected Then List.Add(Pointer(X));

  2264.        End;

  2265.     RemoveBatch(List);

  2266.  Finally

  2267.    List.Free;

  2268.    FParent.FBatchMode := False;

  2269.    FParent.DoChange(Self,3);

  2270.  End;

  2271. End;

  2272. 

  2273. 

  2274. procedure TKAZipEntries.ExtractToStream(Item : TKAZipEntriesEntry; Stream: TStream);

  2275. Var

  2276.   SFS             : TMemoryStream;

  2277.   TFS             : TStream;

  2278.   BUF             : String;

  2279.   NR              : Cardinal;

  2280.   Decompressor    : TDecompressionStream;

  2281.   {$IFDEF USE_BZIP2}

  2282.   DecompressorBZ2 : TBZDecompressionStream;

  2283.   {$ENDIF}

  2284. begin

  2285.   if  (

  2286.        (Item.CompressionMethod=8) or

  2287.        {$IFDEF USE_BZIP2}

  2288.        (Item.CompressionMethod=12) or

  2289.        {$ENDIF}

  2290.        (Item.CompressionMethod=0)

  2291.        )

  2292.   And (NOT Item.FIsEncrypted) Then

  2293.      Begin

  2294.         SFS := TMemoryStream.Create;

  2295.         TFS := Stream;

  2296.         Try

  2297.           if Item.GetCompressedData(SFS) > 0 Then

  2298.              Begin

  2299.                 SFS.Position  := 0;

  2300.                 FParent.FCurrentDFS   := Item.SizeUncompressed;

  2301.                 //****************************************************** DEFLATE

  2302.                 if (Item.CompressionMethod=8) Then

  2303.                    Begin

  2304.                       Decompressor  := TDecompressionStream.Create(SFS);

  2305.                       Decompressor.OnProgress := FParent.OnDecompress;

  2306.                       SetLength(BUF,FParent.FCurrentDFS);

  2307.                       Try

  2308.                         NR := Decompressor.Read(BUF[1],FParent.FCurrentDFS);

  2309.                         if NR=FParent.FCurrentDFS Then TFS.Write(BUF[1],FParent.FCurrentDFS);

  2310.                       Finally

  2311.                         Decompressor.Free;

  2312.                       End;

  2313.                    End

  2314.                 //******************************************************* BZIP2

  2315.                 {$IFDEF USE_BZIP2}

  2316.                 Else

  2317.                 If Item.CompressionMethod=12 Then

  2318.                    Begin

  2319.                       DecompressorBZ2  := TBZDecompressionStream.Create(SFS);

  2320.                       DecompressorBZ2.OnProgress := FParent.OnDecompress;

  2321.                       SetLength(BUF,FParent.FCurrentDFS);

  2322.                       Try

  2323.                         NR := DecompressorBZ2.Read(BUF[1],FParent.FCurrentDFS);

  2324.                         if NR=FParent.FCurrentDFS Then TFS.Write(BUF[1],FParent.FCurrentDFS);

  2325.                       Finally

  2326.                         DecompressorBZ2.Free;

  2327.                       End;

  2328.                    End

  2329.                 {$ENDIF}

  2330.                 //****************************************************** STORED

  2331.                 Else

  2332.                 If Item.CompressionMethod=0 Then

  2333.                    Begin

  2334.                      TFS.CopyFrom(SFS,FParent.FCurrentDFS);

  2335.                    End;

  2336.              End;

  2337.         Finally

  2338.           SFS.Free;

  2339.         End;

  2340.      End

  2341.   Else

  2342.      Begin

  2343.        Raise Exception.Create('Cannot process this file: '+Item.FileName+' ');

  2344.      End;

  2345. end;

  2346. 

  2347. procedure TKAZipEntries.InternalExtractToFile(Item: TKAZipEntriesEntry;

  2348.   FileName: String);

  2349. Var

  2350.   TFS           : TFileStream;

  2351.   Attr          : Integer;

  2352. begin

  2353.   if Item.IsFolder Then

  2354.      Begin

  2355.        ForceDirectories(FileName);

  2356.      End

  2357.   Else

  2358.      Begin

  2359.         TFS := TFileStream.Create(FileName,fmCreate or fmOpenReadWrite or fmShareDenyNone);

  2360.         Try

  2361.           ExtractToStream(Item,TFS);

  2362.         Finally

  2363.           TFS.Free;

  2364.         End;

  2365.         If FParent.FApplyAttributes Then

  2366.            Begin

  2367.              Attr := faArchive;

  2368.              if Item.FCentralDirectoryFile.ExternalFileAttributes And faHidden   > 0 Then Attr := Attr Or faHidden;

  2369.              if Item.FCentralDirectoryFile.ExternalFileAttributes And faSysFile  > 0 Then Attr := Attr Or faSysFile;

  2370.              if Item.FCentralDirectoryFile.ExternalFileAttributes And faReadOnly > 0 Then Attr := Attr Or faReadOnly;

  2371.              FileSetAttr(FileName,Attr);

  2372.            End;

  2373.      End;

  2374. end;

  2375. 

  2376. 

  2377. procedure TKAZipEntries.ExtractToFile(Item: TKAZipEntriesEntry; FileName: String);

  2378. var

  2379.   Can : Boolean;

  2380.   OA  : TOverwriteAction;

  2381. Begin

  2382.   OA  := FParent.FOverwriteAction;

  2383.   Can := True;

  2384.   if ((OA<>oaOverwriteAll) And (OA<>oaSkipAll)) And (Assigned(FParent.FOnOverwriteFile)) Then

  2385.    Begin

  2386.       if FileExists(FileName) Then

  2387.          Begin

  2388.            FParent.FOnOverwriteFile(FParent,FileName,OA);

  2389.          End

  2390.       Else

  2391.          Begin

  2392.            OA := oaOverwrite;

  2393.          End;

  2394.    End;

  2395.    Case OA Of

  2396.      oaSkip          : Can := False;

  2397.      oaSkipAll       : Can := False;

  2398.      oaOverwrite     : Can := True;

  2399.      oaOverwriteAll  : Can := True;

  2400.    End;

  2401.    if Can Then InternalExtractToFile(Item, FileName);

  2402. End;

  2403. 

  2404. procedure TKAZipEntries.ExtractToFile(ItemIndex: Integer; FileName: String);

  2405. var

  2406.   Can       : Boolean;

  2407.   OA        : TOverwriteAction;                                                     

  2408. Begin

  2409.   OA  := FParent.FOverwriteAction;

  2410.   Can := True;

  2411.   if ((OA<>oaOverwriteAll) And (OA<>oaSkipAll)) And (Assigned(FParent.FOnOverwriteFile)) Then

  2412.    Begin

  2413.       if FileExists(FileName) Then

  2414.          Begin

  2415.            FParent.FOnOverwriteFile(FParent,FileName,OA);

  2416.          End

  2417.       Else

  2418.          Begin

  2419.            OA := oaOverwrite;

  2420.          End;

  2421.    End;

  2422.    Case OA Of

  2423.      oaSkip          : Can := False;

  2424.      oaSkipAll       : Can := False;

  2425.      oaOverwrite     : Can := True;

  2426.      oaOverwriteAll  : Can := True;

  2427.    End;

  2428.    if Can Then InternalExtractToFile(Items[ItemIndex],FileName);

  2429. end;

  2430. 

  2431. procedure TKAZipEntries.ExtractToFile(FileName, DestinationFileName: String);

  2432. Var

  2433.   I   : Integer;

  2434.   Can : Boolean;

  2435.   OA  : TOverwriteAction;

  2436. Begin

  2437.   OA  := FParent.FOverwriteAction;

  2438.   Can := True;

  2439.   if ((OA<>oaOverwriteAll) And (OA<>oaSkipAll)) And (Assigned(FParent.FOnOverwriteFile)) Then

  2440.    Begin

  2441.       if FileExists(DestinationFileName) Then

  2442.          Begin

  2443.            FParent.FOnOverwriteFile(FParent,DestinationFileName,OA);

  2444.          End

  2445.       Else

  2446.          Begin

  2447.            OA := oaOverwrite;

  2448.          End;

  2449.    End;

  2450.    Case OA Of

  2451.      oaSkip          : Can := False;

  2452.      oaSkipAll       : Can := False;

  2453.      oaOverwrite     : Can := True;

  2454.      oaOverwriteAll  : Can := True;

  2455.    End;

  2456.    if Can Then

  2457.       Begin

  2458.         I := IndexOf(FileName);

  2459.         InternalExtractToFile(Items[I],DestinationFileName);

  2460.       End;

  2461. end;

  2462. 

  2463. procedure TKAZipEntries.ExtractAll(TargetDirectory: String);

  2464. Var

  2465.   FN        : String;

  2466.   DN        : String;

  2467.   X         : Integer;

  2468.   Can       : Boolean;

  2469.   OA        : TOverwriteAction;

  2470.   FileName  : String;

  2471. begin

  2472.   OA    := FParent.FOverwriteAction;

  2473.   Can   := True;

  2474.   Try

  2475.     For X := 0 To Count-1 do

  2476.         Begin

  2477.           FN := FParent.GetFileName(Items[X].FileName);

  2478.           DN := FParent.GetFilePath(Items[X].FileName);

  2479.           if DN <> '' Then ForceDirectories(TargetDirectory+'\'+DN);

  2480.           FileName := TargetDirectory+'\'+DN+FN;

  2481.           if ((OA<>oaOverwriteAll) And (OA<>oaSkipAll)) And (Assigned(FParent.FOnOverwriteFile)) Then

  2482.              Begin

  2483.                 if FileExists(FileName) Then

  2484.                    Begin

  2485.                      FParent.FOnOverwriteFile(FParent,FileName,OA);

  2486.                    End;

  2487.              End;

  2488.           Case OA Of

  2489.             oaSkip          : Can := False;

  2490.             oaSkipAll       : Can := False;

  2491.             oaOverwrite     : Can := True;

  2492.             oaOverwriteAll  : Can := True;

  2493.           End;

  2494.           if Can Then InternalExtractToFile(Items[X],FileName);

  2495.         End;

  2496.   Finally

  2497.   End;

  2498. end;

  2499. 

  2500. procedure TKAZipEntries.ExtractSelected(TargetDirectory: String);

  2501. Var

  2502.   FN        : String;

  2503.   DN        : String;

  2504.   X         : Integer;

  2505.   OA        : TOverwriteAction;

  2506.   Can       : Boolean;

  2507.   FileName  : String;

  2508. begin

  2509.   OA    := FParent.FOverwriteAction;

  2510.   Can   := True;

  2511.   Try

  2512.     For X := 0 To Count-1 do

  2513.       Begin

  2514.         if Items[X].FSelected Then

  2515.            Begin

  2516.               FN := FParent.GetFileName(Items[X].FileName);

  2517.               DN := FParent.GetFilePath(Items[X].FileName);

  2518.               if DN <> '' Then ForceDirectories(TargetDirectory+'\'+DN);

  2519.               FileName := TargetDirectory+'\'+DN+FN;

  2520.               if ((OA<>oaOverwriteAll) And (OA<>oaSkipAll)) And (Assigned(FParent.FOnOverwriteFile)) Then

  2521.                  Begin

  2522.                     if FileExists(FileName) Then

  2523.                        Begin

  2524.                          FParent.FOnOverwriteFile(FParent,FileName,OA);

  2525.                        End;

  2526.                  End;

  2527.               Case OA Of

  2528.                 oaSkip          : Can := False;

  2529.                 oaSkipAll       : Can := False;

  2530.                 oaOverwrite     : Can := True;

  2531.                 oaOverwriteAll  : Can := True;

  2532.               End;

  2533.              if Can Then InternalExtractToFile(Items[X],TargetDirectory+'\'+DN+FN);

  2534.            End;

  2535.       End;

  2536.   Finally

  2537.   End;

  2538. end;

  2539. 

  2540. 

  2541. 

  2542. procedure TKAZipEntries.DeSelectAll;

  2543. Var

  2544.   X : Integer;

  2545. begin

  2546.   For X := 0 To Count-1 do Items[X].Selected := False;

  2547. end;

  2548. 

  2549. procedure TKAZipEntries.InvertSelection;

  2550. Var

  2551.   X : Integer;

  2552. begin

  2553.   For X := 0 To Count-1 do Items[X].Selected := Not Items[X].Selected;

  2554. end;

  2555. 

  2556. procedure TKAZipEntries.SelectAll;

  2557. Var

  2558.   X : Integer;

  2559. begin

  2560.   For X := 0 To Count-1 do Items[X].Selected := True;

  2561. end;

  2562. 

  2563. procedure TKAZipEntries.Select(WildCard: String);

  2564. Var

  2565.   X : Integer;

  2566. begin

  2567.   For X := 0 To Count-1 do

  2568.       Begin

  2569.         if MatchesMask(ToDosName(Items[X].FileName),WildCard) Then

  2570.            Items[X].Selected := True;

  2571.       End;

  2572. end;

  2573. 

  2574. 

  2575. procedure TKAZipEntries.Rebuild;

  2576. begin

  2577.   FParent.Rebuild;

  2578. end;

  2579. 

  2580. procedure TKAZipEntries.Rename(Item: TKAZipEntriesEntry; NewFileName: String);

  2581. begin

  2582.   Item.FileName := NewFileName;

  2583. end;

  2584. 

  2585. procedure TKAZipEntries.Rename(ItemIndex: Integer; NewFileName: String);

  2586. begin

  2587.   Rename(Items[ItemIndex],NewFileName);

  2588. end;

  2589. 

  2590. procedure TKAZipEntries.Rename(FileName, NewFileName: String);

  2591. Var

  2592.   I    : Integer;

  2593. begin

  2594.   I := IndexOf(FileName);

  2595.   Rename(I,NewFileName);

  2596. end;

  2597. 

  2598. 

  2599. procedure TKAZipEntries.CreateFolder(FolderName: String; FolderDate: TDateTime);

  2600. Var

  2601.   FN : String;

  2602. begin

  2603.   FN       := IncludeTrailingPathDelimiter(FolderName);

  2604.   AddFolderChain(FN,faDirectory,FolderDate);

  2605.   FParent.FIsDirty := True;

  2606. end;

  2607. 

  2608. procedure TKAZipEntries.RenameFolder(FolderName : String; NewFolderName : String);

  2609. Var

  2610.   FN  : String;

  2611.   NFN : String;

  2612.   S   : String;

  2613.   X   : Integer;

  2614.   L   : Integer;

  2615. begin

  2616.   FN  := ToZipName(IncludeTrailingPathDelimiter(FolderName));

  2617.   NFN := ToZipName(IncludeTrailingPathDelimiter(NewFolderName));

  2618.   L   := Length(FN);

  2619.   if IndexOf(NFN) = -1 Then

  2620.      Begin

  2621.        For X := 0 To Count-1 do

  2622.            Begin

  2623.              S := Items[X].FileName;

  2624.              if Pos(FN,S) = 1 Then

  2625.                 Begin

  2626.                   System.Delete(S,1,L);

  2627.                   S := NFN+S;

  2628.                   Items[X].FileName := S;

  2629.                   FParent.FIsDirty := True;

  2630.                 End;

  2631.            End;

  2632.        If (FParent.FIsDirty) And (FParent.FBatchMode=False) Then Rebuild;

  2633.      End;

  2634. end;

  2635. 

  2636. procedure TKAZipEntries.RenameMultiple(Names : TStringList; NewNames : TStringList);

  2637. Var

  2638.   X    : Integer;

  2639.   BR   : Integer;

  2640.   L    : Integer;

  2641. Begin

  2642.   If Names.Count <> NewNames.Count Then

  2643.      Begin

  2644.        Raise Exception.Create('Names and NewNames must have equal count');

  2645.      End

  2646.   Else

  2647.      Begin

  2648.        FParent.FBatchMode := True;

  2649.        Try

  2650.          For X := 0 To Names.Count-1 do

  2651.              Begin

  2652.                L := Length(Names.Strings[X]);

  2653.                if (L>0) And ((Names.Strings[X][L]='\') or (Names.Strings[X][L]='/')) Then

  2654.                   Begin

  2655.                     RenameFolder(Names.Strings[X],NewNames.Strings[X]);

  2656.                     Inc(BR);

  2657.                   End

  2658.                Else

  2659.                   Begin

  2660.                     Rename(Names.Strings[X],NewNames.Strings[X]);

  2661.                     Inc(BR);

  2662.                   End;

  2663.              End;

  2664.        Finally

  2665.          FParent.FBatchMode := False;

  2666.        End;

  2667.        If BR > 0 Then

  2668.           Begin

  2669.             Rebuild;

  2670.             FParent.DoChange(FParent,6);

  2671.           End;

  2672.      End;

  2673. End;

  2674. 

  2675. 

  2676. { TKAZip }

  2677. constructor TKAZip.Create(AOwner: TComponent);

  2678. begin

  2679.  Inherited Create(AOwner);

  2680.  FZipStream          := Nil;

  2681.  FOnDecompressFile   := Nil;

  2682.  FOnCompressFile     := Nil;

  2683.  FOnZipChange        := Nil;

  2684.  FOnZipOpen          := Nil;

  2685.  FOnAddItem          := Nil;

  2686.  FOnOverwriteFile    := Nil;

  2687.  FComponentVersion   := '2.0';

  2688.  FBatchMode          := False;

  2689.  FFileNames          := TStringList.Create;

  2690.  FZipHeader          := TKAZipEntries.Create(Self);

  2691.  FZipComment         := TStringList.Create;

  2692.  FIsZipFile          := False;

  2693.  FFileName           := '';

  2694.  FCurrentDFS         := 0;

  2695.  FExternalStream     := False;

  2696.  FIsDirty            := True;

  2697.  FHasBadEntries      := False;

  2698.  FReadOnly           := False;

  2699. 

  2700.  FApplyAttributes     := True;

  2701.  FOverwriteAction    := oaSkip;

  2702.  FZipSaveMethod      := FastSave;

  2703.  FUseTempFiles       := False;

  2704.  FStoreRelativePath  := True;

  2705.  FStoreFolders       := True;

  2706.  FZipCompressionType := ctMaximum;

  2707. end;

  2708. 

  2709. 

  2710. destructor TKAZip.Destroy;

  2711. begin

  2712.   if Assigned(FZipStream) AND (NOT FExternalStream) Then FZipStream.Free;

  2713.   FZipHeader.Free;

  2714.   FZipComment.Free;

  2715.   FFileNames.Free;

  2716.   inherited Destroy;

  2717. end;

  2718. 

  2719. procedure TKAZip.DoChange(Sender: TObject; Const ChangeType : Integer);

  2720. begin

  2721.   if Assigned(FOnZipChange) Then FOnZipChange(Self, ChangeType);

  2722. end;

  2723. 

  2724. 

  2725. function TKAZip.GetFileName(S: String): String;

  2726. Var

  2727.  FN : String;

  2728.  P  : Integer;

  2729. begin

  2730.  FN := S;

  2731.  FN := StringReplace(FN,'//','\',[rfReplaceAll]);

  2732.  FN := StringReplace(FN,'/','\',[rfReplaceAll]);

  2733.  P := Pos(':\',FN);

  2734.  if P > 0 Then System.Delete(FN,1,P+1);

  2735.  Result := ExtractFileName(StringReplace(FN,'/','\',[rfReplaceAll]));

  2736. end;

  2737. 

  2738. function TKAZip.GetFilePath(S: String): String;

  2739. Var

  2740.  FN : String;

  2741.  P  : Integer;

  2742. begin

  2743.  FN := S;

  2744.  FN := StringReplace(FN,'//','\',[rfReplaceAll]);

  2745.  FN := StringReplace(FN,'/','\',[rfReplaceAll]);

  2746.  P := Pos(':\',FN);

  2747.  if P > 0 Then System.Delete(FN,1,P+1);

  2748.  Result := ExtractFilePath(StringReplace(FN,'/','\',[rfReplaceAll]));

  2749. end;

  2750. 

  2751. 

  2752. procedure TKAZip.LoadFromFile(FileName: String);

  2753. Var

  2754.    Res : Integer;

  2755.    Dir : TSearchRec;

  2756. begin

  2757.    Res := FindFirst(FileName,faAnyFile,Dir);

  2758.    If Res=0 Then

  2759.       Begin

  2760.          if Dir.Attr And faReadOnly > 0 Then

  2761.             Begin

  2762.               FZipStream := TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone);

  2763.               FReadOnly  := True;

  2764.             End

  2765.          Else

  2766.             Begin

  2767.               FZipStream := TFileStream.Create(FileName,fmOpenReadWrite or fmShareDenyNone);

  2768.               FReadOnly  := False;

  2769.             End;

  2770.          {$IFDEF USE_BUFFERED_IO}

  2771.          FZipStream:= TutlPagedBufferStream.Create(FZipStream, 64*1024, true);   // Martok: Buffer for TOC reads

  2772.          {$ENDIF}

  2773.          LoadFromStream(FZipStream);

  2774.          FindClose(Dir);

  2775.       End

  2776.    Else

  2777.       Begin

  2778.         Raise Exception.Create('File "'+FileName+'" not found!');

  2779.       End;

  2780. end;

  2781. 

  2782. procedure TKAZip.LoadFromStream(MS : TStream);

  2783. begin

  2784.   FZipStream := MS;

  2785.   FZipHeader.ParseZip(MS);

  2786.   FIsZipFile := FZipHeader.FIsZipFile;

  2787.   if Not FIsZipFile Then Close;

  2788.   FIsDirty := True;

  2789.   DoChange(Self,1);

  2790. end;

  2791. 

  2792. procedure TKAZip.Close;

  2793. begin

  2794.   Entries.Clear;

  2795.   if Assigned(FZipStream) AND (NOT FExternalStream) Then FZipStream.Free;

  2796.   FExternalStream := False;

  2797.   FZipStream      := Nil;

  2798.   FIsZipFile      := False;

  2799.   FIsDirty        := True;

  2800.   FReadOnly       := False;

  2801.   DoChange(Self,0);

  2802. end;

  2803. 

  2804. procedure TKAZip.SetFileName(const Value: String);

  2805. begin

  2806.   FFileName := Value;

  2807. end;

  2808. 

  2809. procedure TKAZip.Open(FileName: String);

  2810. begin

  2811.   Close;

  2812.   LoadFromFile(FileName);

  2813.   FFileName := FileName;

  2814. end;

  2815. 

  2816. procedure TKAZip.Open(MS: TStream);

  2817. begin

  2818.  Try

  2819.    Close;

  2820.    LoadFromStream(MS);

  2821.  Finally

  2822.    FExternalStream   := True;

  2823.  End;

  2824. end;

  2825. 

  2826. procedure TKAZip.SetIsZipFile(const Value: Boolean);

  2827. begin

  2828.   //****************************************************************************

  2829. end;

  2830. 

  2831. function TKAZip.GetDelphiTempFileName: String;

  2832. Var

  2833.   TmpDir, TmpFn: AnsiString;

  2834. Begin

  2835.   Result := GetCurrentDir;

  2836.   SetLength(TmpDir, GetTempPath(0,nil)+2);

  2837.   SetLength(TmpDir, GetTempPath(Length(TmpDir)-1, PAnsiChar(TmpDir)));

  2838.   if TmpDir>'' then begin

  2839.     SetLength(TmpFn, Length(Tmpdir)+30);

  2840.     if GetTempFileName(PAnsiChar(TmpDir),'',0,PAnsiChar(TmpFN)) <> 0 Then

  2841.       Result := StrPas(PAnsiChar(TmpFN));

  2842.   End;

  2843. End;

  2844. 

  2845. procedure TKAZip.OnDecompress(Sender: TObject);

  2846. Var

  2847.   DS : TStream;

  2848. begin

  2849.   DS := TStream(Sender);

  2850.   if Assigned(FOnDecompressFile) Then FOnDecompressFile(Self,DS.Position,FCurrentDFS);

  2851. end;

  2852. 

  2853. procedure TKAZip.OnCompress(Sender: TObject);

  2854. Var

  2855.   CS : TStream;

  2856. begin

  2857.   CS := TStream(Sender);

  2858.   if Assigned(FOnCompressFile) Then FOnCompressFile(Self,CS.Position,FCurrentDFS);

  2859. end;

  2860. 

  2861. procedure TKAZip.ExtractToFile(Item : TKAZipEntriesEntry; FileName: String);

  2862. begin

  2863.   Entries.ExtractToFile(Item,FileName);

  2864. end;

  2865. 

  2866. procedure TKAZip.ExtractToFile(ItemIndex: Integer; FileName: String);

  2867. begin

  2868.   Entries.ExtractToFile(ItemIndex,FileName);

  2869. end;

  2870. 

  2871. procedure TKAZip.ExtractToFile(FileName, DestinationFileName: String);

  2872. begin

  2873.   Entries.ExtractToFile(FileName,DestinationFileName);

  2874. end;

  2875. 

  2876. procedure TKAZip.ExtractToStream(Item : TKAZipEntriesEntry; Stream: TStream);

  2877. begin

  2878.   Entries.ExtractToStream(Item,Stream);

  2879. end;

  2880. 

  2881. procedure TKAZip.ExtractAll(TargetDirectory: String);

  2882. begin

  2883.   Entries.ExtractAll(TargetDirectory);

  2884. end;

  2885. 

  2886. procedure TKAZip.ExtractSelected(TargetDirectory: String);

  2887. Begin

  2888.   Entries.ExtractSelected(TargetDirectory);

  2889. End;

  2890. 

  2891. function TKAZip.AddFile(FileName, NewFileName: String): TKAZipEntriesEntry;

  2892. begin

  2893.   Result := Entries.AddFile(FileName, NewFileName);

  2894. end;

  2895. 

  2896. function TKAZip.AddFile(FileName: String): TKAZipEntriesEntry;

  2897. begin

  2898.   Result := Entries.AddFile(FileName);

  2899. end;

  2900. 

  2901. function TKAZip.AddFiles(FileNames: TStrings): Boolean;

  2902. begin

  2903.   Result := Entries.AddFiles(FileNames);

  2904. end;

  2905. 

  2906. function TKAZip.AddFolder(FolderName, RootFolder, WildCard: String;

  2907.   WithSubFolders: Boolean): Boolean;

  2908. begin

  2909.   Result := Entries.AddFolder(FolderName,RootFolder,WildCard,WithSubFolders);

  2910. end;

  2911. 

  2912. function TKAZip.AddFilesAndFolders(FileNames: TStrings; RootFolder: String;

  2913.   WithSubFolders: Boolean): Boolean;

  2914. begin

  2915.   Result := Entries.AddFilesAndFolders(FileNames,RootFolder,WithSubFolders);

  2916. end;

  2917. 

  2918. function TKAZip.AddStream(FileName: String; FileAttr: Word;  FileDate: TDateTime; Stream: TStream): TKAZipEntriesEntry;

  2919. begin

  2920.   Result := Entries.AddStream(FileName,FileAttr,FileDate,Stream);

  2921. end;

  2922. 

  2923. function TKAZip.AddStream(FileName: String;  Stream: TStream): TKAZipEntriesEntry;

  2924. begin

  2925.   Result := Entries.AddStream(FileName,Stream);

  2926. end;

  2927. 

  2928. 

  2929. procedure TKAZip.Remove(Item: TKAZipEntriesEntry);

  2930. begin

  2931.   Entries.Remove(Item);

  2932. end;

  2933. 

  2934. procedure TKAZip.Remove(ItemIndex: Integer);

  2935. begin

  2936.   Entries.Remove(ItemIndex);

  2937. end;

  2938. 

  2939. procedure TKAZip.Remove(FileName: String);

  2940. begin

  2941.   Entries.Remove(FileName);

  2942. end;

  2943. 

  2944. procedure TKAZip.RemoveFiles(List: TList);

  2945. begin

  2946.   Entries.RemoveFiles(List);

  2947. end;

  2948. 

  2949. procedure TKAZip.RemoveSelected;

  2950. begin

  2951.   Entries.RemoveSelected;;

  2952. end;

  2953. 

  2954. function TKAZip.GetComment: TStrings;

  2955. Var

  2956.  S : String;

  2957. begin

  2958.   Result := FZipComment;

  2959.   FZipComment.Clear;

  2960.   if FIsZipFile Then

  2961.      Begin

  2962.        if FEndOfCentralDir.ZipfileCommentLength > 0 Then

  2963.           Begin

  2964.             FZipStream.Position := FZipCommentPos;

  2965.             SetLength(S,FEndOfCentralDir.ZipfileCommentLength);

  2966.             FZipStream.Read(S[1],FEndOfCentralDir.ZipfileCommentLength);

  2967.             FZipComment.Text    := S;

  2968.           End;

  2969.      End;

  2970. end;

  2971. 

  2972. procedure TKAZip.SetComment(const Value: TStrings);

  2973. Var

  2974.   Comment : String;

  2975.   L       : Integer;

  2976. begin

  2977.   //****************************************************************************

  2978.   if FZipComment.Text=Value.Text Then Exit;

  2979.   FZipComment.Clear;

  2980.   if FIsZipFile Then

  2981.      Begin

  2982.        FZipComment.Assign(Value);

  2983.        Comment                               := FZipComment.Text;

  2984.        L                                     := Length(Comment);

  2985.        FEndOfCentralDir.ZipfileCommentLength := L;

  2986.        FZipStream.Position                   := FEndOfCentralDirPos;

  2987.        FZipStream.Write(FEndOfCentralDir,SizeOf(TEndOfCentralDir));

  2988.        FZipCommentPos                        := FZipStream.Position;

  2989.        if L > 0 Then

  2990.           Begin

  2991.             FZipStream.Write(Comment[1],L)

  2992.           End

  2993.        Else

  2994.           Begin

  2995.             FZipStream.Size := FZipStream.Position;

  2996.           End;

  2997.      End;

  2998. end;

  2999. 

  3000. procedure TKAZip.DeSelectAll;

  3001. begin

  3002.   Entries.DeSelectAll;

  3003. end;

  3004. 

  3005. procedure TKAZip.Select(WildCard : String);

  3006. begin

  3007.   Entries.Select(WildCard);

  3008. end;

  3009. 

  3010. procedure TKAZip.InvertSelection;

  3011. begin

  3012.   Entries.InvertSelection;

  3013. end;

  3014. 

  3015. procedure TKAZip.SelectAll;

  3016. begin

  3017.   Entries.SelectAll;

  3018. end;

  3019. 

  3020. procedure TKAZip.RebuildLocalFiles(MS: TStream);

  3021. Var

  3022.   X    : Integer;

  3023.   LF   : TLocalFile;

  3024. begin

  3025.   //************************************************* RESAVE ALL LOCAL BLOCKS

  3026.   SetLength(NewLHOffsets,Entries.Count+1);

  3027.   For X := 0 To Entries.Count-1 do

  3028.       Begin

  3029.         NewLHOffsets[X] := MS.Position;

  3030.         LF  := Entries.GetLocalEntry(FZipStream,Entries.Items[X].LocalOffset,False);

  3031.         MS.Write(LF, SizeOf(LF)-3*SizeOf(String));

  3032.         if LF.FilenameLength   > 0 Then MS.Write(LF.FileName[1]  ,LF.FilenameLength);

  3033.         if LF.ExtraFieldLength > 0 Then MS.Write(LF.ExtraField[1],LF.ExtraFieldLength);

  3034.         if LF.CompressedSize   > 0 Then MS.Write(LF.CompressedData[1],LF.CompressedSize);

  3035.         if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,X,Entries.Count-1);

  3036.       End;

  3037. end;

  3038. 

  3039. procedure TKAZip.RebuildCentralDirectory(MS: TStream);

  3040. Var

  3041.   X    : Integer;

  3042.   CDF  : TCentralDirectoryFile;

  3043. begin

  3044.   NewEndOfCentralDir := FEndOfCentralDir;

  3045.   NewEndOfCentralDir.TotalNumberOfEntriesOnThisDisk  := Entries.Count;

  3046.   NewEndOfCentralDir.TotalNumberOfEntries            := Entries.Count;

  3047.   NewEndOfCentralDir.OffsetOfStartOfCentralDirectory := MS.Position;

  3048.   For X := 0 To Entries.Count-1 do

  3049.       Begin

  3050.         CDF := Entries.Items[X].FCentralDirectoryFile;

  3051.         CDF.RelativeOffsetOfLocalHeader := NewLHOffsets[X];

  3052.         MS.Write(CDF,SizeOf(CDF)-3*SizeOf(String));

  3053.         if CDF.FilenameLength > 0 Then

  3054.            MS.Write(CDF.FileName[1],CDF.FilenameLength);

  3055.         if CDF.ExtraFieldLength > 0 Then

  3056.            MS.Write(CDF.ExtraField[1],CDF.ExtraFieldLength);

  3057.         if CDF.FileCommentLength > 0 Then

  3058.            MS.Write(CDF.FileComment[1],CDF.FileCommentLength);

  3059.         if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,X,Entries.Count-1);

  3060.       End;

  3061.   NewEndOfCentralDir.SizeOfTheCentralDirectory := MS.Position-NewEndOfCentralDir.OffsetOfStartOfCentralDirectory;

  3062. end;

  3063. 

  3064. procedure TKAZip.RebuildEndOfCentralDirectory(MS: TStream);

  3065. Var

  3066.   ZipComment : String;

  3067. begin

  3068.   ZipComment   := Comment.Text;

  3069.   FRebuildECDP := MS.Position;

  3070.   MS.Write(NewEndOfCentralDir,SizeOf(NewEndOfCentralDir));

  3071.   FRebuildCP   := MS.Position;

  3072.   if NewEndOfCentralDir.ZipfileCommentLength > 0 Then

  3073.      Begin

  3074.        MS.Write(ZipComment[1],NewEndOfCentralDir.ZipfileCommentLength);

  3075.      End;

  3076.   if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,100,100);

  3077. end;

  3078. 

  3079. Procedure TKAZip.FixZip(MS : TStream);

  3080. Var

  3081.   X          : Integer;

  3082.   Y          : Integer;

  3083.   NewCount   : Integer;

  3084.   LF         : TLocalFile;

  3085.   CDF        : TCentralDirectoryFile;

  3086.   ZipComment : String;

  3087. Begin

  3088.   ZipComment   := Comment.Text;

  3089.   Y            := 0;

  3090.   SetLength(NewLHOffsets,Entries.Count+1);

  3091.   For X := 0 To Entries.Count-1 do

  3092.       Begin

  3093.         LF  := Entries.GetLocalEntry(FZipStream,Entries.Items[X].LocalOffset,False);

  3094.         if (LF.LocalFileHeaderSignature=$04034b50) And (Entries.Items[X].Test) Then

  3095.            Begin

  3096.              NewLHOffsets[Y] := MS.Position;

  3097.              MS.Write(LF, SizeOf(LF)-3*SizeOf(String));

  3098.              if LF.FilenameLength   > 0 Then MS.Write(LF.FileName[1]  ,LF.FilenameLength);

  3099.              if LF.ExtraFieldLength > 0 Then MS.Write(LF.ExtraField[1],LF.ExtraFieldLength);

  3100.              if LF.CompressedSize   > 0 Then MS.Write(LF.CompressedData[1],LF.CompressedSize);

  3101.              if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,X,Entries.Count-1);

  3102.              Inc(Y);

  3103.            End

  3104.         Else

  3105.            Begin

  3106.              Entries.Items[X].FCentralDirectoryFile.CentralFileHeaderSignature := 0;

  3107.              if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,X,Entries.Count-1);

  3108.            End;

  3109.       End;

  3110. 

  3111.   NewCount := Y;

  3112.   Y        := 0;

  3113.   NewEndOfCentralDir := FEndOfCentralDir;

  3114.   NewEndOfCentralDir.TotalNumberOfEntriesOnThisDisk  := NewCount;

  3115.   NewEndOfCentralDir.TotalNumberOfEntries            := NewCount;

  3116.   NewEndOfCentralDir.OffsetOfStartOfCentralDirectory := MS.Position;

  3117.   For X := 0 To Entries.Count-1 do

  3118.       Begin

  3119.         CDF := Entries.Items[X].FCentralDirectoryFile;

  3120.         if CDF.CentralFileHeaderSignature=$02014b50 Then

  3121.            Begin

  3122.              CDF.RelativeOffsetOfLocalHeader := NewLHOffsets[Y];

  3123.              MS.Write(CDF,SizeOf(CDF)-3*SizeOf(String));

  3124.              if CDF.FilenameLength > 0 Then

  3125.                 MS.Write(CDF.FileName[1],CDF.FilenameLength);

  3126.              if CDF.ExtraFieldLength > 0 Then

  3127.                 MS.Write(CDF.ExtraField[1],CDF.ExtraFieldLength);

  3128.              if CDF.FileCommentLength > 0 Then

  3129.                 MS.Write(CDF.FileComment[1],CDF.FileCommentLength);

  3130.              if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,X,Entries.Count-1);

  3131.              Inc(Y);

  3132.            End;

  3133.       End;

  3134.   NewEndOfCentralDir.SizeOfTheCentralDirectory := MS.Position-NewEndOfCentralDir.OffsetOfStartOfCentralDirectory;

  3135. 

  3136.   FRebuildECDP := MS.Position;

  3137.   MS.Write(NewEndOfCentralDir,SizeOf(NewEndOfCentralDir));

  3138.   FRebuildCP   := MS.Position;

  3139.   if NewEndOfCentralDir.ZipfileCommentLength > 0 Then

  3140.      Begin

  3141.        MS.Write(ZipComment[1],NewEndOfCentralDir.ZipfileCommentLength);

  3142.      End;

  3143.   if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,100,100);

  3144. End;

  3145. 

  3146. 

  3147. Procedure TKAZip.SaveToStream(Stream:TStream);

  3148. Begin

  3149.   RebuildLocalFiles(Stream);

  3150.   RebuildCentralDirectory(Stream);

  3151.   RebuildEndOfCentralDirectory(Stream);

  3152. End;

  3153. 

  3154. Procedure TKAZip.Rebuild;

  3155. var

  3156.   TempStream          : TFileStream;

  3157.   TempMSStream        : TMemoryStream;

  3158.   TempFileName        : String;

  3159. Begin

  3160.   if FUseTempFiles Then

  3161.      Begin

  3162.         TempFileName := GetDelphiTempFileName;

  3163.         TempStream   := TFileStream.Create(TempFileName,fmOpenReadWrite or FmCreate);

  3164.         Try

  3165.           SaveToStream(TempStream);

  3166.           FZipStream.Position := 0;

  3167.           FZipStream.Size     := 0;

  3168.           TempStream.Position := 0;

  3169.           FZipStream.CopyFrom(TempStream,TempStream.Size);

  3170.           Entries.ParseZip(FZipStream);

  3171.         Finally

  3172.           TempStream.Free;

  3173.           DeleteFile(TempFileName)

  3174.         End;

  3175.      End

  3176.   Else

  3177.      Begin

  3178.         TempMSStream   := TMemoryStream.Create;

  3179.         Try

  3180.           SaveToStream(TempMSStream);

  3181.           FZipStream.Position   := 0;

  3182.           FZipStream.Size       := 0;

  3183.           TempMSStream.Position := 0;

  3184.           FZipStream.CopyFrom(TempMSStream,TempMSStream.Size);

  3185.           Entries.ParseZip(FZipStream);

  3186.         Finally

  3187.           TempMSStream.Free;

  3188.         End;

  3189.      End;

  3190.   FIsDirty := True;   

  3191. End;

  3192. 

  3193. Procedure TKAZip.CreateZip(Stream:TStream);

  3194. Var

  3195.   ECD : TEndOfCentralDir;

  3196. Begin

  3197.   ECD.EndOfCentralDirSignature        := $06054b50;

  3198.   ECD.NumberOfThisDisk                := 0;

  3199.   ECD.NumberOfTheDiskWithTheStart     := 0;

  3200.   ECD.TotalNumberOfEntriesOnThisDisk  := 0;

  3201.   ECD.TotalNumberOfEntries            := 0;

  3202.   ECD.SizeOfTheCentralDirectory       := 0;

  3203.   ECD.OffsetOfStartOfCentralDirectory := 0;

  3204.   ECD.ZipfileCommentLength            := 0;

  3205.   Stream.Write(ECD,SizeOf(ECD));

  3206. End;

  3207. 

  3208. 

  3209. Procedure TKAZip.CreateZip(FileName:String);

  3210. var

  3211.   FS : TFileStream;

  3212. Begin

  3213.   FS := TFileStream.Create(FileName,fmOpenReadWrite or FmCreate);

  3214.   Try

  3215.     CreateZip(FS);

  3216.   Finally

  3217.     FS.Free;

  3218.   End;

  3219. End;

  3220. 

  3221. procedure TKAZip.SetZipSaveMethod(const Value: TZipSaveMethod);

  3222. begin

  3223.   FZipSaveMethod := Value;

  3224. end;

  3225. 

  3226. procedure TKAZip.SetActive(const Value: Boolean);

  3227. begin

  3228.   if FFileName='' Then Exit;

  3229.   if Value Then Open(FFileName) Else Close;

  3230. end;

  3231. 

  3232. procedure TKAZip.SetZipCompressionType(const Value: TZipCompressionType);

  3233. begin

  3234.   FZipCompressionType := Value;

  3235.   if FZipCompressionType = ctUnknown Then FZipCompressionType := ctNormal;

  3236. end;

  3237. 

  3238. function TKAZip.GetFileNames: TStrings;

  3239. Var

  3240.   X : Integer;

  3241. begin

  3242.   if FIsDirty Then

  3243.      Begin

  3244.        FFileNames.Clear;

  3245.        For X := 0 To Entries.Count-1 do

  3246.            Begin

  3247.              FFileNames.Add(GetFilePath(Entries.Items[X].FileName)+GetFileName(Entries.Items[X].FileName));

  3248.            End;

  3249.        FIsDirty := False;

  3250.      End;

  3251.   Result := FFileNames;

  3252. end;

  3253. 

  3254. procedure TKAZip.SetFileNames(const Value: TStrings);

  3255. begin

  3256.   //*************************************************** READ ONLY

  3257. end;

  3258. 

  3259. 

  3260. procedure TKAZip.SetUseTempFiles(const Value: Boolean);

  3261. begin

  3262.   FUseTempFiles := Value;

  3263. end;

  3264. 

  3265. procedure TKAZip.Rename(Item: TKAZipEntriesEntry; NewFileName: String);

  3266. begin

  3267.   Entries.Rename(Item,NewFileName);

  3268. end;

  3269. 

  3270. procedure TKAZip.Rename(ItemIndex: Integer; NewFileName: String);

  3271. begin

  3272.   Entries.Rename(ItemIndex,NewFileName);

  3273. end;

  3274. 

  3275. procedure TKAZip.Rename(FileName, NewFileName: String);

  3276. begin

  3277.   Entries.Rename(FileName, NewFileName);

  3278. end;

  3279. 

  3280. procedure TKAZip.RenameMultiple(Names, NewNames: TStringList);

  3281. begin

  3282.   Entries.RenameMultiple(Names, NewNames);

  3283. end;

  3284. 

  3285. 

  3286. procedure TKAZip.SetStoreFolders(const Value: Boolean);

  3287. begin

  3288.   FStoreFolders := Value;

  3289. end;

  3290. 

  3291. procedure TKAZip.SetOnAddItem(const Value: TOnAddItem);

  3292. begin

  3293.   FOnAddItem := Value;

  3294. end;

  3295. 

  3296. procedure TKAZip.SetComponentVersion(const Value: String);

  3297. begin

  3298.   //****************************************************************************

  3299. end;

  3300. 

  3301. procedure TKAZip.SetOnRebuildZip(const Value: TOnRebuildZip);

  3302. begin

  3303.   FOnRebuildZip := Value;

  3304. end;

  3305. 

  3306. procedure TKAZip.SetOnRemoveItems(const Value: TOnRemoveItems);

  3307. begin

  3308.   FOnRemoveItems := Value;

  3309. end;

  3310. 

  3311. procedure TKAZip.SetOverwriteAction(const Value: TOverwriteAction);

  3312. begin

  3313.   FOverwriteAction := Value;

  3314. end;

  3315. 

  3316. procedure TKAZip.SetOnOverwriteFile(const Value: TOnOverwriteFile);

  3317. begin

  3318.   FOnOverwriteFile := Value;

  3319. end;

  3320. 

  3321. procedure TKAZip.CreateFolder(FolderName: String; FolderDate: TDateTime);

  3322. begin

  3323.   Entries.CreateFolder(FolderName,FolderDate);

  3324. end;

  3325. 

  3326. procedure TKAZip.RenameFolder(FolderName : String; NewFolderName : String);

  3327. begin

  3328.   Entries.RenameFolder(FolderName,NewFolderName);

  3329. end;

  3330. 

  3331. procedure TKAZip.SetReadOnly(const Value: Boolean);

  3332. begin

  3333.   FReadOnly := Value;

  3334. end;

  3335. 

  3336. procedure TKAZip.SetApplyAtributes(const Value: Boolean);

  3337. begin

  3338.   FApplyAttributes := Value;

  3339. end;

  3340. 

  3341. 

  3342. end.