Subversion Repositories decoder

Rev

Rev 2 | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. unit KAZip;
  2.  
  3. // Verändert für (De)Coder 4.x
  4. // Veränderungen gekennzeichnet mit "Marschall"
  5. // Keine Compilerwarnungen mehr...
  6.  
  7. // Schutz von freiem Speicherplatz
  8. // Gekennzeichnet mit "Sicherheitsbestimmung"
  9.  
  10. // Marschall
  11. {$WARN SYMBOL_PLATFORM OFF}
  12.  
  13. interface
  14. {$DEFINE USE_BZIP2}
  15. uses
  16.   Windows,
  17.   SysUtils,
  18.   Classes,
  19.   Masks,
  20.   TypInfo,
  21.   {$IFDEF USE_BZIP2}
  22.   BZip2,
  23.   {$ENDIF}
  24.   ZLib,
  25.   // Sicherheitsbestimmung
  26.   decutil;
  27.  
  28. type
  29.   TKAZipEntries         = class;
  30.   TKAZip                = class;
  31.   TBytes                = Array of Byte;
  32.   TZipSaveMethod        = (FastSave, RebuildAll);
  33.   TZipCompressionType   = (ctNormal, ctMaximum, ctFast, ctSuperFast, ctNone, ctUnknown);
  34.   TZipCompressionMethod = (cmStored, cmShrunk, cmReduced1, cmReduced2, cmReduced3, cmReduced4, cmImploded, cmTokenizingReserved, cmDeflated, cmDeflated64, cmDCLImploding, cmPKWAREReserved);
  35.   TOverwriteAction      = (oaSkip,oaSkipAll,oaOverwrite,oaOverwriteAll);
  36.  
  37.   TOnDecompressFile=Procedure(Sender:TObject; Current, Total : Integer) of Object;
  38.   TOnCompressFile=Procedure(Sender:TObject; Current, Total : Integer) of Object;
  39.   TOnZipOpen=Procedure(Sender:TObject; Current, Total : Integer) of Object;
  40.   TOnZipChange=Procedure(Sender:TObject; ChangeType : Integer) of Object;
  41.   TOnAddItem=Procedure(Sender:TObject; ItemName : String) of Object;
  42.   TOnRebuildZip=Procedure(Sender:TObject; Current, Total : Integer) of Object;
  43.   TOnRemoveItems=Procedure(Sender:TObject; Current, Total : Integer) of Object;
  44.   TOnOverwriteFile=Procedure(Sender:TObject; Var FileName : String; Var Action : TOverwriteAction) of Object;
  45.  
  46.   {
  47.           0 - The file is stored (no compression)
  48.           1 - The file is Shrunk
  49.           2 - The file is Reduced with compression factor 1
  50.           3 - The file is Reduced with compression factor 2
  51.           4 - The file is Reduced with compression factor 3
  52.           5 - The file is Reduced with compression factor 4
  53.           6 - The file is Imploded
  54.           7 - Reserved for Tokenizing compression algorithm
  55.           8 - The file is Deflated
  56.           9 - Enhanced Deflating using Deflate64(tm)
  57.          10 - PKWARE Data Compression Library Imploding
  58.          11 - Reserved by PKWARE
  59.          12 - File is compressed using BZIP2 algorithm
  60.    }
  61.  
  62.   {DoChange Events
  63.     0 - Zip is Closed;
  64.     1 - Zip is Opened;
  65.     2 - Item is added to the zip
  66.     3 - Item is removed from the Zip
  67.     4 - Item comment changed
  68.     5 - Item name changed
  69.     6 - Item name changed
  70.   }
  71.  
  72.   TZLibStreamHeader = packed record
  73.      CMF : Byte;
  74.      FLG : Byte;
  75.   end;
  76.  
  77.   TLocalFile = packed record
  78.     LocalFileHeaderSignature       : Cardinal;   //    4 bytes  (0x04034b50)
  79.     VersionNeededToExtract         : WORD;       //    2 bytes
  80.     GeneralPurposeBitFlag          : WORD;       //    2 bytes
  81.     CompressionMethod              : WORD;       //    2 bytes
  82.     LastModFileTimeDate            : Cardinal;   //    4 bytes
  83.     Crc32                          : Cardinal;   //    4 bytes
  84.     CompressedSize                 : Cardinal;   //    4 bytes
  85.     UncompressedSize               : Cardinal;   //    4 bytes
  86.     FilenameLength                 : WORD;       //    2 bytes
  87.     ExtraFieldLength               : WORD;       //    2 bytes
  88.     FileName                       : AnsiString; //    variable size
  89.     ExtraField                     : AnsiString; //    variable size
  90.     CompressedData                 : AnsiString; //    variable size
  91.   end;
  92.  
  93.   TDataDescriptor = packed record
  94.     DescriptorSignature            : Cardinal;   //    4 bytes UNDOCUMENTED
  95.     Crc32                          : Cardinal;   //    4 bytes
  96.     CompressedSize                 : Cardinal;   //    4 bytes
  97.     UncompressedSize               : Cardinal;   //    4 bytes
  98.   End;
  99.  
  100.   TCentralDirectoryFile = packed record
  101.     CentralFileHeaderSignature     : Cardinal;   //    4 bytes  (0x02014b50)
  102.     VersionMadeBy                  : WORD;       //    2 bytes
  103.     VersionNeededToExtract         : WORD;       //    2 bytes
  104.     GeneralPurposeBitFlag          : WORD;       //    2 bytes
  105.     CompressionMethod              : WORD;       //    2 bytes
  106.     LastModFileTimeDate            : Cardinal;   //    4 bytes
  107.     Crc32                          : Cardinal;   //    4 bytes
  108.     CompressedSize                 : Cardinal;   //    4 bytes
  109.     UncompressedSize               : Cardinal;   //    4 bytes
  110.     FilenameLength                 : WORD;       //    2 bytes
  111.     ExtraFieldLength               : WORD;       //    2 bytes
  112.     FileCommentLength              : WORD;       //    2 bytes
  113.     DiskNumberStart                : WORD;       //    2 bytes
  114.     InternalFileAttributes         : WORD;       //    2 bytes
  115.     ExternalFileAttributes         : Cardinal;   //    4 bytes
  116.     RelativeOffsetOfLocalHeader    : Cardinal;   //    4 bytes
  117.     FileName                       : AnsiString; //    variable size
  118.     ExtraField                     : AnsiString; //    variable size
  119.     FileComment                    : AnsiString; //    variable size
  120.   end;
  121.  
  122.   TEndOfCentralDir = packed record
  123.     EndOfCentralDirSignature        : Cardinal;  //    4 bytes  (0x06054b50)
  124.     NumberOfThisDisk                : WORD;      //    2 bytes
  125.     NumberOfTheDiskWithTheStart     : WORD;      //    2 bytes
  126.     TotalNumberOfEntriesOnThisDisk  : WORD;      //    2 bytes
  127.     TotalNumberOfEntries            : WORD;      //    2 bytes
  128.     SizeOfTheCentralDirectory       : Cardinal;  //    4 bytes
  129.     OffsetOfStartOfCentralDirectory : Cardinal;  //    4 bytes
  130.     ZipfileCommentLength            : WORD;      //    2 bytes
  131.   end;
  132.  
  133.  
  134.  
  135.   TKAZipEntriesEntry = Class(TCollectionItem)
  136.   private
  137.     { Private declarations }
  138.     FParent               : TKAZipEntries;
  139.     FCentralDirectoryFile : TCentralDirectoryFile;
  140.     FLocalFile            : TLocalFile;
  141.     FIsEncrypted          : Boolean;
  142.     FIsFolder             : Boolean;
  143.     FDate                 : TDateTime;
  144.     FCompressionType      : TZipCompressionType;
  145.     FSelected             : Boolean;
  146.  
  147.     procedure  SetSelected(const Value: Boolean);
  148.     function   GetLocalEntrySize: Cardinal;
  149.     function   GetCentralEntrySize: Cardinal;
  150.     procedure  SetComment(const Value: String);
  151.     procedure  SetFileName(const Value: String);
  152.     function   GetFileName: String;
  153.     function   GetFileComment: String;
  154.   protected
  155.     { Protected declarations }
  156.   public
  157.     { Public declarations }
  158.     constructor Create(Collection: TCollection); override;
  159.     destructor  Destroy; override;
  160.     Function    GetCompressedData : String;Overload;
  161.     Function    GetCompressedData(Stream : TStream) : Integer;Overload;
  162.     procedure   ExtractToFile(FileName: String);
  163.     procedure   ExtractToStream(Stream: TStream);
  164.     procedure   SaveToFile(FileName: String);
  165.     procedure   SaveToStream(Stream: TStream);
  166.     Function    Test:Boolean;
  167.  
  168.     Property    FileName          : String               Read GetFileName                                        Write SetFileName;
  169.     Property    Comment           : String               Read GetFileComment                                     Write SetComment;
  170.     Property    SizeUncompressed  : Cardinal             Read FCentralDirectoryFile.UncompressedSize;
  171.     Property    SizeCompressed    : Cardinal             Read FCentralDirectoryFile.CompressedSize;
  172.     Property    Date              : TDateTime            Read FDate;
  173.     Property    CRC32             : Cardinal             Read FCentralDirectoryFile.CRC32;
  174.     Property    Attributes        : Cardinal             Read FCentralDirectoryFile.ExternalFileAttributes;
  175.     Property    LocalOffset       : Cardinal             Read FCentralDirectoryFile.RelativeOffsetOfLocalHeader;
  176.     Property    IsEncrypted       : Boolean              Read FIsEncrypted;
  177.     Property    IsFolder          : Boolean              Read FIsFolder;
  178.     Property    BitFlag           : Word                 Read FCentralDirectoryFile.GeneralPurposeBitFlag;
  179.     Property    CompressionMethod : Word                 Read FCentralDirectoryFile.CompressionMethod;
  180.     Property    CompressionType   : TZipCompressionType  Read FCompressionType;
  181.     Property    LocalEntrySize    : Cardinal             Read GetLocalEntrySize;
  182.     Property    CentralEntrySize  : Cardinal             Read GetCentralEntrySize;
  183.     Property    Selected          : Boolean              Read FSelected                                          Write  SetSelected;
  184.   End;
  185.  
  186.   TKAZipEntries = class(TCollection)
  187.   private
  188.     { Private declarations }
  189.     FParent              : TKAZip;
  190.     FIsZipFile           : Boolean;
  191.     FLocalHeaderNumFiles : Integer;
  192.  
  193.     function    GetHeaderEntry(Index: Integer): TKAZipEntriesEntry;
  194.     procedure   SetHeaderEntry(Index: Integer; const Value: TKAZipEntriesEntry);
  195.   protected
  196.     { Protected declarations }
  197.     Function    ReadBA(MS: TStream;Sz,Poz:Integer): TBytes;
  198.     function    Adler32(adler : uLong; buf : pByte; len : uInt) : uLong;
  199.     function    CalcCRC32(const UncompressedData : string): Cardinal;
  200.     function    CalculateCRCFromStream(Stream: TStream): Cardinal;
  201.     Function    RemoveRootName(Const FileName, RootName : String):String;
  202.     Procedure   SortList(List : TList);
  203.     function    FileTime2DateTime(FileTime: TFileTime): TDateTime;
  204.     //**************************************************************************
  205.     Function    FindCentralDirectory(MS:TStream):Boolean;
  206.     function    ParseCentralHeaders(MS: TStream): Boolean;
  207.     function    GetLocalEntry(MS: TStream; Offset : Integer; HeaderOnly : Boolean): TLocalFile;
  208.     Procedure   LoadLocalHeaders(MS: TStream);
  209.     Function    ParseLocalHeaders(MS:TStream):Boolean;
  210.  
  211.     //**************************************************************************
  212.     procedure   Remove(ItemIndex: Integer; Flush : Boolean);Overload;
  213.     procedure   RemoveBatch(Files : TList);
  214.     procedure   InternalExtractToFile(Item: TKAZipEntriesEntry; FileName: String);
  215.     //**************************************************************************
  216.     Function    AddStreamFast(ItemName:String; FileAttr : Word; FileDate : TDateTime; Stream:TStream):TKAZipEntriesEntry;Overload;
  217.     Function    AddStreamRebuild(ItemName:String; FileAttr : Word; FileDate : TDateTime; Stream:TStream):TKAZipEntriesEntry;
  218.     Function    AddFolderChain(ItemName:String):Boolean;Overload;
  219.     Function    AddFolderChain(ItemName:String; FileAttr : Word; FileDate : TDateTime):Boolean;Overload;
  220.     Function    AddFolderEx(FolderName:String; RootFolder:String; WildCard:String; WithSubFolders : Boolean):Boolean;
  221.     //**************************************************************************
  222.   public
  223.     { Public declarations }
  224.     Procedure   ParseZip(MS:TStream);
  225.     Constructor Create(AOwner : TKAZip; MS : TStream);Overload;
  226.     Constructor Create(AOwner : TKAZip);Overload;
  227.     Destructor  Destroy; Override;
  228.     //**************************************************************************
  229.     Function    IndexOf(Const FileName:String):Integer;
  230.     //**************************************************************************
  231.     Function    AddFile(FileName, NewFileName: String):TKAZipEntriesEntry;Overload;
  232.     Function    AddFile(FileName:String):TKAZipEntriesEntry;Overload;
  233.     Function    AddFiles(FileNames:TStrings):Boolean;
  234.     Function    AddFolder(FolderName:String; RootFolder:String; WildCard:String; WithSubFolders : Boolean):Boolean;
  235.     Function    AddFilesAndFolders(FileNames:TStrings; RootFolder:String; WithSubFolders : Boolean):Boolean;
  236.     Function    AddStream(FileName:String; FileAttr : Word; FileDate : TDateTime; Stream:TStream):TKAZipEntriesEntry;Overload;
  237.     Function    AddStream(FileName: String; Stream : TStream):TKAZipEntriesEntry;Overload;
  238.     //**************************************************************************
  239.     Procedure   Remove(ItemIndex:Integer);Overload;
  240.     Procedure   Remove(Item:TKAZipEntriesEntry);Overload;
  241.     Procedure   Remove(FileName:String);Overload;
  242.     Procedure   RemoveFiles(List : TList);
  243.     Procedure   RemoveSelected;
  244.     Procedure   Rebuild;
  245.    //**************************************************************************
  246.     Procedure   Select(WildCard : String);
  247.     Procedure   SelectAll;
  248.     Procedure   DeSelectAll;
  249.     Procedure   InvertSelection;
  250.     //**************************************************************************
  251.     Procedure   Rename(Item : TKAZipEntriesEntry; NewFileName: String);Overload;
  252.     Procedure   Rename(ItemIndex : Integer; NewFileName: String);Overload;
  253.     Procedure   Rename(FileName: String; NewFileName: String);Overload;
  254.     procedure   CreateFolder(FolderName: String; FolderDate: TDateTime);
  255.     procedure   RenameFolder(FolderName : String; NewFolderName : String);
  256.     procedure   RenameMultiple(Names : TStringList; NewNames : TStringList);
  257.  
  258.     //**************************************************************************
  259.     procedure   ExtractToFile  (Item : TKAZipEntriesEntry; FileName: String);Overload;
  260.     procedure   ExtractToFile  (ItemIndex : Integer; FileName: String);Overload;
  261.     procedure   ExtractToFile  (FileName, DestinationFileName:String);Overload;
  262.     procedure   ExtractToStream(Item : TKAZipEntriesEntry; Stream: TStream);
  263.     procedure   ExtractAll(TargetDirectory:String);
  264.     procedure   ExtractSelected(TargetDirectory:String);
  265.     //**************************************************************************
  266.     Property    Items[Index : Integer] : TKAZipEntriesEntry read GetHeaderEntry write SetHeaderEntry;
  267.   end;
  268.  
  269.   TKAZip = class(TComponent)
  270.   private
  271.     { Private declarations }
  272.     FZipHeader            : TKAZipEntries;
  273.     FIsDirty              : Boolean;
  274.     FEndOfCentralDirPos   : Cardinal;
  275.     FEndOfCentralDir      : TEndOfCentralDir;
  276.  
  277.     FZipCommentPos        : Cardinal;
  278.     FZipComment           : TStringList;
  279.  
  280.     FRebuildECDP          : Cardinal;
  281.     FRebuildCP            : Cardinal;
  282.  
  283.     FIsZipFile            : Boolean;
  284.     FHasBadEntries        : Boolean;
  285.     FFileName             : String;
  286.     FFileNames            : TStringList;
  287.     FZipSaveMethod        : TZipSaveMethod;
  288.  
  289.     FExternalStream       : Boolean;
  290.     FStoreRelativePath    : Boolean;
  291.     FZipCompressionType   : TZipCompressionType;
  292.  
  293.     FCurrentDFS           : Cardinal;
  294.     FOnDecompressFile     : TOnDecompressFile;
  295.     FOnCompressFile       : TOnCompressFile;
  296.     FOnZipChange          : TOnZipChange;
  297.     FBatchMode            : Boolean;
  298.  
  299.     NewLHOffsets          : Array of Cardinal;
  300.     NewEndOfCentralDir    : TEndOfCentralDir;
  301.     FOnZipOpen            : TOnZipOpen;
  302.     FUseTempFiles         : Boolean;
  303.     FStoreFolders         : Boolean;
  304.     FOnAddItem            : TOnAddItem;
  305.     FComponentVersion     : String;
  306.     FOnRebuildZip         : TOnRebuildZip;
  307.     FOnRemoveItems        : TOnRemoveItems;
  308.     FOverwriteAction      : TOverwriteAction;
  309.     FOnOverwriteFile      : TOnOverwriteFile;
  310.     FReadOnly             : Boolean;
  311.     FApplyAttributes      : Boolean;
  312.  
  313.     procedure   SetFileName(const Value: String);
  314.     procedure   SetIsZipFile(const Value: Boolean);
  315.     function    GetComment: TStrings;
  316.     procedure   SetComment(const Value: TStrings);
  317.     procedure   SetZipSaveMethod(const Value: TZipSaveMethod);
  318.     procedure   SetActive(const Value: Boolean);
  319.     procedure   SetZipCompressionType(const Value: TZipCompressionType);
  320.     function    GetFileNames: TStrings;
  321.     procedure   SetFileNames(const Value: TStrings);
  322.     procedure   SetUseTempFiles(const Value: Boolean);
  323.     procedure   SetStoreFolders(const Value: Boolean);
  324.     procedure   SetOnAddItem(const Value: TOnAddItem);
  325.     procedure   SetComponentVersion(const Value: String);
  326.     procedure   SetOnRebuildZip(const Value: TOnRebuildZip);
  327.     procedure   SetOnRemoveItems(const Value: TOnRemoveItems);
  328.     procedure   SetOverwriteAction(const Value: TOverwriteAction);
  329.     procedure   SetOnOverwriteFile(const Value: TOnOverwriteFile);
  330.     procedure SetReadOnly(const Value: Boolean);
  331.     procedure SetApplyAtributes(const Value: Boolean);
  332.   protected
  333.     { Protected declarations }
  334.     FZipStream  : TStream;
  335.     //**************************************************************************
  336.     Procedure   LoadFromFile(FileName:String);
  337.     Procedure   LoadFromStream(MS : TStream);
  338.     //**************************************************************************
  339.     Procedure   RebuildLocalFiles(MS : TStream);
  340.     Procedure   RebuildCentralDirectory(MS : TStream);
  341.     Procedure   RebuildEndOfCentralDirectory(MS : TStream);
  342.     //**************************************************************************
  343.     procedure   OnDecompress(Sender:TObject);
  344.     procedure   OnCompress(Sender:TObject);
  345.     Procedure   DoChange(Sender:TObject; Const ChangeType : Integer);Virtual;
  346.     //**************************************************************************
  347.   public
  348.     { Public declarations }
  349.     Constructor Create(AOwner:TComponent);Override;
  350.     Destructor  Destroy; Override;
  351.     //**************************************************************************
  352.     function    GetDelphiTempFileName: String;
  353.     function    GetFileName(S: String): String;
  354.     function    GetFilePath(S: String): String;
  355.     //**************************************************************************
  356.     Procedure   CreateZip(Stream:TStream);Overload;
  357.     Procedure   CreateZip(FileName:String);Overload;
  358.     Procedure   Open(FileName:String);Overload;
  359.     Procedure   Open(MS : TStream);Overload;
  360.     Procedure   SaveToStream(Stream:TStream);
  361.     Procedure   Rebuild;
  362.     Procedure   FixZip(MS : TStream);
  363.     Procedure   Close;
  364.     //**************************************************************************
  365.     Function    AddFile(FileName, NewFileName: String):TKAZipEntriesEntry;Overload;
  366.     Function    AddFile(FileName:String):TKAZipEntriesEntry;Overload;
  367.     Function    AddFiles(FileNames:TStrings):Boolean;
  368.     Function    AddFolder(FolderName:String; RootFolder:String; WildCard:String; WithSubFolders : Boolean):Boolean;
  369.     Function    AddFilesAndFolders(FileNames:TStrings; RootFolder:String; WithSubFolders : Boolean):Boolean;
  370.     Function    AddStream(FileName:String; FileAttr : Word; FileDate : TDateTime; Stream:TStream):TKAZipEntriesEntry;Overload;
  371.     Function    AddStream(FileName: String; Stream : TStream):TKAZipEntriesEntry;Overload;
  372.     //**************************************************************************
  373.     Procedure   Remove(ItemIndex:Integer);Overload;
  374.     Procedure   Remove(Item:TKAZipEntriesEntry);Overload;
  375.     Procedure   Remove(FileName:String);Overload;
  376.     Procedure   RemoveFiles(List : TList);
  377.     Procedure   RemoveSelected;
  378.     //**************************************************************************
  379.     Procedure   Select(WildCard : String);
  380.     Procedure   SelectAll;
  381.     Procedure   DeSelectAll;
  382.     Procedure   InvertSelection;
  383.     //**************************************************************************
  384.     Procedure   Rename(Item : TKAZipEntriesEntry; NewFileName: String);Overload;
  385.     Procedure   Rename(ItemIndex : Integer; NewFileName: String);Overload;
  386.     Procedure   Rename(FileName : String; NewFileName: String);Overload;
  387.     Procedure   CreateFolder(FolderName : String; FolderDate : TDateTime);
  388.     Procedure   RenameFolder(FolderName : String; NewFolderName : String);
  389.     procedure   RenameMultiple(Names : TStringList; NewNames : TStringList);
  390.     //**************************************************************************
  391.     procedure   ExtractToFile  (Item      : TKAZipEntriesEntry; FileName: String);Overload;
  392.     procedure   ExtractToFile  (ItemIndex : Integer; FileName: String);Overload;
  393.     procedure   ExtractToFile  (FileName, DestinationFileName:String);Overload;
  394.     procedure   ExtractToStream(Item      : TKAZipEntriesEntry; Stream: TStream);
  395.     procedure   ExtractAll(TargetDirectory: String);
  396.     procedure   ExtractSelected(TargetDirectory: String);
  397.     //**************************************************************************
  398.     Property    Entries         : TKAZipEntries Read FZipHeader;
  399.     Property    HasBadEntries   : Boolean       Read FHasBadEntries;
  400.   published
  401.     { Published declarations }
  402.     Property    FileName          : String              Read FFileName           Write SetFileName;
  403.     Property    IsZipFile         : Boolean             Read FIsZipFile          Write SetIsZipFile;
  404.     Property    SaveMethod        : TZipSaveMethod      Read FZipSaveMethod      Write SetZipSaveMethod;
  405.     Property    StoreRelativePath : Boolean             Read FStoreRelativePath  Write FStoreRelativePath;
  406.     Property    StoreFolders      : Boolean             read FStoreFolders       write SetStoreFolders;
  407.     Property    CompressionType   : TZipCompressionType Read FZipCompressionType Write SetZipCompressionType;
  408.     Property    Comment           : TStrings            Read GetComment          Write SetComment;
  409.     Property    FileNames         : TStrings            Read GetFileNames        Write SetFileNames;
  410.     Property    UseTempFiles      : Boolean             read FUseTempFiles       write SetUseTempFiles;
  411.     Property    OverwriteAction   : TOverwriteAction    read FOverwriteAction    write SetOverwriteAction;
  412.     Property    ComponentVersion  : String              read FComponentVersion   write SetComponentVersion;
  413.     Property    ReadOnly          : Boolean             read FReadOnly           write SetReadOnly;
  414.     Property    ApplyAtributes    : Boolean             read FApplyAttributes    write SetApplyAtributes;
  415.     Property    OnDecompressFile  : TOnDecompressFile   Read FOnDecompressFile   Write FOnDecompressFile;
  416.     Property    OnCompressFile    : TOnCompressFile     Read FOnCompressFile     Write FOnCompressFile;
  417.     Property    OnZipChange       : TOnZipChange        Read FOnZipChange        Write FOnZipChange;
  418.     Property    OnZipOpen         : TOnZipOpen          Read FOnZipOpen          Write FOnZipOpen;
  419.     Property    OnAddItem         : TOnAddItem          read FOnAddItem          write SetOnAddItem;
  420.     Property    OnRebuildZip      : TOnRebuildZip       read FOnRebuildZip       write SetOnRebuildZip;
  421.     Property    OnRemoveItems     : TOnRemoveItems      read FOnRemoveItems      write SetOnRemoveItems;
  422.     Property    OnOverwriteFile   : TOnOverwriteFile    read FOnOverwriteFile    write SetOnOverwriteFile;
  423.     Property    Active            : Boolean             Read FIsZipFile          Write SetActive;
  424.   end;
  425.  
  426. procedure Register;
  427. Function ToZipName(FileName:String):String;
  428. Function ToDosName(FileName:String):String;
  429.  
  430. implementation
  431.  
  432. Const
  433.   ZL_DEF_COMPRESSIONMETHOD  = $8;  { Deflate }
  434.   ZL_ENCH_COMPRESSIONMETHOD = $9;  { Enchanced Deflate }
  435.   ZL_DEF_COMPRESSIONINFO    = $7;  { 32k window for Deflate }
  436.   ZL_PRESET_DICT            = $20;
  437.  
  438.   ZL_FASTEST_COMPRESSION    = $0;
  439.   ZL_FAST_COMPRESSION       = $1;
  440.   ZL_DEFAULT_COMPRESSION    = $2;
  441.   ZL_MAXIMUM_COMPRESSION    = $3;
  442.  
  443.   ZL_FCHECK_MASK            = $1F;
  444.   ZL_CINFO_MASK             = $F0; { mask out leftmost 4 bits }
  445.   ZL_FLEVEL_MASK            = $C0; { mask out leftmost 2 bits }
  446.   ZL_CM_MASK                = $0F; { mask out rightmost 4 bits }
  447.  
  448.  
  449.   ZL_MULTIPLE_DISK_SIG      = $08074b50; // 'PK'#7#8
  450.   ZL_DATA_DESCRIPT_SIG      = $08074b50; // 'PK'#7#8
  451.   ZL_LOCAL_HEADERSIG        = $04034b50; // 'PK'#3#4
  452.   ZL_CENTRAL_HEADERSIG      = $02014b50; // 'PK'#1#2
  453.   ZL_EOC_HEADERSIG          = $06054b50; // 'PK'#5#6
  454.  
  455.   const
  456.   CRCTable: array[0..255] of Cardinal = (
  457.     $00000000, $77073096, $EE0E612C, $990951BA, $076DC419, $706AF48F, $E963A535,
  458.     $9E6495A3, $0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988, $09B64C2B, $7EB17CBD,
  459.     $E7B82D07, $90BF1D91, $1DB71064, $6AB020F2, $F3B97148, $84BE41DE, $1ADAD47D,
  460.     $6DDDE4EB, $F4D4B551, $83D385C7, $136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
  461.     $14015C4F, $63066CD9, $FA0F3D63, $8D080DF5, $3B6E20C8, $4C69105E, $D56041E4,
  462.     $A2677172, $3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B, $35B5A8FA, $42B2986C,
  463.     $DBBBC9D6, $ACBCF940, $32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59, $26D930AC,
  464.     $51DE003A, $C8D75180, $BFD06116, $21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
  465.     $2802B89E, $5F058808, $C60CD9B2, $B10BE924, $2F6F7C87, $58684C11, $C1611DAB,
  466.     $B6662D3D, $76DC4190, $01DB7106, $98D220BC, $EFD5102A, $71B18589, $06B6B51F,
  467.     $9FBFE4A5, $E8B8D433, $7807C9A2, $0F00F934, $9609A88E, $E10E9818, $7F6A0DBB,
  468.     $086D3D2D, $91646C97, $E6635C01, $6B6B51F4, $1C6C6162, $856530D8, $F262004E,
  469.     $6C0695ED, $1B01A57B, $8208F4C1, $F50FC457, $65B0D9C6, $12B7E950, $8BBEB8EA,
  470.     $FCB9887C, $62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65, $4DB26158, $3AB551CE,
  471.     $A3BC0074, $D4BB30E2, $4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB, $4369E96A,
  472.     $346ED9FC, $AD678846, $DA60B8D0, $44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
  473.     $5005713C, $270241AA, $BE0B1010, $C90C2086, $5768B525, $206F85B3, $B966D409,
  474.     $CE61E49F, $5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4, $59B33D17, $2EB40D81,
  475.     $B7BD5C3B, $C0BA6CAD, $EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A, $EAD54739,
  476.     $9DD277AF, $04DB2615, $73DC1683, $E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,
  477.     $E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1, $F00F9344, $8708A3D2, $1E01F268,
  478.     $6906C2FE, $F762575D, $806567CB, $196C3671, $6E6B06E7, $FED41B76, $89D32BE0,
  479.     $10DA7A5A, $67DD4ACC, $F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5, $D6D6A3E8,
  480.     $A1D1937E, $38D8C2C4, $4FDFF252, $D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
  481.     $D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60, $DF60EFC3, $A867DF55, $316E8EEF,
  482.     $4669BE79, $CB61B38C, $BC66831A, $256FD2A0, $5268E236, $CC0C7795, $BB0B4703,
  483.     $220216B9, $5505262F, $C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04, $C2D7FFA7,
  484.     $B5D0CF31, $2CD99E8B, $5BDEAE1D, $9B64C2B0, $EC63F226, $756AA39C, $026D930A,
  485.     $9C0906A9, $EB0E363F, $72076785, $05005713, $95BF4A82, $E2B87A14, $7BB12BAE,
  486.     $0CB61B38, $92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21, $86D3D2D4, $F1D4E242,
  487.     $68DDB3F8, $1FDA836E, $81BE16CD, $F6B9265B, $6FB077E1, $18B74777, $88085AE6,
  488.     $FF0F6A70, $66063BCA, $11010B5C, $8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
  489.     $A00AE278, $D70DD2EE, $4E048354, $3903B3C2, $A7672661, $D06016F7, $4969474D,
  490.     $3E6E77DB, $AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0, $A9BCAE53, $DEBB9EC5,
  491.     $47B2CF7F, $30B5FFE9, $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6, $BAD03605,
  492.     $CDD70693, $54DE5729, $23D967BF, $B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
  493.     $B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D);
  494.  
  495.  
  496. // Sicherheitsbestimmung
  497.  
  498. procedure dc_deletefile(Filename: string);
  499. const
  500.   buf = 1024;
  501. var
  502.   S: TStream;
  503.   size: int64;
  504.   abbruch: boolean;
  505.   lAttributes: integer;
  506. begin
  507.   if fileexists(filename) then
  508.   begin
  509.     try
  510.       lAttributes := FileGetAttr(Filename);
  511.       if lAttributes and SysUtils.faReadOnly <> 0 then
  512.       begin
  513.         lAttributes := lAttributes - SysUtils.faReadOnly;
  514.         FileSetAttr(Filename, lAttributes);
  515.       end;
  516.       S := TFileStream.Create(Filename, fmOpenWrite or fmShareExclusive);
  517.       try
  518.         size := S.Size;
  519.         //mainform.progress_position(wartenform.pbr_progress.min);
  520.         //mainform.progress_text(mainform.GetLangEntry('deletefile'), filename);
  521.         abbruch := false;
  522.         while not abbruch do
  523.         begin
  524.           size := size - buf;
  525.           if size > 0 then
  526.           begin
  527.             ProtectStream(S, buf);
  528.             //mainform.progress_position(floor((s.size-size) / s.Size * wartenform.pbr_progress.max));
  529.           end
  530.           else
  531.           begin
  532.             if size < 0 then
  533.               ProtectStream(S, s.size-s.Position); // wenn nicht size = 0
  534.  
  535.             //mainform.progress_position(wartenform.pbr_progress.min);
  536.  
  537.             abbruch := true;
  538.           end;
  539.         end;
  540.       finally
  541.         S.Free;
  542.       end;
  543.       deletefile(pchar(filename));
  544.     except
  545.  
  546.     end;
  547.   end;
  548. end;
  549.  
  550. // Ende Sicherheitsbestimmung
  551.  
  552. procedure Register;
  553. begin
  554.   RegisterComponents('KA', [TKAZip]);
  555. end;
  556.  
  557. Function ToZipName(FileName:String):String;
  558. Var
  559.  P : Integer;
  560. Begin
  561.   Result := FileName;
  562.   Result := StringReplace(Result,'\','/',[rfReplaceAll]);
  563.   P := Pos(':/',Result);
  564.   if P > 0 Then
  565.      Begin
  566.        System.Delete(Result,1,P+1);
  567.      End;
  568.   P := Pos('//',Result);
  569.   if P > 0 Then
  570.      Begin
  571.        System.Delete(Result,1,P+1);
  572.        P := Pos('/',Result);
  573.        if P > 0 Then
  574.           Begin
  575.              System.Delete(Result,1,P);
  576.              P := Pos('/',Result);
  577.              if P > 0 Then System.Delete(Result,1,P);
  578.           End;
  579.      End;
  580. End;
  581.  
  582.  
  583. Function ToDosName(FileName:String):String;
  584. Var
  585.  P : Integer;
  586. Begin
  587.   Result := FileName;
  588.   Result := StringReplace(Result,'\','/',[rfReplaceAll]);
  589.   P := Pos(':/',Result);
  590.   if P > 0 Then
  591.      Begin
  592.        System.Delete(Result,1,P+1);
  593.      End;
  594.   P := Pos('//',Result);
  595.   if P > 0 Then
  596.      Begin
  597.        System.Delete(Result,1,P+1);
  598.        P := Pos('/',Result);
  599.        if P > 0 Then
  600.           Begin
  601.              System.Delete(Result,1,P);
  602.              P := Pos('/',Result);
  603.              if P > 0 Then System.Delete(Result,1,P);
  604.           End;
  605.      End;
  606.   Result := StringReplace(Result,'/','\',[rfReplaceAll]);
  607. End;
  608.  
  609. { TKAZipEntriesEntry }
  610.  
  611. constructor TKAZipEntriesEntry.Create(Collection: TCollection);
  612. begin
  613.   inherited Create(Collection);
  614.   FParent   := TKAZipEntries(Collection);
  615.   FSelected := False;
  616. end;
  617.  
  618. destructor TKAZipEntriesEntry.Destroy;
  619. begin
  620.  
  621.   inherited Destroy;
  622. end;
  623.  
  624. procedure TKAZipEntriesEntry.ExtractToFile(FileName: String);
  625. begin
  626.   FParent.ExtractToFile(Self,FileName);
  627. end;
  628.  
  629. procedure TKAZipEntriesEntry.ExtractToStream(Stream: TStream);
  630. begin
  631.   FParent.ExtractToStream(Self,Stream);
  632. end;
  633.  
  634. procedure TKAZipEntriesEntry.SaveToFile(FileName: String);
  635. begin
  636.   ExtractToFile(FileName);
  637. end;
  638.  
  639. procedure TKAZipEntriesEntry.SaveToStream(Stream: TStream);
  640. begin
  641.   ExtractToStream(Stream);
  642. end;
  643.  
  644.  
  645. function TKAZipEntriesEntry.GetCompressedData(Stream: TStream): Integer;
  646. Var
  647.   FZLHeader : TZLibStreamHeader;
  648.   BA        : TLocalFile;
  649.   ZLH       : Word;
  650.   Compress  : Byte;
  651. begin
  652.   Result := 0;
  653.   if (CompressionMethod=8) Then
  654.      Begin
  655.        FZLHeader.CMF := (ZL_DEF_COMPRESSIONINFO shl 4);               { 32k Window size }
  656.        FZLHeader.CMF := FZLHeader.CMF or ZL_DEF_COMPRESSIONMETHOD;    { Deflate }
  657.        Compress := ZL_DEFAULT_COMPRESSION;
  658.        Case BitFlag AND 6 of
  659.             0 : Compress := ZL_DEFAULT_COMPRESSION;
  660.             2 : Compress := ZL_MAXIMUM_COMPRESSION;
  661.             4 : Compress := ZL_FAST_COMPRESSION;
  662.             6 : Compress := ZL_FASTEST_COMPRESSION;
  663.        End;
  664.        FZLHeader.FLG := FZLHeader.FLG or (Compress shl 6);
  665.        FZLHeader.FLG := FZLHeader.FLG and not ZL_PRESET_DICT;         { no preset dictionary}
  666.        FZLHeader.FLG := FZLHeader.FLG and not ZL_FCHECK_MASK;
  667.        ZLH           := (FZLHeader.CMF * 256) + FZLHeader.FLG;
  668.        Inc(FZLHeader.FLG, 31 - (ZLH mod 31));
  669.        Result := Result + Stream.Write(FZLHeader,SizeOf(FZLHeader));
  670.      End;
  671.   BA     := FParent.GetLocalEntry(FParent.FParent.FZipStream,LocalOffset,False);
  672.   if BA.LocalFileHeaderSignature<>$04034b50 Then
  673.      Begin
  674.         Result := 0;
  675.         Exit;
  676.      End;
  677.   if SizeCompressed > 0 Then
  678.      Result := Result + Stream.Write(BA.CompressedData[1],SizeCompressed);
  679. end;
  680.  
  681. function TKAZipEntriesEntry.GetFileComment: String;
  682. begin
  683.   result := string(FCentralDirectoryFile.FileComment);
  684. end;
  685.  
  686. function TKAZipEntriesEntry.GetFileName: String;
  687. begin
  688.   result := string(FCentralDirectoryFile.FileName);
  689. end;
  690.  
  691. function TKAZipEntriesEntry.GetCompressedData: String;
  692. Var
  693.   BA        : TLocalFile;
  694.   FZLHeader : TZLibStreamHeader;
  695.   ZLH       : Word;
  696.   Compress  : Byte;
  697. begin
  698.   Result := '';
  699.   if (CompressionMethod=0) or (CompressionMethod=8) Then
  700.      Begin
  701.        BA     := FParent.GetLocalEntry(FParent.FParent.FZipStream,LocalOffset,False);
  702.        if BA.LocalFileHeaderSignature<>$04034b50 Then Exit;
  703.        if (CompressionMethod=8) Then
  704.           Begin
  705.             FZLHeader.CMF := (ZL_DEF_COMPRESSIONINFO shl 4);               { 32k Window size }
  706.             FZLHeader.CMF := FZLHeader.CMF or ZL_DEF_COMPRESSIONMETHOD;    { Deflate }
  707.             Compress := ZL_DEFAULT_COMPRESSION;
  708.             Case BitFlag AND 6 of
  709.                  0 : Compress := ZL_DEFAULT_COMPRESSION;
  710.                  2 : Compress := ZL_MAXIMUM_COMPRESSION;
  711.                  4 : Compress := ZL_FAST_COMPRESSION;
  712.                  6 : Compress := ZL_FASTEST_COMPRESSION;
  713.             End;
  714.             FZLHeader.FLG := FZLHeader.FLG or (Compress shl 6);
  715.             FZLHeader.FLG := FZLHeader.FLG and not ZL_PRESET_DICT;         { no preset dictionary}
  716.             FZLHeader.FLG := FZLHeader.FLG and not ZL_FCHECK_MASK;
  717.             ZLH           := (FZLHeader.CMF * 256) + FZLHeader.FLG;
  718.             Inc(FZLHeader.FLG, 31 - (ZLH mod 31));
  719.             SetLength(Result,SizeOf(FZLHeader));
  720.             SetString(Result,PChar(@FZLHeader),SizeOf(FZLHeader));
  721.           End;
  722.        Result := Result + BA.CompressedData;
  723.      End
  724.   Else
  725.      Begin
  726.        SetLength(Result,0);
  727.      End;
  728. End;
  729.  
  730. procedure TKAZipEntriesEntry.SetSelected(const Value: Boolean);
  731. begin
  732.   FSelected := Value;
  733. end;
  734.  
  735. function TKAZipEntriesEntry.GetLocalEntrySize: Cardinal;
  736. begin
  737.  Result := SizeOf(TLocalFile) - 3*SizeOf(String)+
  738.            FCentralDirectoryFile.CompressedSize+
  739.            FCentralDirectoryFile.FilenameLength+
  740.            FCentralDirectoryFile.ExtraFieldLength;
  741.  if (FCentralDirectoryFile.GeneralPurposeBitFlag And (1 SHL 3)) > 0 Then
  742.     Begin
  743.       Result := Result + SizeOf(TDataDescriptor);
  744.     End;
  745. end;
  746.  
  747. function TKAZipEntriesEntry.GetCentralEntrySize: Cardinal;
  748. begin
  749.   Result := SizeOf(TCentralDirectoryFile) - 3*SizeOf(String)+
  750.                    FCentralDirectoryFile.FilenameLength+
  751.                    FCentralDirectoryFile.ExtraFieldLength+
  752.                    FCentralDirectoryFile.FileCommentLength;
  753. end;
  754.  
  755. function TKAZipEntriesEntry.Test: Boolean;
  756. Var
  757.   FS : TFileStream;
  758.   MS : TMemoryStream;
  759.   FN : String;
  760. begin
  761.   Result  := True;
  762.   Try
  763.     if NOT FIsEncrypted Then
  764.        Begin
  765.          if FParent.FParent.FUseTempFiles  Then
  766.             Begin
  767.               FN := FParent.FParent.GetDelphiTempFileName;
  768.               FS := TFileStream.Create(FN,fmOpenReadWrite or FmCreate);
  769.               Try
  770.                 ExtractToStream(FS);
  771.                 FS.Position := 0;
  772.                 Result      := FParent.CalculateCRCFromStream(FS) = CRC32;
  773.               Finally
  774.                 FS.Free;
  775.  
  776.                 // Sicherheitsbestimmung
  777.                 dc_deletefile(FN); // DeleteFile(FN);
  778.               End;
  779.             End
  780.          Else
  781.             Begin
  782.               MS := TMemoryStream.Create;
  783.               Try
  784.                 ExtractToStream(MS);
  785.                 MS.Position := 0;
  786.                 Result      := FParent.CalculateCRCFromStream(MS) = CRC32;
  787.               Finally
  788.                 MS.Free;
  789.               End;
  790.             End;
  791.        End;
  792.   Except
  793.     Result  := False;
  794.   End;
  795. end;
  796.  
  797. procedure TKAZipEntriesEntry.SetComment(const Value: String);
  798. begin
  799.   FCentralDirectoryFile.FileComment := Value;
  800.   FCentralDirectoryFile.FileCommentLength := Length(FCentralDirectoryFile.FileComment);
  801.   FParent.Rebuild;
  802.   if NOT FParent.FParent.FBatchMode Then
  803.      Begin
  804.        FParent.FParent.DoChange(FParent,4);
  805.      End;
  806. end;
  807.  
  808. procedure TKAZipEntriesEntry.SetFileName(const Value: String);
  809. Var
  810.   FN : String;
  811. begin
  812.   FN := ToZipName(Value);
  813.   if FParent.IndexOf(FN) > -1 Then Raise Exception.Create('File with same name already exists in Archive!');
  814.   FCentralDirectoryFile.FileName         := ToZipName(Value);
  815.   FCentralDirectoryFile.FilenameLength   := Length(FCentralDirectoryFile.FileName);
  816.   if NOT FParent.FParent.FBatchMode Then
  817.      Begin
  818.        FParent.Rebuild;
  819.        FParent.FParent.DoChange(FParent,5);
  820.      End;
  821. end;
  822.  
  823. { TKAZipEntries }
  824. constructor TKAZipEntries.Create(AOwner : TKAZip);
  825. begin
  826.   Inherited Create(TKAZipEntriesEntry);
  827.   FParent    := AOwner;
  828.   FIsZipFile := False;
  829. end;
  830.  
  831. constructor TKAZipEntries.Create(AOwner : TKAZip; MS : TStream);
  832. begin
  833.   Inherited Create(TKAZipEntriesEntry);
  834.   FParent               := AOwner;
  835.   FIsZipFile            := False;
  836.   FLocalHeaderNumFiles  := 0;
  837.   ParseZip(MS);
  838. end;
  839.  
  840. destructor TKAZipEntries.Destroy;
  841. begin
  842.  
  843.   inherited Destroy;
  844. end;
  845.  
  846. function TKAZipEntries.Adler32(adler : uLong; buf : pByte; len : uInt) : uLong;
  847. const
  848.   BASE = uLong(65521);
  849.   NMAX = 3854;
  850. var
  851.   s1, s2 : uLong;
  852.   k      : Integer;
  853. begin
  854.   s1 := adler and $ffff;
  855.   s2 := (adler shr 16) and $ffff;
  856.  
  857.   if not Assigned(buf) then
  858.   begin
  859.     adler32 := uLong(1);
  860.     exit;
  861.   end;
  862.  
  863.   while (len > 0) do
  864.   begin
  865.     if len < NMAX then
  866.       k := len
  867.     else
  868.       k := NMAX;
  869.     Dec(len, k);
  870.     while (k > 0) do
  871.     begin
  872.       Inc(s1, buf^);
  873.       Inc(s2, s1);
  874.       Inc(buf);
  875.       Dec(k);
  876.     end;
  877.     s1 := s1 mod BASE;
  878.     s2 := s2 mod BASE;
  879.   end;
  880.   adler32 := (s2 shl 16) or s1;
  881. end;
  882.  
  883. function TKAZipEntries.CalcCRC32(const UncompressedData : string): Cardinal;
  884. var
  885.   X : Integer;
  886. begin
  887.   Result := $FFFFFFFF;
  888.   for X := 0 to Length(UncompressedData) - 1 do
  889.       Begin
  890.         Result := (Result SHR 8) XOR (CRCTable[Byte(Result) XOR Ord(UncompressedData[X+1])]);
  891.       End;
  892.   Result := Result XOR $FFFFFFFF;
  893. end;
  894.  
  895.  
  896. function TKAZipEntries.CalculateCRCFromStream(Stream: TStream): Cardinal;
  897. var
  898.   Buffer: array[1..8192] of Byte;
  899.   I, ReadCount: Integer;
  900.   TempResult: Longword;
  901. begin
  902.   TempResult := $FFFFFFFF;
  903.   while (Stream.Position <> Stream.Size) do begin
  904.     ReadCount := Stream.Read(Buffer, SizeOf(Buffer));
  905.     for I := 1 to ReadCount do
  906.       TempResult := ((TempResult shr 8) and $FFFFFF) xor CRCTable[(TempResult xor Longword(Buffer[I])) and $FF];
  907.   end;
  908.   Result := not TempResult;
  909. end;
  910.  
  911. Function TKAZipEntries.RemoveRootName(Const FileName, RootName : String):String;
  912. Var
  913.   P : Integer;
  914.   S : String;
  915. Begin
  916.   Result := FileName;
  917.   P      := Pos(AnsiLowerCase(RootName),AnsiLowerCase(FileName));
  918.   if P=1 Then
  919.      Begin
  920.        System.Delete(Result,1,Length(RootName));
  921.        S := Result;
  922.        if (Length(S) > 0) AND (S[1]='\') Then
  923.           Begin
  924.              System.Delete(S,1,1);
  925.              Result := S;
  926.           End;
  927.      End;
  928. End;
  929.  
  930. Procedure TKAZipEntries.SortList(List : TList);
  931. Var
  932.   X        : Integer;
  933.   I1       : Cardinal;
  934.   I2       : Cardinal;
  935.   NoChange : Boolean;
  936. Begin
  937.   if List.Count=1 Then Exit;
  938.   Repeat
  939.     NoChange := True;
  940.     For X := 0 To List.Count-2 Do
  941.       Begin
  942.         I1 := Integer(List.Items[X]);
  943.         I2 := Integer(List.Items[X+1]);
  944.         if I1 > I2 Then
  945.            Begin
  946.              List.Exchange(X,X+1);
  947.              NoChange := False;
  948.            End;
  949.       End;
  950.   Until NoChange;
  951. End;
  952.  
  953.  
  954.  
  955.  
  956. function TKAZipEntries.FileTime2DateTime(FileTime: TFileTime): TDateTime;
  957. var
  958.    LocalFileTime: TFileTime;
  959.    SystemTime: TSystemTime;
  960. begin
  961.    FileTimeToLocalFileTime(FileTime, LocalFileTime) ;
  962.    FileTimeToSystemTime(LocalFileTime, SystemTime) ;
  963.    Result := SystemTimeToDateTime(SystemTime) ;
  964. end;
  965.  
  966. function TKAZipEntries.GetHeaderEntry(Index: Integer): TKAZipEntriesEntry;
  967. begin
  968.   Result := TKAZipEntriesEntry(Inherited Items[Index]);
  969. end;
  970.  
  971. procedure TKAZipEntries.SetHeaderEntry(Index: Integer; const Value: TKAZipEntriesEntry);
  972. begin
  973.   Inherited Items[Index] := TCollectionItem(Value);
  974. end;
  975.  
  976. Function TKAZipEntries.ReadBA(MS: TStream; Sz, Poz:Integer): TBytes;
  977. Begin
  978.   SetLength(Result,SZ);
  979.   MS.Position := Poz;
  980.   MS.Read(Result[0],SZ);
  981. End;
  982.  
  983. function TKAZipEntries.FindCentralDirectory(MS: TStream): Boolean;
  984. Var
  985.   SeekStart : Integer;
  986.   Poz       : Integer;
  987.   BR        : Integer;
  988.   Byte_     : Array[0..3] of Byte;
  989.  
  990. begin
  991.   Result     := False;
  992.   if MS.Size < 22 Then Exit;
  993.   if MS.Size < 256 Then
  994.      SeekStart := MS.Size
  995.   Else
  996.      SeekStart := 256;
  997.   Poz       := MS.Size-22;
  998.   BR        := SeekStart;
  999.   Repeat
  1000.     MS.Position := Poz;
  1001.     MS.Read(Byte_,4);
  1002.     If Byte_[0]=$50 Then
  1003.        Begin
  1004.          if  (Byte_[1]=$4B)
  1005.          And (Byte_[2]=$05)
  1006.          And (Byte_[3]=$06) Then
  1007.              Begin
  1008.                MS.Position                  := Poz;
  1009.                FParent.FEndOfCentralDirPos  := MS.Position;
  1010.                MS.Read(FParent.FEndOfCentralDir,SizeOf(FParent.FEndOfCentralDir));
  1011.                FParent.FZipCommentPos       := MS.Position;
  1012.                FParent.FZipComment.Clear;
  1013.                Result  := True;
  1014.              End
  1015.          Else
  1016.              Begin
  1017.                Dec(Poz,4);
  1018.                Dec(BR ,4);
  1019.              End;
  1020.        End
  1021.     Else
  1022.        Begin
  1023.          Dec(Poz);
  1024.          Dec(BR)
  1025.        End;
  1026.     if BR < 0 Then
  1027.        Begin
  1028.          Case SeekStart of
  1029.                256   : Begin
  1030.                         SeekStart := 1024;
  1031.                         Poz       := MS.Size-(256+22);
  1032.                         BR        := SeekStart;
  1033.                       End;
  1034.               1024  : Begin
  1035.                         SeekStart := 65536;
  1036.                         Poz       := MS.Size-(1024+22);
  1037.                         BR        := SeekStart;
  1038.                       End;
  1039.               65536 : Begin
  1040.                         SeekStart := -1;
  1041.                       End;
  1042.          End;
  1043.        End;
  1044.     if BR < 0              Then SeekStart := -1;
  1045.     if MS.Size < SeekStart Then SeekStart := -1;
  1046.   Until (Result) or (SeekStart=-1);
  1047. end;
  1048.  
  1049.  
  1050. function TKAZipEntries.ParseCentralHeaders(MS: TStream): Boolean;
  1051. Var
  1052.   X                 : Integer;
  1053.   Entry             : TKAZipEntriesEntry;
  1054.   CDFile            : TCentralDirectoryFile;
  1055. begin
  1056.   Result            := False;
  1057.   Try
  1058.     MS.Position     := FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory;
  1059.     For X := 0 To FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk-1 do
  1060.         Begin
  1061.           FillChar(CDFile,SizeOf(TCentralDirectoryFile),0);
  1062.           MS.Read(CDFile,SizeOf(TCentralDirectoryFile)-3*SizeOf(String));
  1063.           Entry                       := TKAZipEntriesEntry.Create(Self);
  1064.           Entry.FDate                 := FileDateToDateTime(CDFile.LastModFileTimeDate);
  1065.           if (CDFile.GeneralPurposeBitFlag And 1) > 0 Then
  1066.               Entry.FIsEncrypted := True
  1067.           Else
  1068.               Entry.FIsEncrypted := False;
  1069.           If CDFile.FilenameLength > 0 Then
  1070.              Begin
  1071.                SetLength(CDFile.FileName,CDFile.FilenameLength);
  1072.                MS.Read(CDFile.FileName[1],   CDFile.FilenameLength)
  1073.              End;
  1074.           If CDFile.ExtraFieldLength > 0 Then
  1075.              Begin
  1076.                SetLength(CDFile.ExtraField,CDFile.ExtraFieldLength);
  1077.                MS.Read(CDFile.ExtraField[1], CDFile.ExtraFieldLength);
  1078.              End;
  1079.           If CDFile.FileCommentLength > 0 Then
  1080.              Begin
  1081.                SetLength(CDFile.FileComment,CDFile.FileCommentLength);
  1082.                MS.Read(CDFile.FileComment[1],CDFile.FileCommentLength);
  1083.              End;
  1084.           Entry.FIsFolder          := (CDFile.ExternalFileAttributes and faDirectory) > 0;
  1085.  
  1086.           Entry.FCompressionType   := ctUnknown;
  1087.           if (CDFile.CompressionMethod=8) or (CDFile.CompressionMethod=9) Then
  1088.              Begin
  1089.                Case CDFile.GeneralPurposeBitFlag AND 6 of
  1090.                     0 : Entry.FCompressionType := ctNormal;
  1091.                     2 : Entry.FCompressionType := ctMaximum;
  1092.                     4 : Entry.FCompressionType := ctFast;
  1093.                     6 : Entry.FCompressionType := ctSuperFast
  1094.                End;
  1095.              End;
  1096.           Entry.FCentralDirectoryFile := CDFile;
  1097.           If Assigned(FParent.FOnZipOpen) Then FParent.FOnZipOpen(FParent,X,FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk);
  1098.         End;
  1099.    Except
  1100.      Exit;
  1101.    End;
  1102.    Result := Count=FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk;
  1103. end;
  1104.  
  1105.  
  1106. procedure TKAZipEntries.ParseZip(MS: TStream);
  1107. begin
  1108.   FIsZipFile := False;
  1109.   Clear;
  1110.   if FindCentralDirectory(MS) Then
  1111.     Begin
  1112.       if ParseCentralHeaders(MS) Then
  1113.          Begin
  1114.            FIsZipFile := True;
  1115.            LoadLocalHeaders(MS);
  1116.          End;
  1117.     End
  1118.   Else
  1119.     Begin
  1120.       if ParseLocalHeaders(MS) Then
  1121.          Begin
  1122.            FIsZipFile := Count > 0;
  1123.            if FIsZipFile Then FParent.FHasBadEntries := True;
  1124.          End;
  1125.     End;
  1126. end;
  1127.  
  1128.  
  1129. function TKAZipEntries.GetLocalEntry(MS: TStream; Offset : Integer; HeaderOnly : Boolean): TLocalFile;
  1130. Var
  1131.   Byte_             : Array[0..4] of Byte;
  1132.   DataDescriptor    : TDataDescriptor;
  1133. begin
  1134.   FillChar(Result,SizeOf(Result),0);
  1135.   MS.Position := Offset;
  1136.   MS.Read(Byte_,4);
  1137.   if  (Byte_[0]  = $50)
  1138.   And (Byte_[1]  = $4B)
  1139.   And (Byte_[2]  = $03)
  1140.   And (Byte_[3]  = $04) Then
  1141.     Begin
  1142.       MS.Position := Offset;
  1143.       MS.Read(Result,SizeOf(Result)-3*SizeOf(AnsiString));
  1144.       if Result.FilenameLength > 0 Then
  1145.          Begin
  1146.            SetLength(Result.FileName,Result.FilenameLength);
  1147.            MS.Read(Result.FileName[1],Result.FilenameLength);
  1148.          End;
  1149.       if Result.ExtraFieldLength > 0 Then
  1150.          Begin
  1151.            SetLength(Result.ExtraField,Result.ExtraFieldLength);
  1152.            MS.Read(Result.ExtraField[1],Result.ExtraFieldLength);
  1153.          End;
  1154.       if (Result.GeneralPurposeBitFlag And (1 SHL 3)) > 0 Then
  1155.          Begin
  1156.            MS.Read(DataDescriptor,SizeOf(TDataDescriptor));
  1157.            Result.Crc32            := DataDescriptor.Crc32;
  1158.            Result.CompressedSize   := DataDescriptor.CompressedSize;
  1159.            Result.UnCompressedSize := DataDescriptor.UnCompressedSize;
  1160.          End;
  1161.       if Not HeaderOnly Then
  1162.          Begin
  1163.            if Result.CompressedSize > 0 Then
  1164.               Begin
  1165.                 SetLength(Result.CompressedData,Result.CompressedSize);
  1166.                 MS.Read(Result.CompressedData[1],Result.CompressedSize);
  1167.               End;
  1168.          End;
  1169.     End
  1170.   Else
  1171.     Begin
  1172.     End;
  1173. end;
  1174.  
  1175. procedure TKAZipEntries.LoadLocalHeaders(MS: TStream);
  1176. Var
  1177.   X : Integer;
  1178. begin
  1179.   FParent.FHasBadEntries := False;
  1180.   For X := 0 To Count-1 do
  1181.       Begin
  1182.         If Assigned(FParent.FOnZipOpen) Then FParent.FOnZipOpen(FParent,X,FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk);
  1183.         Items[X].FLocalFile := GetLocalEntry(MS,Items[X].FCentralDirectoryFile.RelativeOffsetOfLocalHeader,True);
  1184.         if Items[X].FLocalFile.LocalFileHeaderSignature<>$04034b50 Then FParent.FHasBadEntries := True;
  1185.       End;
  1186. end;
  1187.  
  1188. function TKAZipEntries.ParseLocalHeaders(MS: TStream): Boolean;
  1189. Var
  1190.   Poz                 : Integer;
  1191.   NLE                 : Integer;
  1192.   Byte_               : Array[0..4] of Byte;
  1193.   LocalFile           : TLocalFile;
  1194.   DataDescriptor      : TDataDescriptor;
  1195.   Entry               : TKAZipEntriesEntry;
  1196.   CDFile              : TCentralDirectoryFile;
  1197.   CDSize              : Cardinal;
  1198.   L                   : Integer;
  1199.   NoMore              : Boolean;
  1200. begin
  1201.   Result               := False;
  1202.   FLocalHeaderNumFiles := 0;
  1203.   Clear;
  1204.   Try
  1205.       Poz    := 0;
  1206.       NLE    := 0;
  1207.       CDSize := 0;
  1208.       Repeat
  1209.         NoMore      := True;
  1210.         MS.Position := Poz;
  1211.         MS.Read(Byte_,4);
  1212.         if  (Byte_[0]  = $50)
  1213.         And (Byte_[1]  = $4B)
  1214.         And (Byte_[2]  = $03)
  1215.         And (Byte_[3]  = $04) Then
  1216.             Begin
  1217.               Result := True;
  1218.               Inc(FLocalHeaderNumFiles);
  1219.               NoMore      := False;
  1220.               MS.Position := Poz;
  1221.               MS.Read(LocalFile,SizeOf(TLocalFile)-3*SizeOf(String));
  1222.               if LocalFile.FilenameLength > 0 Then
  1223.                  Begin
  1224.                    SetLength(LocalFile.FileName,LocalFile.FilenameLength);
  1225.                    MS.Read(LocalFile.FileName[1],LocalFile.FilenameLength);
  1226.                  End;
  1227.               if LocalFile.ExtraFieldLength > 0 Then
  1228.                  Begin
  1229.                    SetLength(LocalFile.ExtraField,LocalFile.ExtraFieldLength);
  1230.                    MS.Read(LocalFile.ExtraField[1],LocalFile.ExtraFieldLength);
  1231.                  End;
  1232.               if (LocalFile.GeneralPurposeBitFlag And (1 SHL 3)) > 0 Then
  1233.                  Begin
  1234.                    MS.Read(DataDescriptor,SizeOf(TDataDescriptor));
  1235.                    LocalFile.Crc32            := DataDescriptor.Crc32;
  1236.                    LocalFile.CompressedSize   := DataDescriptor.CompressedSize;
  1237.                    LocalFile.UncompressedSize := DataDescriptor.UncompressedSize;
  1238.                  End;
  1239.               MS.Position := MS.Position+LocalFile.CompressedSize;
  1240.  
  1241.               FillChar(CDFile,SizeOf(TCentralDirectoryFile),0);
  1242.               CDFile.CentralFileHeaderSignature     := $02014B50;
  1243.               CDFile.VersionMadeBy                  := 20;
  1244.               CDFile.VersionNeededToExtract         := LocalFile.VersionNeededToExtract;
  1245.               CDFile.GeneralPurposeBitFlag          := LocalFile.GeneralPurposeBitFlag;
  1246.               CDFile.CompressionMethod              := LocalFile.CompressionMethod;
  1247.               CDFile.LastModFileTimeDate            := LocalFile.LastModFileTimeDate;
  1248.               CDFile.Crc32                          := LocalFile.Crc32;
  1249.               CDFile.CompressedSize                 := LocalFile.CompressedSize;
  1250.               CDFile.UncompressedSize               := LocalFile.UncompressedSize;
  1251.               CDFile.FilenameLength                 := LocalFile.FilenameLength;
  1252.               CDFile.ExtraFieldLength               := LocalFile.ExtraFieldLength;
  1253.               CDFile.FileCommentLength              := 0;
  1254.               CDFile.DiskNumberStart                := 0;
  1255.               CDFile.InternalFileAttributes         := LocalFile.VersionNeededToExtract;
  1256.               CDFile.ExternalFileAttributes         := faArchive;
  1257.               CDFile.RelativeOffsetOfLocalHeader    := Poz;
  1258.               CDFile.FileName                       := LocalFile.FileName;
  1259.               L := Length(CDFile.FileName);
  1260.               if L > 0 Then
  1261.                  Begin
  1262.                    if CDFile.FileName[L]='/' Then CDFile.ExternalFileAttributes := faDirectory;
  1263.                  End;
  1264.               CDFile.ExtraField                     := LocalFile.ExtraField;
  1265.               CDFile.FileComment                    := '';
  1266.  
  1267.               Entry                                 := TKAZipEntriesEntry.Create(Self);
  1268.               Entry.FDate                           := FileDateToDateTime(CDFile.LastModFileTimeDate);
  1269.               if (CDFile.GeneralPurposeBitFlag And 1) > 0 Then
  1270.                  Entry.FIsEncrypted    := True
  1271.               Else
  1272.                  Entry.FIsEncrypted    := False;
  1273.               Entry.FIsFolder          := (CDFile.ExternalFileAttributes and faDirectory) > 0;
  1274.               Entry.FCompressionType   := ctUnknown;
  1275.               if (CDFile.CompressionMethod=8) or (CDFile.CompressionMethod=9) Then
  1276.                  Begin
  1277.                    Case CDFile.GeneralPurposeBitFlag AND 6 of
  1278.                         0 : Entry.FCompressionType := ctNormal;
  1279.                         2 : Entry.FCompressionType := ctMaximum;
  1280.                         4 : Entry.FCompressionType := ctFast;
  1281.                         6 : Entry.FCompressionType := ctSuperFast
  1282.                    End;
  1283.                  End;
  1284.               Entry.FCentralDirectoryFile := CDFile;
  1285.               Poz         := MS.Position;
  1286.               Inc(NLE);
  1287.               CDSize      := CDSize+Entry.CentralEntrySize;
  1288.             End;
  1289.       Until NoMore;
  1290.  
  1291.       FParent.FEndOfCentralDir.EndOfCentralDirSignature        := $06054b50;
  1292.       FParent.FEndOfCentralDir.NumberOfThisDisk                := 0;
  1293.       FParent.FEndOfCentralDir.NumberOfTheDiskWithTheStart     := 0;
  1294.       FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk  := NLE;
  1295.       FParent.FEndOfCentralDir.SizeOfTheCentralDirectory       := CDSize;
  1296.       FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory := MS.Position;
  1297.       FParent.FEndOfCentralDir.ZipfileCommentLength            := 0;
  1298.   Except
  1299.     Exit;
  1300.   End;
  1301. end;
  1302.  
  1303. procedure TKAZipEntries.Remove(ItemIndex: Integer; Flush : Boolean);
  1304. Var
  1305.   TempStream          : TFileStream;
  1306.   TempMSStream        : TMemoryStream;
  1307.   TempFileName        : String;
  1308.   BUF                 : String;
  1309.   ZipComment          : String;
  1310.   OSL                 : Cardinal;
  1311.   //*********************************************
  1312.   X                   : Integer;
  1313.   TargetPos           : Cardinal;
  1314.   Border              : Cardinal;
  1315.  
  1316.   //Marschall: NR                  : Integer;
  1317.   //Marschall: NW                  : Integer;
  1318.   BufStart            : Integer;
  1319.   BufLen              : Integer;
  1320.   ShiftSize           : Cardinal;
  1321.   NewSize             : Cardinal;
  1322. begin
  1323.  TargetPos          := Items[ItemIndex].FCentralDirectoryFile.RelativeOffsetOfLocalHeader;
  1324.  ShiftSize          := Items[ItemIndex].LocalEntrySize;
  1325.  BufStart           := TargetPos+ShiftSize;
  1326.  BufLen             := FParent.FZipStream.Size-BufStart;
  1327.  Border             := TargetPos;
  1328.  Delete(ItemIndex);
  1329.  if (FParent.FZipSaveMethod=FastSave) AND (Count > 0) Then
  1330.     Begin
  1331.        ZipComment := FParent.Comment.Text;
  1332.  
  1333.        SetLength(BUF,BufLen);
  1334.        FParent.FZipStream.Position := BufStart;
  1335.        FParent.FZipStream.Read(BUF[1],BufLen); //Marschall: NR := FParent.FZipStream.Read(BUF[1],BufLen);
  1336.        FParent.FZipStream.Position := TargetPos;
  1337.        FParent.FZipStream.Write(BUF[1],BufLen); //Marschall: NW := FParent.FZipStream.Write(BUF[1],BufLen);
  1338.        SetLength(BUF,0);
  1339.  
  1340.        For X := 0 to Count-1 do
  1341.            Begin
  1342.              if Items[X].FCentralDirectoryFile.RelativeOffsetOfLocalHeader > Border Then
  1343.                 Begin
  1344.                   Dec(Items[X].FCentralDirectoryFile.RelativeOffsetOfLocalHeader, ShiftSize);
  1345.                   TargetPos := TargetPos+Items[X].LocalEntrySize;
  1346.                 End
  1347.            End;
  1348.  
  1349.        FParent.FZipStream.Position := TargetPos;
  1350.        //************************************ MARK START OF CENTRAL DIRECTORY
  1351.        FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory := FParent.FZipStream.Position;
  1352.        //************************************ SAVE CENTRAL DIRECTORY
  1353.        For X := 0 To Count-1 do
  1354.            Begin
  1355.              FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile,SizeOf(Self.Items[X].FCentralDirectoryFile)-3*SizeOf(String));
  1356.              if Self.Items[X].FCentralDirectoryFile.FilenameLength > 0 Then
  1357.                 FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile.FileName[1],Self.Items[X].FCentralDirectoryFile.FilenameLength);
  1358.              if Self.Items[X].FCentralDirectoryFile.ExtraFieldLength > 0 Then
  1359.                 FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile.ExtraField[1],Self.Items[X].FCentralDirectoryFile.ExtraFieldLength);
  1360.              if Self.Items[X].FCentralDirectoryFile.FileCommentLength > 0 Then
  1361.                 FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile.FileComment[1],Self.Items[X].FCentralDirectoryFile.FileCommentLength);
  1362.            End;
  1363.      //************************************ SAVE END CENTRAL DIRECTORY RECORD
  1364.      FParent.FEndOfCentralDirPos := FParent.FZipStream.Position;
  1365.      FParent.FEndOfCentralDir.SizeOfTheCentralDirectory := FParent.FEndOfCentralDirPos-FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory;
  1366.      Dec(FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk);
  1367.      Dec(FParent.FEndOfCentralDir.TotalNumberOfEntries);
  1368.      FParent.FZipStream.Write(FParent.FEndOfCentralDir, SizeOf(TEndOfCentralDir));
  1369.      //************************************ SAVE ZIP COMMENT IF ANY
  1370.      FParent.FZipCommentPos := FParent.FZipStream.Position;
  1371.      if Length(ZipComment) > 0 Then
  1372.         Begin
  1373.           FParent.FZipStream.Write(ZipComment[1],Length(ZipComment));
  1374.         End;
  1375.      FParent.FZipStream.Size     := FParent.FZipStream.Position;
  1376.     End
  1377.  Else
  1378.     Begin
  1379.        if FParent.FUseTempFiles Then
  1380.           Begin
  1381.              TempFileName := FParent.GetDelphiTempFileName;
  1382.              TempStream   := TFileStream.Create(TempFileName,fmOpenReadWrite or FmCreate);
  1383.              Try
  1384.                FParent.SaveToStream(TempStream);
  1385.                TempStream.Position := 0;
  1386.                OSL                 := FParent.FZipStream.Size;
  1387.  
  1388.                // Sicherheitsbestimmung
  1389.                ProtectStream(FParent.FZipStream);
  1390.  
  1391.                Try
  1392.                  FParent.FZipStream.Size := TempStream.Size;
  1393.                Except
  1394.                  FParent.FZipStream.Size := OSL;
  1395.                  Raise;
  1396.                End;
  1397.                FParent.FZipStream.Position := 0;
  1398.  
  1399.                FParent.FZipStream.CopyFrom(TempStream,TempStream.Size);
  1400.                //*********************************************************************
  1401.                FParent.FZipHeader.ParseZip(FParent.FZipStream);
  1402.                //*********************************************************************
  1403.              Finally
  1404.                TempStream.Free;
  1405.                // Sicherheitsbestimmung
  1406.                dc_deletefile(tempfilename); // DeleteFile(TempFileName)
  1407.              End;
  1408.           End
  1409.        Else
  1410.           Begin
  1411.             NewSize := 0;
  1412.             For X := 0 To Count-1 do
  1413.                 Begin
  1414.                   NewSize := NewSize+Items[X].LocalEntrySize+Items[X].CentralEntrySize;
  1415.                   if Assigned(FParent.FOnRemoveItems) Then FParent.FOnRemoveItems(FParent,X,Count-1);
  1416.                 End;
  1417.             NewSize := NewSize+SizeOf(FParent.FEndOfCentralDir)+FParent.FEndOfCentralDir.ZipfileCommentLength;
  1418.             TempMSStream := TMemoryStream.Create;
  1419.             Try
  1420.                TempMSStream.SetSize(NewSize);
  1421.                TempMSStream.Position := 0;
  1422.                FParent.SaveToStream(TempMSStream);
  1423.                TempMSStream.Position := 0;
  1424.                OSL                   := FParent.FZipStream.Size;
  1425.  
  1426.                // Sicherheitsbestimmung
  1427.                ProtectStream(FParent.FZipStream);
  1428.  
  1429.                Try
  1430.                  FParent.FZipStream.Size := TempMSStream.Size;
  1431.                Except
  1432.                  FParent.FZipStream.Size := OSL;
  1433.                  Raise;
  1434.                End;
  1435.                FParent.FZipStream.Position := 0;
  1436.  
  1437.                FParent.FZipStream.CopyFrom(TempMSStream,TempMSStream.Size);
  1438.                //*********************************************************************
  1439.                FParent.FZipHeader.ParseZip(FParent.FZipStream);
  1440.                //*********************************************************************
  1441.              Finally
  1442.                TempMSStream.Free;
  1443.              End;
  1444.           End;
  1445.     End;
  1446.  FParent.FIsDirty := True;
  1447.  if NOT FParent.FBatchMode Then
  1448.     Begin
  1449.        FParent.DoChange(FParent,3);
  1450.     End;
  1451. end;
  1452.  
  1453. procedure TKAZipEntries.Remove(ItemIndex: Integer);
  1454. Begin
  1455.   Remove(ItemIndex,True);
  1456. End;
  1457.  
  1458. procedure TKAZipEntries.Remove(Item: TKAZipEntriesEntry);
  1459. Var
  1460.  X : Integer;
  1461. begin
  1462.  For X := 0 To Count-1 do
  1463.      Begin
  1464.        if Self.Items[X]=Item Then
  1465.           Begin
  1466.             Remove(X);
  1467.             Exit;
  1468.           End;
  1469.      End;
  1470. end;
  1471.  
  1472. procedure TKAZipEntries.Remove(FileName: String);
  1473. Var
  1474.   I : Integer;
  1475. begin
  1476.   I := IndexOf(FileName);
  1477.   if I <> -1 Then Remove(I);
  1478. end;
  1479.  
  1480. procedure TKAZipEntries.RemoveBatch(Files:TList);
  1481. Var
  1482.   X             : Integer;
  1483.   OSL           : Integer;
  1484.   NewSize       : Cardinal;
  1485.   TempStream    : TFileStream;
  1486.   TempMSStream  : TMemoryStream;
  1487.   TempFileName  : String;
  1488. Begin
  1489.   For X := Files.Count-1 DownTo 0 do
  1490.       Begin
  1491.         Delete(Integer(Files.Items[X]));
  1492.         if Assigned(FParent.FOnRemoveItems) Then FParent.FOnRemoveItems(FParent,Files.Count-X,Files.Count);
  1493.       End;
  1494.   NewSize := 0;
  1495.   if FParent.FUseTempFiles Then
  1496.       Begin
  1497.          TempFileName := FParent.GetDelphiTempFileName;
  1498.          TempStream   := TFileStream.Create(TempFileName,fmOpenReadWrite or FmCreate);
  1499.          Try
  1500.            FParent.SaveToStream(TempStream);
  1501.            TempStream.Position := 0;
  1502.            OSL                 := FParent.FZipStream.Size;
  1503.  
  1504.            // Sicherheitsbestimmung
  1505.            ProtectStream(FParent.FZipStream);
  1506.  
  1507.            Try
  1508.              FParent.FZipStream.Size := TempStream.Size;
  1509.            Except
  1510.              FParent.FZipStream.Size := OSL;
  1511.              Raise;
  1512.            End;
  1513.            FParent.FZipStream.Position := 0;
  1514.  
  1515.            FParent.FZipStream.CopyFrom(TempStream,TempStream.Size);
  1516.            //*********************************************************************
  1517.            FParent.FZipHeader.ParseZip(FParent.FZipStream);
  1518.            //*********************************************************************
  1519.          Finally
  1520.            TempStream.Free;
  1521.            // Sicherheitsbestimmung
  1522.            dc_deletefile(tempfilename); // DeleteFile(TempFileName)
  1523.          End;
  1524.       End
  1525.    Else
  1526.       Begin
  1527.         For X := 0 To Count-1 do
  1528.             Begin
  1529.               NewSize := NewSize+Items[X].LocalEntrySize+Items[X].CentralEntrySize;
  1530.               if Assigned(FParent.FOnRemoveItems) Then FParent.FOnRemoveItems(FParent,X,Count-1);
  1531.             End;
  1532.         NewSize := NewSize+SizeOf(FParent.FEndOfCentralDir)+FParent.FEndOfCentralDir.ZipfileCommentLength;
  1533.         TempMSStream := TMemoryStream.Create;
  1534.         Try
  1535.            TempMSStream.SetSize(NewSize);
  1536.            TempMSStream.Position := 0;
  1537.            FParent.SaveToStream(TempMSStream);
  1538.            TempMSStream.Position := 0;
  1539.            OSL                   := FParent.FZipStream.Size;
  1540.  
  1541.            // Sicherheitsbestimmung
  1542.            ProtectStream(FParent.FZipStream);
  1543.  
  1544.            Try
  1545.              FParent.FZipStream.Size := TempMSStream.Size;
  1546.            Except
  1547.              FParent.FZipStream.Size := OSL;
  1548.              Raise;
  1549.            End;
  1550.            FParent.FZipStream.Position := 0;
  1551.  
  1552.            FParent.FZipStream.CopyFrom(TempMSStream,TempMSStream.Size);
  1553.            //*********************************************************************
  1554.            FParent.FZipHeader.ParseZip(FParent.FZipStream);
  1555.            //*********************************************************************
  1556.          Finally
  1557.            TempMSStream.Free;
  1558.          End;
  1559.       End;
  1560. End;
  1561.  
  1562. Function TKAZipEntries.IndexOf(Const FileName:String):Integer;
  1563. Var
  1564.   X   : Integer;
  1565.   FN  : String;
  1566. Begin
  1567.   Result := -1;
  1568.   FN     := ToZipName(FileName);
  1569.   For X := 0 To Count-1 do
  1570.       Begin
  1571.         if AnsiCompareText(FN,ToZipName(Items[X].FCentralDirectoryFile.FileName))=0 Then
  1572.            Begin
  1573.              Result := X;
  1574.              Exit;
  1575.            End;
  1576.       End;
  1577. End;
  1578.  
  1579.  
  1580. Function TKAZipEntries.AddStreamFast( ItemName  : String;
  1581.                                       FileAttr  : Word;
  1582.                                       FileDate  : TDateTime;
  1583.                                       Stream    : TStream):TKAZipEntriesEntry;
  1584. Var
  1585.   Compressor   : TCompressionStream;
  1586.   CS           : TStringStream;
  1587.   CM           : WORD;
  1588.   S            : String;
  1589.   X            : Integer;
  1590.   I            : Integer;
  1591.   UL           : Integer;
  1592.   CL           : Integer;
  1593.   FCRC32       : Cardinal;
  1594.   SizeToAppend : Integer;
  1595.   ZipComment   : String;
  1596.   Level        : TCompressionLevel;
  1597.   OBM          : Boolean;
  1598. begin
  1599.   //*********************************** COMPRESS DATA
  1600.   ZipComment              := FParent.Comment.Text;
  1601.  
  1602.   if NOT FParent.FStoreRelativePath Then
  1603.      ItemName             := ExtractFileName(ItemName);
  1604.  
  1605.   ItemName                := ToZipName(ItemName);
  1606.   I   := IndexOf(ItemName);
  1607.   if I > -1 Then
  1608.      Begin
  1609.        OBM := FParent.FBatchMode;
  1610.        Try
  1611.          if OBM=False Then FParent.FBatchMode := True;
  1612.          Remove(I);
  1613.        Finally
  1614.          FParent.FBatchMode := OBM;
  1615.        End;
  1616.      End;
  1617.  
  1618.   CS                      := TStringStream.Create('');
  1619.   CS.Position             := 0;
  1620.   Try
  1621.     UL                    := Stream.Size-Stream.Position;
  1622.     SetLength(S,UL);
  1623.     CM                    := 0;
  1624.     if UL > 0 Then
  1625.        Begin
  1626.          Stream.Read(S[1],UL);
  1627.          CM               := 8;
  1628.        End;
  1629.     FCRC32                := CalcCRC32(S);
  1630.     FParent.FCurrentDFS   := UL;
  1631.  
  1632.  
  1633.     Level                 := clDefault;
  1634.     Case FParent.FZipCompressionType of
  1635.          ctNormal    : Level := clDefault;
  1636.          ctMaximum   : Level := clMax;
  1637.          ctFast      : Level := clFastest;
  1638.          ctSuperFast : Level := clFastest;
  1639.          ctNone      : Level := clNone;
  1640.     End;
  1641.  
  1642.     if CM = 8 Then
  1643.        Begin
  1644.          Compressor            := TCompressionStream.Create(Level,CS);
  1645.          Try
  1646.            Compressor.OnProgress := FParent.OnCompress;
  1647.            Compressor.Write(S[1],UL);
  1648.          Finally
  1649.            Compressor.Free;
  1650.          End;
  1651.          S                     := Copy(CS.DataString, 3, Length(CS.DataString)-6);
  1652.        End;
  1653.   Finally
  1654.     CS.Free;
  1655.   End;
  1656.   //***********************************
  1657.   CL  := Length(S);
  1658.   //*********************************** FILL RECORDS
  1659.   Result := TKAZipEntriesEntry(Self.Add);
  1660.   With Result.FLocalFile do
  1661.     Begin
  1662.       LocalFileHeaderSignature := $04034B50;
  1663.       VersionNeededToExtract   := 20;
  1664.       GeneralPurposeBitFlag    := 0;
  1665.       CompressionMethod        := CM;
  1666.       LastModFileTimeDate      := DateTimeToFileDate(FileDate);
  1667.       Crc32                    := FCRC32;
  1668.       CompressedSize           := CL;
  1669.       UncompressedSize         := UL;
  1670.       FilenameLength           := Length(ItemName);
  1671.       ExtraFieldLength         := 0;
  1672.       FileName                 := ItemName;
  1673.       ExtraField               := '';
  1674.       CompressedData           := '';
  1675.     End;
  1676.  
  1677.  With Result.FCentralDirectoryFile Do
  1678.    Begin
  1679.       CentralFileHeaderSignature     := $02014B50;
  1680.       VersionMadeBy                  := 20;
  1681.       VersionNeededToExtract         := 20;
  1682.       GeneralPurposeBitFlag          := 0;
  1683.       CompressionMethod              := CM;
  1684.       LastModFileTimeDate            := DateTimeToFileDate(FileDate);
  1685.       Crc32                          := FCRC32;
  1686.       CompressedSize                 := CL;
  1687.       UncompressedSize               := UL;
  1688.       FilenameLength                 := Length(ItemName);
  1689.       ExtraFieldLength               := 0;
  1690.       FileCommentLength              := 0;
  1691.       DiskNumberStart                := 0;
  1692.       InternalFileAttributes         := 0;
  1693.       ExternalFileAttributes         := FileAttr;
  1694.       RelativeOffsetOfLocalHeader    := FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory;
  1695.       FileName                       := ItemName;
  1696.       ExtraField                     := '';
  1697.       FileComment                    := '';
  1698.    End;
  1699.  
  1700.  //************************************ EXPAND ZIP STREAM SIZE
  1701.  SizeToAppend := 0;
  1702.  SizeToAppend := SizeToAppend+SizeOf(Result.FLocalFile)-3*SizeOf(String);
  1703.  SizeToAppend := SizeToAppend+Result.FLocalFile.FilenameLength;
  1704.  SizeToAppend := SizeToAppend+CL;
  1705.  SizeToAppend := SizeToAppend+SizeOf(Result.FCentralDirectoryFile)-3*SizeOf(String);
  1706.  SizeToAppend := SizeToAppend+Result.FCentralDirectoryFile.FilenameLength;
  1707.  FParent.FZipStream.Size := FParent.FZipStream.Size+SizeToAppend;
  1708.  
  1709.  //************************************ SAVE LOCAL HEADER AND COMPRESSED DATA
  1710.  FParent.FZipStream.Position := Result.FCentralDirectoryFile.RelativeOffsetOfLocalHeader;
  1711.  FParent.FZipStream.Write(Result.FLocalFile,SizeOf(Result.FLocalFile)-3*SizeOf(String));
  1712.  if Result.FLocalFile.FilenameLength > 0 Then FParent.FZipStream.Write(Result.FLocalFile.FileName[1],Result.FLocalFile.FilenameLength);
  1713.  if CL > 0 Then FParent.FZipStream.Write(S[1],CL);
  1714.  
  1715.  //************************************ MARK START OF CENTRAL DIRECTORY
  1716.  FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory := FParent.FZipStream.Position;
  1717.  
  1718.  //************************************ SAVE CENTRAL DIRECTORY
  1719.  For X := 0 To Count-1 do
  1720.      Begin
  1721.        FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile,SizeOf(Self.Items[X].FCentralDirectoryFile)-3*SizeOf(String));
  1722.        if Self.Items[X].FCentralDirectoryFile.FilenameLength > 0 Then
  1723.           FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile.FileName[1],Self.Items[X].FCentralDirectoryFile.FilenameLength);
  1724.        if Self.Items[X].FCentralDirectoryFile.ExtraFieldLength > 0 Then
  1725.           FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile.ExtraField[1],Self.Items[X].FCentralDirectoryFile.ExtraFieldLength);
  1726.        if Self.Items[X].FCentralDirectoryFile.FileCommentLength > 0 Then
  1727.           FParent.FZipStream.Write(Self.Items[X].FCentralDirectoryFile.FileComment[1],Self.Items[X].FCentralDirectoryFile.FileCommentLength);
  1728.      End;
  1729.  
  1730.  //************************************ SAVE END CENTRAL DIRECTORY RECORD
  1731.  FParent.FEndOfCentralDirPos := FParent.FZipStream.Position;
  1732.  FParent.FEndOfCentralDir.SizeOfTheCentralDirectory := FParent.FEndOfCentralDirPos-FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory;
  1733.  Inc(FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk);
  1734.  Inc(FParent.FEndOfCentralDir.TotalNumberOfEntries);
  1735.  FParent.FZipStream.Write(FParent.FEndOfCentralDir, SizeOf(TEndOfCentralDir));
  1736.  
  1737.  //************************************ SAVE ZIP COMMENT IF ANY
  1738.  FParent.FZipCommentPos := FParent.FZipStream.Position;
  1739.  if Length(ZipComment) > 0 Then
  1740.     Begin
  1741.       FParent.FZipStream.Write(ZipComment[1],Length(ZipComment));
  1742.     End;
  1743.  
  1744.   Result.FDate   := FileDate;
  1745.  
  1746.   if (Result.FCentralDirectoryFile.GeneralPurposeBitFlag And 1) > 0 Then
  1747.       Result.FIsEncrypted := True
  1748.   Else
  1749.       Result.FIsEncrypted := False;
  1750.   Result.FIsFolder          := (Result.FCentralDirectoryFile.ExternalFileAttributes and faDirectory) > 0;
  1751.   Result.FCompressionType   := ctUnknown;
  1752.   if (Result.FCentralDirectoryFile.CompressionMethod=8) or (Result.FCentralDirectoryFile.CompressionMethod=9) Then
  1753.      Begin
  1754.        Case Result.FCentralDirectoryFile.GeneralPurposeBitFlag AND 6 of
  1755.             0 : Result.FCompressionType := ctNormal;
  1756.             2 : Result.FCompressionType := ctMaximum;
  1757.             4 : Result.FCompressionType := ctFast;
  1758.             6 : Result.FCompressionType := ctSuperFast
  1759.        End;
  1760.      End;
  1761.   FParent.FIsDirty := True;
  1762.   if NOT FParent.FBatchMode Then
  1763.     Begin
  1764.       FParent.DoChange(FParent,2);
  1765.     End;
  1766. end;
  1767.  
  1768. Function TKAZipEntries.AddStreamRebuild( ItemName  : String;
  1769.                                          FileAttr  : Word;
  1770.                                          FileDate  : TDateTime;
  1771.                                          Stream    : TStream):TKAZipEntriesEntry;
  1772. Var
  1773.   Compressor   : TCompressionStream;
  1774.   CS           : TStringStream;
  1775.   CM           : Word;
  1776.   S            : String;
  1777.   UL           : Integer;
  1778.   CL           : Integer;
  1779.   I            : Integer;
  1780.   X            : Integer;
  1781.   FCRC32       : Cardinal;
  1782.   OSL          : Cardinal;
  1783.   NewSize      : Cardinal;
  1784.   ZipComment   : String;
  1785.   TempStream   : TFileStream;
  1786.   TempMSStream : TMemoryStream;
  1787.   TempFileName : String;
  1788.   Level        : TCompressionLevel;
  1789.   OBM          : Boolean;
  1790. Begin
  1791.   if FParent.FUseTempFiles Then
  1792.      Begin
  1793.         TempFileName := FParent.GetDelphiTempFileName;
  1794.         TempStream   := TFileStream.Create(TempFileName,fmOpenReadWrite or FmCreate);
  1795.         Try
  1796.             //*********************************** SAVE ALL OLD LOCAL ITEMS
  1797.             FParent.RebuildLocalFiles(TempStream);
  1798.             //*********************************** COMPRESS DATA
  1799.             ZipComment              := FParent.Comment.Text;
  1800.             if NOT FParent.FStoreRelativePath Then
  1801.                ItemName             := ExtractFileName(ItemName);
  1802.             ItemName                := ToZipName(ItemName);
  1803.             I := IndexOf(ItemName);
  1804.             if I > -1 Then
  1805.                Begin
  1806.                  OBM := FParent.FBatchMode;
  1807.                  Try
  1808.                    if OBM=False Then FParent.FBatchMode := True;
  1809.                    Remove(I);
  1810.                  Finally
  1811.                    FParent.FBatchMode := OBM;
  1812.                  End;
  1813.                End;
  1814.  
  1815.             CM                      := 0;
  1816.             CS                      := TStringStream.Create('');
  1817.             CS.Position             := 0;
  1818.             Try
  1819.               UL                    := Stream.Size-Stream.Position;
  1820.               SetLength(S,UL);
  1821.               if UL > 0 Then
  1822.                  Begin
  1823.                    Stream.Read(S[1],UL);
  1824.                    CM               := 8;
  1825.                  End;
  1826.               FCRC32                := CalcCRC32(S);
  1827.               FParent.FCurrentDFS   := UL;
  1828.  
  1829.               Level                 := clDefault;
  1830.               Case FParent.FZipCompressionType of
  1831.                    ctNormal    : Level := clDefault;
  1832.                    ctMaximum   : Level := clMax;
  1833.                    ctFast      : Level := clFastest;
  1834.                    ctSuperFast : Level := clFastest;
  1835.                    ctNone      : Level := clNone;
  1836.               End;
  1837.  
  1838.               if CM=8 Then
  1839.                  Begin
  1840.                     Compressor            := TCompressionStream.Create(Level,CS);
  1841.                     Try
  1842.                        Compressor.OnProgress := FParent.OnCompress;
  1843.                        Compressor.Write(S[1],UL);
  1844.                     Finally
  1845.                        Compressor.Free;
  1846.                     End;
  1847.                     S                     := Copy(CS.DataString, 3, Length(CS.DataString)-6);
  1848.                  End;
  1849.             Finally
  1850.               CS.Free;
  1851.             End;
  1852.             //************************************************************************
  1853.             CL := Length(S);
  1854.             //*********************************** FILL RECORDS
  1855.             Result := TKAZipEntriesEntry(Self.Add);
  1856.             With Result.FLocalFile do
  1857.               Begin
  1858.                 LocalFileHeaderSignature := $04034B50;
  1859.                 VersionNeededToExtract   := 20;
  1860.                 GeneralPurposeBitFlag    := 0;
  1861.                 CompressionMethod        := CM;
  1862.                 LastModFileTimeDate      := DateTimeToFileDate(FileDate);
  1863.                 Crc32                    := FCRC32;
  1864.                 CompressedSize           := CL;
  1865.                 UncompressedSize         := UL;
  1866.                 FilenameLength           := Length(ItemName);
  1867.                 ExtraFieldLength         := 0;
  1868.                 FileName                 := ItemName;
  1869.                 ExtraField               := '';
  1870.                 CompressedData           := '';
  1871.               End;
  1872.  
  1873.             With Result.FCentralDirectoryFile Do
  1874.              Begin
  1875.                 CentralFileHeaderSignature     := $02014B50;
  1876.                 VersionMadeBy                  := 20;
  1877.                 VersionNeededToExtract         := 20;
  1878.                 GeneralPurposeBitFlag          := 0;
  1879.                 CompressionMethod              := CM;
  1880.                 LastModFileTimeDate            := DateTimeToFileDate(FileDate);
  1881.                 Crc32                          := FCRC32;
  1882.                 CompressedSize                 := CL;
  1883.                 UncompressedSize               := UL;
  1884.                 FilenameLength                 := Length(ItemName);
  1885.                 ExtraFieldLength               := 0;
  1886.                 FileCommentLength              := 0;
  1887.                 DiskNumberStart                := 0;
  1888.                 InternalFileAttributes         := 0;
  1889.                 ExternalFileAttributes         := FileAttr;
  1890.                 RelativeOffsetOfLocalHeader    := TempStream.Position;
  1891.                 FileName                       := ItemName;
  1892.                 ExtraField                     := '';
  1893.                 FileComment                    := '';
  1894.              End;
  1895.  
  1896.            //************************************ SAVE LOCAL HEADER AND COMPRESSED DATA
  1897.            TempStream.Write(Result.FLocalFile,SizeOf(Result.FLocalFile)-3*SizeOf(String));
  1898.            if Result.FLocalFile.FilenameLength > 0 Then TempStream.Write(Result.FLocalFile.FileName[1],Result.FLocalFile.FilenameLength);
  1899.            if CL > 0 Then TempStream.Write(S[1],CL);
  1900.            //************************************
  1901.            FParent.NewLHOffsets[Count-1] := Result.FCentralDirectoryFile.RelativeOffsetOfLocalHeader;
  1902.            FParent.RebuildCentralDirectory(TempStream);
  1903.            FParent.RebuildEndOfCentralDirectory(TempStream);
  1904.            //************************************
  1905.            TempStream.Position := 0;
  1906.            OSL                 := FParent.FZipStream.Size;
  1907.  
  1908.            // Sicherheitsbestimmung
  1909.            ProtectStream(FParent.FZipStream);
  1910.  
  1911.            Try
  1912.              FParent.FZipStream.Size := TempStream.Size;
  1913.            Except
  1914.              FParent.FZipStream.Size := OSL;
  1915.              Raise;
  1916.            End;
  1917.            FParent.FZipStream.Position := 0;
  1918.  
  1919.            FParent.FZipStream.CopyFrom(TempStream,TempStream.Size);
  1920.        Finally
  1921.          TempStream.Free;
  1922.          // Sicherheitsbestimmung
  1923.          dc_deletefile(tempfilename); // DeleteFile(TempFileName)
  1924.        End;
  1925.      End
  1926.   Else
  1927.      Begin
  1928.         TempMSStream := TMemoryStream.Create;
  1929.         NewSize := 0;
  1930.         For X := 0 To Count-1 do
  1931.             Begin
  1932.               NewSize := NewSize+Items[X].LocalEntrySize+Items[X].CentralEntrySize;
  1933.               if Assigned(FParent.FOnRemoveItems) Then FParent.FOnRemoveItems(FParent,X,Count-1);
  1934.             End;
  1935.         NewSize := NewSize+SizeOf(FParent.FEndOfCentralDir)+FParent.FEndOfCentralDir.ZipfileCommentLength;
  1936.         Try
  1937.             TempMSStream.SetSize(NewSize);
  1938.             TempMSStream.Position := 0;
  1939.             //*********************************** SAVE ALL OLD LOCAL ITEMS
  1940.             FParent.RebuildLocalFiles(TempMSStream);
  1941.             //*********************************** COMPRESS DATA
  1942.             ZipComment              := FParent.Comment.Text;
  1943.             if NOT FParent.FStoreRelativePath Then
  1944.                ItemName             := ExtractFileName(ItemName);
  1945.             ItemName                := ToZipName(ItemName);
  1946.             I := IndexOf(ItemName);
  1947.             if I > -1 Then
  1948.                Begin
  1949.                  OBM := FParent.FBatchMode;
  1950.                  Try
  1951.                    if OBM=False Then FParent.FBatchMode := True;
  1952.                    Remove(I);
  1953.                  Finally
  1954.                    FParent.FBatchMode := OBM;
  1955.                  End;
  1956.                End;
  1957.  
  1958.             CM                      := 0;
  1959.             CS                      := TStringStream.Create('');
  1960.             CS.Position             := 0;
  1961.             Try
  1962.               UL                    := Stream.Size-Stream.Position;
  1963.               SetLength(S,UL);
  1964.               if UL > 0 Then
  1965.                  Begin
  1966.                    Stream.Read(S[1],UL);
  1967.                    CM               := 8;
  1968.                  End;
  1969.               FCRC32                := CalcCRC32(S);
  1970.               FParent.FCurrentDFS   := UL;
  1971.  
  1972.               Level                 := clDefault;
  1973.               Case FParent.FZipCompressionType of
  1974.                    ctNormal    : Level := clDefault;
  1975.                    ctMaximum   : Level := clMax;
  1976.                    ctFast      : Level := clFastest;
  1977.                    ctSuperFast : Level := clFastest;
  1978.                    ctNone      : Level := clNone;
  1979.               End;
  1980.  
  1981.               if CM=8 Then
  1982.                  Begin
  1983.                     Compressor            := TCompressionStream.Create(Level,CS);
  1984.                     Try
  1985.                        Compressor.OnProgress := FParent.OnCompress;
  1986.                        Compressor.Write(S[1],UL);
  1987.                     Finally
  1988.                        Compressor.Free;
  1989.                     End;
  1990.                     S                     := Copy(CS.DataString, 3, Length(CS.DataString)-6);
  1991.                  End;
  1992.             Finally
  1993.               CS.Free;
  1994.             End;
  1995.             //************************************************************************
  1996.             CL := Length(S);
  1997.             //*********************************** FILL RECORDS
  1998.             Result := TKAZipEntriesEntry(Self.Add);
  1999.             With Result.FLocalFile do
  2000.               Begin
  2001.                 LocalFileHeaderSignature := $04034B50;
  2002.                 VersionNeededToExtract   := 20;
  2003.                 GeneralPurposeBitFlag    := 0;
  2004.                 CompressionMethod        := CM;
  2005.                 LastModFileTimeDate      := DateTimeToFileDate(FileDate);
  2006.                 Crc32                    := FCRC32;
  2007.                 CompressedSize           := CL;
  2008.                 UncompressedSize         := UL;
  2009.                 FilenameLength           := Length(ItemName);
  2010.                 ExtraFieldLength         := 0;
  2011.                 FileName                 := ItemName;
  2012.                 ExtraField               := '';
  2013.                 CompressedData           := '';
  2014.               End;
  2015.  
  2016.             With Result.FCentralDirectoryFile Do
  2017.              Begin
  2018.                 CentralFileHeaderSignature     := $02014B50;
  2019.                 VersionMadeBy                  := 20;
  2020.                 VersionNeededToExtract         := 20;
  2021.                 GeneralPurposeBitFlag          := 0;
  2022.                 CompressionMethod              := CM;
  2023.                 LastModFileTimeDate            := DateTimeToFileDate(FileDate);
  2024.                 Crc32                          := FCRC32;
  2025.                 CompressedSize                 := CL;
  2026.                 UncompressedSize               := UL;
  2027.                 FilenameLength                 := Length(ItemName);
  2028.                 ExtraFieldLength               := 0;
  2029.                 FileCommentLength              := 0;
  2030.                 DiskNumberStart                := 0;
  2031.                 InternalFileAttributes         := 0;
  2032.                 ExternalFileAttributes         := FileAttr;
  2033.                 RelativeOffsetOfLocalHeader    := TempMSStream.Position;
  2034.                 FileName                       := ItemName;
  2035.                 ExtraField                     := '';
  2036.                 FileComment                    := '';
  2037.              End;
  2038.  
  2039.            //************************************ SAVE LOCAL HEADER AND COMPRESSED DATA
  2040.            TempMSStream.Write(Result.FLocalFile,SizeOf(Result.FLocalFile)-3*SizeOf(String));
  2041.            if Result.FLocalFile.FilenameLength > 0 Then TempMSStream.Write(Result.FLocalFile.FileName[1],Result.FLocalFile.FilenameLength);
  2042.            if CL > 0 Then TempMSStream.Write(S[1],CL);
  2043.            //************************************
  2044.            FParent.NewLHOffsets[Count-1] := Result.FCentralDirectoryFile.RelativeOffsetOfLocalHeader;
  2045.            FParent.RebuildCentralDirectory(TempMSStream);
  2046.            FParent.RebuildEndOfCentralDirectory(TempMSStream);
  2047.            //************************************
  2048.            TempMSStream.Position := 0;
  2049.            OSL                 := FParent.FZipStream.Size;
  2050.  
  2051.            // Sicherheitsbestimmung
  2052.            ProtectStream(FParent.FZipStream);
  2053.  
  2054.            Try
  2055.              FParent.FZipStream.Size := TempMSStream.Size;
  2056.            Except
  2057.              FParent.FZipStream.Size := OSL;
  2058.              Raise;
  2059.            End;
  2060.            FParent.FZipStream.Position := 0;
  2061.  
  2062.            FParent.FZipStream.CopyFrom(TempMSStream,TempMSStream.Size);
  2063.        Finally
  2064.          TempMSStream.Free;
  2065.        End;
  2066.      End;
  2067.  
  2068.   Result.FDate              := FileDateToDateTime(Result.FCentralDirectoryFile.LastModFileTimeDate);
  2069.   if (Result.FCentralDirectoryFile.GeneralPurposeBitFlag And 1) > 0 Then
  2070.       Result.FIsEncrypted := True
  2071.   Else
  2072.       Result.FIsEncrypted := False;
  2073.   Result.FIsFolder          := (Result.FCentralDirectoryFile.ExternalFileAttributes and faDirectory) > 0;
  2074.   Result.FCompressionType   := ctUnknown;
  2075.   if (Result.FCentralDirectoryFile.CompressionMethod=8) or (Result.FCentralDirectoryFile.CompressionMethod=9) Then
  2076.      Begin
  2077.        Case Result.FCentralDirectoryFile.GeneralPurposeBitFlag AND 6 of
  2078.             0 : Result.FCompressionType := ctNormal;
  2079.             2 : Result.FCompressionType := ctMaximum;
  2080.             4 : Result.FCompressionType := ctFast;
  2081.             6 : Result.FCompressionType := ctSuperFast
  2082.        End;
  2083.      End;
  2084.  FParent.FIsDirty := True;
  2085.  if NOT FParent.FBatchMode Then
  2086.     Begin
  2087.       FParent.DoChange(FParent,2);
  2088.     End;
  2089. End;
  2090.  
  2091. function TKAZipEntries.AddFolderChain(ItemName: String; FileAttr: Word;
  2092.   FileDate: TDateTime): Boolean;
  2093. Var
  2094.  FN     : String;
  2095.  TN     : String;
  2096.  INCN   : String;
  2097.  P      : Integer;
  2098.  MS     : TMemoryStream;
  2099.  NoMore : Boolean;
  2100. Begin
  2101.   //Marschall: Result := False;
  2102.   FN     := ExtractFilePath(ToDosName(ToZipName(ItemName)));
  2103.   TN     := FN;
  2104.   INCN   := '';
  2105.   MS     := TMemoryStream.Create;
  2106.   Try
  2107.     Repeat
  2108.       NoMore := True;
  2109.       P      := Pos('\',TN);
  2110.       if P > 0 Then
  2111.          Begin
  2112.             INCN        := INCN+Copy(TN,1,P);
  2113.             System.Delete(TN,1,P);
  2114.             MS.Position := 0;
  2115.             MS.Size     := 0;
  2116.             If IndexOf(INCN) = -1 Then
  2117.                Begin
  2118.                   if FParent.FZipSaveMethod = FastSave Then
  2119.                      AddStreamFast(INCN,FileAttr,FileDate,MS)
  2120.                   Else
  2121.                   if FParent.FZipSaveMethod = RebuildAll Then
  2122.                      AddStreamRebuild(INCN,FileAttr,FileDate,MS);
  2123.                End;
  2124.             NoMore := False;
  2125.          End;
  2126.     Until NoMore;
  2127.     Result := True;
  2128.   Finally
  2129.     MS.Free;
  2130.   End;
  2131. End;
  2132.  
  2133. Function TKAZipEntries.AddFolderChain(ItemName : String):Boolean;
  2134. begin
  2135.   Result := AddFolderChain(ItemName,faDirectory,Now);
  2136. end;
  2137.  
  2138. function TKAZipEntries.AddStream(FileName : String; FileAttr : Word; FileDate : TDateTime; Stream : TStream):TKAZipEntriesEntry;
  2139. Begin
  2140.   Result := Nil;
  2141.   if (FParent.FStoreFolders) AND (FParent.FStoreRelativePath) Then AddFolderChain(FileName);
  2142.   if FParent.FZipSaveMethod = FastSave Then
  2143.      Result := AddStreamFast(FileName,FileAttr,FileDate,Stream)
  2144.   Else
  2145.   if FParent.FZipSaveMethod = RebuildAll Then
  2146.      Result := AddStreamRebuild(FileName,FileAttr,FileDate,Stream);
  2147.   if Assigned(FParent.FOnAddItem) Then FParent.FOnAddItem(FParent,FileName);
  2148. End;
  2149.  
  2150. Function TKAZipEntries.AddStream(FileName: String; Stream : TStream):TKAZipEntriesEntry;
  2151. begin
  2152.   Result := AddStream(FileName,faArchive,Now,Stream);
  2153. end;
  2154.  
  2155. Function TKAZipEntries.AddFile(FileName, NewFileName: String):TKAZipEntriesEntry;
  2156. Var
  2157.  FS  : TFileStream;
  2158.  Dir : TSearchRec;
  2159.  Res : Integer;
  2160. begin
  2161.  Result := Nil;
  2162.  Res    := FindFirst(FileName,faAnyFile,Dir);
  2163.  if Res=0 Then
  2164.     Begin
  2165.       FS := TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone);
  2166.       Try
  2167.         FS.Position := 0;
  2168.         Result := AddStream(NewFileName,Dir.Attr,FileDateToDateTime(Dir.Time),FS)
  2169.       Finally
  2170.         FS.Free;
  2171.       End;
  2172.     End;
  2173.  FindClose(Dir);
  2174. end;
  2175.  
  2176. Function TKAZipEntries.AddFile(FileName: String):TKAZipEntriesEntry;
  2177. begin
  2178.   Result := AddFile(FileName,FileName);
  2179. end;
  2180.  
  2181. function TKAZipEntries.AddFiles(FileNames: TStrings): Boolean;
  2182. Var
  2183.   X : Integer;
  2184. begin
  2185.   Result     := False;
  2186.   FParent.FBatchMode := True;
  2187.   Try
  2188.     For X := 0 To FileNames.Count-1 do AddFile(FileNames.Strings[X]);
  2189.   Except
  2190.     FParent.FBatchMode := False;
  2191.     FParent.DoChange(FParent,2);
  2192.     Exit;
  2193.   End;
  2194.   FParent.FBatchMode := False;
  2195.   FParent.DoChange(FParent,2);
  2196.   Result     := True;
  2197. end;
  2198.  
  2199. Function  TKAZipEntries.AddFolderEx(FolderName:String; RootFolder:String; WildCard : String; WithSubFolders : Boolean):Boolean;
  2200. Var
  2201.   Res : Integer;
  2202.   Dir : TSearchRec;
  2203.   FN  : String;
  2204. Begin
  2205.   Res := FindFirst(FolderName+'\*.*',faAnyFile,Dir);
  2206.   While Res=0 Do
  2207.      Begin
  2208.         if (Dir.Attr and faDirectory) > 0 Then
  2209.             Begin
  2210.               if (Dir.Name <> '..') And (Dir.Name <> '.') Then
  2211.                  Begin
  2212.                    FN := FolderName+'\'+Dir.Name;
  2213.                    if (FParent.FStoreFolders) AND (FParent.FStoreRelativePath) Then
  2214.                       AddFolderChain(RemoveRootName(FN+'\',RootFolder),Dir.Attr,FileDateToDateTime(Dir.Time));
  2215.                    if WithSubFolders Then
  2216.                       Begin
  2217.                         AddFolderEx(FN, RootFolder, WildCard, WithSubFolders);
  2218.                       End;
  2219.                  End
  2220.               Else
  2221.                  Begin
  2222.                    if (Dir.Name = '.') Then AddFolderChain(RemoveRootName(FolderName+'\',RootFolder),Dir.Attr,FileDateToDateTime(Dir.Time));
  2223.                  End;
  2224.             End
  2225.         Else
  2226.             Begin
  2227.               FN := FolderName+'\'+Dir.Name;
  2228.               if MatchesMask(FN,WildCard) Then
  2229.                  Begin
  2230.                    AddFile(FN,RemoveRootName(FN,RootFolder));
  2231.                  End;
  2232.             End;
  2233.         Res := FindNext(Dir);
  2234.      End;
  2235.   FindClose(Dir);
  2236.   Result := True;
  2237. End;
  2238.  
  2239. Function  TKAZipEntries.AddFolder(FolderName:String; RootFolder:String; WildCard : String; WithSubFolders : Boolean):Boolean;
  2240. Begin
  2241.   FParent.FBatchMode := True;
  2242.   Try
  2243.     Result := AddFolderEx(FolderName,RootFolder,WildCard,WithSubFolders);
  2244.   Finally
  2245.     FParent.FBatchMode := False;
  2246.     FParent.DoChange(FParent,2);
  2247.   End;
  2248. End;
  2249.  
  2250. Function TKAZipEntries.AddFilesAndFolders(FileNames:TStrings; RootFolder:String; WithSubFolders : Boolean):Boolean;
  2251. Var
  2252.   X   : Integer;
  2253.   Res : Integer;
  2254.   Dir : TSearchRec;
  2255. Begin
  2256.   FParent.FBatchMode := True;
  2257.   Try
  2258.     For X := 0 To FileNames.Count-1 do
  2259.         Begin
  2260.            Res := FindFirst(FileNames.Strings[X],faAnyFile,Dir);
  2261.            if Res=0 Then
  2262.               Begin
  2263.                 if (Dir.Attr and faDirectory) > 0 Then
  2264.                    Begin
  2265.                      if (Dir.Name <> '..') And (Dir.Name <> '.') Then
  2266.                         Begin
  2267.                           AddFolderEx(FileNames.Strings[X],RootFolder,'*.*',WithSubFolders);
  2268.                         End;  
  2269.                    End
  2270.                 Else
  2271.                    Begin
  2272.                      AddFile(FileNames.Strings[X],RemoveRootName(FileNames.Strings[X],RootFolder));
  2273.                    End;
  2274.               End;
  2275.            FindClose(Dir);
  2276.         End;
  2277.   Finally
  2278.     FParent.FBatchMode := False;
  2279.     FParent.DoChange(FParent,2);
  2280.   End;
  2281.   Result := True;
  2282. End;
  2283.  
  2284.  
  2285. procedure TKAZipEntries.RemoveFiles(List: TList);
  2286. begin
  2287.   if List.Count=1 Then
  2288.      Begin
  2289.        Remove(Integer(List.Items[0]));
  2290.      End
  2291.   Else
  2292.      Begin
  2293.        SortList(List);
  2294.        FParent.FBatchMode := True;
  2295.        Try
  2296.          RemoveBatch(List);
  2297.        Finally
  2298.          FParent.FBatchMode := False;
  2299.          FParent.DoChange(Self,3);
  2300.        End;
  2301.      End;
  2302. end;
  2303.  
  2304. Procedure TKAZipEntries.RemoveSelected;
  2305. Var
  2306.  X    : Integer;
  2307.  List : TList;
  2308. Begin
  2309.  FParent.FBatchMode := True;
  2310.  List               := TList.Create;
  2311.  Try
  2312.     For X := 0 to Count-1 do
  2313.        Begin
  2314.          if Self.Items[X].Selected Then List.Add(Pointer(X));
  2315.        End;
  2316.     RemoveBatch(List);
  2317.  Finally
  2318.    List.Free;
  2319.    FParent.FBatchMode := False;
  2320.    FParent.DoChange(Self,3);
  2321.  End;
  2322. End;
  2323.  
  2324.  
  2325. procedure TKAZipEntries.ExtractToStream(Item : TKAZipEntriesEntry; Stream: TStream);
  2326. Var
  2327.   SFS             : TMemoryStream;
  2328.   TFS             : TStream;
  2329.   BUF             : String;
  2330.   NR              : Cardinal;
  2331.   Decompressor    : TDecompressionStream;
  2332.   {$IFDEF USE_BZIP2}
  2333.   DecompressorBZ2 : TBZDecompressionStream;
  2334.   {$ENDIF}
  2335. begin
  2336.   if  (
  2337.        (Item.CompressionMethod=8) or
  2338.        {$IFDEF USE_BZIP2}
  2339.        (Item.CompressionMethod=12) or
  2340.        {$ENDIF}
  2341.        (Item.CompressionMethod=0)
  2342.        )
  2343.   And (NOT Item.FIsEncrypted) Then
  2344.      Begin
  2345.         SFS := TMemoryStream.Create;
  2346.         TFS := Stream;
  2347.         Try
  2348.           if Item.GetCompressedData(SFS) > 0 Then
  2349.              Begin
  2350.                 SFS.Position  := 0;
  2351.                 FParent.FCurrentDFS   := Item.SizeUncompressed;
  2352.                 //****************************************************** DEFLATE
  2353.                 if (Item.CompressionMethod=8) Then
  2354.                    Begin
  2355.                       Decompressor  := TDecompressionStream.Create(SFS);
  2356.                       Decompressor.OnProgress := FParent.OnDecompress;
  2357.                       SetLength(BUF,FParent.FCurrentDFS);
  2358.                       Try
  2359.                         NR := Decompressor.Read(BUF[1],FParent.FCurrentDFS);
  2360.                         if NR=FParent.FCurrentDFS Then TFS.Write(BUF[1],FParent.FCurrentDFS);
  2361.                       Finally
  2362.                         Decompressor.Free;
  2363.                       End;
  2364.                    End
  2365.                 //******************************************************* BZIP2
  2366.                 {$IFDEF USE_BZIP2}
  2367.                 Else
  2368.                 If Item.CompressionMethod=12 Then
  2369.                    Begin
  2370.                       DecompressorBZ2  := TBZDecompressionStream.Create(SFS);
  2371.                       DecompressorBZ2.OnProgress := FParent.OnDecompress;
  2372.                       SetLength(BUF,FParent.FCurrentDFS);
  2373.                       Try
  2374.                         NR := DecompressorBZ2.Read(BUF[1],FParent.FCurrentDFS);
  2375.                         if NR=FParent.FCurrentDFS Then TFS.Write(BUF[1],FParent.FCurrentDFS);
  2376.                       Finally
  2377.                         DecompressorBZ2.Free;
  2378.                       End;
  2379.                    End
  2380.                 {$ENDIF}
  2381.                 //****************************************************** STORED
  2382.                 Else
  2383.                 If Item.CompressionMethod=0 Then
  2384.                    Begin
  2385.                      TFS.CopyFrom(SFS,FParent.FCurrentDFS);
  2386.                    End;
  2387.              End;
  2388.         Finally
  2389.           SFS.Free;
  2390.         End;
  2391.      End
  2392.   Else
  2393.      Begin
  2394.        Raise Exception.Create('Cannot process this file: '+Item.FileName+' ');
  2395.      End;
  2396. end;
  2397.  
  2398. procedure TKAZipEntries.InternalExtractToFile(Item: TKAZipEntriesEntry;
  2399.   FileName: String);
  2400. Var
  2401.   TFS           : TFileStream;
  2402.   Attr          : Integer;
  2403. begin
  2404.   if Item.IsFolder Then
  2405.      Begin
  2406.        ForceDirectories(FileName);
  2407.      End
  2408.   Else
  2409.      Begin
  2410.         TFS := TFileStream.Create(FileName,fmCreate or fmOpenReadWrite or fmShareDenyNone);
  2411.         Try
  2412.           ExtractToStream(Item,TFS);
  2413.         Finally
  2414.           TFS.Free;
  2415.         End;
  2416.         If FParent.FApplyAttributes Then
  2417.            Begin
  2418.              Attr := faArchive;
  2419.              if Item.FCentralDirectoryFile.ExternalFileAttributes And faHidden   > 0 Then Attr := Attr Or faHidden;
  2420.              if Item.FCentralDirectoryFile.ExternalFileAttributes And faSysFile  > 0 Then Attr := Attr Or faSysFile;
  2421.              if Item.FCentralDirectoryFile.ExternalFileAttributes And faReadOnly > 0 Then Attr := Attr Or faReadOnly;
  2422.              FileSetAttr(FileName,Attr);
  2423.            End;
  2424.      End;
  2425. end;
  2426.  
  2427.  
  2428. procedure TKAZipEntries.ExtractToFile(Item: TKAZipEntriesEntry; FileName: String);
  2429. var
  2430.   Can : Boolean;
  2431.   OA  : TOverwriteAction;
  2432. Begin
  2433.   OA  := FParent.FOverwriteAction;
  2434.   Can := True;
  2435.   if ((OA<>oaOverwriteAll) And (OA<>oaSkipAll)) And (Assigned(FParent.FOnOverwriteFile)) Then
  2436.    Begin
  2437.       if FileExists(FileName) Then
  2438.          Begin
  2439.            FParent.FOnOverwriteFile(FParent,FileName,OA);
  2440.          End
  2441.       Else
  2442.          Begin
  2443.            OA := oaOverwrite;
  2444.          End;
  2445.    End;
  2446.    Case OA Of
  2447.      oaSkip          : Can := False;
  2448.      oaSkipAll       : Can := False;
  2449.      oaOverwrite     : Can := True;
  2450.      oaOverwriteAll  : Can := True;
  2451.    End;
  2452.    if Can Then InternalExtractToFile(Item, FileName);
  2453. End;
  2454.  
  2455. procedure TKAZipEntries.ExtractToFile(ItemIndex: Integer; FileName: String);
  2456. var
  2457.   Can       : Boolean;
  2458.   OA        : TOverwriteAction;                                                    
  2459. Begin
  2460.   OA  := FParent.FOverwriteAction;
  2461.   Can := True;
  2462.   if ((OA<>oaOverwriteAll) And (OA<>oaSkipAll)) And (Assigned(FParent.FOnOverwriteFile)) Then
  2463.    Begin
  2464.       if FileExists(FileName) Then
  2465.          Begin
  2466.            FParent.FOnOverwriteFile(FParent,FileName,OA);
  2467.          End
  2468.       Else
  2469.          Begin
  2470.            OA := oaOverwrite;
  2471.          End;
  2472.    End;
  2473.    Case OA Of
  2474.      oaSkip          : Can := False;
  2475.      oaSkipAll       : Can := False;
  2476.      oaOverwrite     : Can := True;
  2477.      oaOverwriteAll  : Can := True;
  2478.    End;
  2479.    if Can Then InternalExtractToFile(Items[ItemIndex],FileName);
  2480. end;
  2481.  
  2482. procedure TKAZipEntries.ExtractToFile(FileName, DestinationFileName: String);
  2483. Var
  2484.   I   : Integer;
  2485.   Can : Boolean;
  2486.   OA  : TOverwriteAction;
  2487. Begin
  2488.   OA  := FParent.FOverwriteAction;
  2489.   Can := True;
  2490.   if ((OA<>oaOverwriteAll) And (OA<>oaSkipAll)) And (Assigned(FParent.FOnOverwriteFile)) Then
  2491.    Begin
  2492.       if FileExists(DestinationFileName) Then
  2493.          Begin
  2494.            FParent.FOnOverwriteFile(FParent,DestinationFileName,OA);
  2495.          End
  2496.       Else
  2497.          Begin
  2498.            OA := oaOverwrite;
  2499.          End;
  2500.    End;
  2501.    Case OA Of
  2502.      oaSkip          : Can := False;
  2503.      oaSkipAll       : Can := False;
  2504.      oaOverwrite     : Can := True;
  2505.      oaOverwriteAll  : Can := True;
  2506.    End;
  2507.    if Can Then
  2508.       Begin
  2509.         I := IndexOf(FileName);
  2510.         InternalExtractToFile(Items[I],DestinationFileName);
  2511.       End;
  2512. end;
  2513.  
  2514. procedure TKAZipEntries.ExtractAll(TargetDirectory: String);
  2515. Var
  2516.   FN        : String;
  2517.   DN        : String;
  2518.   X         : Integer;
  2519.   Can       : Boolean;
  2520.   OA        : TOverwriteAction;
  2521.   FileName  : String;
  2522. begin
  2523.   OA    := FParent.FOverwriteAction;
  2524.   Can   := True;
  2525.   Try
  2526.     For X := 0 To Count-1 do
  2527.         Begin
  2528.           FN := FParent.GetFileName(Items[X].FileName);
  2529.           DN := FParent.GetFilePath(Items[X].FileName);
  2530.           if DN <> '' Then ForceDirectories(TargetDirectory+'\'+DN);
  2531.           FileName := TargetDirectory+'\'+DN+FN;
  2532.           if ((OA<>oaOverwriteAll) And (OA<>oaSkipAll)) And (Assigned(FParent.FOnOverwriteFile)) Then
  2533.              Begin
  2534.                 if FileExists(FileName) Then
  2535.                    Begin
  2536.                      FParent.FOnOverwriteFile(FParent,FileName,OA);
  2537.                    End;
  2538.              End;
  2539.           Case OA Of
  2540.             oaSkip          : Can := False;
  2541.             oaSkipAll       : Can := False;
  2542.             oaOverwrite     : Can := True;
  2543.             oaOverwriteAll  : Can := True;
  2544.           End;
  2545.           if Can Then InternalExtractToFile(Items[X],FileName);
  2546.         End;
  2547.   Finally
  2548.   End;
  2549. end;
  2550.  
  2551. procedure TKAZipEntries.ExtractSelected(TargetDirectory: String);
  2552. Var
  2553.   FN        : String;
  2554.   DN        : String;
  2555.   X         : Integer;
  2556.   OA        : TOverwriteAction;
  2557.   Can       : Boolean;
  2558.   FileName  : String;
  2559. begin
  2560.   OA    := FParent.FOverwriteAction;
  2561.   Can   := True;
  2562.   Try
  2563.     For X := 0 To Count-1 do
  2564.       Begin
  2565.         if Items[X].FSelected Then
  2566.            Begin
  2567.               FN := FParent.GetFileName(Items[X].FileName);
  2568.               DN := FParent.GetFilePath(Items[X].FileName);
  2569.               if DN <> '' Then ForceDirectories(TargetDirectory+'\'+DN);
  2570.               FileName := TargetDirectory+'\'+DN+FN;
  2571.               if ((OA<>oaOverwriteAll) And (OA<>oaSkipAll)) And (Assigned(FParent.FOnOverwriteFile)) Then
  2572.                  Begin
  2573.                     if FileExists(FileName) Then
  2574.                        Begin
  2575.                          FParent.FOnOverwriteFile(FParent,FileName,OA);
  2576.                        End;
  2577.                  End;
  2578.               Case OA Of
  2579.                 oaSkip          : Can := False;
  2580.                 oaSkipAll       : Can := False;
  2581.                 oaOverwrite     : Can := True;
  2582.                 oaOverwriteAll  : Can := True;
  2583.               End;
  2584.              if Can Then InternalExtractToFile(Items[X],TargetDirectory+'\'+DN+FN);
  2585.            End;
  2586.       End;
  2587.   Finally
  2588.   End;
  2589. end;
  2590.  
  2591.  
  2592.  
  2593. procedure TKAZipEntries.DeSelectAll;
  2594. Var
  2595.   X : Integer;
  2596. begin
  2597.   For X := 0 To Count-1 do Items[X].Selected := False;
  2598. end;
  2599.  
  2600. procedure TKAZipEntries.InvertSelection;
  2601. Var
  2602.   X : Integer;
  2603. begin
  2604.   For X := 0 To Count-1 do Items[X].Selected := Not Items[X].Selected;
  2605. end;
  2606.  
  2607. procedure TKAZipEntries.SelectAll;
  2608. Var
  2609.   X : Integer;
  2610. begin
  2611.   For X := 0 To Count-1 do Items[X].Selected := True;
  2612. end;
  2613.  
  2614. procedure TKAZipEntries.Select(WildCard: String);
  2615. Var
  2616.   X : Integer;
  2617. begin
  2618.   For X := 0 To Count-1 do
  2619.       Begin
  2620.         if MatchesMask(ToDosName(Items[X].FileName),WildCard) Then
  2621.            Items[X].Selected := True;
  2622.       End;
  2623. end;
  2624.  
  2625.  
  2626. procedure TKAZipEntries.Rebuild;
  2627. begin
  2628.   FParent.Rebuild;
  2629. end;
  2630.  
  2631. procedure TKAZipEntries.Rename(Item: TKAZipEntriesEntry; NewFileName: String);
  2632. begin
  2633.   Item.FileName := NewFileName;
  2634. end;
  2635.  
  2636. procedure TKAZipEntries.Rename(ItemIndex: Integer; NewFileName: String);
  2637. begin
  2638.   Rename(Items[ItemIndex],NewFileName);
  2639. end;
  2640.  
  2641. procedure TKAZipEntries.Rename(FileName, NewFileName: String);
  2642. Var
  2643.   I    : Integer;
  2644. begin
  2645.   I := IndexOf(FileName);
  2646.   Rename(I,NewFileName);
  2647. end;
  2648.  
  2649.  
  2650. procedure TKAZipEntries.CreateFolder(FolderName: String; FolderDate: TDateTime);
  2651. Var
  2652.   FN : String;
  2653. begin
  2654.   FN       := IncludeTrailingBackslash(FolderName);
  2655.   AddFolderChain(FN,faDirectory,FolderDate);
  2656.   FParent.FIsDirty := True;
  2657. end;
  2658.  
  2659. procedure TKAZipEntries.RenameFolder(FolderName : String; NewFolderName : String);
  2660. Var
  2661.   FN  : String;
  2662.   NFN : String;
  2663.   S   : String;
  2664.   X   : Integer;
  2665.   L   : Integer;
  2666. begin
  2667.   FN  := ToZipName(IncludeTrailingBackslash(FolderName));
  2668.   NFN := ToZipName(IncludeTrailingBackslash(NewFolderName));
  2669.   L   := Length(FN);
  2670.   if IndexOf(NFN) = -1 Then
  2671.      Begin
  2672.        For X := 0 To Count-1 do
  2673.            Begin
  2674.              S := Items[X].FileName;
  2675.              if Pos(FN,S) = 1 Then
  2676.                 Begin
  2677.                   System.Delete(S,1,L);
  2678.                   S := NFN+S;
  2679.                   Items[X].FileName := S;
  2680.                   FParent.FIsDirty := True;
  2681.                 End;
  2682.            End;
  2683.        If (FParent.FIsDirty) And (FParent.FBatchMode=False) Then Rebuild;
  2684.      End;
  2685. end;
  2686.  
  2687. procedure TKAZipEntries.RenameMultiple(Names : TStringList; NewNames : TStringList);
  2688. Var
  2689.   X    : Integer;
  2690.   BR   : Integer;
  2691.   L    : Integer;
  2692. Begin
  2693.   BR := 0; // Marschall
  2694.   If Names.Count <> NewNames.Count Then
  2695.      Begin
  2696.        Raise Exception.Create('Names and NewNames must have equal count');
  2697.      End
  2698.   Else
  2699.      Begin
  2700.        FParent.FBatchMode := True;
  2701.        Try
  2702.          For X := 0 To Names.Count-1 do
  2703.              Begin
  2704.                L := Length(Names.Strings[X]);
  2705.                if (L>0) And ((Names.Strings[X][L]='\') or (Names.Strings[X][L]='/')) Then
  2706.                   Begin
  2707.                     RenameFolder(Names.Strings[X],NewNames.Strings[X]);
  2708.                     Inc(BR);
  2709.                   End
  2710.                Else
  2711.                   Begin
  2712.                     Rename(Names.Strings[X],NewNames.Strings[X]);
  2713.                     Inc(BR);
  2714.                   End;
  2715.              End;
  2716.        Finally
  2717.          FParent.FBatchMode := False;
  2718.        End;
  2719.        If BR > 0 Then
  2720.           Begin
  2721.             Rebuild;
  2722.             FParent.DoChange(FParent,6);
  2723.           End;
  2724.      End;
  2725. End;
  2726.  
  2727.  
  2728. { TKAZip }
  2729. constructor TKAZip.Create(AOwner: TComponent);
  2730. begin
  2731.  Inherited Create(AOwner);
  2732.  FZipStream          := Nil;
  2733.  FOnDecompressFile   := Nil;
  2734.  FOnCompressFile     := Nil;
  2735.  FOnZipChange        := Nil;
  2736.  FOnZipOpen          := Nil;
  2737.  FOnAddItem          := Nil;
  2738.  FOnOverwriteFile    := Nil;
  2739.  FComponentVersion   := '2.0';
  2740.  FBatchMode          := False;
  2741.  FFileNames          := TStringList.Create;
  2742.  FZipHeader          := TKAZipEntries.Create(Self);
  2743.  FZipComment         := TStringList.Create;
  2744.  FIsZipFile          := False;
  2745.  FFileName           := '';
  2746.  FCurrentDFS         := 0;
  2747.  FExternalStream     := False;
  2748.  FIsDirty            := True;
  2749.  FHasBadEntries      := False;
  2750.  FReadOnly           := False;
  2751.  
  2752.  FApplyAttributes     := True;
  2753.  FOverwriteAction    := oaSkip;
  2754.  FZipSaveMethod      := FastSave;
  2755.  FUseTempFiles       := False;
  2756.  FStoreRelativePath  := True;
  2757.  FStoreFolders       := True;
  2758.  FZipCompressionType := ctMaximum;
  2759. end;
  2760.  
  2761.  
  2762. destructor TKAZip.Destroy;
  2763. begin
  2764.   if Assigned(FZipStream) AND (NOT FExternalStream) Then FZipStream.Free;
  2765.   FZipHeader.Free;
  2766.   FZipComment.Free;
  2767.   FFileNames.Free;
  2768.   inherited Destroy;
  2769. end;
  2770.  
  2771. procedure TKAZip.DoChange(Sender: TObject; Const ChangeType : Integer);
  2772. begin
  2773.   if Assigned(FOnZipChange) Then FOnZipChange(Self, ChangeType);
  2774. end;
  2775.  
  2776.  
  2777. function TKAZip.GetFileName(S: String): String;
  2778. Var
  2779.  FN : String;
  2780.  P  : Integer;
  2781. begin
  2782.  FN := S;
  2783.  FN := StringReplace(FN,'//','\',[rfReplaceAll]);
  2784.  FN := StringReplace(FN,'/','\',[rfReplaceAll]);
  2785.  P := Pos(':\',FN);
  2786.  if P > 0 Then System.Delete(FN,1,P+1);
  2787.  Result := ExtractFileName(StringReplace(FN,'/','\',[rfReplaceAll]));
  2788. end;
  2789.  
  2790. function TKAZip.GetFilePath(S: String): String;
  2791. Var
  2792.  FN : String;
  2793.  P  : Integer;
  2794. begin
  2795.  FN := S;
  2796.  FN := StringReplace(FN,'//','\',[rfReplaceAll]);
  2797.  FN := StringReplace(FN,'/','\',[rfReplaceAll]);
  2798.  P := Pos(':\',FN);
  2799.  if P > 0 Then System.Delete(FN,1,P+1);
  2800.  Result := ExtractFilePath(StringReplace(FN,'/','\',[rfReplaceAll]));
  2801. end;
  2802.  
  2803.  
  2804. procedure TKAZip.LoadFromFile(FileName: String);
  2805. Var
  2806.    Res : Integer;
  2807.    Dir : TSearchRec;
  2808. begin
  2809.    Res := FindFirst(FileName,faAnyFile,Dir);
  2810.    If Res=0 Then
  2811.       Begin
  2812.          if Dir.Attr And faReadOnly > 0 Then
  2813.             Begin
  2814.               FZipStream := TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone);
  2815.               FReadOnly  := True;
  2816.             End
  2817.          Else
  2818.             Begin
  2819.               FZipStream := TFileStream.Create(FileName,fmOpenReadWrite or fmShareDenyNone);
  2820.               FReadOnly  := False;
  2821.             End;
  2822.          LoadFromStream(FZipStream);
  2823.       End
  2824.    Else
  2825.       Begin
  2826.         Raise Exception.Create('File "'+FileName+'" not found!');
  2827.       End;
  2828. end;
  2829.  
  2830. procedure TKAZip.LoadFromStream(MS : TStream);
  2831. begin
  2832.   FZipStream := MS;
  2833.   FZipHeader.ParseZip(MS);
  2834.   FIsZipFile := FZipHeader.FIsZipFile;
  2835.   if Not FIsZipFile Then Close;
  2836.   FIsDirty := True;
  2837.   DoChange(Self,1);
  2838. end;
  2839.  
  2840. procedure TKAZip.Close;
  2841. begin
  2842.   Entries.Clear;
  2843.   if Assigned(FZipStream) AND (NOT FExternalStream) Then FZipStream.Free;
  2844.   FExternalStream := False;
  2845.   FZipStream      := Nil;
  2846.   FIsZipFile      := False;
  2847.   FIsDirty        := True;
  2848.   FReadOnly       := False;
  2849.   DoChange(Self,0);
  2850. end;
  2851.  
  2852. procedure TKAZip.SetFileName(const Value: String);
  2853. begin
  2854.   FFileName := Value;
  2855. end;
  2856.  
  2857. procedure TKAZip.Open(FileName: String);
  2858. begin
  2859.   Close;
  2860.   LoadFromFile(FileName);
  2861.   FFileName := FileName;
  2862. end;
  2863.  
  2864. procedure TKAZip.Open(MS: TStream);
  2865. begin
  2866.  Try
  2867.    Close;
  2868.    LoadFromStream(MS);
  2869.  Finally
  2870.    FExternalStream   := True;
  2871.  End;
  2872. end;
  2873.  
  2874. procedure TKAZip.SetIsZipFile(const Value: Boolean);
  2875. begin
  2876.   //****************************************************************************
  2877. end;
  2878.  
  2879. function TKAZip.GetDelphiTempFileName: String;
  2880. Var
  2881.  TmpDir : Array[0..1000] of Char;
  2882.  TmpFN  : Array[0..1000] of Char;
  2883. Begin
  2884.  Result := GetCurrentDir;
  2885.  if GetTempPath(1000,TmpDir) <> 0 Then
  2886.     Begin
  2887.      if GetTempFileName(TmpDir,'',0,TmpFN) <> 0 Then Result := StrPas(TmpFN);
  2888.     End;
  2889. End;
  2890.  
  2891. procedure TKAZip.OnDecompress(Sender: TObject);
  2892. Var
  2893.   DS : TStream;
  2894. begin
  2895.   DS := TStream(Sender);
  2896.   if Assigned(FOnDecompressFile) Then FOnDecompressFile(Self,DS.Position,FCurrentDFS);
  2897. end;
  2898.  
  2899. procedure TKAZip.OnCompress(Sender: TObject);
  2900. Var
  2901.   CS : TStream;
  2902. begin
  2903.   CS := TStream(Sender);
  2904.   if Assigned(FOnCompressFile) Then FOnCompressFile(Self,CS.Position,FCurrentDFS);
  2905. end;
  2906.  
  2907. procedure TKAZip.ExtractToFile(Item : TKAZipEntriesEntry; FileName: String);
  2908. begin
  2909.   Entries.ExtractToFile(Item,FileName);
  2910. end;
  2911.  
  2912. procedure TKAZip.ExtractToFile(ItemIndex: Integer; FileName: String);
  2913. begin
  2914.   Entries.ExtractToFile(ItemIndex,FileName);
  2915. end;
  2916.  
  2917. procedure TKAZip.ExtractToFile(FileName, DestinationFileName: String);
  2918. begin
  2919.   Entries.ExtractToFile(FileName,DestinationFileName);
  2920. end;
  2921.  
  2922. procedure TKAZip.ExtractToStream(Item : TKAZipEntriesEntry; Stream: TStream);
  2923. begin
  2924.   Entries.ExtractToStream(Item,Stream);
  2925. end;
  2926.  
  2927. procedure TKAZip.ExtractAll(TargetDirectory: String);
  2928. begin
  2929.   Entries.ExtractAll(TargetDirectory);
  2930. end;
  2931.  
  2932. procedure TKAZip.ExtractSelected(TargetDirectory: String);
  2933. Begin
  2934.   Entries.ExtractSelected(TargetDirectory);
  2935. End;
  2936.  
  2937. function TKAZip.AddFile(FileName, NewFileName: String): TKAZipEntriesEntry;
  2938. begin
  2939.   Result := Entries.AddFile(FileName, NewFileName);
  2940. end;
  2941.  
  2942. function TKAZip.AddFile(FileName: String): TKAZipEntriesEntry;
  2943. begin
  2944.   Result := Entries.AddFile(FileName);
  2945. end;
  2946.  
  2947. function TKAZip.AddFiles(FileNames: TStrings): Boolean;
  2948. begin
  2949.   Result := Entries.AddFiles(FileNames);
  2950. end;
  2951.  
  2952. function TKAZip.AddFolder(FolderName, RootFolder, WildCard: String;
  2953.   WithSubFolders: Boolean): Boolean;
  2954. begin
  2955.   Result := Entries.AddFolder(FolderName,RootFolder,WildCard,WithSubFolders);
  2956. end;
  2957.  
  2958. function TKAZip.AddFilesAndFolders(FileNames: TStrings; RootFolder: String;
  2959.   WithSubFolders: Boolean): Boolean;
  2960. begin
  2961.   Result := Entries.AddFilesAndFolders(FileNames,RootFolder,WithSubFolders);
  2962. end;
  2963.  
  2964. function TKAZip.AddStream(FileName: String; FileAttr: Word;  FileDate: TDateTime; Stream: TStream): TKAZipEntriesEntry;
  2965. begin
  2966.   Result := Entries.AddStream(FileName,FileAttr,FileDate,Stream);
  2967. end;
  2968.  
  2969. function TKAZip.AddStream(FileName: String;  Stream: TStream): TKAZipEntriesEntry;
  2970. begin
  2971.   Result := Entries.AddStream(FileName,Stream);
  2972. end;
  2973.  
  2974.  
  2975. procedure TKAZip.Remove(Item: TKAZipEntriesEntry);
  2976. begin
  2977.   Entries.Remove(Item);
  2978. end;
  2979.  
  2980. procedure TKAZip.Remove(ItemIndex: Integer);
  2981. begin
  2982.   Entries.Remove(ItemIndex);
  2983. end;
  2984.  
  2985. procedure TKAZip.Remove(FileName: String);
  2986. begin
  2987.   Entries.Remove(FileName);
  2988. end;
  2989.  
  2990. procedure TKAZip.RemoveFiles(List: TList);
  2991. begin
  2992.   Entries.RemoveFiles(List);
  2993. end;
  2994.  
  2995. procedure TKAZip.RemoveSelected;
  2996. begin
  2997.   Entries.RemoveSelected;;
  2998. end;
  2999.  
  3000. function TKAZip.GetComment: TStrings;
  3001. Var
  3002.  S : String;
  3003. begin
  3004.   Result := FZipComment;
  3005.   FZipComment.Clear;
  3006.   if FIsZipFile Then
  3007.      Begin
  3008.        if FEndOfCentralDir.ZipfileCommentLength > 0 Then
  3009.           Begin
  3010.             FZipStream.Position := FZipCommentPos;
  3011.             SetLength(S,FEndOfCentralDir.ZipfileCommentLength);
  3012.             FZipStream.Read(S[1],FEndOfCentralDir.ZipfileCommentLength);
  3013.             FZipComment.Text    := S;
  3014.           End;
  3015.      End;
  3016. end;
  3017.  
  3018. procedure TKAZip.SetComment(const Value: TStrings);
  3019. Var
  3020.   Comment : String;
  3021.   L       : Integer;
  3022. begin
  3023.   //****************************************************************************
  3024.   if FZipComment.Text=Value.Text Then Exit;
  3025.   FZipComment.Clear;
  3026.   if FIsZipFile Then
  3027.      Begin
  3028.        FZipComment.Assign(Value);
  3029.        Comment                               := FZipComment.Text;
  3030.        L                                     := Length(Comment);
  3031.        FEndOfCentralDir.ZipfileCommentLength := L;
  3032.        FZipStream.Position                   := FEndOfCentralDirPos;
  3033.        FZipStream.Write(FEndOfCentralDir,SizeOf(TEndOfCentralDir));
  3034.        FZipCommentPos                        := FZipStream.Position;
  3035.        if L > 0 Then
  3036.           Begin
  3037.             FZipStream.Write(Comment[1],L)
  3038.           End
  3039.        Else
  3040.           Begin
  3041.             FZipStream.Size := FZipStream.Position;
  3042.           End;
  3043.      End;
  3044. end;
  3045.  
  3046. procedure TKAZip.DeSelectAll;
  3047. begin
  3048.   Entries.DeSelectAll;
  3049. end;
  3050.  
  3051. procedure TKAZip.Select(WildCard : String);
  3052. begin
  3053.   Entries.Select(WildCard);
  3054. end;
  3055.  
  3056. procedure TKAZip.InvertSelection;
  3057. begin
  3058.   Entries.InvertSelection;
  3059. end;
  3060.  
  3061. procedure TKAZip.SelectAll;
  3062. begin
  3063.   Entries.SelectAll;
  3064. end;
  3065.  
  3066. procedure TKAZip.RebuildLocalFiles(MS: TStream);
  3067. Var
  3068.   X    : Integer;
  3069.   LF   : TLocalFile;
  3070. begin
  3071.   //************************************************* RESAVE ALL LOCAL BLOCKS
  3072.   SetLength(NewLHOffsets,Entries.Count+1);
  3073.   For X := 0 To Entries.Count-1 do
  3074.       Begin
  3075.         NewLHOffsets[X] := MS.Position;
  3076.         LF  := Entries.GetLocalEntry(FZipStream,Entries.Items[X].LocalOffset,False);
  3077.         MS.Write(LF, SizeOf(LF)-3*SizeOf(String));
  3078.         if LF.FilenameLength   > 0 Then MS.Write(LF.FileName[1]  ,LF.FilenameLength);
  3079.         if LF.ExtraFieldLength > 0 Then MS.Write(LF.ExtraField[1],LF.ExtraFieldLength);
  3080.         if LF.CompressedSize   > 0 Then MS.Write(LF.CompressedData[1],LF.CompressedSize);
  3081.         if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,X,Entries.Count-1);
  3082.       End;
  3083. end;
  3084.  
  3085. procedure TKAZip.RebuildCentralDirectory(MS: TStream);
  3086. Var
  3087.   X    : Integer;
  3088.   CDF  : TCentralDirectoryFile;
  3089. begin
  3090.   NewEndOfCentralDir := FEndOfCentralDir;
  3091.   NewEndOfCentralDir.TotalNumberOfEntriesOnThisDisk  := Entries.Count;
  3092.   NewEndOfCentralDir.TotalNumberOfEntries            := Entries.Count;
  3093.   NewEndOfCentralDir.OffsetOfStartOfCentralDirectory := MS.Position;
  3094.   For X := 0 To Entries.Count-1 do
  3095.       Begin
  3096.         CDF := Entries.Items[X].FCentralDirectoryFile;
  3097.         CDF.RelativeOffsetOfLocalHeader := NewLHOffsets[X];
  3098.         MS.Write(CDF,SizeOf(CDF)-3*SizeOf(String));
  3099.         if CDF.FilenameLength > 0 Then
  3100.            MS.Write(CDF.FileName[1],CDF.FilenameLength);
  3101.         if CDF.ExtraFieldLength > 0 Then
  3102.            MS.Write(CDF.ExtraField[1],CDF.ExtraFieldLength);
  3103.         if CDF.FileCommentLength > 0 Then
  3104.            MS.Write(CDF.FileComment[1],CDF.FileCommentLength);
  3105.         if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,X,Entries.Count-1);
  3106.       End;
  3107.   NewEndOfCentralDir.SizeOfTheCentralDirectory := MS.Position-NewEndOfCentralDir.OffsetOfStartOfCentralDirectory;
  3108. end;
  3109.  
  3110. procedure TKAZip.RebuildEndOfCentralDirectory(MS: TStream);
  3111. Var
  3112.   ZipComment : String;
  3113. begin
  3114.   ZipComment   := Comment.Text;
  3115.   FRebuildECDP := MS.Position;
  3116.   MS.Write(NewEndOfCentralDir,SizeOf(NewEndOfCentralDir));
  3117.   FRebuildCP   := MS.Position;
  3118.   if NewEndOfCentralDir.ZipfileCommentLength > 0 Then
  3119.      Begin
  3120.        MS.Write(ZipComment[1],NewEndOfCentralDir.ZipfileCommentLength);
  3121.      End;
  3122.   if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,100,100);
  3123. end;
  3124.  
  3125. Procedure TKAZip.FixZip(MS : TStream);
  3126. Var
  3127.   X          : Integer;
  3128.   Y          : Integer;
  3129.   NewCount   : Integer;
  3130.   LF         : TLocalFile;
  3131.   CDF        : TCentralDirectoryFile;
  3132.   ZipComment : String;
  3133. Begin
  3134.   ZipComment   := Comment.Text;
  3135.   Y            := 0;
  3136.   SetLength(NewLHOffsets,Entries.Count+1);
  3137.   For X := 0 To Entries.Count-1 do
  3138.       Begin
  3139.         LF  := Entries.GetLocalEntry(FZipStream,Entries.Items[X].LocalOffset,False);
  3140.         if (LF.LocalFileHeaderSignature=$04034b50) And (Entries.Items[X].Test) Then
  3141.            Begin
  3142.              NewLHOffsets[Y] := MS.Position;
  3143.              MS.Write(LF, SizeOf(LF)-3*SizeOf(String));
  3144.              if LF.FilenameLength   > 0 Then MS.Write(LF.FileName[1]  ,LF.FilenameLength);
  3145.              if LF.ExtraFieldLength > 0 Then MS.Write(LF.ExtraField[1],LF.ExtraFieldLength);
  3146.              if LF.CompressedSize   > 0 Then MS.Write(LF.CompressedData[1],LF.CompressedSize);
  3147.              if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,X,Entries.Count-1);
  3148.              Inc(Y);
  3149.            End
  3150.         Else
  3151.            Begin
  3152.              Entries.Items[X].FCentralDirectoryFile.CentralFileHeaderSignature := 0;
  3153.              if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,X,Entries.Count-1);
  3154.            End;
  3155.       End;
  3156.  
  3157.   NewCount := Y;
  3158.   Y        := 0;
  3159.   NewEndOfCentralDir := FEndOfCentralDir;
  3160.   NewEndOfCentralDir.TotalNumberOfEntriesOnThisDisk  := NewCount;
  3161.   NewEndOfCentralDir.TotalNumberOfEntries            := NewCount;
  3162.   NewEndOfCentralDir.OffsetOfStartOfCentralDirectory := MS.Position;
  3163.   For X := 0 To Entries.Count-1 do
  3164.       Begin
  3165.         CDF := Entries.Items[X].FCentralDirectoryFile;
  3166.         if CDF.CentralFileHeaderSignature=$02014b50 Then
  3167.            Begin
  3168.              CDF.RelativeOffsetOfLocalHeader := NewLHOffsets[Y];
  3169.              MS.Write(CDF,SizeOf(CDF)-3*SizeOf(String));
  3170.              if CDF.FilenameLength > 0 Then
  3171.                 MS.Write(CDF.FileName[1],CDF.FilenameLength);
  3172.              if CDF.ExtraFieldLength > 0 Then
  3173.                 MS.Write(CDF.ExtraField[1],CDF.ExtraFieldLength);
  3174.              if CDF.FileCommentLength > 0 Then
  3175.                 MS.Write(CDF.FileComment[1],CDF.FileCommentLength);
  3176.              if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,X,Entries.Count-1);
  3177.              Inc(Y);
  3178.            End;
  3179.       End;
  3180.   NewEndOfCentralDir.SizeOfTheCentralDirectory := MS.Position-NewEndOfCentralDir.OffsetOfStartOfCentralDirectory;
  3181.  
  3182.   FRebuildECDP := MS.Position;
  3183.   MS.Write(NewEndOfCentralDir,SizeOf(NewEndOfCentralDir));
  3184.   FRebuildCP   := MS.Position;
  3185.   if NewEndOfCentralDir.ZipfileCommentLength > 0 Then
  3186.      Begin
  3187.        MS.Write(ZipComment[1],NewEndOfCentralDir.ZipfileCommentLength);
  3188.      End;
  3189.   if Assigned(FOnRebuildZip) Then FOnRebuildZip(Self,100,100);
  3190. End;
  3191.  
  3192.  
  3193. Procedure TKAZip.SaveToStream(Stream:TStream);
  3194. Begin
  3195.   RebuildLocalFiles(Stream);
  3196.   RebuildCentralDirectory(Stream);
  3197.   RebuildEndOfCentralDirectory(Stream);
  3198. End;
  3199.  
  3200. Procedure TKAZip.Rebuild;
  3201. var
  3202.   TempStream          : TFileStream;
  3203.   TempMSStream        : TMemoryStream;
  3204.   TempFileName        : String;
  3205. Begin
  3206.   if FUseTempFiles Then
  3207.      Begin
  3208.         TempFileName := GetDelphiTempFileName;
  3209.         TempStream   := TFileStream.Create(TempFileName,fmOpenReadWrite or FmCreate);
  3210.         Try
  3211.           SaveToStream(TempStream);
  3212.  
  3213.           // Sicherheitsbestimmung
  3214.           ProtectStream(FZipStream);
  3215.  
  3216.           FZipStream.Position := 0;
  3217.           FZipStream.Size     := 0;
  3218.           TempStream.Position := 0;
  3219.           FZipStream.CopyFrom(TempStream,TempStream.Size);
  3220.           Entries.ParseZip(FZipStream);
  3221.         Finally
  3222.           TempStream.Free;
  3223.           // Sicherheitsbestimmung
  3224.           dc_deletefile(tempfilename); // DeleteFile(TempFileName)
  3225.         End;
  3226.      End
  3227.   Else
  3228.      Begin
  3229.         TempMSStream   := TMemoryStream.Create;
  3230.         Try
  3231.           SaveToStream(TempMSStream);
  3232.  
  3233.           // Sicherheitsbestimmung
  3234.           ProtectStream(FZipStream);
  3235.  
  3236.           FZipStream.Position   := 0;
  3237.           FZipStream.Size       := 0;
  3238.           TempMSStream.Position := 0;
  3239.           FZipStream.CopyFrom(TempMSStream,TempMSStream.Size);
  3240.           Entries.ParseZip(FZipStream);
  3241.         Finally
  3242.           TempMSStream.Free;
  3243.         End;
  3244.      End;
  3245.   FIsDirty := True;  
  3246. End;
  3247.  
  3248. Procedure TKAZip.CreateZip(Stream:TStream);
  3249. Var
  3250.   ECD : TEndOfCentralDir;
  3251. Begin
  3252.   ECD.EndOfCentralDirSignature        := $06054b50;
  3253.   ECD.NumberOfThisDisk                := 0;
  3254.   ECD.NumberOfTheDiskWithTheStart     := 0;
  3255.   ECD.TotalNumberOfEntriesOnThisDisk  := 0;
  3256.   ECD.TotalNumberOfEntries            := 0;
  3257.   ECD.SizeOfTheCentralDirectory       := 0;
  3258.   ECD.OffsetOfStartOfCentralDirectory := 0;
  3259.   ECD.ZipfileCommentLength            := 0;
  3260.   Stream.Write(ECD,SizeOf(ECD));
  3261. End;
  3262.  
  3263.  
  3264. Procedure TKAZip.CreateZip(FileName:String);
  3265. var
  3266.   FS : TFileStream;
  3267. Begin
  3268.   FS := TFileStream.Create(FileName,fmOpenReadWrite or FmCreate);
  3269.   Try
  3270.     CreateZip(FS);
  3271.   Finally
  3272.     FS.Free;
  3273.   End;
  3274. End;
  3275.  
  3276. procedure TKAZip.SetZipSaveMethod(const Value: TZipSaveMethod);
  3277. begin
  3278.   FZipSaveMethod := Value;
  3279. end;
  3280.  
  3281. procedure TKAZip.SetActive(const Value: Boolean);
  3282. begin
  3283.   if FFileName='' Then Exit;
  3284.   if Value Then Open(FFileName) Else Close;
  3285. end;
  3286.  
  3287. procedure TKAZip.SetZipCompressionType(const Value: TZipCompressionType);
  3288. begin
  3289.   FZipCompressionType := Value;
  3290.   if FZipCompressionType = ctUnknown Then FZipCompressionType := ctNormal;
  3291. end;
  3292.  
  3293. function TKAZip.GetFileNames: TStrings;
  3294. Var
  3295.   X : Integer;
  3296. begin
  3297.   if FIsDirty Then
  3298.      Begin
  3299.        FFileNames.Clear;
  3300.        For X := 0 To Entries.Count-1 do
  3301.            Begin
  3302.              FFileNames.Add(GetFilePath(Entries.Items[X].FileName)+GetFileName(Entries.Items[X].FileName));
  3303.            End;
  3304.        FIsDirty := False;
  3305.      End;
  3306.   Result := FFileNames;
  3307. end;
  3308.  
  3309. procedure TKAZip.SetFileNames(const Value: TStrings);
  3310. begin
  3311.   //*************************************************** READ ONLY
  3312. end;
  3313.  
  3314.  
  3315. procedure TKAZip.SetUseTempFiles(const Value: Boolean);
  3316. begin
  3317.   FUseTempFiles := Value;
  3318. end;
  3319.  
  3320. procedure TKAZip.Rename(Item: TKAZipEntriesEntry; NewFileName: String);
  3321. begin
  3322.   Entries.Rename(Item,NewFileName);
  3323. end;
  3324.  
  3325. procedure TKAZip.Rename(ItemIndex: Integer; NewFileName: String);
  3326. begin
  3327.   Entries.Rename(ItemIndex,NewFileName);
  3328. end;
  3329.  
  3330. procedure TKAZip.Rename(FileName, NewFileName: String);
  3331. begin
  3332.   Entries.Rename(FileName, NewFileName);
  3333. end;
  3334.  
  3335. procedure TKAZip.RenameMultiple(Names, NewNames: TStringList);
  3336. begin
  3337.   Entries.RenameMultiple(Names, NewNames);
  3338. end;
  3339.  
  3340.  
  3341. procedure TKAZip.SetStoreFolders(const Value: Boolean);
  3342. begin
  3343.   FStoreFolders := Value;
  3344. end;
  3345.  
  3346. procedure TKAZip.SetOnAddItem(const Value: TOnAddItem);
  3347. begin
  3348.   FOnAddItem := Value;
  3349. end;
  3350.  
  3351. procedure TKAZip.SetComponentVersion(const Value: String);
  3352. begin
  3353.   //****************************************************************************
  3354. end;
  3355.  
  3356. procedure TKAZip.SetOnRebuildZip(const Value: TOnRebuildZip);
  3357. begin
  3358.   FOnRebuildZip := Value;
  3359. end;
  3360.  
  3361. procedure TKAZip.SetOnRemoveItems(const Value: TOnRemoveItems);
  3362. begin
  3363.   FOnRemoveItems := Value;
  3364. end;
  3365.  
  3366. procedure TKAZip.SetOverwriteAction(const Value: TOverwriteAction);
  3367. begin
  3368.   FOverwriteAction := Value;
  3369. end;
  3370.  
  3371. procedure TKAZip.SetOnOverwriteFile(const Value: TOnOverwriteFile);
  3372. begin
  3373.   FOnOverwriteFile := Value;
  3374. end;
  3375.  
  3376. procedure TKAZip.CreateFolder(FolderName: String; FolderDate: TDateTime);
  3377. begin
  3378.   Entries.CreateFolder(FolderName,FolderDate);
  3379. end;
  3380.  
  3381. procedure TKAZip.RenameFolder(FolderName : String; NewFolderName : String);
  3382. begin
  3383.   Entries.RenameFolder(FolderName,NewFolderName);
  3384. end;
  3385.  
  3386. procedure TKAZip.SetReadOnly(const Value: Boolean);
  3387. begin
  3388.   FReadOnly := Value;
  3389. end;
  3390.  
  3391. procedure TKAZip.SetApplyAtributes(const Value: Boolean);
  3392. begin
  3393.   FApplyAttributes := Value;
  3394. end;
  3395.  
  3396.  
  3397. end.
  3398.  
  3399.