Add Redir support to Extract7ZipArchive.

Projects/Src/Compression.SevenZipDecoder.pas

@@ -15,18 +15,21 @@ interface
 type
   TOnExtractionProgress = function(const ArchiveName, FileName: string; const Progress, ProgressMax: Int64): Boolean of object;
 
-procedure Extract7ZipArchive(const ArchiveFileName, DestDir: String;
-  const FullPaths: Boolean; const OnExtractionProgress: TOnExtractionProgress);
+procedure Extract7ZipArchiveRedir(const DisableFsRedir: Boolean;
+  const ArchiveFileName, DestDir: String; const FullPaths: Boolean;
+  const OnExtractionProgress: TOnExtractionProgress);
 
 implementation
 
 uses
   Windows, SysUtils, Forms,
   PathFunc,
-  Shared.SetupMessageIDs, SetupLdrAndSetup.Messages, Setup.LoggingFunc, Setup.MainFunc, Setup.InstFunc;
+  Shared.SetupMessageIDs, SetupLdrAndSetup.Messages, SetupLdrAndSetup.RedirFunc,
+  Setup.LoggingFunc, Setup.MainFunc, Setup.InstFunc;
 
 type
   TSevenZipDecodeState = record
+    DisableFsRedir: Boolean;
     ExpandedArchiveFileName, ExpandedDestDir: String;
     LogBuffer: AnsiString;
     ExtractedArchiveName: String;
@@ -51,7 +54,7 @@ function __CreateDirectoryW(lpPathName: LPCWSTR;
 begin
   var ExpandedDir: String;
   if ValidateAndCombinePath(State.ExpandedDestDir, lpPathName, ExpandedDir) then
-    Result := CreateDirectoryW(PChar(ExpandedDir), lpSecurityAttributes)
+    Result := CreateDirectoryRedir(State.DisableFsRedir, ExpandedDir, lpSecurityAttributes)
   else begin
     Result := False;
     SetLastError(ERROR_ACCESS_DENIED);
@@ -82,7 +85,9 @@ begin
       (PathCompare(ExpandedFileName, State.ExpandedArchiveFileName) = 0)) or
      ((dwDesiredAccess = GENERIC_WRITE) and
       ValidateAndCombinePath(State.ExpandedDestDir, lpFileName, ExpandedFileName)) then
-    Result := CreateFileW(PChar(ExpandedFileName), dwDesiredAccess, dwShareMode, lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile)
+    Result := CreateFileRedir(State.DisableFsRedir, ExpandedFileName,
+      dwDesiredAccess, dwShareMode, lpSecurityAttributes,
+      dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile)
   else begin
     Result := INVALID_HANDLE_VALUE;
     SetLastError(ERROR_ACCESS_DENIED);
@@ -110,7 +115,7 @@ end;
 
 function __SetFileAttributesW(lpFileName: LPCWSTR; dwFileAttributes: DWORD): BOOL; cdecl;
 begin
-  Result := SetFileAttributesW(lpFileName, dwFileAttributes);
+  Result := SetFileAttributesRedir(State.DisableFsRedir, lpFileName, dwFileAttributes);
 end;
 
 function __SetFilePointer(hFile: THandle; lDistanceToMove: Longint;
@@ -266,8 +271,9 @@ begin
     State.Aborted := True;
 end;
 
-procedure Extract7ZipArchive(const ArchiveFileName, DestDir: String;
-  const FullPaths: Boolean; const OnExtractionProgress: TOnExtractionProgress);
+procedure Extract7ZipArchiveRedir(const DisableFsRedir: Boolean;
+  const ArchiveFileName, DestDir: String; const FullPaths: Boolean;
+  const OnExtractionProgress: TOnExtractionProgress);
 begin
   if ArchiveFileName = '' then
     InternalError('Extract7ZipArchive: Invalid ArchiveFileName value');
@@ -280,6 +286,7 @@ begin
   if not ForceDirectoriesRedir(False, DestDir) or not SetCurrentDir(DestDir) then
     raise Exception.Create(FmtSetupMessage(msgErrorExtractionFailed, ['-1']));
   try
+    State.DisableFsRedir := DisableFsRedir;
     State.ExpandedArchiveFileName := PathExpand(ArchiveFileName);
     State.ExpandedDestDir := AddBackslash(PathExpand(DestDir));
     State.LogBuffer := '';

Projects/Src/Setup.ScriptDlg.pas

@@ -2,7 +2,7 @@ unit Setup.ScriptDlg;
 
 {
   Inno Setup
-  Copyright (C) 1997-2012 Jordan Russell
+  Copyright (C) 1997-2025 Jordan Russell
   Portions by Martijn Laan
   For conditions of distribution and use, see LICENSE.TXT.
 
@@ -1185,7 +1185,7 @@ begin
 
   for var A in FArchives do begin
     { Don't need to set DownloadTemporaryFileOrExtract7ZipArchiveProcessMessages before extraction since we already process messages ourselves. }
-    Extract7ZipArchive(A.FileName, A.DestDir, A.FullPaths, InternalOnExtractionProgress);
+    Extract7ZipArchiveRedir(ScriptFuncDisableFsRedir, A.FileName, A.DestDir, A.FullPaths, InternalOnExtractionProgress);
   end;
 end;
 

Projects/Src/Setup.ScriptFunc.pas

@@ -1786,7 +1786,7 @@ var
     end);
     RegisterScriptFunc('EXTRACT7ZIPARCHIVE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
     begin
-      Extract7ZipArchive(Stack.GetString(PStart), Stack.GetString(PStart-1), Stack.GetBool(PStart-2), TOnExtractionProgress(Stack.GetProc(PStart-3, Caller)));
+      Extract7ZipArchiveRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart), Stack.GetString(PStart-1), Stack.GetBool(PStart-2), TOnExtractionProgress(Stack.GetProc(PStart-3, Caller)));
     end);
     RegisterScriptFunc('DEBUGGING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
     begin

Projects/Src/SetupLdrAndSetup.RedirFunc.pas

@@ -2,7 +2,7 @@ unit SetupLdrAndSetup.RedirFunc;
 
 {
   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.
 
@@ -29,7 +29,11 @@ function DisableFsRedirectionIf(const Disable: Boolean;
   var PreviousState: TPreviousFsRedirectionState): Boolean;
 procedure RestoreFsRedirection(const PreviousState: TPreviousFsRedirectionState);
 
-function CreateDirectoryRedir(const DisableFsRedir: Boolean; const Filename: String): BOOL;
+function CreateFileRedir(const DisableFsRedir: Boolean; const FileName: String;
+  const DesiredAccess, ShareMode: DWORD; const SecurityAttributes: PSecurityAttributes;
+  const CreationDisposition, FlagsAndAttributes: DWORD; TemplateFile: THandle): THandle;
+function CreateDirectoryRedir(const DisableFsRedir: Boolean; const Filename: String;
+  const SecurityAttributes: PSecurityAttributes = nil): BOOL;
 function CreateProcessRedir(const DisableFsRedir: Boolean;
   const lpApplicationName: PChar; const lpCommandLine: PChar;
   const lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
@@ -157,7 +161,29 @@ end;
 
 { *Redir functions }
 
-function CreateDirectoryRedir(const DisableFsRedir: Boolean; const Filename: String): BOOL;
+function CreateFileRedir(const DisableFsRedir: Boolean; const FileName: String;
+  const DesiredAccess, ShareMode: DWORD; const SecurityAttributes: PSecurityAttributes;
+  const CreationDisposition, FlagsAndAttributes: DWORD; TemplateFile: THandle): THandle;
+var
+  PrevState: TPreviousFsRedirectionState;
+  ErrorCode: DWORD;
+begin
+  if not DisableFsRedirectionIf(DisableFsRedir, PrevState) then begin
+    Result := INVALID_HANDLE_VALUE;
+    Exit;
+  end;
+  try
+    Result := CreateFile(PChar(Filename), DesiredAccess, ShareMode, SecurityAttributes,
+      CreationDisposition, FlagsAndAttributes, TemplateFile);
+    ErrorCode := GetLastError;
+  finally
+    RestoreFsRedirection(PrevState);
+  end;
+  SetLastError(ErrorCode);
+end;
+
+function CreateDirectoryRedir(const DisableFsRedir: Boolean; const Filename: String;
+  const SecurityAttributes: PSecurityAttributes): BOOL;
 var
   PrevState: TPreviousFsRedirectionState;
   ErrorCode: DWORD;
@@ -167,7 +193,7 @@ begin
     Exit;
   end;
   try
-    Result := CreateDirectory(PChar(Filename), nil);
+    Result := CreateDirectory(PChar(Filename), SecurityAttributes);
     ErrorCode := GetLastError;
   finally
     RestoreFsRedirection(PrevState);

whatsnew.htm

@@ -112,7 +112,12 @@ issigtool --key-file="MyKey.ispublickey" verify "MyProg.dll"</pre>
 <ul>
   <li>Compiler IDE: the <i>Find in Files</i> result list will now update its line numbers when you add or delete lines.</li>
   <li><tt>[Files]</tt> section parameter <tt>Excludes</tt> can now be combined with the <tt>external</tt> flag.</li>
-  <li>Pascal Scripting: Added new <tt>GetSHA256OfStream</tt> support function.</li>
+  <li>Pascal Scripting changes:
+  <ul>
+    <li>Added new <tt>GetSHA256OfStream</tt> support function.</li>
+    <li><tt>Extract7ZipArchive</tt> now honors the file system redirection state set by <tt>EnableFsRedirection</tt> or 64-bit install mode.</li>
+  </ul>
+  </li>
   <li>Example script <i>CodeDownloadFiles.iss</i> now also demonstrates how to use the <tt>CreateExtractionPage</tt> support function to extract a 7-Zip archive. See the <a href="https://jrsoftware.org/ishelp/index.php?topic=isxfunc_extract7ziparchive">Extract7ZipArchive help topic</a> for information about this function's limitations.</li>
   <li>Documentation improvements.</li>
 </ul>