在InnoSetup向导中显示CMD ARC提取进度的输出

问题描述

InnoSetup v6 使用unarc.dll从FreeArc 0.67（2014年3月15日）归档文件中提取，曾经在某个时候使用unarc.exe，直到我在下面找到了它。 Inno Setup - How to add cancel button to decompressing page?

使用FreeARC，因为它是迄今为止我能找到的最好的压缩软件。

我想在向导安装程序上显示CMD（命令提示符）的输出进度。 该代码当前显示的页面显示进度条正在进行提取。 我想在下面添加一个框，显示unarc.dll进程的输出。

下面是一个例子。

这是我的InnoSetup代码。

#define ArcArchive "data.arc"

[Setup]
AppName=Test
DefaultDirName=Test
AppVerName=Test
WizardStyle=modern
Uninstallable=no
disableProgramGroupPage=yes

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

[Code]

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,S,Length(S),Result,0);
  SetLength(Result,Len);
  WideCharToMultiByte(CP_UTF8,Len,0);
end;

var
  ArcTotalSize: 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
    ArcTotalSize := Int1;
    Log(Format('Total size of files to be extracted is %d MB',[ArcTotalSize]));
  end
    else
  if What = 'write' then
  begin
    if ArcTotalSize > 0 then
    begin
      ArcProgresspage.SetProgress(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(ArcExtracted,ArcTotalSize);
    end;
  end;

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

function FreeArcCmd(
  Cmd1,Cmd10: string): Integer;
begin
  ArcCancel := False;
  try
    Result :=
      FreeArcExtract(
        CreateCallback(@FreeArcCallback),GetStringAsUtf8(Cmd1),GetStringAsUtf8(Cmd2),GetStringAsUtf8(Cmd3),GetStringAsUtf8(Cmd4),GetStringAsUtf8(Cmd5),GetStringAsUtf8(Cmd6),GetStringAsUtf8(Cmd7),GetStringAsUtf8(Cmd8),GetStringAsUtf8(Cmd9),GetStringAsUtf8(Cmd10));

    Log(Format('Arc command "%s" result %d',[Cmd1,Result]));
  except
    Result := -63;
  end;
end;

function UnPackArchive(ArchivePath: string; DestPath: string): Integer;
begin
  { Find out length of files to be extracted - origsize }
  Result := FreeArcCmd('l','--',ArchivePath,'','');

  if Result = 0 then
  begin
    { Actually extract }
    Result :=
      FreeArcCmd('x','-o+','-dp' + DestPath,'-w' + DestPath,'');
  end;
end;

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

procedure ExtractArc;
var
  ArcArchivePath: string;
  UnpackResult: Integer;
  PrevCancelButtonClick: TNotifyEvent;
  Error: string;
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;

    ArcArchivePath := ExpandConstant('{src}\{#ArcArchive}');
    Log(Format('Arc extraction starting - %s',[ArcArchivePath]));

    ArcExtracted := 0;
    UnpackResult := UnPackArchive(ArcArchivePath,ExpandConstant('{app}'));

    if UnpackResult <> 0 then
    begin
      if ArcCancel then
      begin
        Error := 'Extraction cancelled';
      end
        else
      begin
        Error := Format('Extraction Failed with code %d',[UnpackResult]);
      end;

      MsgBox(Error,mbError,MB_OK);
    end;
  finally
    Log('Arc extraction cleanup');
    ArcProgresspage.Hide;
    WizardForm.CancelButton.OnClick := PrevCancelButtonClick;
  end;
end;

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

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）