소스 검색

Add support functions Init7ZipLibrary and ExtractArchive.

Martijn Laan 3 달 전
부모
커밋
d9356ae8ca
5개의 변경된 파일40개의 추가작업 그리고 21개의 파일을 삭제
  1. 3 1
      Projects/Setup.dpr
  2. 2 0
      Projects/Setup.dproj
  3. 24 19
      Projects/Src/Compression.SevenZipDllDecoder.pas
  4. 9 1
      Projects/Src/Setup.ScriptFunc.pas
  5. 2 0
      Projects/Src/Shared.ScriptFunc.pas

+ 3 - 1
Projects/Setup.dpr

@@ -98,7 +98,9 @@ uses
   Setup.ScriptFunc.HelperFunc in 'Src\Setup.ScriptFunc.HelperFunc.pas',
   ECDSA in '..\Components\ECDSA.pas',
   ISSigFunc in '..\Components\ISSigFunc.pas',
-  StringScanner in '..\Components\StringScanner.pas';
+  StringScanner in '..\Components\StringScanner.pas',
+  Compression.SevenZipDllDecoder in 'Src\Compression.SevenZipDllDecoder.pas',
+  Compression.SevenZipDllDecoder.Interfaces in 'Src\Compression.SevenZipDllDecoder.Interfaces.pas';
 
 {$SETPEOSVERSION 6.1}
 {$SETPESUBSYSVERSION 6.1}

+ 2 - 0
Projects/Setup.dproj

@@ -171,6 +171,8 @@
         <DCCReference Include="..\Components\ECDSA.pas"/>
         <DCCReference Include="..\Components\ISSigFunc.pas"/>
         <DCCReference Include="..\Components\StringScanner.pas"/>
+        <DCCReference Include="Src\Compression.SevenZipDllDecoder.pas"/>
+        <DCCReference Include="Src\Compression.SevenZipDllDecoder.Interfaces.pas"/>
         <BuildConfiguration Include="Base">
             <Key>Base</Key>
         </BuildConfiguration>

+ 24 - 19
Projects/Src/Compression.SevenZipDllDecoder.pas

@@ -6,7 +6,7 @@ unit Compression.SevenZipDllDecoder;
   Portions by Martijn Laan
   For conditions of distribution and use, see LICENSE.TXT.
 
-  Interface to the 7-Zip 7z(x)(a).dll Decoder DLL's, used by Setup
+  Interface to the 7-Zip 7z(xa).dll Decoder DLL's, used by Setup
 
   Based on the 7-zip source code and the 7-zip Delphi API by Henri Gourvest
   https://github.com/geoffsmith82/d7zip MPL 1.1 licensed
@@ -14,12 +14,14 @@ unit Compression.SevenZipDllDecoder;
 
 interface
 
-type
-  TOnExtractionProgress = function(const ArchiveName, FileName: string; const Progress, ProgressMax: Int64): Boolean of object;
+uses
+  Compression.SevenZipDecoder;
 
-function InitSevenZipLibrary(const DllFilename: String): Boolean;
-procedure ExtractArchive(const ArchiveFilename, DestDir, Password: String;
-  const FullPaths: Boolean; const OnExtractionProgress: TOnExtractionProgress);
+procedure InitSevenZipLibrary(const DllFilename: String);
+
+procedure ExtractArchiveRedir(const DisableFsRedir: Boolean;
+  const ArchiveFilename, DestDir, Password: String; const FullPaths: Boolean;
+  const OnExtractionProgress: TOnExtractionProgress);
 
 implementation
 
@@ -370,20 +372,23 @@ begin
   end;
 end;
 
-function InitSevenZipLibrary(const DllFilename: String): Boolean;
+procedure InitSevenZipLibrary(const DllFilename: String);
 begin
   if SevenZipLibrary = 0 then begin
     SevenZipLibrary := LoadLibrary(PChar(DllFilename));
-    if SevenZipLibrary <> 0 then begin
-      CreateSevenZipObject := GetProcAddress(SevenZipLibrary, 'CreateObject');
-      if not Assigned(CreateSevenZipObject) then
-        FreeSevenZipLibrary;
+    if SevenZipLibrary = 0 then
+      Win32ErrorMsg('LoadLibrary');
+    CreateSevenZipObject := GetProcAddress(SevenZipLibrary, 'CreateObject');
+    if not Assigned(CreateSevenZipObject) then begin
+      var LastError := GetLastError;
+      FreeSevenZipLibrary;
+      Win32ErrorMsgEx('GetProcAddress', LastError);
     end;
   end;
-  Result := SevenZipLibrary <> 0;
 end;
 
-procedure ExtractArchive(const ArchiveFilename, DestDir, Password: String;
+procedure ExtractArchiveRedir(const DisableFsRedir: Boolean;
+  const ArchiveFilename, DestDir, Password: String;
   const FullPaths: Boolean; const OnExtractionProgress: TOnExtractionProgress);
 
   function GetHandler(const Ext: String): TGUID;
@@ -417,6 +422,8 @@ procedure ExtractArchive(const ArchiveFilename, DestDir, Password: String;
   end;
 
 begin
+  if not Assigned(CreateSevenZipObject) then
+    InternalError('ExtractArchive: 7z(xa).dll not loaded');
   if ArchiveFileName = '' then
     InternalError('ExtractArchive: Invalid ArchiveFileName value');
   if DestDir = '' then
@@ -424,24 +431,22 @@ begin
 
   LogFmt('Extracting archive %s to %s. Full paths? %s', [ArchiveFileName, DestDir, SYesNo[FullPaths]]);
 
-  var DisableFsRedir := InstallDefaultDisableFsRedir;
-
   { CreateObject }
   var InArchive: IInArchive;
   if CreateSevenZipObject(GetHandler(PathExtractExt(ArchiveFilename)), IInArchive, InArchive) <> S_OK then
     raise Exception.Create(FmtSetupMessage(msgErrorExtractionFailed, ['Cannot get class object'])); { From Client7z.cpp }
 
   { Open }
-  var InStream := TInStream.Create(TFileRedir.Create(DisableFsRedir, ArchiveFilename, fdOpenExisting, faRead, fsRead));
+  const InStream = TInStream.Create(TFileRedir.Create(DisableFsRedir, ArchiveFilename, fdOpenExisting, faRead, fsRead));
   var ScanSize: Int64 := 1 shl 23; { From Client7z.cpp }
-  var OpenCallback := TArchiveOpenCallback.Create(Password);
+  const OpenCallback = TArchiveOpenCallback.Create(Password);
   if InArchive.Open(InStream, @ScanSize, OpenCallback as IArchiveOpenCallback) <> S_OK then
     raise Exception.Create(FmtSetupMessage(msgErrorExtractionFailed, ['Cannot open file as archive'])); { From Client7z.cpp }
 
   { Extract }
-  var ExtractCallback := TArchiveExtractCallback.Create(InArchive, DisableFsRedir,
+  const ExtractCallback = TArchiveExtractCallback.Create(InArchive, DisableFsRedir,
     ArchiveFilename, DestDir, Password, FullPaths, OnExtractionProgress);
-  var Res := InArchive.Extract(nil, $FFFFFFFF, 0, ExtractCallback as IArchiveExtractCallback);
+  const Res = InArchive.Extract(nil, $FFFFFFFF, 0, ExtractCallback as IArchiveExtractCallback);
   if Res = E_ABORT then
     raise Exception.Create(SetupMessages[msgErrorExtractionAborted])
   else if Res <> S_OK then

+ 9 - 1
Projects/Src/Setup.ScriptFunc.pas

@@ -29,7 +29,7 @@ uses
   Setup.WizardForm, Shared.VerInfoFunc, Shared.SetupTypes,
   Shared.Int64Em, Setup.LoggingFunc, Setup.SetupForm, Setup.RegDLL, Setup.Helper,
   Setup.SpawnClient, Setup.DotNetFunc, Setup.MainForm,
-  Shared.DotNetVersion, Setup.MsiFunc, Compression.SevenZipDecoder,
+  Shared.DotNetVersion, Setup.MsiFunc, Compression.SevenZipDecoder, Compression.SevenZipDllDecoder,
   Setup.DebugClient, Shared.ScriptFunc, Setup.ScriptFunc.HelperFunc;
 
 type
@@ -1788,6 +1788,14 @@ var
     begin
       Extract7ZipArchive(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
+      InitSevenZipLibrary(Stack.GetString(PStart));
+    end);
+    RegisterScriptFunc('EXTRACTARCHIVE', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
+    begin
+      ExtractArchiveRedir(ScriptFuncDisableFsRedir, Stack.GetString(PStart), Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetBool(PStart-3), TOnExtractionProgress(Stack.GetProc(PStart-4, Caller)));
+    end);
     RegisterScriptFunc('DEBUGGING', procedure(const Caller: TPSExec; const OrgName: AnsiString; const Stack: TPSStack; const PStart: Cardinal)
     begin
       Stack.SetBool(PStart, Debugging);

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

@@ -540,6 +540,8 @@ initialization
     'function IsMsiProductInstalled(const UpgradeCode: String; const PackedMinVersion: Int64): Boolean;',
     'function InitializeBitmapImageFromIcon(const BitmapImage: TBitmapImage; const IconFilename: String; const BkColor: TColor; const AscendingTrySizes: TArrayOfInteger): Boolean;',
     'procedure Extract7ZipArchive(const ArchiveFileName, DestDir: String; const FullPaths: Boolean; const OnExtractionProgress: TOnExtractionProgress);',
+    'procedure Init7ZipLibrary(const DllFilename: String);',
+    'procedure ExtractArchive(const ArchiveFilename, DestDir, Password: String; const FullPaths: Boolean; const OnExtractionProgress: TOnExtractionProgress);',
     'function Debugging: Boolean;',
     'function StringJoin(const Separator: String; const Values: TArrayOfString): String;',
     'function StringSplit(const S: String; const Separators: TArrayOfString; const Typ: TSplitType): TArrayOfString;',