Add TExtractionWizardPage.AddEx. Todo: test & doc. Also some other minor tweaks.

Left the lack of password support as an internal implementation detail of Extract7ZipArchiveRedir.

Projects/Src/Compiler.ScriptClasses.pas

@@ -567,6 +567,7 @@ begin
     RegisterProperty('AbortedByUser', 'Boolean', iptr);
     RegisterProperty('ShowArchiveInsteadOfFile', 'Boolean', iptrw);
     RegisterMethod('procedure Add(const ArchiveFileName, DestDir: String; const FullPaths: Boolean)');
+    RegisterMethod('procedure AddEx(const ArchiveFileName, DestDir, Password: String; const FullPaths: Boolean)');
     RegisterMethod('procedure Clear');
     RegisterMethod('procedure Extract');
     RegisterMethod('procedure Show'); { Without this TOutputProgressWizardPage's Show will be called }

Projects/Src/Compression.SevenZipDecoder.pas

@@ -16,7 +16,7 @@ type
   TOnExtractionProgress = function(const ArchiveName, FileName: string; const Progress, ProgressMax: Int64): Boolean of object;
 
 procedure Extract7ZipArchiveRedir(const DisableFsRedir: Boolean;
-  const ArchiveFileName, DestDir: String; const FullPaths: Boolean;
+  const ArchiveFileName, DestDir, Password: String; const FullPaths: Boolean;
   const OnExtractionProgress: TOnExtractionProgress);
 
 implementation
@@ -279,7 +279,7 @@ begin
 end;
 
 procedure Extract7ZipArchiveRedir(const DisableFsRedir: Boolean;
-  const ArchiveFileName, DestDir: String; const FullPaths: Boolean;
+  const ArchiveFileName, DestDir, Password: String; const FullPaths: Boolean;
   const OnExtractionProgress: TOnExtractionProgress);
 begin
   if ArchiveFileName = '' then
@@ -289,8 +289,13 @@ begin
 
   LogFmt('Extracting 7-Zip archive %s to %s. Full paths? %s', [ArchiveFileName, DestDir, SYesNo[FullPaths]]);
 
-  if not ForceDirectories(DisableFsRedir, DestDir) then
+  if Password <> '' then begin
+    Log('ERROR: Password not supported by built-in extraction'); { Just like 7zMain.c }
+    raise Exception.Create(FmtSetupMessage(msgErrorExtractionFailed, ['-2']))
+  end else if not ForceDirectories(DisableFsRedir, DestDir) then begin
+    Log('ERROR: Failed to create destination directory'); { Just like 7zMain.c }
     raise Exception.Create(FmtSetupMessage(msgErrorExtractionFailed, ['-1']));
+  end;
 
   State.DisableFsRedir := DisableFsRedir;
   State.ExpandedArchiveFileName := PathExpand(ArchiveFileName);

Projects/Src/Compression.SevenZipDllDecoder.pas

@@ -371,31 +371,11 @@ begin
 end;
 
 function TArchiveExtractCallback.SetOperationResult(opRes: TNOperationResult): HRESULT;
-
-  function OperationResultToString(const opRes: TNOperationResult): String;
-  begin
-    case opRes of
-      kOK: Result := 'OK';
-      kUnsupportedMethod: Result := 'Unsupported method';
-      kDataError: Result := 'Data error';
-      kCRCError: Result := 'CRC error';
-      kUnavailable: Result := 'Unavailable';
-      kUnexpectedEnd: Result := 'Unexpected end';
-      kDataAfterEnd: Result := 'Data after end';
-      kIsNotArc: Result := 'Is not an archive';
-      kHeadersError: Result := 'Headers error';
-      kWrongPassword: Result := 'Wrong password';
-    else
-      Result := Format('Unknown result %d', [Ord(opRes)]);
-    end;
-  end;
-
 begin
   { From IArchive.h: Can now can close the file, set attributes, timestamps and security information }
   try
     if opRes <> kOK then begin
       FOpRes := opRes;
-      LogFmt('ERROR: %s', [OperationResultToString(opRes)]);  { Just like 7zMain.c }
       Result := E_FAIL;
     end else begin
       if (FCurrent.ExpandedPath <> '') and FCurrent.HasAttrib and
@@ -487,6 +467,24 @@ procedure ExtractArchiveRedir(const DisableFsRedir: Boolean;
       InternalError('ExtractArchive: Unknown ArchiveFileName extension');
   end;
 
+  function OperationResultToString(const opRes: TNOperationResult): String;
+  begin
+    case opRes of
+      kOK: Result := 'OK';
+      kUnsupportedMethod: Result := 'Unsupported method';
+      kDataError: Result := 'Data error';
+      kCRCError: Result := 'CRC error';
+      kUnavailable: Result := 'Unavailable';
+      kUnexpectedEnd: Result := 'Unexpected end';
+      kDataAfterEnd: Result := 'Data after end';
+      kIsNotArc: Result := 'Is not an archive';
+      kHeadersError: Result := 'Headers error';
+      kWrongPassword: Result := 'Wrong password';
+    else
+      Result := Format('Unknown result %d', [Ord(opRes)]);
+    end;
+  end;
+
 begin
   if not IsExtractArchiveRedirAvailable then
     InternalError('ExtractArchive: 7z(xa).dll not loaded');
@@ -500,16 +498,20 @@ begin
 
   { CreateObject }
   var InArchive: IInArchive;
-  if CreateSevenZipObject(clsid, IInArchive, InArchive) <> S_OK then
-    raise Exception.Create(FmtSetupMessage(msgErrorExtractionFailed, ['Cannot get class object'])); { From Client7z.cpp }
+  if CreateSevenZipObject(clsid, IInArchive, InArchive) <> S_OK then begin
+    Log('ERROR: Cannot get class object'); { Just like 7zMain.c and Client7z.cpp }
+    raise Exception.Create(FmtSetupMessage(msgErrorExtractionFailed, ['-1']));
+  end;
 
   { Open }
   const InStream: IInStream =
     TInStream.Create(TFileRedir.Create(DisableFsRedir, ArchiveFilename, fdOpenExisting, faRead, fsRead));
   var ScanSize: Int64 := 1 shl 23; { From Client7z.cpp }
   const OpenCallback: IArchiveOpenCallback = TArchiveOpenCallback.Create(Password);
-  if InArchive.Open(InStream, @ScanSize, OpenCallback) <> S_OK then
-    raise Exception.Create(FmtSetupMessage(msgErrorExtractionFailed, ['Cannot open file as archive'])); { From Client7z.cpp }
+  if InArchive.Open(InStream, @ScanSize, OpenCallback) <> S_OK then begin
+    Log('ERROR: Cannot open file as archive'); { Just like 7zMain.c and Client7z.cpp }
+    raise Exception.Create(FmtSetupMessage(msgErrorExtractionFailed, ['-2']));
+  end;
 
   { Extract }
   const ExtractCallback: IArchiveExtractCallback =
@@ -520,9 +522,10 @@ begin
     raise Exception.Create(SetupMessages[msgErrorExtractionAborted])
   else begin
     var OpRes := (ExtractCallback as TArchiveExtractCallback).OpRes;
-    if OpRes <> kOK then
+    if OpRes <> kOK then begin
+      LogFmt('ERROR: %s', [OperationResultToString(opRes)]); { Just like 7zMain.c }
       raise Exception.Create(FmtSetupMessage(msgErrorExtractionFailed, [Ord(OpRes).ToString]))
-    else if Res <> S_OK then
+    end else if Res <> S_OK then
       raise Exception.Create(FmtSetupMessage(msgErrorExtractionFailed, [Format('%s %s', [Win32ErrorString(Res), IntToHexStr8(Res)])]));
   end;
 

Projects/Src/Setup.ScriptDlg.pas

@@ -204,7 +204,7 @@ type
   end;
   
   TArchive = class
-    FileName, DestDir: String;
+    FileName, DestDir, Password: String;
     FullPaths: Boolean;
   end;
   TArchives = TObjectList<TArchive>;
@@ -224,6 +224,7 @@ type
       destructor Destroy; override;
       procedure Initialize; override;
       procedure Add(const ArchiveFileName, DestDir: String; const FullPaths: Boolean);
+      procedure AddEx(const ArchiveFileName, DestDir, Password: String; const FullPaths: Boolean);
       procedure Clear;
       procedure Extract;
       property OnExtractionProgress: TOnExtractionProgress write FOnExtractionProgress;
@@ -1167,9 +1168,15 @@ end;
 
 procedure TExtractionWizardPage.Add(const ArchiveFileName, DestDir: String; const FullPaths: Boolean);
 begin
-  var A := TArchive.Create;
+  AddEx(ArchiveFileName, DestDir, '', FullPaths);
+end;
+
+procedure TExtractionWizardPage.AddEx(const ArchiveFileName, DestDir, Password: String; const FullPaths: Boolean);
+begin
+  const A = TArchive.Create;
   A.FileName := ArchiveFileName;
   A.DestDir := DestDir;
+  A.Password := Password;
   A.FullPaths := FullPaths;
   FArchives.Add(A);
 end;
@@ -1192,9 +1199,9 @@ begin
   for var A in FArchives do begin
     { Don't need to set DownloadTemporaryFileOrExtractArchiveProcessMessages before extraction since we already process messages ourselves }
     if ExtractArchiveRedirAvailable then
-      ExtractArchiveRedir(ScriptFuncDisableFsRedir, A.FileName, A.DestDir, '', A.FullPaths, InternalOnExtractionProgress)
+      ExtractArchiveRedir(ScriptFuncDisableFsRedir, A.FileName, A.DestDir, A.Password, A.FullPaths, InternalOnExtractionProgress)
     else
-      Extract7ZipArchiveRedir(ScriptFuncDisableFsRedir, A.FileName, A.DestDir, A.FullPaths, InternalOnExtractionProgress);
+      Extract7ZipArchiveRedir(ScriptFuncDisableFsRedir, A.FileName, A.DestDir, A.Password, 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
-      Extract7ZipArchiveRedir(ScriptFuncDisableFsRedir, 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('INIT7ZIPLIBRARY', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
     begin