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

前端之家收集整理的这篇文章主要介绍了inno-setup – Inno Setup – 如何添加多个arc文件进行解压缩?前端之家小编觉得挺不错的,现在分享给大家,也给大家做个参考。
我正在使用此代码Inno Setup – How to add cancel button to decompressing page?(Martin Prikryl的答案)使用Inno Setup解压缩弧文件.

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

解决方法

这是我对 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,S,Length(S),Result,0);
  SetLength(Result,Len);
  WideCharToMultiByte(CP_UTF8,Len,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,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,'');
    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;
原文链接:https://www.f2er.com/delphi/102968.html

猜你在找的Delphi相关文章