Inno Setup 在 PrepareToInstall 页面上显示目录复制进度条和标签

Question

我试图在将以前的安装复制（迁移）到新位置时在 PrepareToInstall 页面上显示进度条和标签。我使用的是 Martin Prikryl 的程序的略微修改版本，并且按预期工作；文件和目录被复制到新位置，操作被记录到文件。

然而，在复制文件时，如果有很多文件（我用 2,500 个文件测试了这个，总计约 1.2GB），这可能是一个相当长的运行操作，GUI 没有更新并且似乎冻结，而不显示任何我的自定义控件（即没有进度条和进度标签）。我设法通过调用 Refresh 或 Update 强制显示它们，但进度条没有动画，并且在复制操作完成时整个 GUI 似乎没有响应。我认为 Inno Setup 仅支持 single-threaded operations is maybe what is causing the GUI to freeze and not update。有没有办法在复制文件的同时更新 GUI？

[Code]
var
  PrepareToInstallLabel: TNewStaticText;
  PrepareToInstallProgressBar: TNewProgressBar;

//Slightly modified Public Domain code to copy a directory recursively and update PrepareToInstall label progress
//Contributed by Martin Prikryl on Stack Overflow
procedure DirCopy(strSourcePath, strDestPath: String);
var
  FindRec: TFindRec;
  strSourceFilePath, strDestFilePath: String;
begin
  if FindFirst(strSourcePath + '\*', FindRec) then
    begin
      try
        repeat
          if (FindRec.Name <> '.') and (FindRec.Name <> '..') then
            begin
              strSourceFilePath := strSourcePath + '\' + FindRec.Name;
              strDestFilePath := strDestPath + '\' + FindRec.Name;
              if FindRec.Attributes and FILE_ATTRIBUTE_DIRECTORY = 0 then
                begin
                  PrepareToInstallLabel.Caption := 'Copying ' + strSourceFilePath + '...';
                  if FileCopy(strSourceFilePath, strDestFilePath, False) then
                    begin
                      Log(Format('Copied %s to %s', [strSourceFilePath, strDestFilePath]));
                    end
                  else
                    begin
                      SuppressibleMsgBox(Format('Failed to copy %s to %s', [strSourceFilePath, strDestFilePath]),
                        mbError, MB_OK, IDOK);
                    end;
                end
              else
                begin
                  if CreateDir(strDestFilePath) then
                    begin
                      Log(Format('Created %s', [strDestFilePath]));
                      DirCopy(strSourceFilePath, strDestFilePath);
                    end
                  else
                    begin
                      SuppressibleMsgBox(Format('Failed to create %s', [strDestFilePath]),
                        mbError, MB_OK, IDOK);
                    end;
                end;
            end;
        until
          not FindNext(FindRec);
      finally
        FindClose(FindRec);
      end;
    end
  else
    begin
      SuppressibleMsgBox(Format('Failed to list %s', [strSourcePath]),
        mbError, MB_OK, IDOK);
    end;
end;

//Show PrepareToInstall page GUI controls
procedure ShowPrepareToInstallGuiControls();
begin
  PrepareToInstallProgressBar.Visible := True;
  PrepareToInstallLabel.Visible := True;
end;

//Update PrepareToInstall page GUI controls; note this procedure should not be needed
procedure UpdatePrepareToInstallGuiControls();
begin
//Both lines below seem to be needed to force the Cancel button to disable,
//despite already disabling the button at the beginning of the PrepareToInstall event
  WizardForm.CancelButton.Enabled := False;
  WizardForm.CancelButton.Refresh;
//Both lines below seem to be needed to force display of the progress bar and label,
//despite already showing them in the PrepareToInstall event; without them no controls are shown on the page.
  PrepareToInstallLabel.Update;
  PrepareToInstallProgressBar.Update;
end;

//Hide PrepareToInstall page GUI controls
procedure HidePrepareToInstallGuiControls();
begin
  PrepareToInstallProgressBar.Visible := False;
  PrepareToInstallLabel.Visible := False;
end;

function PrepareToInstall(var NeedsRestart: Boolean): String;
begin
  WizardForm.CancelButton.Enabled := False;
//Migrate installation
  if IsMigration then
    begin
      ShowPrepareToInstallGuiControls;
      PrepareToInstallLabel.Caption := 'Migrating installation...';
      UpdatePrepareToInstallGuiControls;
      Log('Installation migration started.');
      ForceDirectories(ExpandConstant('{app}\FolderToMigrate'));
      DirCopy(strExistingInstallPath + '\Database', ExpandConstant('{app}\FolderToMigrate'));
      Log('Installation migration finished.');
    end;
  HidePrepareToInstallGuiControls;
end;

procedure InitializeWizard();
//Define the label for the Preparing to Install page
  PrepareToInstallLabel := TNewStaticText.Create(WizardForm);
  with PrepareToInstallLabel do
    begin
      Visible := False;
      Parent := WizardForm.PreparingPage;
      Left := WizardForm.StatusLabel.Left;
      Top := WizardForm.StatusLabel.Top;
    end;
//Define Progress Bar for the Preparing to Install Page
  PrepareToInstallProgressBar := TNewProgressBar.Create(WizardForm);
  with PrepareToInstallProgressBar do
    begin
      Visible := False;
      Parent := WizardForm.PreparingPage;
      Left := WizardForm.ProgressGauge.Left;
      Top := WizardForm.ProgressGauge.Top;
      Width := WizardForm.ProgressGauge.Width;
      Height := WizardForm.ProgressGauge.Height;
      Min := 0;
      Max := 100;
      Style := npbstMarquee;
    end;
end;

更新：我在PrepareToInstallLabel.Caption := 'Copying ' + strSourceFilePath + '...';下添加了WizardForm.Refresh;，这似乎强制标签更新，但仍然没有进度条动画。另外，调用WizardForm.Refresh数千次，每个文件都被复制后，效率似乎不是特别高。

Answer 1

最简单的解决方案是在 repeat...until 循环中抽取 windows 消息队列。

或者您可以使用TOutputProgressWizardPage来显示操作进度。

我添加了更多详细信息，包括示例实现的链接
Inno Setup: How to modify long running script so it will not freeze GUI?

Inno Setup 在 PrepareToInstall 页面上显示目录复制进度条和标签

Inno Setup show directory copy progress bar and label on PrepareToInstall page

inno-setup

pascalscript