Question

I have been working with the JclCompression library attempting to add a file to an existing archive. Unfortunately, when archive.compress is called in my function below, it deletes the original archive and replaces it with an archive (with the same file name) containing just the single compressed file that I am attempting to add. All of the original files have been removed.

function TMyCompression.AddZipItems(const archiveFileName: string; const itemsToZip: TList<TMyCompressionItem>): boolean;
var
  archive: TJclUpdateArchive;
  archiveClass: TJclUpdateArchiveClass;
  packedItemName : string;
  i: Integer;
begin
  archiveClass := GetArchiveFormats.FindUpdateFormat(archiveFileName);
  archive := archiveClass.Create(archiveFileName);
  if NOT Assigned(archive) then
    Result := FALSE
  else
    try
      for i := 0 to itemsToZip.Count -1 do
        begin
          packedItemName := RootPath(itemsToZip[i].Name);
          if itemsToZip[i].IsDirectory then
            archive.AddDirectory(packedItemName, itemsToZip[i].Name, true, true)
          else
            archive.AddFile(packedItemName, itemsToZip[i].Name);
        end;
      archive.Compress;
    finally
      archive.Free;
    end;
 end;

Is there a way to accomplish this with the JclCompression tool?

Edits:

Removed a couple of internal function calls that did not affect the code.

Other Delphi Compression Tools I have tried and rejected:

Delphi XE's internal System.Zip; there are no hooks for any type of progress or feedback.
TurboPower Abbrevia v5; I have used this tool successfully for decades with the old zip32 compression. However, I now need zip64 support and the latest version failed on the first two over 4GB files I tried (As I recall it was an invalid block size). Both files could be opened with 7-zip and with Windows File Explorer.
Shell to the internal zip tool that Windows File Explorer uses; I let a 6GB compressed file run overnight and when I returned in the morning it still reported 20 hours to go.

7-Zip is extremely fast, allows for good feedback, and has been thoroughly exercised and tested.

Answer 1

所有原始文件都已删除

使用 ListFiles 方法

procedure ArchivingLog;
var
  file_name,
  archive_name   : string;
  archive        : TJclCompressArchive;
  archive_format : TJclCompressArchiveClass;
begin
  file_name := format('%s\111.log', [GetCurrentDir]);

  if (FileExists(file_name)) then
  begin
    archive_name   := GetCurrentDir + '\111.log.7z';
    archive_format := GetArchiveFormats.FindUpdateFormat(archive_name);

    if archive_format <> nil then
    begin
      archive := archive_format.Create(archive_name);

      if (FileExists(archive_name)) then
        (archive as TJcl7zUpdateArchive).ListFiles; //without this call deletes all previous files in the archive


      (archive as TJcl7zUpdateArchive).AddFile(ExtractFileName(file_name), file_name);

      try
        (archive as TJcl7zUpdateArchive).Compress;
      finally
        FreeAndNil(archive);
      end;
    end;
  end;
end;

Cannot get a TJclUpdateArchive to add a compressed file to an already existing archive

1 个答案: