[архив] Скрипты Inno Setup. Помощь и советы [часть 2]

A1EXXX · Отправлено: **00:43, 25-11-2009** | #**491**

Serega, ещё один скромный вопросик: как только начинается распаковка, прогресс-бар сразу заполняется почти наполовину

, а до этого заполнение
было в два раза меньше

Это поправимо?

Кажется разобрался

Цитата:

else
begin
SecondProgressBar.Position:= SecondProgressBar.Position + 3;
WaitProgUntilTerminated;
end;
end;

здесь +3 заменил на +1

A1EXXX · Отправлено: **16:46, 25-11-2009** | #**492**

Serega, разобрался, да не совсем ))) Начинается распаковка с приемлемым заполнением, а заполняется дальше просто ужасно.... Не знаю, как тут разрулить... И ещё: можно сделать так, чтобы при нажатии "Отмена" в инсталле надпись менялась, типа "Откат изменений" или нечто подобное??? А то создаётся впечатление, что установщик завис

Пробовал добавить WizardForm.StatusLabel.Caption:= 'Откат изменений...'; после DelTree(ExpandConstant('{app}'), True, True, True); - если много распаковано, - не работает

Serega · Конфигурация компьютера

Цитата A1EXXX:

разобрался, да не совсем ))) »

Переделал вам скрипт, с учётом расширенной версии. Прогрессбар при распаковке, показывает реальные значения, попробуйте:

Пример

Код:

#define MyAppName "Test"
#define MyAppVerName "Test"
#define MyAppExeName "Test.exe"

[Setup]
AppName={#MyAppName}
AppVerName={#MyAppName}
DefaultDirName={pf}\{#MyAppName}
DirExistsWarning=no
;DisableReadyPage=true
ShowLanguageDialog=auto
OutputBaseFilename=setup
OutputDir=.
UninstallDisplayIcon={app}\{#MyAppExeName}
DefaultGroupName={#MyAppName}
InternalCompressLevel=none
Compression=none

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

[Languages]
Name: eng; MessagesFile: compiler:Default.isl
Name: rus; MessagesFile: compiler:Languages\Russian.isl

[Files]
; измените на своё место расположение dll'ки, у меня она расположена
; C:\Program Files\Inno Setup 5\Libraries\*
Source: C:\Program Files\Inno Setup 5\Libraries\ISTask.dll; Flags: dontcopy
Source: C:\Program Files\FreeArc\bin\Arc.exe; Flags: dontcopy

[CustomMessages]
ExtrError=Произошла ошибка во время извлечения данных. Установка будет прервана.

[Code]
function RunTaskA(FileName: string; bFullpath: Boolean): Boolean;
  external 'RunTask@files:ISTask.dll stdcall delayload setuponly';
function KillTaskA(ExeFileName: string): Integer;
  external 'KillTask@files:ISTask.dll stdcall delayload setuponly';

// запускает указанный файл, с параметрами указанными в CmdShow
function WinExec(lpCmdLine: PChar; uCmdShow: Cardinal): Cardinal;
  external 'WinExec@kernel32.dll stdcall';

////////////////////////////////////////////////////////////////////////////////////
const
  CountArc = 4; // количество архивов

var
  SecondProgressBar: TNewProgressBar;
  ExtractAllArc: Boolean;
  StartPos: Integer;
  
procedure InitializeWizard();
begin
  WizardForm.FileNameLabel.Hide;
  WizardForm.StatusLabel.Top:= ScaleY(81);
  WizardForm.StatusLabel.Width:= WizardForm.InnerNotebook.Width;
  WizardForm.StatusLabel.Width:= ScaleX(262);
  WizardForm.ProgressGauge.Top:= ScaleY(100);
  WizardForm.ProgressGauge.Left:= ScaleX(155);
  WizardForm.ProgressGauge.Width:= ScaleX(262);

  SecondProgressBar:= TNewProgressBar.Create(WizardForm);
  with SecondProgressBar do
    begin
      Parent:= WizardForm.InstallingPage;
      SetBounds(0, 100, 150, 21);
      Min:= 0;
      Max:= 100;
      Position:= 0;
    end;
end;

procedure ParserLog;
var
  in_File, out_File, S, S1: string;
  i, j, n: Integer;
begin
  in_File := ExpandConstant('{tmp}\in_log');
  out_File := ExpandConstant('{tmp}\out_log');
//  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));
        StringChange(S1, ' ', ''); // удаляем пробелы
        for i:= 0 to 100 do
         if S1 = IntToStr(i) then
          begin
            j:= StrToInt(S1);
            SecondProgressBar.Position:= StartPos + (j/CountArc);
            WizardForm.StatusLabel.Caption:= 'Распаковка файлов, ждите...  ' +
              IntToStr(SecondProgressBar.Position)+'%';
            Application.ProcessMessages; // необходима расширенная версия от Restools
          end;
      end;
  until (Pos('Extracted', S) or Pos('ERROR', S)) > 0;
  StartPos:= SecondProgressBar.Position;
  // удаляем временные файлы
  DelayDeleteFile(in_File, 4);
  DelayDeleteFile(out_File, 4);
end;

procedure ExtractArc(arcArchName, arcDestDir:string);
var
  ResultCode: Integer;
begin
//  WizardForm.StatusLabel.Caption:= SetupMessage(msgStatusExtractFiles);
  // запускаем файл
  ResultCode:= WinExec('cmd.exe /c ' + AddQuotes(ExpandConstant('{tmp}\arc.exe')) + ' x ' +
    AddQuotes(ExpandConstant(arcArchName)) + ' -y -s2 -dp' +
      AddQuotes(ExpandConstant(arcDestDir)) + ' >' +
        AddQuotes(ExpandConstant('{tmp}\in_log')), SW_HIDE);

  if (ResultCode < 33) then
    begin
      MsgBox(ExpandConstant('{cm:ExtrError}'), mbCriticalError, MB_OK);
      SecondProgressBar.Position:= 0;
      if RunTaskA('Arc.exe', False) then KillTaskA('Arc.exe'); // теоретически не нужно, но всё же...
      if DirExists(ExpandConstant('{app}')) then DelTree(ExpandConstant('{app}'), True, True, True);
      Abort;
    end
  else ParserLog;
end;

procedure CloseSetup;
begin
  WizardForm.StatusLabel.Caption:= 'Откат изменений...';
  SecondProgressBar.Position:= 0;
  if RunTaskA('Arc.exe', False) then KillTaskA('Arc.exe');
  DelTree(ExpandConstant('{app}'), True, True, True);
  // при убиваниии процесса остаётся одна папка в Temp, поэтому решил её удалить батником
  SaveStringToFile(ExpandConstant('{tmp}\del.bat'), 'rd /s /q ' +
    AddQuotes(ExpandConstant('{tmp}')), False);
  WinExec(ExpandConstant('{tmp}\del.bat'), SW_HIDE);
  KillTaskA(ChangeFileExt(ExtractFileName(ParamStr(0)), '.tmp'));
end;

procedure PlsInsertNextDisk(num: Integer; CheckedFile: string);
var
  Capt: string;
begin
  CheckedFile:= ExpandConstant(CheckedFile);
  if not FileExists(CheckedFile) then
    begin
      Capt:= Format('Пожалуйста, вставьте диск №%d и нажмите ОК для продолжения установки.' + #13 +
        'Если Вы нажмёте Отмена, то дальнейшая установка %s будет невозможна.', [num, '{#MyAppName}']);
      // конечно для красоты лучше делать отдельную форму в виде сообщения, чтоб текст был по центру,
      // но так самое простое...
      if MsgBox(Capt, mbInformation, MB_OKCANCEL) = IDOK then
        PlsInsertNextDisk(num, CheckedFile)
      else CloseSetup;
    end;
end;

procedure CurStepChanged(CurStep: TSetupStep);
begin
  if CurStep = ssInstall then
    begin
      ExtractTemporaryFile('arc.exe');

      ExtractArc('{src}\data-1.arc','{app}');
      ExtractArc('{src}\data-2.arc','{app}');

      PlsInsertNextDisk(2, '{src}\data-3.arc'); //если data3.arc не найден в корне диска, просим второй диск
      ExtractArc('{src}\data-3.arc','{app}');
      ExtractArc('{src}\data-4.arc','{app}');
      PlsInsertNextDisk(1, '{src}\data-1.arc'); //снова просим первый диск

      ExtractAllArc:= True; // сообщим, что все архивы распаковали
    end;
end;

procedure CancelButtonClick(CurPageID: Integer; var Cancel, Confirm: Boolean);
begin
  if CurPageID = wpInstalling then
    if ExtractAllArc then
      Cancel:= True
    else
    if ExitSetupMsgBox then
      CloseSetup
    else
  Cancel:= False;
end;