Merge branch 'main' into files-downloadarchive

# Conflicts:
#	Projects/Src/Setup.ScriptDlg.pas

Projects/Bin/Debug.iss

@@ -2,6 +2,7 @@
 ; Opened when you run the Compil32 project in Debug mode from the Delphi IDE
 ; Same for ISCmplr, ISCC, and ISPP and for any of the islzma projects
 ; Use it to test the compiler or Setup or the uninstaller
+; The Setup project enables logging to Setup.log when you run it
 
 #pragma message "ɯɐɹƃoɹd ʎɯ"
 
@@ -13,9 +14,11 @@
 AppName=ɯɐɹƃoɹd ʎɯ
 AppVerName=My Program version 1.5
 DefaultDirName={autopf}\My Program
-UseSetupLdr=0
-OutputDir=.
 AppVersion=1.2.3
+; The following four lines make the output debuggable from the Setup project
+; If you put them in any example script you can debug that example as well
+UseSetupLdr=0
+OutputDir={#CompilerPath}
 OutputBaseFilename=Setup
 PrivilegesRequired=lowest
 

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/IDE.ScintStylerInnoSetup.pas

@@ -387,8 +387,7 @@ const
   ];
 
   Constants: array of AnsiString = [
-    { #emit and #file handled separately by BuildConstantsWordList.
-      Also doesnt include constants with non words chars. }
+    { Doesnt include constants with non words chars }
     '{', 'app', 'win', 'sys', 'sysnative', 'syswow64', 'src', 'sd', 'commonpf',
     'commoncf', 'tmp', 'commonfonts', 'dao', 'dotnet11', 'dotnet20', 'dotnet40',
     'group', 'localappdata', 'userappdata', 'commonappdata', 'usercf',
@@ -402,6 +401,12 @@ const
     'userinfoorg', 'userinfoserial', 'username', 'log'
   ];
 
+  ISPPPredefinedVariables: array of AnsiString = [
+    { #emit and #file handled separately by BuildConstantsWordList.
+      Only includes predefined variables that are useful on their own. }
+    'CompilerPath', 'SourcePath'
+  ];
+
   PascalConstants: array of AnsiString = [
     { ROPS }
     'varEmpty', 'varNull', 'varSmallInt', 'varInteger', 'varSingle', 'varDouble',
@@ -876,6 +881,8 @@ begin
     if ISPPInstalled then begin
       AddWordToList(SL, '{#', awtConstant);
       AddWordToList(SL, '{#file ', awtConstant);
+      for var ISPPPredefinedVariable in ISPPPredefinedVariables do
+        AddWordToList(SL, '{#' + ISPPPredefinedVariable + '}', awtConstant);
     end;
     for var ConstantWithParam in ConstantsWithParam do
       AddWordToList(SL, '{' + ConstantWithParam, awtConstant);

Projects/Src/Setup.Install.pas

@@ -3708,7 +3708,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;
@@ -3726,41 +3726,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;
 
@@ -190,12 +190,14 @@ type
       FShowBaseNameInsteadOfUrl: Boolean;
       FAbortButton: TNewButton;
       FShowProgressControlsOnNextProgress, FAbortedByUser: Boolean;
+      FThrottler: TProgressThrottler;
       FLastBaseNameOrUrl: String;
       function DoAdd(const Url, BaseName, RequiredSHA256OfFile: String;
         const UserName, Password: String; const ISSigVerify: Boolean;
         const ISSigAllowedKeys: AnsiString; const DotISSigEntry: Boolean; const Data: NativeUInt): 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;
@@ -234,8 +236,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;
@@ -991,11 +995,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, PathExtractName(BaseName), Url);
     if ProgressMax > MaxLongInt then begin
       Progress32 := Round((Progress / ProgressMax) * MaxLongInt);
@@ -1012,13 +1011,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;
@@ -1028,6 +1042,7 @@ end;
 
 destructor TDownloadWizardPage.Destroy;
 begin
+  FThrottler.Free;
   FFiles.Free;
   inherited;
 end;
@@ -1210,13 +1225,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;
@@ -1226,6 +1255,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,25 @@ type
     SuiteMask: Word;
   end;
 
+  { Makes 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 +716,57 @@ 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;
+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,23 @@ 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
+        Throttler.Free;
       end;
     end);
     RegisterScriptFunc('MapArchiveExtensions', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)

whatsnew.htm

@@ -91,7 +91,7 @@ Source: "{tmp}\MyProg-ExtraReadmes.7z"; DestDir: "{app}"; \
     <li>Supports HTTPS (but not expired or self-signed certificates) and HTTP. Redirects are automatically followed and proxy settings are automatically used. Safe to use from services.</li>
     <li>Flag <tt>download</tt> must be combined with the <tt>external</tt> and <tt>ignoreversion</tt> flags. Additionally, the <tt>DestName</tt> and <tt>ExternalSize</tt> parameters must be set.<br/>
         It can also be combined with the new <tt>issigverify</tt> flag (see below) for efficient and highly secure verification of the download file.<br/>
-        It cannot be combined with the <tt>comparetimestampalso</tt>, <tt>recursesubdirs</tt> and <tt>skipifsourcedoesntexist</tt> flags.</li>
+        It cannot be combined with the <tt>comparetimestamp</tt>, <tt>recursesubdirs</tt> and <tt>skipifsourcedoesntexist</tt> flags.</li>
     <li>File download otherwise behaves the same as external file copying. For example, it supports automatic uninstallation of downloaded files and can be combined with same other flags and parameters.</li>
     <li>Example script:
       <pre>[Files]