Inno Setup - 如何添加多个arc文件进行解压缩?

时间:2017-03-28 14:36:36

标签: inno-setup compression

我正在使用此代码:Inno Setup - How to add cancel button to decompressing page?(Martin Prikryl的回答)使用Inno Setup解压缩弧文件。

我希望能够解压缩多个arc文件,以便从组件选择中安装文件(例如)。但仍然显示所有提取的整体进度条。这可能吗?

1 个答案:

答案 0 :(得分:1)

这是我对Inno Setup - How to add cancel button to decompressing page?

的回答的修改

预先设定是相同的,请参考另一个答案。

ExtractArc中,为要提取的每个存档调用AddArchive

[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 'WideCharToMultiByte@kernel32.dll 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;