Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Общие вопросы > 7z.dll+sevenzip.pas для Delphi


Автор: CHERRY 30.10.2012, 20:52
Доброго времени суток!
Есть не решаемые проблемы с ProgressCallback.
Распаковка архива работает без проблем:
Код

function ProgressCallback(sender: Pointer; total: boolean; value: int64): HRESULT; stdcall;
 begin
   if total then
     Form1.ProgressBar1.Max := value else
     Form1.ProgressBar1.Position := value;
   Result := S_OK;
 end;

procedure TForm1.butExtractClick(Sender: TObject);
begin
  with CreateInArchive(CLSID_CFormatZip) do
  begin
    OpenFile('d:\temp\test.zip');
    SetProgressCallback(nil, ProgressCallback);
    ExtractTo('d:\temp\1111\');
  end;
end;

С архивацией проблемы:
Код

procedure TForm1.butCompressClick(Sender: TObject);
begin
  with CreateOutArchive(CLSID_CFormatZip) do
  begin
    AddFiles(ediSource.Text, ExtractFileName(ediSource.Text), '*.*', True);
    SetProgressCallback(nil, ProgressCallback);
    SaveToFile(ediDestFile.Text);
  end;
end;

Если закомментировать SetProgressCallback(nil, ProgressCallback);, архивация проходит нормально.
Иначе все виснет намертво.
Это глюки продукта или непонимание процесса.

Версия продукта:
(*                        7-ZIP DELPHI API                                      *)
(* Unit owner : Henri Gourvest <[email protected]>     *)
(* V1.2                                                                                  *)
Оригинал прилагается.
(********************************************************************************)

Автор: CHERRY 30.10.2012, 22:30
Выяснилось, что ProgressCallback при архивации срабатывает для одного файла.
Вот рабочий пример:
Код

function ProgressCallback(sender: Pointer; total: boolean; value: int64): HRESULT; stdcall;
 begin
   if total then
     fmArxiv.ProgressBar1.Max := value else
     fmArxiv.ProgressBar1.Position := value;
   Result := S_OK;
 end;

procedure TfmArxiv.Button3Click(Sender: TObject);
begin
 DoCreateArchive('d:\temp\kot.bmp', 'd:\temp\1111111.zip')
end;

//Архивация
function TfmArxiv.DoCreateArchive(const arFilename, arSaveTo: string): Boolean;
var
  OutArchive: I7zOutArchive;
begin
  Result := False;
  // создаем ZIP-архив
  OutArchive := CreateOutArchive(CLSID_CFormatZip);
  try
    //Добавим один файл в архив
    OutArchive.AddFile(arFilename, ExtractFileName(arFilename));
     //Добавим директорий в архив
     //вызов: DoCreateArchive('d:\temp\111', 'd:\temp\1111111.zip')
    //OutArchive.AddFiles(arFilename,ExtractFileName(arFilename),'*.*',true);
    // степень сжатия максимальная
    SetCompressionLevel(OutArchive, 5);
    // метод сжатия Deflate (гарантия того, что архив может впоследствии распакован
    // любым ZIP-архиватором независимо от платформы)
    SetCompressionMethod(OutArchive, mzDeflate);

    OutArchive.SetProgressCallback(nil,ProgressCallback);

    OutArchive.SaveToFile(arSaveTo);
    Result := FileExists(arSaveTo);
  finally
    OutArchive := nil;
  end;
end;


Как то так.

Автор: CHERRY 1.11.2012, 16:18
Все хорошо работает только для архивов 7z
OutArchive := CreateOutArchive(CLSID_CFormatZip);
Спасибо за внимание.

Добавлено через 1 минуту и 34 секунды
Ошибочка, вот так
CreateOutArchive(CLSID_CFormat7z)

Автор: barbee 6.6.2013, 22:22
Времени прошло немало, но всё же вопрос висит без ответа, а топик в гугле находится первым по запросу "sevenzip.pas setprogresscallback".
Так что напишу, как решить проблему, мало ли кто-то ещё столкнётся.

Дело явно в кривой работе с потоками где-то на стыке VCL и 7z.dll. То ли распаковка там идёт не в том потоке, где нужно, то ли ещё что. В общем, расковыривать проблему до основания я не стал, благо решение быстро нашлось.

Пример одного из вариантов решения приложен в комментариях прямо на https://code.google.com/p/d7zip/issues/detail?id=2#c1.

Второй, на мой взгляд, несколько проще. Достаточно одного вызова, по документации устанавливающего количество рабочих потоков в 1.
Код
SetMultiThreading(OutArchive, 1);

И всё начинает работать как надо.

Итого, код будет выглядеть так:
Код

function ProgressCallback(sender: Pointer; total: boolean; value: int64): HRESULT; stdcall;
 begin
   if total then
     fmArxiv.ProgressBar1.Max := value else
     fmArxiv.ProgressBar1.Position := value;
   Result := S_OK;
 end;

procedure TfmArxiv.Button3Click(Sender: TObject);
begin
 DoCreateArchive('d:\temp\kot.bmp', 'd:\temp\1111111.zip')
end;

//Архивация
function TfmArxiv.DoCreateArchive(const arFilename, arSaveTo: string): Boolean;
var
  OutArchive: I7zOutArchive;
begin
  Result := False;
  // создаем ZIP-архив
  OutArchive := CreateOutArchive(CLSID_CFormatZip);
  try
    //Добавим один файл в архив
    OutArchive.AddFile(arFilename, ExtractFileName(arFilename));
     //Добавим директорий в архив
     //вызов: DoCreateArchive('d:\temp\111', 'd:\temp\1111111.zip')
    //OutArchive.AddFiles(arFilename,ExtractFileName(arFilename),'*.*',true);
    // степень сжатия максимальная
    SetCompressionLevel(OutArchive, 5);
    // метод сжатия Deflate (гарантия того, что архив может впоследствии распакован
    // любым ZIP-архиватором независимо от платформы)
    SetCompressionMethod(OutArchive, mzDeflate);

    // ограничиваем количество потоков
    SetMultiThreading(OutArchive, 1);

    OutArchive.SetProgressCallback(nil,ProgressCallback);

    OutArchive.SaveToFile(arSaveTo);
    Result := FileExists(arSaveTo);
  finally
    OutArchive := nil;
  end;
end;

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)