[Serega]

Скрипт для отображения процесса распаковки внешних FreeArc архивов во втором прогрессбаре, необходима расширенная версия от Restools:

читать дальше »

Код:

; Скрипт для отображения процесса распаковки внешних FreeArc архивов во втором прогрессбаре
; Рядом с архивом необходимо расположить архивы и Arc.exe
; Для нормальной работы необходима расширенная версия Inno Setup от Restools http://restools.hanzify.org/
; Отдельное спасибо BlackSelf, http://www.forum.oszone.ru/member.php?userid=147308, за подсказанную идею... :)
; Автор скрипта: Serega, http://forum.oszone.net/member.php?userid=88670

[Setup]
AppName=My Program
AppVerName=My Program v 1.5
DefaultDirName={pf}\My Program
OutputDir=.
Compression=lzma/ultra
InternalCompressLevel=ultra
SolidCompression=yes

[Languages]
Name: russian; MessagesFile: compiler:Languages\Russian.isl

[UninstallDelete]
Name: {app}; Type: filesandordirs

[code]
var
  ProgressLabel: TLabel;
  ProgressBar: TNewProgressBar;

procedure ParserLog;
var
  in_File, out_File, S, S1, S2: string;
  i, j, n: Integer;
begin
  n:= 0;
  in_File := ExpandConstant('{tmp}\in_log');
  out_File := ExpandConstant('{tmp}\out_log');
  ProgressBar.Position:= 0;
  ProgressBar.Show;
  ProgressLabel.Show;
  // если файла нет, то подождём... ;)
  if FileExists(in_File) = False then
    repeat
      Application.ProcessMessages; // необходима расширенная версия от Restools
      n:= n + 1;
      Sleep(500); // ждём полсекунды и повторяем цикл
    until (FileExists(in_File) = True) or (n = 10); // максимально повторяем цикл 10 раз, что составит 5 секунд...
  // если всё же файла нет, то выходим
  if FileExists(in_File) = False then Exit;
  // если файл существует, то обрабатываем его
  repeat
    FileCopy(in_File, out_File, False); // копируем файл, чтоб можно было открыть out_File для чтения
    LoadStringFromFile(out_File, S); // если попытаться загрузить in_File, то ничего не выйдет, пока в него пишет Arc.exe...
    Application.ProcessMessages; // необходима расширенная версия от Restools
    if Pos('%', S) > 0 then begin
      S1:= Copy(S, Length(S) - 4, (Length(S) - 2) - (Length(S) - 4));
      S2:= Copy(S, Length(S) - 4, Length(S) - (Length(S) - 5));
      StringChange(S1, ' ', ''); // удаляем пробелы
      for i:= 0 to 100 do if S1 = IntToStr(i) then begin
        j:= StrToInt(S1);
        ProgressBar.Position := j;
        StringChange(S2, ' ', '');
        ProgressLabel.Caption:= S2;
        Application.ProcessMessages; // необходима расширенная версия от Restools
      end;
    end;
  until (Pos('Extracted', S) or Pos('ERROR', S)) > 0;
  ProgressBar.Position:= 100;
end;

procedure UnpackArc(archive_Name, archive_Path: string);
var
  res: Integer;
begin
  if FileExists(ExpandConstant('{tmp}\in_log')) then DelayDeleteFile(ExpandConstant('{tmp}\in_log'),8);
// запускаем Arc.exe... ;)
  Exec('cmd.exe', '/C arc.exe x ' + archive_Name + ' -y -dp' + archive_Path + ' >' +
       AddQuotes(ExpandConstant('{tmp}\in_log')), ExpandConstant('{src}'), SW_HIDE, ewNoWait, res);
  WizardForm.StatusLabel.Caption:= 'Распаковка архива ' + ExtractFileName(archive_Name) + ', ждите...';
  ParserLog; // обрабатываем лог файл
end;

procedure CurStepChanged(CurStep: TSetupStep);
begin
  if CurStep = ssPostInstall then begin
    WizardForm.CancelButton.Enabled:= False; // отключаем кнопку 'Отмена'
  // AddQuotes - добавляет двойные кавычки в начало и конец строки...
    UnpackArc(AddQuotes(ExpandConstant('{src}\Project.arc')), // расположение 1-го архива
      AddQuotes(ExpandConstant('{app}\Archive1'))); // место распаковки 1-го архива
    UnpackArc(AddQuotes(ExpandConstant('{src}\Project.arc')), // расположение 2-го архива
      AddQuotes(ExpandConstant('{app}\Archive2'))); // место распаковки 2-го архива
    WizardForm.StatusLabel.Caption:= WizardForm.StatusLabel.Caption;
  end;
end;

procedure InitializeWizard;
begin
  // второй прогрессбар
  ProgressBar := TNewProgressBar.Create(WizardForm);
  with ProgressBar do begin
    Left := WizardForm.ProgressGauge.Left;
    Top := WizardForm.ProgressGauge.Top + ScaleX(30);
    Width := WizardForm.ProgressGauge.Width;
    Height := WizardForm.ProgressGauge.Height;
    Parent := WizardForm.InstallingPage;
    Hide;
  end;
  // создаём Label для отображения процентов
  ProgressLabel := TLabel.Create(WizardForm);
  with ProgressLabel do begin
    Left := ProgressBar.Left;
    Top := ProgressBar.Top + ProgressBar.Height + ScaleX(5);
    AutoSize:= True;
    Caption:= '0%';
    Parent := WizardForm.InstallingPage;
    Transparent:= True;
    Font.Color:= clDefault;
    Hide;
  end;
end;

Вопросы

1. Как сделать чтоб во время установки, архив копировался во временную папку %temp% и от туда распаковывался, т.е. использовать не внешний архив, а упакованный внутри инсталлятора?
Нужно добавить в скрипт секцию [Files] и исправить процедуру CurStepChanged:

Пример

Код:

..........................
[Files]
Source: Arc.exe; Flags: dontcopy
Source: Project.arc; Flags: dontcopy
..........................
procedure CurStepChanged(CurStep: TSetupStep);
begin
  if CurStep = ssPostInstall then begin
    ExtractTemporaryFile('Arc.exe'); // извлекаем в {tmp} Arc.exe
    WizardForm.StatusLabel.Caption:= 'Извлечение архива, ждите...';
    ExtractTemporaryFile('Project.arc'); // извлекаем в {tmp} Project.arc

    patch_Arc:= AddQuotes(ExpandConstant('{tmp}\Arc.exe')); // расположение Arc.exe
    UnpackArc(AddQuotes(ExpandConstant('{tmp}\Project.arc')), // расположение архива
      AddQuotes(ExpandConstant('{app}'))); // место распаковки архива
  // AddQuotes - добавляет двойные кавычки в начало и конец строки...
  end;
end;
..........................