Browse Source

Work on adding CreateExtractionPage and also make some other improvements. Some todos left as mentioned in the code and also didn't actually test the page yet.

Martijn Laan 9 months ago
parent
commit
dc634c99de

+ 9 - 0
ISHelp/isxclasses.pas

@@ -780,6 +780,15 @@ TDownloadWizardPage = class(TOutputProgressWizardPage)
   property ShowBaseNameInsteadOfUrl: Boolean; read write;
   property ShowBaseNameInsteadOfUrl: Boolean; read write;
 end;
 end;
 
 
+TExtractionWizardPage = class(TOutputProgressWizardPage)
+  property AbortButton: TNewButton; read;
+  property AbortedByUser: Boolean; read;
+  procedure Add(const ArchiveFileName, DestDir: String; const FullPaths: Boolean);
+  procedure Clear;
+  function Extract: Integer;
+  property ShowArchiveInsteadOfFile: Boolean; read write;
+end;
+
 TUIStateForm = class(TForm)
 TUIStateForm = class(TForm)
 end;
 end;
 
 

+ 23 - 20
ISHelp/isxclasses_wordlists_generated.pas

@@ -23,21 +23,22 @@ var
     'TComponent', 'TConstraintSize', 'TControl', 'TCursor', 'TCustomCheckBox', 'TCustomComboBox',
     'TComponent', 'TConstraintSize', 'TControl', 'TCursor', 'TCustomCheckBox', 'TCustomComboBox',
     'TCustomControl', 'TCustomEdit', 'TCustomFolderTreeView', 'TCustomLabel', 'TCustomLinkLabel',
     'TCustomControl', 'TCustomEdit', 'TCustomFolderTreeView', 'TCustomLabel', 'TCustomLinkLabel',
     'TCustomListBox', 'TCustomMemo', 'TCustomPanel', 'TDownloadWizardPage', 'TDuplicates',
     'TCustomListBox', 'TCustomMemo', 'TCustomPanel', 'TDownloadWizardPage', 'TDuplicates',
-    'TEdit', 'TEditCharCase', 'TEShiftState', 'TFileStream', 'TFolderRenameEvent', 'TFolderTreeView',
-    'TFont', 'TFontStyle', 'TFontStyles', 'TForm', 'TFormBorderStyle', 'TFormStyle', 'TGraphic',
-    'TGraphicControl', 'TGraphicsObject', 'THandleStream', 'TInputDirWizardPage', 'TInputFileWizardPage',
-    'TInputOptionWizardPage', 'TInputQueryWizardPage', 'TKeyEvent', 'TKeyPressEvent', 'TLabel',
-    'TLinkLabel', 'TListBox', 'TListBoxStyle', 'TMainForm', 'TMemo', 'TNewButton', 'TNewCheckBox',
-    'TNewCheckListBox', 'TNewComboBox', 'TNewEdit', 'TNewLinkLabel', 'TNewListBox', 'TNewMemo',
-    'TNewNotebook', 'TNewNotebookPage', 'TNewProgressBar', 'TNewProgressBarState', 'TNewProgressBarStyle',
-    'TNewRadioButton', 'TNewStaticText', 'TNotifyEvent', 'TObject', 'TOutputMarqueeProgressWizardPage',
-    'TOutputMsgMemoWizardPage', 'TOutputMsgWizardPage', 'TOutputProgressWizardPage', 'TPanel',
-    'TPanelBevel', 'TPasswordEdit', 'TPen', 'TPenMode', 'TPenStyle', 'TPersistent', 'TPosition',
-    'TRadioButton', 'TRichEditViewer', 'TScrollingWinControl', 'TScrollStyle', 'TSetupForm',
-    'TShiftState', 'TSizeConstraints', 'TStartMenuFolderTreeView', 'TStream', 'TStringList',
-    'TStrings', 'TStringStream', 'TSysLinkEvent', 'TSysLinkType', 'TUIStateForm', 'TUninstallProgressForm',
-    'TWinControl', 'TWizardForm', 'TWizardPage', 'TWizardPageButtonEvent', 'TWizardPageCancelEvent',
-    'TWizardPageNotifyEvent', 'TWizardPageShouldSkipEvent'
+    'TEdit', 'TEditCharCase', 'TEShiftState', 'TExtractionWizardPage', 'TFileStream', 'TFolderRenameEvent',
+    'TFolderTreeView', 'TFont', 'TFontStyle', 'TFontStyles', 'TForm', 'TFormBorderStyle',
+    'TFormStyle', 'TGraphic', 'TGraphicControl', 'TGraphicsObject', 'THandleStream', 'TInputDirWizardPage',
+    'TInputFileWizardPage', 'TInputOptionWizardPage', 'TInputQueryWizardPage', 'TKeyEvent',
+    'TKeyPressEvent', 'TLabel', 'TLinkLabel', 'TListBox', 'TListBoxStyle', 'TMainForm',
+    'TMemo', 'TNewButton', 'TNewCheckBox', 'TNewCheckListBox', 'TNewComboBox', 'TNewEdit',
+    'TNewLinkLabel', 'TNewListBox', 'TNewMemo', 'TNewNotebook', 'TNewNotebookPage', 'TNewProgressBar',
+    'TNewProgressBarState', 'TNewProgressBarStyle', 'TNewRadioButton', 'TNewStaticText',
+    'TNotifyEvent', 'TObject', 'TOutputMarqueeProgressWizardPage', 'TOutputMsgMemoWizardPage',
+    'TOutputMsgWizardPage', 'TOutputProgressWizardPage', 'TPanel', 'TPanelBevel', 'TPasswordEdit',
+    'TPen', 'TPenMode', 'TPenStyle', 'TPersistent', 'TPosition', 'TRadioButton', 'TRichEditViewer',
+    'TScrollingWinControl', 'TScrollStyle', 'TSetupForm', 'TShiftState', 'TSizeConstraints',
+    'TStartMenuFolderTreeView', 'TStream', 'TStringList', 'TStrings', 'TStringStream',
+    'TSysLinkEvent', 'TSysLinkType', 'TUIStateForm', 'TUninstallProgressForm', 'TWinControl',
+    'TWizardForm', 'TWizardPage', 'TWizardPageButtonEvent', 'TWizardPageCancelEvent', 'TWizardPageNotifyEvent',
+    'TWizardPageShouldSkipEvent'
   ];
   ];
 
 
   PascalEnumValues_Isxclasses: array of AnsiString = [
   PascalEnumValues_Isxclasses: array of AnsiString = [
@@ -89,6 +90,7 @@ var
     'function CheckItem(Index: Integer; AOperation: TCheckItemOperation): Boolean;',
     'function CheckItem(Index: Integer; AOperation: TCheckItemOperation): Boolean;',
     'function CopyFrom(Source: TStream; ByteCount: Int64; BufferSize: Integer): Int64;',
     'function CopyFrom(Source: TStream; ByteCount: Int64; BufferSize: Integer): Int64;',
     'function Download: Int64;',
     'function Download: Int64;',
+    'function Extract: Integer;',
     'function Find(S: String; var Index: Integer): Boolean;',
     'function Find(S: String; var Index: Integer): Boolean;',
     'function FindComponent(AName: String): TComponent;',
     'function FindComponent(AName: String): TComponent;',
     'function FindNextPage(CurPage: TNewNotebookPage; GoForward: Boolean): TNewNotebookPage;',
     'function FindNextPage(CurPage: TNewNotebookPage; GoForward: Boolean): TNewNotebookPage;',
@@ -102,6 +104,7 @@ var
     'function TextHeight(Text: String): Integer;',
     'function TextHeight(Text: String): Integer;',
     'function TextWidth(Text: String): Integer;',
     'function TextWidth(Text: String): Integer;',
     'function Write(Buffer: AnyString; ByteCount: Longint): Longint;',
     'function Write(Buffer: AnyString; ByteCount: Longint): Longint;',
+    'procedure Add(ArchiveFileName, DestDir: String; FullPaths: Boolean);',
     'procedure Add(Url, BaseName, RequiredSHA256OfFile: String);',
     'procedure Add(Url, BaseName, RequiredSHA256OfFile: String);',
     'procedure AddEx(Url, BaseName, RequiredSHA256OfFile, UserName, Password: String);',
     'procedure AddEx(Url, BaseName, RequiredSHA256OfFile, UserName, Password: String);',
     'procedure AddStrings(Strings: TStrings);',
     'procedure AddStrings(Strings: TStrings);',
@@ -195,11 +198,11 @@ var
     'SelectComponentsPage', 'SelectDirBitmapImage', 'SelectDirBrowseLabel', 'SelectDirLabel',
     'SelectComponentsPage', 'SelectDirBitmapImage', 'SelectDirBrowseLabel', 'SelectDirLabel',
     'SelectDirPage', 'Selected', 'SelectedValueIndex', 'SelectGroupBitmapImage', 'SelectProgramGroupPage',
     'SelectDirPage', 'Selected', 'SelectedValueIndex', 'SelectGroupBitmapImage', 'SelectProgramGroupPage',
     'SelectStartMenuFolderBrowseLabel', 'SelectStartMenuFolderLabel', 'SelectTasksLabel',
     'SelectStartMenuFolderBrowseLabel', 'SelectStartMenuFolderLabel', 'SelectTasksLabel',
-    'SelectTasksPage', 'SelLength', 'SelStart', 'SelText', 'Shape', 'ShowAccelChar', 'ShowBaseNameInsteadOfUrl',
-    'ShowHint', 'Showing', 'ShowLines', 'Size', 'SizeAndCenterOnShow', 'Sorted', 'State',
-    'StatusLabel', 'Stretch', 'Strings', 'Style', 'SubCaptionLabel', 'SubItemFontStyle',
-    'Surface', 'SurfaceColor', 'SurfaceHeight', 'SurfaceWidth', 'TabOrder', 'TabStop',
-    'Tag', 'TasksList', 'Text', 'Top', 'TypesCombo', 'UseRichEdit', 'UserInfoNameEdit',
+    'SelectTasksPage', 'SelLength', 'SelStart', 'SelText', 'Shape', 'ShowAccelChar', 'ShowArchiveInsteadOfFile',
+    'ShowBaseNameInsteadOfUrl', 'ShowHint', 'Showing', 'ShowLines', 'Size', 'SizeAndCenterOnShow',
+    'Sorted', 'State', 'StatusLabel', 'Stretch', 'Strings', 'Style', 'SubCaptionLabel',
+    'SubItemFontStyle', 'Surface', 'SurfaceColor', 'SurfaceHeight', 'SurfaceWidth', 'TabOrder',
+    'TabStop', 'Tag', 'TasksList', 'Text', 'Top', 'TypesCombo', 'UseRichEdit', 'UserInfoNameEdit',
     'UserInfoNameLabel', 'UserInfoOrgEdit', 'UserInfoOrgLabel', 'UserInfoPage', 'UserInfoSerialEdit',
     'UserInfoNameLabel', 'UserInfoOrgEdit', 'UserInfoOrgLabel', 'UserInfoPage', 'UserInfoSerialEdit',
     'UserInfoSerialLabel', 'UseVisualStyle', 'Values', 'Visible', 'WantReturns', 'WantTabs',
     'UserInfoSerialLabel', 'UseVisualStyle', 'Values', 'Visible', 'WantReturns', 'WantTabs',
     'WelcomeLabel1', 'WelcomeLabel2', 'WelcomePage', 'Width', 'WizardBitmapImage', 'WizardBitmapImage2',
     'WelcomeLabel1', 'WelcomeLabel2', 'WelcomePage', 'Width', 'WizardBitmapImage', 'WizardBitmapImage2',

+ 50 - 6
ISHelp/isxfunc.xml

@@ -1795,7 +1795,8 @@ end;</pre></example>
 <link topic="isxfunc_DownloadTemporaryFileSize">DownloadTemporaryFileSize</link><br />
 <link topic="isxfunc_DownloadTemporaryFileSize">DownloadTemporaryFileSize</link><br />
 <link topic="isxfunc_DownloadTemporaryFileDate">DownloadTemporaryFileDate</link><br />
 <link topic="isxfunc_DownloadTemporaryFileDate">DownloadTemporaryFileDate</link><br />
 <link topic="isxfunc_CreateDownloadPage">CreateDownloadPage</link><br />
 <link topic="isxfunc_CreateDownloadPage">CreateDownloadPage</link><br />
-<link topic="isxfunc_ExtractTemporaryFile">ExtractTemporaryFile</link></p></seealso>
+<link topic="isxfunc_ExtractTemporaryFile">ExtractTemporaryFile</link><br />
+<link topic="isxfunc_Extract7ZipArchive">Extract7ZipArchive</link></p></seealso>
         <example><pre>
         <example><pre>
 [Code]
 [Code]
 function OnDownloadProgress(const Url, Filename: String; const Progress, ProgressMax: Int64): Boolean;
 function OnDownloadProgress(const Url, Filename: String; const Progress, ProgressMax: Int64): Boolean;
@@ -1841,11 +1842,16 @@ end;</pre>
 <p>See <link topic="isxfunc_DownloadTemporaryFile">DownloadTemporaryFile</link> for other considerations.</p></description>
 <p>See <link topic="isxfunc_DownloadTemporaryFile">DownloadTemporaryFile</link> for other considerations.</p></description>
       </function>
       </function>
       <function>
       <function>
-        <name>Extract7ZipFile</name>
-        <prototype>function Extract7ZipFile(const FileName, DestDir: String; const FullPaths: Boolean): Integer;</prototype>
-        <description><p>Extracts the specified 7-Zip archive to the specified directory, with or without using path names. Returns zero if successful, nonzero otherwise</p>
-<p>The archive must not be encrypted.</p></description>
-        <remarks><p>Uses an embedded version of the &quot;7z ANSI-C Decoder&quot; from the LZMA SDK by Igor Pavlov, as-is, except that Unicode support and error messages were improved and that it outputs memory requirements.</p>
+        <name>Extract7ZipArchive</name>
+        <prototype>function Extract7ZipArchive(const ArchiveFileName, DestDir: String; const FullPaths: Boolean; const OnExtractionProgress: TOnExtractionProgress): Integer;</prototype>
+        <description><p>Extracts the specified 7-Zip archive to the specified directory, with or without using path names.</p>
+<p>Returns zero if successful, nonzero otherwise</p>
+<p>The archive must not be encrypted.</p>
+<p>Set OnExtractionProgress to a function to be informed of progress, or <tt>nil</tt> otherwise.</p></description>
+        <remarks><p>TOnExtractionProgress is defined as:</p>
+<p><tt>TOnExtractionProgress = function(const ArchiveFileName, FileName: string; const Progress, ProgressMax: Int64): Boolean;</tt></p>
+<p>Return True to allow the extraction to continue, False otherwise.</p>
+<p><tt>Extract7ZipArchive</tt> uses an embedded version of the &quot;7z ANSI-C Decoder&quot; from the LZMA SDK by Igor Pavlov, as-is, except that Unicode support and error messages were improved and that it outputs memory requirements.</p>
 <p>All output of the decoder is logged if logging is enabled, including error messages but excluding empty lines.</p>
 <p>All output of the decoder is logged if logging is enabled, including error messages but excluding empty lines.</p>
 <p>The decoder has the following limitations, as written by Igor Pavlov in the LZMA SDK:<br /><br />
 <p>The decoder has the following limitations, as written by Igor Pavlov in the LZMA SDK:<br /><br />
 -It reads only &quot;FileName&quot;, &quot;Size&quot;, &quot;LastWriteTime&quot; and &quot;CRC&quot; information for each file in archive.<br />
 -It reads only &quot;FileName&quot;, &quot;Size&quot;, &quot;LastWriteTime&quot; and &quot;CRC&quot; information for each file in archive.<br />
@@ -1858,6 +1864,27 @@ You can create .7z archive with 7z.exe, 7za.exe or 7zr.exe:<br /><br />
 If you have big number of files in archive, and you need fast extracting, you can use partly-solid archives:<br /><br />
 If you have big number of files in archive, and you need fast extracting, you can use partly-solid archives:<br /><br />
 7za.exe a archive.7z *.htm -ms=512K -r -mx -m0fb=255 -m0d=512K<br /><br />
 7za.exe a archive.7z *.htm -ms=512K -r -mx -m0fb=255 -m0d=512K<br /><br />
 In that example 7-Zip will use 512KB solid blocks. So it needs to decompress only 512KB for extracting one file from such archive.</p></remarks>
 In that example 7-Zip will use 512KB solid blocks. So it needs to decompress only 512KB for extracting one file from such archive.</p></remarks>
+        <seealso><p><link topic="isxfunc_CreateExtractionPage">CreateExtractionPage</link><br />
+<link topic="isxfunc_CreateDownloadPage">CreateDownloadPage</link><br />
+<link topic="isxfunc_DownloadTemporaryFile">DownloadTemporaryFile</link><br />
+<link topic="isxfunc_ExtractTemporaryFile">ExtractTemporaryFile</link></p></seealso>
+        <example><pre>
+[Code]
+function OnExtractionProgress(const ArchiveFileName, FileName: string; const Progress, ProgressMax: Int64): Boolean;
+begin
+  Log(Format('  %s\%s: %d of %d bytes done.', [ArchiveFileName, FileName, Progress, ProgressMax]))
+  Result := True;
+end;
+
+function InitializeSetup: Boolean;
+begin
+  try
+    Result := Extract7ZipArchive(ExpandConstant('{tmp}\Archive.7z'), ExpandConstant('{app}'), True, @OnExtractionProgress) = 0;
+  except
+    Log(GetExceptionMessage);
+    Result := False;
+  end;
+end;</pre></example>
       </function>
       </function>
     </subcategory>
     </subcategory>
     <subcategory>
     <subcategory>
@@ -2621,6 +2648,23 @@ Page := CreateOutputMsgMemoPage(wpWelcome,
         <example><p>See <i>CodeDownloadFiles.iss</i> for an example.</p></example>
         <example><p>See <i>CodeDownloadFiles.iss</i> for an example.</p></example>
         <seealso><p><link topic="scriptclasses" anchor="TDownloadWizardPage">TDownloadWizardPage</link><br />
         <seealso><p><link topic="scriptclasses" anchor="TDownloadWizardPage">TDownloadWizardPage</link><br />
 <link topic="isxfunc_DownloadTemporaryFile">DownloadTemporaryFile</link><br />
 <link topic="isxfunc_DownloadTemporaryFile">DownloadTemporaryFile</link><br />
+<link topic="isxfunc_CreateOutputProgressPage">CreateOutputProgressPage</link></p></seealso>
+      </function>
+      <function>
+        <name>CreateExtractionPage</name>
+        <prototype>function CreateExtractionPage(const ACaption, ADescription: String; const OnExtractionProgress: TOnExtractionProgress): ExtractionWizardPage;</prototype>
+        <description><p>Creates a wizard page to extract 7-Zip archives and show progress.</p>
+<p>Set OnExtractionProgress to a function to be informed of progress, or <tt>nil</tt> otherwise.</p>    
+<p>Unlike the other types of wizard pages, progress pages are not displayed as part of the normal page sequence (note that there is no <tt>AfterID</tt> parameter). A progress page can only be displayed programmatically by calling its <tt>Show</tt> method.</p></description>
+        <remarks><p>Call the <tt>Show</tt> method to activate and show the page. When you're finished with it, call the <tt>Hide</tt> method to revert to the previous page.</p>
+<p>Always put the <tt>Hide</tt> call inside the <tt>finally</tt> part of a <tt>try..finally</tt> language construct, as demonstrated in <i>CodeDownloadFiles.iss</i>. Not calling <tt>Hide</tt> will result in the wizard being permanently stuck on the progress page.</p>
+<p>To add a new archive to extract, call the <tt>Add</tt> method. Always call the <tt>Clear</tt> method before adding the first file.</p>
+<p>To start the extraction, call the <tt>Extract</tt> method. An exception will be raised if there was an error. Otherwise, <tt>Extract</tt> returns the number of archives extracted.</p>
+<p>Set the <tt>ShowArchiveInsteadFile</tt> property to <tt>True</tt> to show the name of the archive which is being extracted to the user instead of the names of the files inside the archive.</p>
+<p>See <link topic="isxfunc_Extract7ZipArchive">Extract7ZipArchive</link> for other considerations and the definition of <tt>TOnExtractionProgress</tt>.</p></remarks>
+        <example><p>See <i>CodeDownloadFiles.iss</i> for an example of <tt>CreateDownloadPage</tt> which works very similar to <tt>CreateExtractionPage</tt>.</p></example>
+        <seealso><p><link topic="scriptclasses" anchor="TExtractionWizardPage">TExtractionWizardPage</link><br />
+<link topic="isxfunc_Extract7ZipArchive">Extract7ZipArchive</link><br />
 <link topic="isxfunc_CreateOutputProgressPage">CreateOutputProgressPage</link></p></seealso>
 <link topic="isxfunc_CreateOutputProgressPage">CreateOutputProgressPage</link></p></seealso>
       </function>
       </function>
       <function>
       <function>

+ 15 - 0
Projects/Src/Compiler.ScriptClasses.pas

@@ -567,6 +567,20 @@ begin
   end;
   end;
 end;
 end;
 
 
+procedure RegisterExtractionWizardPage_C(Cl: TPSPascalCompiler);
+begin
+  with CL.AddClassN(Cl.FindClass('TOutputProgressWizardPage'),'TExtractionWizardPage') do
+  begin
+    RegisterProperty('AbortButton', 'TNewButton', iptr);
+    RegisterProperty('AbortedByUser', 'Boolean', iptr);
+    RegisterProperty('ShowArchiveInsteadOfFile', 'Boolean', iptrw);
+    RegisterMethod('procedure Add(const ArchiveFileName, DestDir: String; const FullPaths: Boolean)');
+    RegisterMethod('procedure Clear');
+    RegisterMethod('function Extract: Integer');
+    RegisterMethod('procedure Show'); { Without this TOutputProgressWizardPage's Show will be called }
+  end;
+end;
+
 procedure RegisterHandCursor_C(Cl: TPSPascalCompiler);
 procedure RegisterHandCursor_C(Cl: TPSPascalCompiler);
 begin
 begin
   cl.AddConstantN('crHand', 'Integer').Value.ts32 := crHand;
   cl.AddConstantN('crHand', 'Integer').Value.ts32 := crHand;
@@ -675,6 +689,7 @@ begin
   RegisterOutputProgressWizardPage_C(Cl);
   RegisterOutputProgressWizardPage_C(Cl);
   RegisterOutputMarqueeProgressWizardPage_C(Cl);
   RegisterOutputMarqueeProgressWizardPage_C(Cl);
   RegisterDownloadWizardPage_C(Cl);
   RegisterDownloadWizardPage_C(Cl);
+  RegisterExtractionWizardPage_C(Cl);
 
 
   RegisterHandCursor_C(Cl);
   RegisterHandCursor_C(Cl);
   
   

+ 1 - 0
Projects/Src/Compiler.ScriptFunc.pas

@@ -139,6 +139,7 @@ begin
     'end');
     'end');
 
 
   RegisterType('TOnDownloadProgress', 'function(const Url, FileName: string; const Progress, ProgressMax: Int64): Boolean;');
   RegisterType('TOnDownloadProgress', 'function(const Url, FileName: string; const Progress, ProgressMax: Int64): Boolean;');
+  RegisterType('TOnExtractionProgress', 'function(const ArchiveFileName, FileName: string; const Progress, ProgressMax: Int64): Boolean;');
   RegisterType('TOnLog', 'procedure(const S: String; const Error, FirstLine: Boolean);');
   RegisterType('TOnLog', 'procedure(const S: String; const Error, FirstLine: Boolean);');
 
 
   for var ScriptFuncTable in ScriptFuncTables do
   for var ScriptFuncTable in ScriptFuncTables do

+ 64 - 23
Projects/Src/Compression.SevenZipDecoder.pas

@@ -12,18 +12,29 @@ unit Compression.SevenZipDecoder;
 
 
 interface
 interface
 
 
-function SevenZipDecode(const FileName, DestDir: String;
-  const FullPaths: Boolean): Integer;
+type
+  TOnExtractionProgress = function(const ArchiveFileName, FileName: string; const Progress, ProgressMax: Int64): Boolean of object;
+
+function Extract7ZipArchive(const ArchiveFileName, DestDir: String;
+  const FullPaths: Boolean; const OnExtractionProgress: TOnExtractionProgress): Integer;
 
 
 implementation
 implementation
 
 
 uses
 uses
   Windows, SysUtils, Forms,
   Windows, SysUtils, Forms,
   PathFunc,
   PathFunc,
-  Setup.LoggingFunc, Setup.MainFunc;
+  Setup.LoggingFunc, Setup.MainFunc, Setup.InstFunc;
+
+type
+  TSevenZipDecodeState = record
+    ExpandedDestDir: String;
+    LogBuffer: AnsiString;
+    OnExtractionProgress: TOnExtractionProgress;
+    LastReportedProgress, LastReportedProgressMax: UInt64;
+  end;
 
 
 var
 var
-  ExpandedDestDir: String;
+  State: TSevenZipDecodeState;
 
 
 { Compiled by Visual Studio 2022 using compile.bat
 { Compiled by Visual Studio 2022 using compile.bat
   To enable source debugging recompile using compile-bcc32c.bat and turn off the VISUALSTUDIO define below
   To enable source debugging recompile using compile-bcc32c.bat and turn off the VISUALSTUDIO define below
@@ -37,7 +48,7 @@ function __CreateDirectoryW(lpPathName: LPCWSTR;
   lpSecurityAttributes: PSecurityAttributes): BOOL; cdecl;
   lpSecurityAttributes: PSecurityAttributes): BOOL; cdecl;
 begin
 begin
   var ExpandedDir: String;
   var ExpandedDir: String;
-  if PathExpand(lpPathName, ExpandedDir) and  PathStartsWith(ExpandedDir, ExpandedDestDir) then
+  if PathExpand(lpPathName, ExpandedDir) and  PathStartsWith(ExpandedDir, State.ExpandedDestDir) then
     Result := CreateDirectoryW(PChar(ExpandedDir), lpSecurityAttributes)
     Result := CreateDirectoryW(PChar(ExpandedDir), lpSecurityAttributes)
   else begin
   else begin
     Result := False;
     Result := False;
@@ -61,7 +72,7 @@ function __CreateFileW(lpFileName: LPCWSTR; dwDesiredAccess, dwShareMode: DWORD;
   hTemplateFile: THandle): THandle; cdecl;
   hTemplateFile: THandle): THandle; cdecl;
 begin
 begin
   var ExpandedFileName: String;
   var ExpandedFileName: String;
-  if PathExpand(lpFileName, ExpandedFileName) and PathStartsWith(ExpandedFileName, ExpandedDestDir) then
+  if PathExpand(lpFileName, ExpandedFileName) and PathStartsWith(ExpandedFileName, State.ExpandedDestDir) then
     Result := CreateFileW(PChar(ExpandedFileName), dwDesiredAccess, dwShareMode, lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile)
     Result := CreateFileW(PChar(ExpandedFileName), dwDesiredAccess, dwShareMode, lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile)
   else begin
   else begin
     Result := INVALID_HANDLE_VALUE;
     Result := INVALID_HANDLE_VALUE;
@@ -189,9 +200,6 @@ begin
     Setup.LoggingFunc.Log(UTF8ToString(S));
     Setup.LoggingFunc.Log(UTF8ToString(S));
 end;
 end;
 
 
-var
-  LogBuffer: AnsiString;
-
 function __fputs(str: PAnsiChar; unused: Pointer): Integer; cdecl;
 function __fputs(str: PAnsiChar; unused: Pointer): Integer; cdecl;
 
 
   function FindNewLine(const S: AnsiString): Integer;
   function FindNewLine(const S: AnsiString): Integer;
@@ -206,14 +214,14 @@ function __fputs(str: PAnsiChar; unused: Pointer): Integer; cdecl;
 
 
 begin
 begin
   try
   try
-    LogBuffer := LogBuffer + str;
-    var P := FindNewLine(LogBuffer);
+    State.LogBuffer := State.LogBuffer + str;
+    var P := FindNewLine(State.LogBuffer);
     while P <> 0 do begin
     while P <> 0 do begin
-      Log(Copy(LogBuffer, 1, P-1));
-      if (LogBuffer[P] = #13) and (P < Length(LogBuffer)) and (LogBuffer[P+1] = #10) then
+      Log(Copy(State.LogBuffer, 1, P-1));
+      if (State.LogBuffer[P] = #13) and (P < Length(State.LogBuffer)) and (State.LogBuffer[P+1] = #10) then
         Inc(P);
         Inc(P);
-      Delete(LogBuffer, 1, P);
-      P := FindNewLine(LogBuffer);
+      Delete(State.LogBuffer, 1, P);
+      P := FindNewLine(State.LogBuffer);
     end;
     end;
     Result := 0;
     Result := 0;
   except
   except
@@ -223,23 +231,56 @@ end;
 
 
 procedure _ReportProgress(const FileName: PChar; const Progress, ProgressMax: UInt64; var Abort: Bool); cdecl;
 procedure _ReportProgress(const FileName: PChar; const Progress, ProgressMax: UInt64; var Abort: Bool); cdecl;
 begin
 begin
-  //Setup.LoggingFunc.Log(Format('%s: %d of %d', [FileName, Progress, ProgressMax]));
+  if Assigned(State.OnExtractionProgress) 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 (Progress = 0) or (Progress = ProgressMax) or
+       (Progress < State.LastReportedProgress) or (ProgressMax <> State.LastReportedProgressMax) or
+       ((Progress - State.LastReportedProgress) > 524288) then begin
+      try
+        var ArchiveFileName := '?'; //todo: fix
+        if not State.OnExtractionProgress(ArchiveFileName, FileName, Progress, ProgressMax) then
+          Abort := True;
+      finally
+        State.LastReportedProgress := Progress;
+        State.LastReportedProgressMax := ProgressMax;
+      end;
+    end;
+  end;
+
   if not Abort and DownloadTemporaryFileOrSevenZipDecodeProcessMessages then
   if not Abort and DownloadTemporaryFileOrSevenZipDecodeProcessMessages then
     Application.ProcessMessages;
     Application.ProcessMessages;
 end;
 end;
 
 
-function SevenZipDecode(const FileName, DestDir: String;
-  const FullPaths: Boolean): Integer;
+function Extract7ZipArchive(const ArchiveFileName, DestDir: String;
+  const FullPaths: Boolean; const OnExtractionProgress: TOnExtractionProgress): Integer;
 begin
 begin
+  if ArchiveFileName = '' then
+    InternalError('Extract7ZipArchive: Invalid ArchiveFileName value');
+  if DestDir = '' then
+    InternalError('Extract7ZipArchive: Invalid DestDir value');
+
+  LogFmt('Extracting 7-Zip archive %s to %s. Full paths? %s', [ArchiveFileName, DestDir, SYesNo[FullPaths]]);
+
   var SaveCurDir := GetCurrentDir;
   var SaveCurDir := GetCurrentDir;
   if not SetCurrentDir(DestDir) then
   if not SetCurrentDir(DestDir) then
     Exit(-1);
     Exit(-1);
   try
   try
-    LogBuffer := '';
-    ExpandedDestDir := AddBackslash(PathExpand(DestDir));
-    Result := IS_7zDec(PChar(FileName), FullPaths);
-    if LogBuffer <> '' then
-      Log(LogBuffer);
+    State.LogBuffer := '';
+    State.ExpandedDestDir := AddBackslash(PathExpand(DestDir));
+    State.OnExtractionProgress := OnExtractionProgress;
+    State.LastReportedProgress := 0;
+    State.LastReportedProgressMax := 0;
+
+    Result := IS_7zDec(PChar(ArchiveFileName), FullPaths);
+
+    //todo: throw exception on Result <> 0 like DownloadTemporaryFile uses exceptions?
+
+    if State.LogBuffer <> '' then
+      Log(State.LogBuffer);
   finally
   finally
     SetCurrentDir(SaveCurDir);
     SetCurrentDir(SaveCurDir);
   end;
   end;

+ 1 - 1
Projects/Src/IDE.ScintStylerInnoSetup.pas

@@ -455,7 +455,7 @@ const
     'TArrayOfString', 'TArrayOfChar', 'TArrayOfBoolean', 'TArrayOfInteger', 'DWORD',
     'TArrayOfString', 'TArrayOfChar', 'TArrayOfBoolean', 'TArrayOfInteger', 'DWORD',
     'UINT', 'BOOL', 'DWORD_PTR', 'UINT_PTR', 'INT_PTR', 'TFileTime',
     'UINT', 'BOOL', 'DWORD_PTR', 'UINT_PTR', 'INT_PTR', 'TFileTime',
     'TExecWait', 'TExecOutput', 'TFindRec', 'TWindowsVersion',
     'TExecWait', 'TExecOutput', 'TFindRec', 'TWindowsVersion',
-    'TOnDownloadProgress', 'TOnLog'
+    'TOnDownloadProgress', 'TOnExtractionProgress', 'TOnLog'
     { ScriptClasses: see PascalTypes_Isxclasses in isxclasses_wordlists_generated }
     { ScriptClasses: see PascalTypes_Isxclasses in isxclasses_wordlists_generated }
   ];
   ];
 
 

+ 12 - 0
Projects/Src/Setup.ScriptClasses.pas

@@ -343,6 +343,17 @@ begin
   end;
   end;
 end;
 end;
 
 
+procedure RegisterExtractionWizardPage_R(CL: TPSRuntimeClassImporter);
+begin
+  with CL.Add(TExtractionWizardPage) do
+  begin
+    RegisterMethod(@TExtractionWizardPage.Add, 'Add');
+    RegisterMethod(@TExtractionWizardPage.Clear, 'Clear');
+    RegisterMethod(@TExtractionWizardPage.Extract, 'Extract');
+    RegisterMethod(@TExtractionWizardPage.Show, 'Show');
+  end;
+end;
+
 procedure RegisterHandCursor_R(Cl: TPSRuntimeClassImporter);
 procedure RegisterHandCursor_R(Cl: TPSRuntimeClassImporter);
 const
 const
   IDC_HAND = MakeIntResource(32649);
   IDC_HAND = MakeIntResource(32649);
@@ -447,6 +458,7 @@ begin
     RegisterOutputProgressWizardPage_R(Cl);
     RegisterOutputProgressWizardPage_R(Cl);
     RegisterOutputMarqueeProgressWizardPage_R(Cl);
     RegisterOutputMarqueeProgressWizardPage_R(Cl);
     RegisterDownloadWizardPage_R(Cl);
     RegisterDownloadWizardPage_R(Cl);
+    RegisterExtractionWizardPage_R(Cl);
 
 
     RegisterHandCursor_R(Cl);
     RegisterHandCursor_R(Cl);
 
 

+ 157 - 18
Projects/Src/Setup.ScriptDlg.pas

@@ -12,8 +12,8 @@ unit Setup.ScriptDlg;
 interface
 interface
 
 
 uses
 uses
-  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, Contnrs,
-  Setup.WizardForm, Setup.Install,
+  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, Contnrs, Generics.Collections,
+  Setup.WizardForm, Setup.Install, Compression.SevenZipDecoder,
   NewCheckListBox, NewStaticText, NewProgressBar, PasswordEdit, RichEditViewer,
   NewCheckListBox, NewStaticText, NewProgressBar, PasswordEdit, RichEditViewer,
   BidiCtrls, TaskbarProgressFunc;
   BidiCtrls, TaskbarProgressFunc;
 
 
@@ -172,9 +172,14 @@ type
       procedure SetProgress(const Position, Max: Longint);
       procedure SetProgress(const Position, Max: Longint);
   end;
   end;
 
 
+  TDownloadFile = class
+    Url, BaseName, RequiredSHA256OfFile, UserName, Password: String;
+  end;
+  TDownloadFiles = TObjectList<TDownloadFile>;
+
   TDownloadWizardPage = class(TOutputProgressWizardPage)
   TDownloadWizardPage = class(TOutputProgressWizardPage)
     private
     private
-      FFiles: TObjectList;
+      FFiles: TDownloadFiles;
       FOnDownloadProgress: TOnDownloadProgress;
       FOnDownloadProgress: TOnDownloadProgress;
       FShowBaseNameInsteadOfUrl: Boolean;
       FShowBaseNameInsteadOfUrl: Boolean;
       FAbortButton: TNewButton;
       FAbortButton: TNewButton;
@@ -198,6 +203,37 @@ type
       property ShowBaseNameInsteadOfUrl: Boolean read FShowBaseNameInsteadOfUrl write FShowBaseNameInsteadOfUrl;
       property ShowBaseNameInsteadOfUrl: Boolean read FShowBaseNameInsteadOfUrl write FShowBaseNameInsteadOfUrl;
   end;
   end;
   
   
+  TArchive = class
+    FileName, DestDir: String;
+    FullPaths: Boolean;
+  end;
+  TArchives = TObjectList<TArchive>;
+
+  TExtractionWizardPage = class(TOutputProgressWizardPage)
+    private
+      FArchives: TArchives;
+      FOnExtractionProgress: TOnExtractionProgress;
+      FShowArchiveInsteadOfFile: Boolean;
+      FAbortButton: TNewButton;
+      FShowProgressControlsOnNextProgress, FAbortedByUser: Boolean;
+      procedure AbortButtonClick(Sender: TObject);
+      function InternalOnExtractionProgress(const ArchiveFileName, FileName: string; const Progress, ProgressMax: Int64): Boolean;
+      procedure ShowProgressControls(const AVisible: Boolean);
+    public
+      constructor Create(AOwner: TComponent); override;
+      destructor Destroy; override;
+      procedure Initialize; override;
+      procedure Add(const ArchiveFileName, DestDir: String; const FullPaths: Boolean);
+      procedure Clear;
+      function Extract: Integer;
+      property OnExtractionProgress: TOnExtractionProgress write FOnExtractionProgress;
+      procedure Show; override;
+    published
+      property AbortButton: TNewButton read FAbortButton;
+      property AbortedByUser: Boolean read FAbortedByUser;
+      property ShowArchiveInsteadOfFile: Boolean read FShowArchiveInsteadOfFile write FShowArchiveInsteadOfFile;
+  end;
+
 implementation
 implementation
 
 
 uses
 uses
@@ -920,11 +956,6 @@ end;
 
 
 {--- Download ---}
 {--- Download ---}
 
 
-type
-  TDownloadFile = class
-    Url, BaseName, RequiredSHA256OfFile, UserName, Password: String;
-  end;
-
 procedure TDownloadWizardPage.AbortButtonClick(Sender: TObject);
 procedure TDownloadWizardPage.AbortButtonClick(Sender: TObject);
 begin
 begin
   FAbortedByUser := LoggedMsgBox(SetupMessages[msgStopDownload], '', mbConfirmation, MB_YESNO, True, ID_YES) = IDYES;
   FAbortedByUser := LoggedMsgBox(SetupMessages[msgStopDownload], '', mbConfirmation, MB_YESNO, True, ID_YES) = IDYES;
@@ -970,7 +1001,7 @@ constructor TDownloadWizardPage.Create(AOwner: TComponent);
 begin
 begin
   inherited;
   inherited;
   FUseMarqueeStyle := True;
   FUseMarqueeStyle := True;
-  FFiles := TObjectList.Create;
+  FFiles := TDownloadFiles.Create;
 end;
 end;
 
 
 destructor TDownloadWizardPage.Destroy;
 destructor TDownloadWizardPage.Destroy;
@@ -1019,10 +1050,8 @@ begin
 end;
 end;
 
 
 procedure TDownloadWizardPage.AddEx(const Url, BaseName, RequiredSHA256OfFile, UserName, Password: String);
 procedure TDownloadWizardPage.AddEx(const Url, BaseName, RequiredSHA256OfFile, UserName, Password: String);
-var
-  F: TDownloadFile;
 begin
 begin
-  F := TDownloadFile.Create;
+  var F := TDownloadFile.Create;
   F.Url := Url;
   F.Url := Url;
   F.BaseName := BaseName;
   F.BaseName := BaseName;
   F.RequiredSHA256OfFile := RequiredSHA256OfFile;
   F.RequiredSHA256OfFile := RequiredSHA256OfFile;
@@ -1037,15 +1066,11 @@ begin
 end;
 end;
 
 
 function TDownloadWizardPage.Download: Int64;
 function TDownloadWizardPage.Download: Int64;
-var
-  F: TDownloadFile;
-  I: Integer;
 begin
 begin
   FAbortedByUser := False;
   FAbortedByUser := False;
-  
+
   Result := 0;
   Result := 0;
-  for I := 0 to FFiles.Count-1 do begin
-    F := TDownloadFile(FFiles[I]);
+  for var F in FFiles do begin
     { Don't need to set DownloadTemporaryFileProcessMessages before downloading since we already process messages ourselves. }
     { Don't need to set DownloadTemporaryFileProcessMessages before downloading since we already process messages ourselves. }
     SetDownloadCredentials(F.UserName, F.Password);
     SetDownloadCredentials(F.UserName, F.Password);
     Result := Result + DownloadTemporaryFile(F.Url, F.BaseName, F.RequiredSHA256OfFile, InternalOnDownloadProgress);
     Result := Result + DownloadTemporaryFile(F.Url, F.BaseName, F.RequiredSHA256OfFile, InternalOnDownloadProgress);
@@ -1053,4 +1078,118 @@ begin
   SetDownloadCredentials('', '');
   SetDownloadCredentials('', '');
 end;
 end;
 
 
+{--- Extraction ---}
+
+procedure TExtractionWizardPage.AbortButtonClick(Sender: TObject);
+begin
+  //todo: fix msg!
+  FAbortedByUser := LoggedMsgBox(SetupMessages[msgStopDownload], '', mbConfirmation, MB_YESNO, True, ID_YES) = IDYES;
+end;
+
+function TExtractionWizardPage.InternalOnExtractionProgress(const ArchiveFileName, FileName: string; const Progress, ProgressMax: Int64): Boolean;
+var
+  Progress32, ProgressMax32: LongInt;
+begin
+  if FAbortedByUser then begin
+    Log('Need to abort extraction.');
+    Result := False;
+  end else begin
+    Log(Format('  %d bytes done.', [Progress]));
+
+    FMsg2Label.Caption := IfThen(FShowArchiveInsteadOfFile, ArchiveFileName, FileName);
+    if ProgressMax > MaxLongInt then begin
+      Progress32 := Round((Progress / ProgressMax) * MaxLongInt);
+      ProgressMax32 := MaxLongInt;
+    end else begin
+      Progress32 := Progress;
+      ProgressMax32 := ProgressMax;
+    end;
+    SetProgress(Progress32, ProgressMax32); { This will process messages which we need for the abort button to work }
+
+    if FShowProgressControlsOnNextProgress then begin
+      ShowProgressControls(True);
+      FShowProgressControlsOnNextProgress := False;
+      ProcessMsgs;
+    end;
+
+    if Assigned(FOnExtractionProgress) then
+      Result := FOnExtractionProgress(ArchiveFileName, FileName, Progress, ProgressMax)
+    else
+      Result := True;
+  end;
+end;
+
+constructor TExtractionWizardPage.Create(AOwner: TComponent);
+begin
+  inherited;
+  FUseMarqueeStyle := True;
+  FArchives := TArchives.Create;
+end;
+
+destructor TExtractionWizardPage.Destroy;
+begin
+  FArchives.Free;
+  inherited;
+end;
+
+procedure TExtractionWizardPage.Initialize;
+begin
+  inherited;
+
+  FMsg1Label.Caption := SetupMessages[msgDownloadingLabel]; //todo: fix message
+
+  FAbortButton := TNewButton.Create(Self);
+  with FAbortButton do begin
+    Caption := SetupMessages[msgButtonStopDownload]; //todo: fix message
+    Top := FProgressBar.Top + FProgressBar.Height + WizardForm.ScalePixelsY(8);
+    Width := WizardForm.CalculateButtonWidth([Caption]);
+    Anchors := [akLeft, akTop];
+    Height := WizardForm.CancelButton.Height;
+    OnClick := AbortButtonClick;
+  end;
+  SetCtlParent(FAbortButton, Surface);
+end;
+
+procedure TExtractionWizardPage.Show;
+begin
+  if WizardForm.CurPageID <> ID then begin
+    ShowProgressControls(False);
+    FShowProgressControlsOnNextProgress := True;
+  end;
+  inherited;
+end;
+
+procedure TExtractionWizardPage.ShowProgressControls(const AVisible: Boolean);
+begin
+  FMsg2Label.Visible := AVisible;
+  FProgressBar.Visible := AVisible;
+  FAbortButton.Visible := AVisible;
+end;
+
+procedure TExtractionWizardPage.Add(const ArchiveFileName, DestDir: String; const FullPaths: Boolean);
+begin
+  var A := TArchive.Create;
+  A.FileName := ArchiveFileName;
+  A.DestDir := DestDir;
+  A.FullPaths := FullPaths;
+  FArchives.Add(A);
+end;
+
+procedure TExtractionWizardPage.Clear;
+begin
+  FArchives.Clear;
+end;
+
+function TExtractionWizardPage.Extract: Integer;
+begin
+  FAbortedByUser := False;
+
+  Result := 0;
+  for var A in FArchives do begin
+    { Don't need to set DownloadTemporaryFileOrSevenZipDecodeProcessMessages before extraction since we already process messages ourselves. }
+    if Extract7ZipArchive(A.FileName, A.DestDir, A.FullPaths, InternalOnExtractionProgress) = 0 then
+      Inc(Result);
+  end;
+end;
+
 end.
 end.

+ 44 - 26
Projects/Src/Setup.ScriptFunc.pas

@@ -129,18 +129,6 @@ end;
 function ScriptDlgProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
 function ScriptDlgProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
 var
 var
   PStart: Cardinal;
   PStart: Cardinal;
-  NewPage: TWizardPage;
-  NewInputQueryPage: TInputQueryWizardPage;
-  NewInputOptionPage: TInputOptionWizardPage;
-  NewInputDirPage: TInputDirWizardPage;
-  NewInputFilePage: TInputFileWizardPage;
-  NewOutputMsgPage: TOutputMsgWizardPage;
-  NewOutputMsgMemoPage: TOutputMsgMemoWizardPage;
-  NewOutputProgressPage: TOutputProgressWizardPage;
-  NewOutputMarqueeProgressPage: TOutputMarqueeProgressWizardPage;
-  NewDownloadPage: TDownloadWizardPage;
-  OnDownloadProgress: TOnDownloadProgress;
-  NewSetupForm: TSetupForm;
 begin
 begin
   PStart := Stack.Count-1;
   PStart := Stack.Count-1;
   Result := True;
   Result := True;
@@ -156,7 +144,7 @@ begin
   end else if Proc.Name = 'CREATECUSTOMPAGE' then begin
   end else if Proc.Name = 'CREATECUSTOMPAGE' then begin
     if IsUninstaller then
     if IsUninstaller then
       NoUninstallFuncError(Proc.Name);
       NoUninstallFuncError(Proc.Name);
-    NewPage := TWizardPage.Create(GetWizardForm);
+    var NewPage := TWizardPage.Create(GetWizardForm);
     try
     try
       NewPage.Caption := Stack.GetString(PStart-2);
       NewPage.Caption := Stack.GetString(PStart-2);
       NewPage.Description := Stack.GetString(PStart-3);
       NewPage.Description := Stack.GetString(PStart-3);
@@ -169,7 +157,7 @@ begin
   end else if Proc.Name = 'CREATEINPUTQUERYPAGE' then begin
   end else if Proc.Name = 'CREATEINPUTQUERYPAGE' then begin
     if IsUninstaller then
     if IsUninstaller then
       NoUninstallFuncError(Proc.Name);
       NoUninstallFuncError(Proc.Name);
-    NewInputQueryPage := TInputQueryWizardPage.Create(GetWizardForm);
+    var NewInputQueryPage := TInputQueryWizardPage.Create(GetWizardForm);
     try
     try
       NewInputQueryPage.Caption := Stack.GetString(PStart-2);
       NewInputQueryPage.Caption := Stack.GetString(PStart-2);
       NewInputQueryPage.Description := Stack.GetString(PStart-3);
       NewInputQueryPage.Description := Stack.GetString(PStart-3);
@@ -183,7 +171,7 @@ begin
   end else if Proc.Name = 'CREATEINPUTOPTIONPAGE' then begin
   end else if Proc.Name = 'CREATEINPUTOPTIONPAGE' then begin
     if IsUninstaller then
     if IsUninstaller then
       NoUninstallFuncError(Proc.Name);
       NoUninstallFuncError(Proc.Name);
-    NewInputOptionPage := TInputOptionWizardPage.Create(GetWizardForm);
+    var NewInputOptionPage := TInputOptionWizardPage.Create(GetWizardForm);
     try
     try
       NewInputOptionPage.Caption := Stack.GetString(PStart-2);
       NewInputOptionPage.Caption := Stack.GetString(PStart-2);
       NewInputOptionPage.Description := Stack.GetString(PStart-3);
       NewInputOptionPage.Description := Stack.GetString(PStart-3);
@@ -198,7 +186,7 @@ begin
   end else if Proc.Name = 'CREATEINPUTDIRPAGE' then begin
   end else if Proc.Name = 'CREATEINPUTDIRPAGE' then begin
     if IsUninstaller then
     if IsUninstaller then
       NoUninstallFuncError(Proc.Name);
       NoUninstallFuncError(Proc.Name);
-    NewInputDirPage := TInputDirWizardPage.Create(GetWizardForm);
+    var NewInputDirPage := TInputDirWizardPage.Create(GetWizardForm);
     try
     try
       NewInputDirPage.Caption := Stack.GetString(PStart-2);
       NewInputDirPage.Caption := Stack.GetString(PStart-2);
       NewInputDirPage.Description := Stack.GetString(PStart-3);
       NewInputDirPage.Description := Stack.GetString(PStart-3);
@@ -213,7 +201,7 @@ begin
   end else if Proc.Name = 'CREATEINPUTFILEPAGE' then begin
   end else if Proc.Name = 'CREATEINPUTFILEPAGE' then begin
     if IsUninstaller then
     if IsUninstaller then
       NoUninstallFuncError(Proc.Name);
       NoUninstallFuncError(Proc.Name);
-    NewInputFilePage := TInputFileWizardPage.Create(GetWizardForm);
+    var NewInputFilePage := TInputFileWizardPage.Create(GetWizardForm);
     try
     try
       NewInputFilePage.Caption := Stack.GetString(PStart-2);
       NewInputFilePage.Caption := Stack.GetString(PStart-2);
       NewInputFilePage.Description := Stack.GetString(PStart-3);
       NewInputFilePage.Description := Stack.GetString(PStart-3);
@@ -227,7 +215,7 @@ begin
   end else if Proc.Name = 'CREATEOUTPUTMSGPAGE' then begin
   end else if Proc.Name = 'CREATEOUTPUTMSGPAGE' then begin
     if IsUninstaller then
     if IsUninstaller then
       NoUninstallFuncError(Proc.Name);
       NoUninstallFuncError(Proc.Name);
-    NewOutputMsgPage := TOutputMsgWizardPage.Create(GetWizardForm);
+    var NewOutputMsgPage := TOutputMsgWizardPage.Create(GetWizardForm);
     try
     try
       NewOutputMsgPage.Caption := Stack.GetString(PStart-2);
       NewOutputMsgPage.Caption := Stack.GetString(PStart-2);
       NewOutputMsgPage.Description := Stack.GetString(PStart-3);
       NewOutputMsgPage.Description := Stack.GetString(PStart-3);
@@ -241,7 +229,7 @@ begin
   end else if Proc.Name = 'CREATEOUTPUTMSGMEMOPAGE' then begin
   end else if Proc.Name = 'CREATEOUTPUTMSGMEMOPAGE' then begin
     if IsUninstaller then
     if IsUninstaller then
       NoUninstallFuncError(Proc.Name);
       NoUninstallFuncError(Proc.Name);
-    NewOutputMsgMemoPage := TOutputMsgMemoWizardPage.Create(GetWizardForm);
+    var NewOutputMsgMemoPage := TOutputMsgMemoWizardPage.Create(GetWizardForm);
     try
     try
       NewOutputMsgMemoPage.Caption := Stack.GetString(PStart-2);
       NewOutputMsgMemoPage.Caption := Stack.GetString(PStart-2);
       NewOutputMsgMemoPage.Description := Stack.GetString(PStart-3);
       NewOutputMsgMemoPage.Description := Stack.GetString(PStart-3);
@@ -256,7 +244,7 @@ begin
   end else if Proc.Name = 'CREATEOUTPUTPROGRESSPAGE' then begin
   end else if Proc.Name = 'CREATEOUTPUTPROGRESSPAGE' then begin
     if IsUninstaller then
     if IsUninstaller then
       NoUninstallFuncError(Proc.Name);
       NoUninstallFuncError(Proc.Name);
-    NewOutputProgressPage := TOutputProgressWizardPage.Create(GetWizardForm);
+    var NewOutputProgressPage := TOutputProgressWizardPage.Create(GetWizardForm);
     try
     try
       NewOutputProgressPage.Caption := Stack.GetString(PStart-1);
       NewOutputProgressPage.Caption := Stack.GetString(PStart-1);
       NewOutputProgressPage.Description := Stack.GetString(PStart-2);
       NewOutputProgressPage.Description := Stack.GetString(PStart-2);
@@ -270,7 +258,7 @@ begin
   end else if Proc.Name = 'CREATEOUTPUTMARQUEEPROGRESSPAGE' then begin
   end else if Proc.Name = 'CREATEOUTPUTMARQUEEPROGRESSPAGE' then begin
     if IsUninstaller then
     if IsUninstaller then
       NoUninstallFuncError(Proc.Name);
       NoUninstallFuncError(Proc.Name);
-    NewOutputMarqueeProgressPage := TOutputMarqueeProgressWizardPage.Create(GetWizardForm);
+    var NewOutputMarqueeProgressPage := TOutputMarqueeProgressWizardPage.Create(GetWizardForm);
     try
     try
       NewOutputMarqueeProgressPage.Caption := Stack.GetString(PStart-1);
       NewOutputMarqueeProgressPage.Caption := Stack.GetString(PStart-1);
       NewOutputMarqueeProgressPage.Description := Stack.GetString(PStart-2);
       NewOutputMarqueeProgressPage.Description := Stack.GetString(PStart-2);
@@ -285,12 +273,13 @@ begin
     if IsUninstaller then
     if IsUninstaller then
       NoUninstallFuncError(Proc.Name);
       NoUninstallFuncError(Proc.Name);
     var P: PPSVariantProcPtr := Stack.Items[PStart-3];
     var P: PPSVariantProcPtr := Stack.Items[PStart-3];
+    var OnDownloadProgress: TOnDownloadProgress;
     { ProcNo 0 means nil was passed by the script }
     { ProcNo 0 means nil was passed by the script }
     if P.ProcNo <> 0 then
     if P.ProcNo <> 0 then
       OnDownloadProgress := TOnDownloadProgress(Caller.GetProcAsMethod(P.ProcNo))
       OnDownloadProgress := TOnDownloadProgress(Caller.GetProcAsMethod(P.ProcNo))
     else
     else
       OnDownloadProgress := nil;
       OnDownloadProgress := nil;
-    NewDownloadPage := TDownloadWizardPage.Create(GetWizardForm);
+    var NewDownloadPage := TDownloadWizardPage.Create(GetWizardForm);
     try
     try
       NewDownloadPage.Caption := Stack.GetString(PStart-1);
       NewDownloadPage.Caption := Stack.GetString(PStart-1);
       NewDownloadPage.Description := Stack.GetString(PStart-2);
       NewDownloadPage.Description := Stack.GetString(PStart-2);
@@ -302,6 +291,28 @@ begin
       raise;
       raise;
     end;
     end;
     Stack.SetClass(PStart, NewDownloadPage);
     Stack.SetClass(PStart, NewDownloadPage);
+  end else if Proc.Name = 'CREATEXTRACTIONPAGE' then begin
+    if IsUninstaller then
+      NoUninstallFuncError(Proc.Name);
+    var P: PPSVariantProcPtr := Stack.Items[PStart-3];
+    var OnExtractionProgress: TOnExtractionProgress;
+    { ProcNo 0 means nil was passed by the script }
+    if P.ProcNo <> 0 then
+      OnExtractionProgress := TOnExtractionProgress(Caller.GetProcAsMethod(P.ProcNo))
+    else
+      OnExtractionProgress := nil;
+    var NewExtractionPage := TExtractionWizardPage.Create(GetWizardForm);
+    try
+      NewExtractionPage.Caption := Stack.GetString(PStart-1);
+      NewExtractionPage.Description := Stack.GetString(PStart-2);
+      GetWizardForm.AddPage(NewExtractionPage, -1);
+      NewExtractionPage.Initialize;
+      NewExtractionPage.OnExtractionProgress := OnExtractionProgress;
+    except
+      NewExtractionPage.Free;
+      raise;
+    end;
+    Stack.SetClass(PStart, NewExtractionPage);
   end else if Proc.Name = 'SCALEX' then begin
   end else if Proc.Name = 'SCALEX' then begin
     InitializeScaleBaseUnits;
     InitializeScaleBaseUnits;
     Stack.SetInt(PStart, MulDiv(Stack.GetInt(PStart-1), ScaleBaseUnitX, OrigBaseUnitX));
     Stack.SetInt(PStart, MulDiv(Stack.GetInt(PStart-1), ScaleBaseUnitX, OrigBaseUnitX));
@@ -309,7 +320,7 @@ begin
     InitializeScaleBaseUnits;
     InitializeScaleBaseUnits;
     Stack.SetInt(PStart, MulDiv(Stack.GetInt(PStart-1), ScaleBaseUnitY, OrigBaseUnitY));
     Stack.SetInt(PStart, MulDiv(Stack.GetInt(PStart-1), ScaleBaseUnitY, OrigBaseUnitY));
   end else if Proc.Name = 'CREATECUSTOMFORM' then begin
   end else if Proc.Name = 'CREATECUSTOMFORM' then begin
-    NewSetupForm := TSetupForm.CreateNew(nil);
+    var NewSetupForm := TSetupForm.CreateNew(nil);
     try
     try
       NewSetupForm.AutoScroll := False;
       NewSetupForm.AutoScroll := False;
       NewSetupForm.BorderStyle := bsDialog;
       NewSetupForm.BorderStyle := bsDialog;
@@ -773,7 +784,6 @@ end;
 function InstallProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
 function InstallProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
 var
 var
   PStart: Cardinal;
   PStart: Cardinal;
-  OnDownloadProgress: TOnDownloadProgress;
 begin
 begin
   if IsUninstaller then
   if IsUninstaller then
     NoUninstallFuncError(Proc.Name);
     NoUninstallFuncError(Proc.Name);
@@ -787,6 +797,7 @@ begin
     Stack.SetInt(PStart, ExtractTemporaryFiles(Stack.GetString(PStart-1)));
     Stack.SetInt(PStart, ExtractTemporaryFiles(Stack.GetString(PStart-1)));
   end else if Proc.Name = 'DOWNLOADTEMPORARYFILE' then begin
   end else if Proc.Name = 'DOWNLOADTEMPORARYFILE' then begin
     var P: PPSVariantProcPtr := Stack.Items[PStart-4];
     var P: PPSVariantProcPtr := Stack.Items[PStart-4];
+    var OnDownloadProgress: TOnDownloadProgress;
     { ProcNo 0 means nil was passed by the script }
     { ProcNo 0 means nil was passed by the script }
     if P.ProcNo <> 0 then
     if P.ProcNo <> 0 then
       OnDownloadProgress := TOnDownloadProgress(Caller.GetProcAsMethod(P.ProcNo))
       OnDownloadProgress := TOnDownloadProgress(Caller.GetProcAsMethod(P.ProcNo))
@@ -2106,8 +2117,15 @@ begin
     for I := 0 to N-1 do
     for I := 0 to N-1 do
       AscendingTrySizes[I] := VNGetInt(PSGetArrayField(Arr, I));
       AscendingTrySizes[I] := VNGetInt(PSGetArrayField(Arr, I));
     Stack.SetBool(PStart, TBitmapImage(Stack.GetClass(PStart-1)).InitializeFromIcon(0, PChar(Stack.GetString(PStart-2)), Stack.GetInt(PStart-3), AscendingTrySizes));
     Stack.SetBool(PStart, TBitmapImage(Stack.GetClass(PStart-1)).InitializeFromIcon(0, PChar(Stack.GetString(PStart-2)), Stack.GetInt(PStart-3), AscendingTrySizes));
-  end else if Proc.Name = 'EXTRACT7ZIPFILE' then begin
-    Stack.SetInt(PStart, SevenZipDecode(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetBool(PStart-3)));
+  end else if Proc.Name = 'EXTRACT7ZIPARCHIVE' then begin
+    var P: PPSVariantProcPtr := Stack.Items[PStart-4];
+    var OnExtractionProgress: TOnExtractionProgress;
+    { ProcNo 0 means nil was passed by the script }
+    if P.ProcNo <> 0 then
+      OnExtractionProgress := TOnExtractionProgress(Caller.GetProcAsMethod(P.ProcNo))
+    else
+      OnExtractionProgress := nil;
+    Stack.SetInt(PStart, Extract7ZipArchive(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetBool(PStart-3), OnExtractionProgress));
   end else if Proc.Name = 'DEBUGGING' then begin
   end else if Proc.Name = 'DEBUGGING' then begin
     Stack.SetBool(PStart, Debugging);
     Stack.SetBool(PStart, Debugging);
   end else
   end else

+ 2 - 1
Projects/Src/Shared.ScriptFunc.pas

@@ -221,6 +221,7 @@ initialization
     'function CreateOutputProgressPage(const ACaption, ADescription: String): TOutputProgressWizardPage;',
     'function CreateOutputProgressPage(const ACaption, ADescription: String): TOutputProgressWizardPage;',
     'function CreateOutputMarqueeProgressPage(const ACaption, ADescription: String): TOutputMarqueeProgressWizardPage;',
     'function CreateOutputMarqueeProgressPage(const ACaption, ADescription: String): TOutputMarqueeProgressWizardPage;',
     'function CreateDownloadPage(const ACaption, ADescription: String; const OnDownloadProgress: TOnDownloadProgress): TDownloadWizardPage;',
     'function CreateDownloadPage(const ACaption, ADescription: String; const OnDownloadProgress: TOnDownloadProgress): TDownloadWizardPage;',
+    'function CreateExtractionPage(const ACaption, ADescription: String; const OnExtractionProgress: TOnExtractionProgress): TExtractionWizardPage;',
     'function ScaleX(X: Integer): Integer;',
     'function ScaleX(X: Integer): Integer;',
     'function ScaleY(Y: Integer): Integer;',
     'function ScaleY(Y: Integer): Integer;',
     'function CreateCustomForm: TSetupForm;'
     'function CreateCustomForm: TSetupForm;'
@@ -539,7 +540,7 @@ initialization
     'function IsDotNetInstalled(const MinVersion: TDotNetVersion; const MinServicePack: Cardinal): Boolean;',
     'function IsDotNetInstalled(const MinVersion: TDotNetVersion; const MinServicePack: Cardinal): Boolean;',
     'function IsMsiProductInstalled(const UpgradeCode: String; const PackedMinVersion: Int64): Boolean;',
     'function IsMsiProductInstalled(const UpgradeCode: String; const PackedMinVersion: Int64): Boolean;',
     'function InitializeBitmapImageFromIcon(const BitmapImage: TBitmapImage; const IconFilename: String; const BkColor: TColor; const AscendingTrySizes: TArrayOfInteger): Boolean;',
     'function InitializeBitmapImageFromIcon(const BitmapImage: TBitmapImage; const IconFilename: String; const BkColor: TColor; const AscendingTrySizes: TArrayOfInteger): Boolean;',
-    'function Extract7ZipFile(const FileName, DestDir: String; const FullPaths: Boolean): Integer;',
+    'function Extract7ZipArchive(const FileName, DestDir: String; const FullPaths: Boolean; const OnExtractionProgress: TOnExtractionProgress): Integer;',
     'function Debugging: Boolean;'
     'function Debugging: Boolean;'
   ];
   ];
 
 

+ 1 - 1
whatsnew.htm

@@ -95,7 +95,7 @@ For conditions of distribution and use, see <a href="files/is/license.txt">LICEN
   <li>Added a dark mode version of the documentation, automatically used by the Compiler IDE if a dark theme is chosen.</li>
   <li>Added a dark mode version of the documentation, automatically used by the Compiler IDE if a dark theme is chosen.</li>
   <li>Pascal Scripting changes:
   <li>Pascal Scripting changes:
   <ul>
   <ul>
-    <il>Added new <tt>Extract7ZipFile</tt> support function to extract a 7-Zip archive, based on the &quot;7z ANSI-C Decoder&quot; from the LZMA SDK by Igor Pavlov. See the new <a href="https://jrsoftware.org/ishelp/index.php?topic=isxfunc_extract7zipfile">help topic</a> for information about its limitations.</il>
+    <li>Added new <tt>Extract7ZipArchive</tt> support function to extract a 7-Zip archive, based on the &quot;7z ANSI-C Decoder&quot; from the LZMA SDK by Igor Pavlov. See the new <a href="https://jrsoftware.org/ishelp/index.php?topic=isxfunc_extract7ziparchive">help topic</a> for information about its limitations.<br />Added new <tt>CreateExtractionPage</tt> support function to easily show the extraction progress to the user.</li>
     <li>Added new <tt>ExecAndCaptureOutput</tt> support function to execute a program or batch file and capture its <i>stdout</i> and <i>stderr</i> outputs separately.</li>
     <li>Added new <tt>ExecAndCaptureOutput</tt> support function to execute a program or batch file and capture its <i>stdout</i> and <i>stderr</i> outputs separately.</li>
     <li>Output logging now raises an exception if there was an error setting up output redirection (which should be very rare). The <i>PowerShell.iss</i> example script has been updated to catch the exception.</li>
     <li>Output logging now raises an exception if there was an error setting up output redirection (which should be very rare). The <i>PowerShell.iss</i> example script has been updated to catch the exception.</li>
     <li><tt>TInputDirWizardPage</tt>: Added new <tt>NewFolderName</tt> property to update the initial value passed to <tt>CreateInputDirPage</tt>.</li>
     <li><tt>TInputDirWizardPage</tt>: Added new <tt>NewFolderName</tt> property to update the initial value passed to <tt>CreateInputDirPage</tt>.</li>