Put throttling of progress callbacks to [Code] in the correct places and also make it time-based.

Positive side effect: removes throttling which existed for TDownloadWizardPage's and TExtractionWizardPage's progress UI updates which wasn't needed because those updates don't use [Code] callbacks.

Did keep throttling for TDownloadWizardPage built-in logging.

Also cleans up THTTPDataReceiver.OnReceiveData which gotten a bit messy.

Note: uses TStopWatch from System.Diagnostics. This unit name sounds bloaty to me but in fact TStopWatch is simple and is actually the only thing in the entire unit, so it's OK.

Projects/Src/Compression.SevenZipDecoder.pas

@@ -272,24 +272,9 @@ end;
 procedure _ReportProgress(const FileName: PChar; const Progress, ProgressMax: UInt64; var Abort: Bool); cdecl;
 begin
   try
-    if Assigned(State.OnExtractionProgress) then begin
-      { Make sure script isn't called crazy often because that would slow the extraction significantly. Only report:
-        -At start or finish
-        -Or if somehow Progress decreased or Max changed
-        -Or if at least 512 KB progress was made since last report
-      }
-      if (Progress = 0) or (Progress = ProgressMax) or
-         (Progress < State.LastReportedProgress) or (ProgressMax <> State.LastReportedProgressMax) or
-         ((Progress - State.LastReportedProgress) > 524288) then begin
-        try
-          if not State.OnExtractionProgress(State.ExtractedArchiveName, FileName, Progress, ProgressMax) then
-            Abort := True;
-        finally
-          State.LastReportedProgress := Progress;
-          State.LastReportedProgressMax := ProgressMax;
-        end;
-      end;
-    end;
+    if Assigned(State.OnExtractionProgress) then
+      if not State.OnExtractionProgress(State.ExtractedArchiveName, FileName, Progress, ProgressMax) then
+        Abort := True;
 
     if not Abort and DownloadTemporaryFileOrExtractArchiveProcessMessages then
       Application.ProcessMessages;

Projects/Src/Setup.Install.pas

@@ -3700,7 +3700,7 @@ type
     FOnSimpleDownloadProgressParam: Integer64;
     FAborted: Boolean;
     FProgress, FProgressMax: Int64;
-    FLastReportedProgress, FLastReportedProgressMax: Int64;
+    FLastReportedProgress: Int64;
   public
     property BaseName: String write FBaseName;
     property Url: String write FUrl;
@@ -3718,41 +3718,29 @@ begin
   FProgress := AReadCount;
   FProgressMax := AContentLength;
 
-  if Assigned(FOnDownloadProgress) then begin
-    { Make sure script isn't called crazy often because that would slow the download significantly. Only report:
-      -At start or finish
-      -Or if somehow Progress decreased or Max changed
-      -Or if at least 512 KB progress was made since last report
-    }
-    if (FProgress = 0) or (FProgress = FProgressMax) or
-       (FProgress < FLastReportedProgress) or (FProgressMax <> FLastReportedProgressMax) or
-       ((FProgress - FLastReportedProgress) > 524288) then begin
+  try
+    if Assigned(FOnDownloadProgress) then begin
+      if not FOnDownloadProgress(FUrl, FBaseName, FProgress, FProgressMax) then
+        Abort := True;
+    end else if Assigned(FOnSimpleDownloadProgress) then begin
       try
-        if not FOnDownloadProgress(FUrl, FBaseName, FProgress, FProgressMax) then
-          Abort := True;
+        FOnSimpleDownloadProgress(Integer64(Progress-FLastReportedProgress), FOnSimpleDownloadProgressParam);
       finally
-        FLastReportedProgress := FProgress;
-        FLastReportedProgressMax := FProgressMax;
+        FLastReportedProgress := Progress;
       end;
     end;
+  except
+    if ExceptObject is EAbort then { FOnSimpleDownloadProgress always uses Abort to abort }
+      Abort := True
+    else
+      raise;
+  end;
 
-    if not Abort and DownloadTemporaryFileOrExtractArchiveProcessMessages then
-      Application.ProcessMessages;
+  if not Abort and DownloadTemporaryFileOrExtractArchiveProcessMessages then
+    Application.ProcessMessages;
 
-    if Abort then
-      FAborted := True
-  end else if Assigned(FOnSimpleDownloadProgress) then begin
-    try
-      FOnSimpleDownloadProgress(Integer64(Progress-FLastReportedProgress), FOnSimpleDownloadProgressParam);
-    except
-      if ExceptObject is EAbort then begin
-        Abort := True;
-        FAborted := True;
-      end else
-        raise;
-    end;
-    FLastReportedProgress := Progress;
-  end;
+  if Abort then
+    FAborted := True
 end;
 
 procedure SetUserAgentAndSecureProtocols(const AHTTPClient: THTTPClient);

Projects/Src/Setup.ScriptDlg.pas

@@ -13,7 +13,7 @@ interface
 
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, Contnrs, Generics.Collections,
-  Shared.Struct, Setup.WizardForm, Setup.Install, Compression.SevenZipDecoder,
+  Shared.Struct, Setup.WizardForm, Setup.Install, Setup.ScriptFunc.HelperFunc, Compression.SevenZipDecoder,
   NewCheckListBox, NewStaticText, NewProgressBar, PasswordEdit, RichEditViewer,
   BidiCtrls, TaskbarProgressFunc;
 
@@ -185,11 +185,13 @@ type
       FShowBaseNameInsteadOfUrl: Boolean;
       FAbortButton: TNewButton;
       FShowProgressControlsOnNextProgress, FAbortedByUser: Boolean;
+      FThrottler: TProgressThrottler;
       function DoAdd(const Url, BaseName, RequiredSHA256OfFile: String;
         const UserName: String = ''; const Password: String = '';
         const ISSigVerify: Boolean = False; const ISSigAllowedKeys: AnsiString = ''): Integer;
       procedure AbortButtonClick(Sender: TObject);
       function InternalOnDownloadProgress(const Url, BaseName: string; const Progress, ProgressMax: Int64): Boolean;
+      function InternalThrottledOnDownloadProgress(const Url, BaseName: string; const Progress, ProgressMax: Int64): Boolean;
       procedure ShowProgressControls(const AVisible: Boolean);
     public
       constructor Create(AOwner: TComponent); override;
@@ -224,8 +226,10 @@ type
       FShowArchiveInsteadOfFile: Boolean;
       FAbortButton: TNewButton;
       FShowProgressControlsOnNextProgress, FAbortedByUser: Boolean;
+      FThrottler: TProgressThrottler;
       procedure AbortButtonClick(Sender: TObject);
       function InternalOnExtractionProgress(const ArchiveName, FileName: string; const Progress, ProgressMax: Int64): Boolean;
+      function InternalThrottledOnExtractionProgress(const ArchiveName, FileName: string; const Progress, ProgressMax: Int64): Boolean;
       procedure ShowProgressControls(const AVisible: Boolean);
     public
       constructor Create(AOwner: TComponent); override;
@@ -981,11 +985,6 @@ begin
     Log('Need to abort download.');
     Result := False;
   end else begin
-    if ProgressMax > 0 then
-      Log(Format('  %d of %d bytes done.', [Progress, ProgressMax]))
-    else
-      Log(Format('  %d bytes done.', [Progress]));
-
     FMsg2Label.Caption := IfThen(FShowBaseNameInsteadOfUrl, BaseName, Url);
     if ProgressMax > MaxLongInt then begin
       Progress32 := Round((Progress / ProgressMax) * MaxLongInt);
@@ -1002,13 +1001,28 @@ begin
       ProcessMsgs;
     end;
 
-    if Assigned(FOnDownloadProgress) then
-      Result := FOnDownloadProgress(Url, BaseName, Progress, ProgressMax)
-    else
-      Result := True;
+    { This will call InternalThrottledOnDownloadProgress, which will log progress and call the script's FOnDownloadProgress, but throttled }
+    if FThrottler = nil then begin
+      const OnDownloadProgress: TOnDownloadProgress = InternalThrottledOnDownloadProgress;
+      FThrottler := TProgressThrottler.Create(OnDownloadProgress);
+    end;
+    Result := FThrottler.OnDownloadProgress(Url, BaseName, Progress, ProgressMax);
   end;
 end;
 
+function TDownloadWizardPage.InternalThrottledOnDownloadProgress(const Url, BaseName: string; const Progress, ProgressMax: Int64): Boolean;
+begin
+  if ProgressMax > 0 then
+    Log(Format('  %d of %d bytes done.', [Progress, ProgressMax]))
+  else
+    Log(Format('  %d bytes done.', [Progress]));
+
+  if Assigned(FOnDownloadProgress) then
+    Result := FOnDownloadProgress(Url, BaseName, Progress, ProgressMax)
+  else
+    Result := True;
+end;
+
 constructor TDownloadWizardPage.Create(AOwner: TComponent);
 begin
   inherited;
@@ -1018,6 +1032,7 @@ end;
 
 destructor TDownloadWizardPage.Destroy;
 begin
+  FThrottler.Free;
   FFiles.Free;
   inherited;
 end;
@@ -1174,13 +1189,27 @@ begin
       ProcessMsgs;
     end;
 
-    if Assigned(FOnExtractionProgress) then
-      Result := FOnExtractionProgress(ArchiveName, FileName, Progress, ProgressMax)
-    else
+    { This will call InternalThrottledOnExtractionProgress, which will call the script's FOnExtractionProgress, but throttled
+      Because it does nothing else we first check if FOnExtractionProgress is actually assigned }
+    if Assigned(FOnExtractionProgress) then begin
+      if FThrottler = nil then begin
+        const OnExtractionProgress: TOnExtractionProgress = InternalThrottledOnExtractionProgress;
+        FThrottler := TProgressThrottler.Create(OnExtractionProgress);
+      end;
+      Result := FThrottler.OnExtractionProgress(ArchiveName, FileName, Progress, ProgressMax);
+    end else
       Result := True;
   end;
 end;
 
+function TExtractionWizardPage.InternalThrottledOnExtractionProgress(const ArchiveName, FileName: string; const Progress, ProgressMax: Int64): Boolean;
+begin
+  if Assigned(FOnExtractionProgress) then { Always True, see above }
+    Result := FOnExtractionProgress(ArchiveName, FileName, Progress, ProgressMax)
+  else
+    Result := True;
+end;
+
 constructor TExtractionWizardPage.Create(AOwner: TComponent);
 begin
   inherited;
@@ -1190,6 +1219,7 @@ end;
 
 destructor TExtractionWizardPage.Destroy;
 begin
+  FThrottler.Free;
   FArchives.Free;
   inherited;
 end;

Projects/Src/Setup.ScriptFunc.HelperFunc.pas

@@ -2,20 +2,20 @@ unit Setup.ScriptFunc.HelperFunc;
 
 {
   Inno Setup
-  Copyright (C) 1997-2024 Jordan Russell
+  Copyright (C) 1997-2025 Jordan Russell
   Portions by Martijn Laan
   For conditions of distribution and use, see LICENSE.TXT.
 
-  Helper functions for the script support functions (run time - used by Setup)
+  Helper types and functions for the script support functions (run time - used by Setup)
 }
 
 interface
 
 uses
-  Windows,
+  Windows, Diagnostics,
   uPSRuntime, MD5, SHA1,
   Shared.CommonFunc, Shared.FileClass, Setup.MainForm, Setup.WizardForm,
-  Setup.UninstallProgressForm;
+  Setup.UninstallProgressForm, Setup.Install, Compression.SevenZipDecoder;
 
 type
   { Must keep this in synch with Compiler.ScriptFunc.pas }
@@ -46,6 +46,26 @@ type
     SuiteMask: Word;
   end;
 
+  { Make sure script isn't called crazy often because that would slow the download significantly.
+    Only reports:
+      -At start or finish
+      -If at least 50 ms passed since last report
+  }
+  TProgressThrottler = class
+  private
+    FOnDownloadProgress: TOnDownloadProgress;
+    FOnExtractionProgress: TOnExtractionProgress;
+    FStopWatch: TStopWatch;
+    FLastOkProgress: Int64;
+    function ThrottleOk(const Progress, ProgressMax: Int64): Boolean;
+  public
+    constructor Create(const OnDownloadProgress: TOnDownloadProgress); overload;
+    constructor Create(const OnExtractionProgress: TOnExtractionProgress); overload;
+    procedure Reset;
+    function OnDownloadProgress(const Url, BaseName: string; const Progress, ProgressMax: Int64): Boolean;
+    function OnExtractionProgress(const ArchiveName, FileName: string; const Progress, ProgressMax: Int64): Boolean;
+  end;
+
 var
   ScaleBaseUnitX, ScaleBaseUnitY: Integer;
 
@@ -697,6 +717,58 @@ begin
   SetLength(ASMInliners, 0);
 end;
 
+{ TProgressThrottler }
+
+constructor TProgressThrottler.Create(const OnDownloadProgress: TOnDownloadProgress);
+begin
+  inherited Create;
+  FOnDownloadProgress := OnDownloadProgress;
+end;
+
+constructor TProgressThrottler.Create(const OnExtractionProgress: TOnExtractionProgress);
+begin
+  inherited Create;
+  FOnExtractionProgress := OnExtractionProgress;
+end;
+
+procedure TProgressThrottler.Reset;
+begin
+  FStopWatch.Stop;
+  FLastOkProgress := -1;
+end;
+
+function TProgressThrottler.ThrottleOk(const Progress, ProgressMax: Int64): Boolean;
+begin
+  if FStopWatch.IsRunning then begin
+    Result := ((Progress = ProgressMax) and (FLastOkProgress <> ProgressMax)) or (FStopWatch.ElapsedMilliseconds >= 50);
+    if Result then
+      FStopWatch.Reset;
+  end else begin
+    Result := True;
+    FStopWatch := TStopwatch.StartNew;
+  end;
+  if Result then
+    FLastOkProgress := Progress;
+end;
+
+function TProgressThrottler.OnDownloadProgress(const Url, BaseName: string; const Progress,
+  ProgressMax: Int64): Boolean;
+begin
+  if Assigned(FOnDownloadProgress) and ThrottleOk(Progress, ProgressMax) then begin
+    Result := FOnDownloadProgress(Url, BaseName, Progress, ProgressMax)
+  end else
+    Result := True;
+end;
+
+function TProgressThrottler.OnExtractionProgress(const ArchiveName, FileName: string;
+  const Progress, ProgressMax: Int64): Boolean;
+begin
+  if Assigned(FOnExtractionProgress) and ThrottleOk(Progress, ProgressMax) then
+    Result := FOnExtractionProgress(ArchiveName, FileName, Progress, ProgressMax)
+  else
+    Result := True;
+end;
+
 initialization
 finalization
   FreeASMInliners;

Projects/Src/Setup.ScriptFunc.pas

@@ -831,10 +831,16 @@ var
         Verification.ISSigAllowedKeys := ISSigAllowedKeys
       end;
 
-      { Also see Setup.ScriptDlg TDownloadWizardPage.AddExWithISSigVerify }
-      if ISSigVerify then
-        DownloadTemporaryFile(GetISSigUrl(Url, ISSigUrl), BaseName + ISSigExt, NoVerification, OnDownloadProgress);
-      Stack.SetInt64(PStart, DownloadTemporaryFile(Url, BaseName, Verification, OnDownloadProgress));
+      const Throttler = TProgressThrottler.Create(OnDownloadProgress);
+      try
+        { Also see Setup.ScriptDlg TDownloadWizardPage.AddExWithISSigVerify }
+        if ISSigVerify then
+          DownloadTemporaryFile(GetISSigUrl(Url, ISSigUrl), BaseName + ISSigExt, NoVerification, Throttler.OnDownloadProgress);
+        Throttler.Reset;
+        Stack.SetInt64(PStart, DownloadTemporaryFile(Url, BaseName, Verification, Throttler.OnDownloadProgress));
+      finally
+        Throttler.Free;
+      end;
     end);
     RegisterScriptFunc('DownloadTemporaryFileSize', sfNoUninstall, procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
     begin
@@ -1826,16 +1832,22 @@ var
         FullDirsItemNo := PStart-3;
       end;
 
+      const Throttler = TProgressThrottler.Create(TOnExtractionProgress(Stack.GetProc(FullDirsItemNo-1, Caller)));
       try
-        if SetupHeader.SevenZipLibraryName <> '' then
-          ExtractArchiveRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart), Stack.GetString(PStart-1), Password, Stack.GetBool(FullDirsItemNo), TOnExtractionProgress(Stack.GetProc(FullDirsItemNo-1, Caller)))
-        else
-          Extract7ZipArchiveRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart), Stack.GetString(PStart-1), Password, Stack.GetBool(FullDirsItemNo), TOnExtractionProgress(Stack.GetProc(FullDirsItemNo-1, Caller)));
-      except
-        on E: EAbort do
-          raise Exception.Create(SetupMessages[msgErrorExtractionAborted])
-        else
-          raise Exception.Create(FmtSetupMessage1(msgErrorExtractionFailed, GetExceptMessage));
+        try
+          if SetupHeader.SevenZipLibraryName <> '' then
+            ExtractArchiveRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart), Stack.GetString(PStart-1),
+              Password, Stack.GetBool(FullDirsItemNo), Throttler.OnExtractionProgress)
+          else
+            Extract7ZipArchiveRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart), Stack.GetString(PStart-1),
+              Password, Stack.GetBool(FullDirsItemNo), Throttler.OnExtractionProgress);
+        except
+          on E: EAbort do
+            raise Exception.Create(SetupMessages[msgErrorExtractionAborted])
+          else
+            raise Exception.Create(FmtSetupMessage1(msgErrorExtractionFailed, GetExceptMessage));
+        end;
+      finally
       end;
     end);
     RegisterScriptFunc('MapArchiveExtensions', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)