[Deep88]

использую компонент sevenzip.
процедура распаковки выглядит так

Код:

  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.Button1Click(Sender: TObject);
var i:integer; 
arhives:tstringlist;
begin
arhives.create;
arhives.add:='test.7z';
arhives.add:='test2.7z';
  with CreateInArchive(CLSID_CFormat7z) do
  for i:=0 to archives.count=-1 do
   begin
     OpenFile(arhives[i]);
     SetProgressCallback(nil, ProgressCallback);
     ExtractTo('c:\1');
   end;
end;

как сделать обший прогресс бар на все архивы и как сделать лабел с именем извлекаемого файла ?

[lmikle]

1. Делаешь приведение total к 100%
2. Max у прогрессбара ставишь на [кол-во архивов]*100.
3. Запоминаешь номер обрабатываемого архива.
4. Текущее значение распаковки конкретного рахива будет
(N-1)*100 + value

Алгоритм даст тебе общий прогрессбар, но его части будут заполняться неравномерно. Можно выяснить размеры архивов и пересчитывать total и value с соотв. коэф. Вопрос, оно тебе нужно?

[Deep88]

нужно)
я в делфи не сильно силён, поподробней))

Код:

 if total=100 then
    form1.ProgressBar1.Max := archives.count*100 else
     form1.ProgressBar1.Position := archives[i]-1;
   Result := S_OK;

как то так?
в каком направлении копать чтоб сделать плавный прогрессбар?
есть ещё пример для архиватора Freearc. там тоже как ни крутил не получалсоь общий прогрессбар. приду домой скину пример.

[M.A.D.M.A.N.]

Там спецом передается аргумент "total: boolean", если он true, значит в value значение общего прогресса, иначе прогресс текущего файла.

[Deep88]

если ставлю total в false вообще ничё не показывает.


http://rghost.ru/49750502 тут прмер исползование unarc.dll. тож самое, не могу настроить общий прогрессбар. максимум что получилось это он останавливается там где должен след архив начаться.

[lmikle]

Сообщение от Deep88

нужно)
я в делфи не сильно силён, поподробней))
как то так?

Нет, не так.
Как-то так:

Код:

 if total then
    form1.ProgressBar1.Max := archives.count*100 else
     form1.ProgressBar1.Position := (i-1)*100 + value;
   Result := S_OK;

[Deep88]

Сообщение от lmikle

Нет, не так.
Как-то так:

Код:

 if total then
    form1.ProgressBar1.Max := archives.count*100 else
     form1.ProgressBar1.Position := (i-1)*100 + value;
   Result := S_OK;

всё равно показует каждый архив в отдельности, только ещё хуже)
сразу прогрес заполняется и приложение подвисает до след архива.

подскажи лучше как сделать через размеры архивов.
может напрямую через 7z.dll будет проще?

да кстате если сделать лабел с именем архива так
label2.Caption:='извлекается архив '+archives.strings[i];
то имя появляется только на последнем архиве.

[lmikle]

Сообщение от Deep88

всё равно показует каждый архив в отдельности, только ещё хуже)
сразу прогрес заполняется и приложение подвисает до след архива.

подскажи лучше как сделать через размеры архивов.
может напрямую через 7z.dll будет проще?

да кстате если сделать лабел с именем архива так
label2.Caption:='извлекается архив '+archives.strings[i];
то имя появляется только на последнем архиве.

Имя появляется только в конце по другой причине, тк пока идет обработка, у тебя не обрабатывается очередь сообщений, соотв. не проходит отрисовка.

Ты для начала сделай, что бы у тебя нормально отрабатывалось в общем случае, потом уже будешь биться над сглаживанием.

Еще раз.

Код:

type
  TForm1 = class(TForm)
  public
    // Текущий архив
    ArcNum : Integer;
    // Total текущего архива
   ArcLen : Integer;
  ...

function ProgressCallback(sender: Pointer; total: boolean; value: int64): HRESULT; stdcall;
 begin
   if total 
     then form1.ArcLen := value 
     else form1.ProgressBar1.Position := ArcNum*100 + 100*value/ArcLen;
   Result := S_OK;
  // Даем отрисоваться обновлению
  Application.ProcessMessages;
 end;
  
procedure TForm1.Button1Click(Sender: TObject);
var 
  i:integer; 
  arhives:tstringlist;
begin
  arhives.create;
  arhives.add:='test.7z';
  arhives.add:='test2.7z';

  // инициализируем прогресс бар
  ProgressBar1.Max := archives.count*100;
  ProgressBar1.Position := 0;
  ArcNum := 0;
  ArcLen := 0;
  with CreateInArchive(CLSID_CFormat7z) do
    for i:=0 to archives.count-1 do
      begin
        OpenFile(arhives[i]);
        SetProgressCallback(nil, ProgressCallback);
        ExtractTo('c:\1');
        Inc(ArcNum);
     end;
end;

Короче, как-то вот так. Может где и накосячил, но идея, вроде, изложена правильно.

ЗЫ. Кстати, а чем тебя не устроит вариант с 2мя прогресс барами. Один показывает прогресс извлечения из текущего архива, второй - общий, по кол-ву обработанных архивов.

[Deep88]

form1.ProgressBar1.Position := ArcNum*100 + 100*value/ArcLen;
пишет Incompatible types: 'Integer' and 'Extended'

ну я вообще и хотел 2 прогрессбара, просто на каждый архив и так же работает, нада общий чтоб получился)

поставил trunc(ArcNum*100 + 100*value/ArcLen); компилируется, но при нажатии кнопки в приложении вылазит access violation

[lmikle]

Сообщение от Deep88

form1.ProgressBar1.Position := ArcNum*100 + 100*value/ArcLen;
пишет Incompatible types: 'Integer' and 'Extended'

ну я вообще и хотел 2 прогрессбара, просто на каждый архив и так же работает, нада общий чтоб получился)

поставил trunc(ArcNum*100 + 100*value/ArcLen); компилируется, но при нажатии кнопки в приложении вылазит access violation

Ну, достаточно было оттранкать (или Round) последнее слагаемое, где деление. Что-то не подумал об этой фишке.

access violation - это скорее всего обращение к еще не созданному объекту. Смотри в отладчике где у тебя чего не успело создаться.

[Deep88]

эмм, это где смотреть?)
на форме всего то только прогрессбар и кнопка.
на всякий случай вот весь код

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,SevenZip, Vcl.ComCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ProgressBar1: TProgressBar;
    procedure Button1Click(Sender: TObject);

  private
    { Private declarations }
  public


  end;

var
Form1: TForm1;
ArcNum : Integer;
ArcLen : Integer;
  
implementation

{$R *.dfm}

function ProgressCallback(sender: Pointer; total: boolean; value: int64): HRESULT; stdcall;
 begin
   if total  then ArcLen := value
     else form1.ProgressBar1.Position :=trunc (ArcNum*100 + 100*value/ArcLen);
   Result := S_OK;
  // Даем отрисоваться обновлению
 Application.ProcessMessages;
 end;

procedure TForm1.Button1Click(Sender: TObject);
 var
  i:integer; archives := TStringList.Create;
begin
  archives.create;
  archives.add('test.7z');
  archives.add('test2.7z');
  ArcNum := 0;
  ArcLen := 0;
  with CreateInArchive(CLSID_CFormat7z) do
    for i:=0 to archives.count-1 do
      begin
        OpenFile(archives[i]);
        SetProgressCallback(nil, ProgressCallback);
        ExtractTo('c:\1');
        Inc(ArcNum);
     end;
  // инициализируем прогресс бар
  ProgressBar1.Position := 0;
  ProgressBar1.Max := archives.count*100;

end;
end.

хмм, если archives.create и add поставить в процедуру при создании формы, ошибка вылазит сразу при запуске.

всё, заработало, неправильно стринглист создавал. нужно было archives := TStringList.Create;
теперь не пойму, толи прогрессбар заполняется быстрее распаковки второго архива, толи всё равно тока первый показывает. потому как когда он уже полный файлы в папке назначения продолжают создаваться и приложение немного подвисает. завтра попробую с архивами побольше.

[Deep88]

c большими архивами получилось так - прогрессбар дошёл до конца когда распаковался первый архив, а потом пошёл в обратную сторону при распаковке второго. но он закончил уменьшаться раньше чем распаковался архив.

[lmikle]

Сообщение от Deep88

c большими архивами получилось так - прогрессбар дошёл до конца когда распаковался первый архив, а потом пошёл в обратную сторону при распаковке второго. но он закончил уменьшаться раньше чем распаковался архив.

1. Инициализацию прогресс бара зачем вниз перенес? Она должна проходить до распаковки.
2. Под отладчиком пройди, я не совсем понимаю что передается в CallBack. По логике, сначала он должен вызваться с total=true (т.е. отдать "всего"), потом вызываться с конкретными значениями прогресса (т.е. total будет false). Может оно и не так работает. Тут надо понять.

[Deep88]

пробовал в разные места прогресс бар ставить, всё равно неправильно.
только что поставил сразху после созадния стринглиста, дошёл до середины и пошёл на втором архиве в обратную сторону и закончился опять до того как архив распаковался.
исходник sevenzip на всякий http://rghost.ru/49779527

в общем если архивы маленькие то норм, а беру 2 архива, один 500мб, распакованых получается дето 1 гб и второй 1гб архив, распакованых гдето 2, тогда чёрти что.

по поводу отладчика, запустил в режиме дебага, куча месаджей внизу о том что загружается, в основном dll всякие, куда смотреть нада?)

опять чудеса, взял тот же архив на 500 метров и другой на 200, всё нормально показало. может быть причина в том что во втором архиве до этого были теже самые файлы что и в первом?
только что взял 3 архива с разными данными, показало всё как нада. правда дёргано немного, но то ладно, плохо ток что подвисает приложение если его двигать по экрану)

сделал лабел с именем извлекаемого архива.
сделал мемо с именми извлекаемых файлов, оно записывает туда сразу все файлы в архиве разом. как сделать имя файла извлекаемого в данный момент?
делал так

Код:

 OpenFile(archives[i]);
label1.Caption:=archives[i];
for f := 0 to NumberOfItems - 1 do
if not ItemIsFolder[f] then
mlog.Lines.Add(ItemPath[f]);

второй прогресс бар добавил так

Код:

function ProgressCallback(sender: Pointer; total: boolean; value: int64): HRESULT; stdcall;
 begin
   if total  then  begin
   ArcLen := value ;
   form1.ProgressBar2.Max := value;  end else form1.ProgressBar1.Position :=trunc(ArcNum*100 + 100*value/ArcLen);
   form1.ProgressBar2.Position := value;
  Application.ProcessMessages;
  Result := S_OK; 
end;