Inno Setup - How to add multiple arc files to deco

问题:

I am using this code: Inno Setup - How to add cancel button to decompressing page? (answer of Martin Prikryl) to decompress an arc file with Inno Setup.

I want to have the possibility of decompress more than one arc file to install files from components selection (for example). But still show on overall progress bar for all extractions. whole Is this possible?

回答1:

This is modification of my answer to Inno Setup - How to add cancel button to decompressing page?

Prerequisities are the same, refer to the other answer.

In the ExtractArc, call AddArchive for each archive you want to extract.

---

[Files]
Source: unarc.dll; Flags: dontcopy
Source: InnoCallback.dll; Flags: dontcopy

[Code]

type
  TFreeArcCallback =
    function(What: PAnsiChar; Int1, Int2: Integer; Str: PAnsiChar): Integer;

function WrapFreeArcCallback(Callback: TFreeArcCallback; ParamCount: Integer): LongWord;
  external 'wrapcallback@files:innocallback.dll stdcall';

const
  ArcCancelCode = -10;

function FreeArcExtract(
  Callback: LongWord;
  Cmd1, Cmd2, Cmd3, Cmd4, Cmd5, Cmd6, Cmd7, Cmd8, Cmd9, Cmd10: PAnsiChar): Integer;
  external 'FreeArcExtract@files:unarc.dll cdecl';

const
  CP_UTF8 = 65001;

function WideCharToMultiByte(CodePage: UINT; dwFlags: DWORD;
  lpWideCharStr: string; cchWideChar: Integer; lpMultiByteStr: AnsiString;
  cchMultiByte: Integer; lpDefaultCharFake: Integer;
  lpUsedDefaultCharFake: Integer): Integer;
  external '[e-mail] stdcall';

function GetStringAsUtf8(S: string): AnsiString;
var
  Len: Integer;
begin
  Len := WideCharToMultiByte(CP_UTF8, 0, S, Length(S), Result, 0, 0, 0);
  SetLength(Result, Len);
  WideCharToMultiByte(CP_UTF8, 0, S, Length(S), Result, Len, 0, 0);
end;

var
  ArcTotalSize: Integer;
  ArcTotalExtracted: Integer;
  ArcExtracted: Integer;
  ArcCancel: Boolean;
  ArcProgressPage: TOutputProgressWizardPage;

function FreeArcCallback(AWhat: PAnsiChar; Int1, Int2: Integer; Str: PAnsiChar): Integer;
var
  What: string;
begin
  What := AWhat;
  if What = 'origsize' then
  begin
    Log(Format('Adding archive with files with total size %d MB', [Int1]));
    ArcTotalSize := ArcTotalSize + Int1;
  end
    else
  if What = 'write' then
  begin
    if ArcTotalSize > 0 then
    begin
      ArcProgressPage.SetProgress(ArcTotalExtracted + Int1, ArcTotalSize);
    end;
    ArcExtracted := Int1;
  end
    else
  begin
    { Just to pump message queue more often (particularly for 'read' callbacks), }
    { to get more smooth progress bar }
    if (ArcExtracted > 0) and (ArcTotalSize > 0) then
    begin
      ArcProgressPage.SetProgress(ArcTotalExtracted + ArcExtracted, ArcTotalSize);
    end;
  end;

  if ArcCancel then Result := ArcCancelCode
    else Result := 0;
end;

procedure FreeArcCmd(Cmd1, Cmd2, Cmd3, Cmd4, Cmd5, Cmd6, Cmd7, Cmd8, Cmd9, Cmd10: string);
var
  ArcResult: Integer;
begin
  ArcCancel := False;
  ArcResult :=
    FreeArcExtract(
      WrapFreeArcCallback(@FreeArcCallback, 4),
      GetStringAsUtf8(Cmd1), GetStringAsUtf8(Cmd2), GetStringAsUtf8(Cmd3),
      GetStringAsUtf8(Cmd4), GetStringAsUtf8(Cmd5), GetStringAsUtf8(Cmd6),
      GetStringAsUtf8(Cmd7), GetStringAsUtf8(Cmd8), GetStringAsUtf8(Cmd9),
      GetStringAsUtf8(Cmd10));

  if ArcCancel then
  begin
    RaiseException('Extraction cancelled');
  end
    else
  if ArcResult <> 0 then
  begin
    RaiseException(Format('Extraction failed with code %d', [ArcResult]));
  end;
end;

var
  ArcArchives: array of string;

procedure AddArchive(ArchivePath: string);
begin
  SetArrayLength(ArcArchives, GetArrayLength(ArcArchives) + 1); 
  ArcArchives[GetArrayLength(ArcArchives) - 1] := ArchivePath;
  FreeArcCmd('l', '--', ArchivePath, '', '', '', '', '', '', '');
end;

procedure UnPackArchives(DestPath: string);
var
  I: Integer;
  ArchivePath: string;
begin
  Log(Format('Total size of files to be extracted is %d MB', [ArcTotalSize]));

  ArcTotalExtracted := 0;
  for I := 0 to GetArrayLength(ArcArchives) - 1 do
  begin
    ArcExtracted := 0;
    ArchivePath := ArcArchives[I];
    Log(Format('Extracting %s', [ArchivePath]));
    FreeArcCmd('x', '-o+', '-dp' + DestPath, '-w' + DestPath, '--', ArchivePath,
               '', '', '', '');
    ArcTotalExtracted := ArcTotalExtracted + ArcExtracted;
  end;
end;

procedure UnpackCancelButtonClick(Sender: TObject);
begin
  ArcCancel := True;
end;

procedure ExtractArc;
var
  PrevCancelButtonClick: TNotifyEvent;
begin
  ArcProgressPage := CreateOutputProgressPage('Decompression', 'Decompressing archive...');
  ArcProgressPage.SetProgress(0, 100);
  ArcProgressPage.Show;
  try
    WizardForm.CancelButton.Visible := True;
    WizardForm.CancelButton.Enabled := True;
    PrevCancelButtonClick := WizardForm.CancelButton.OnClick;
    WizardForm.CancelButton.OnClick := @UnpackCancelButtonClick;

    try
      AddArchive(ExpandConstant('{src}\test1.arc'));
      AddArchive(ExpandConstant('{src}\test2.arc'));

      Log('Arc extraction starting');
      UnPackArchives(ExpandConstant('{app}'));
    except
      MsgBox(GetExceptionMessage(), mbError, MB_OK);
    end;
  finally
    Log('Arc extraction done');
    ArcProgressPage.Hide;
    WizardForm.CancelButton.OnClick := PrevCancelButtonClick;
  end;
end;

procedure CurStepChanged(CurStep: TSetupStep);
begin
  if CurStep = ssPostInstall then
  begin
    ExtractArc;
  end;
end;