 jcl/source/common/JclCompression.pas | 180 ++++++++++++++++++++++++++++++-----
 jcl/source/windows/sevenzip.pas      |  10 +-
 2 files changed, 161 insertions(+), 29 deletions(-)

diff --git a/jcl/source/common/JclCompression.pas b/jcl/source/common/JclCompression.pas
index e5e6a2f..80889a3 100644
--- a/jcl/source/common/JclCompression.pas
+++ b/jcl/source/common/JclCompression.pas
@@ -44,8 +44,7 @@

 unit JclCompression;

-{$I jcl.inc}
-{$I crossplatform.inc}
+{$mode delphi}

 interface

@@ -75,7 +74,10 @@ uses
   ZLib,
   {$ENDIF ZLIB_RTL}
   {$ENDIF ~HAS_UNITSCOPE}
-  zlibh, bzip2, JclWideStrings, JclBase, JclStreams;
+  {$IFNDEF FPC}
+  zlibh, bzip2,
+  {$ENDIF FPC}
+  DCJclAlternative; // Must be after Classes, SysUtils, Windows

 {$IFDEF RTL230_UP}
 {$HPPEMIT '// To avoid ambiguity with System::Zlib::z_stream_s we force using ours'}
@@ -180,6 +182,9 @@ uses
 **************************************************************************************************}

 type
+
+{$IFNDEF FPC}
+
   TJclCompressionStream = class(TJclStream)
   private
     FOnProgress: TNotifyEvent;
@@ -562,8 +567,12 @@ type
     function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
   end;

+{$ENDIF FPC}
+
   EJclCompressionError = class(EJclError);

+{$IFNDEF FPC}
+
   // callback type used in helper functions below:
   TJclCompressStreamProgressCallback = procedure(FileSize, Position: Int64; UserData: Pointer) of object;

@@ -586,6 +595,8 @@ procedure BZip2Stream(SourceStream, DestinationStream: TStream; CompressionLevel
 procedure UnBZip2Stream(SourceStream, DestinationStream: TStream;
   ProgressCallback: TJclCompressStreamProgressCallback = nil; UserData: Pointer = nil);

+{$ENDIF FPC}
+
 // archive ancestor classes
 {$IFDEF MSWINDOWS}
 type
@@ -595,6 +606,7 @@ type
     var AVolumeMaxSize: Int64) of object;
   TJclCompressionProgressEvent = procedure(Sender: TObject; const Value, MaxValue: Int64) of object;
   TJclCompressionRatioEvent = procedure(Sender: TObject; const InSize, OutSize: Int64) of object;
+  TJclCompressionPasswordEvent = procedure(Sender: TObject; var Password: WideString) of object;

   TJclCompressionItemProperty = (ipPackedName, ipPackedSize, ipPackedExtension,
     ipFileSize, ipFileName, ipAttributes, ipCreationTime, ipLastAccessTime,
@@ -770,6 +782,7 @@ type
     FOnRatio: TJclCompressionRatioEvent;
     FOnVolume: TJclCompressionVolumeEvent;
     FOnVolumeMaxSize: TJclCompressionVolumeMaxSizeEvent;
+    FOnPassword: TJclCompressionPasswordEvent;
     FPassword: WideString;
     FVolumeIndex: Integer;
     FVolumeIndexOffset: Integer;
@@ -803,6 +816,9 @@ type
     // function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
     function _AddRef: Integer; stdcall;
     function _Release: Integer; stdcall;
+  public
+    PropNames: array of WideString;
+    PropValues: array of TPropVariant;
   public
     class function MultipleItemContainer: Boolean; virtual;
     class function VolumeAccess: TJclStreamAccess; virtual;
@@ -855,6 +871,7 @@ type
     property OnVolume: TJclCompressionVolumeEvent read FOnVolume write FOnVolume;
     property OnVolumeMaxSize: TJclCompressionVolumeMaxSizeEvent read FOnVolumeMaxSize
       write FOnVolumeMaxSize;
+    property OnPassword: TJclCompressionPasswordEvent read FOnPassword write FOnPassword;
     property Password: WideString read FPassword write FPassword;

     property SupportsNestedArchive: Boolean read GetSupportsNestedArchive;
@@ -1193,6 +1210,7 @@ function GetArchiveFormats: TJclCompressionArchiveFormats;
 type
   TJclSevenzipCompressArchive = class(TJclCompressArchive, IInterface)
   private
+    FSfxModule: String;
     FOutArchive: IOutArchive;
   protected
     function GetItemClass: TJclCompressionItemClass; override;
@@ -1203,6 +1221,7 @@ type
     destructor Destroy; override;
     procedure Compress; override;
     property OutArchive: IOutArchive read GetOutArchive;
+    property SfxModule: String read FSfxModule write FSfxModule;
   end;

   // file formats
@@ -2189,6 +2208,9 @@ function Create7zFile(const SourceFile, DestinationFile: TFileName; VolumeSize:
   OnArchiveProgress: TJclCompressionProgressEvent = nil;
   OnArchiveRatio: TJclCompressionRatioEvent = nil): Boolean; overload;

+var
+  JclCompressSharedFiles: Boolean = False;
+
 {$ENDIF MSWINDOWS}

 {$IFDEF UNITVERSIONING}
@@ -2206,8 +2228,7 @@ const
 implementation

 uses
-  JclUnicode, // WideSameText
-  JclDateTime, JclFileUtils, JclResources, JclStrings, JclSysUtils;
+  DCJclResources, DCJclCompression;

 const
   JclDefaultBufferSize = 131072; // 128k
@@ -2218,6 +2239,8 @@ var
   GlobalStreamFormats: TObject;
   GlobalArchiveFormats: TObject;

+{$IFNDEF FPC}
+
 //=== { TJclCompressionStream } ==============================================

 constructor TJclCompressionStream.Create(AStream: TStream);
@@ -3743,6 +3766,8 @@ begin
   end;
 end;

+{$ENDIF FPC}
+
 {$IFDEF MSWINDOWS}

 function OpenFileStream(const FileName: TFileName; StreamAccess: TJclStreamAccess): TStream;
@@ -3887,7 +3912,7 @@ end;
 function TJclCompressionItem.GetNestedArchiveName: WideString;
 var
   ParentArchiveExtension, ArchiveFileName, ArchiveExtension: WideString;
-  ExtensionMap: TJclWideStrings;
+  ExtensionMap: TStrings;
 begin
   if ipPackedName in ValidProperties then
     Result := PackedName
@@ -3914,7 +3939,7 @@ begin
     else
     if ArchiveFileName <> '' then
     begin
-      ExtensionMap := TJclWideStringList.Create;
+      ExtensionMap := TStringList.Create;
       try
         ExtensionMap.Delimiter := ';';
         ExtensionMap.DelimitedText := Archive.ArchiveSubExtensions;
@@ -3962,9 +3987,16 @@ begin
 end;

 function TJclCompressionItem.GetStream: TStream;
+var
+  AItemAccess: TJclStreamAccess;
 begin
   if not Assigned(FStream) and (FileName <> '') then
-    FStream := OpenFileStream(FileName, Archive.ItemAccess);
+  begin
+    AItemAccess:= Archive.ItemAccess;
+    if (AItemAccess = saReadOnly) and JclCompressSharedFiles then
+      AItemAccess:= saReadOnlyDenyNone;
+    FStream := OpenFileStream(FileName, AItemAccess);
+  end;

   Result := FStream;
 end;
@@ -5544,6 +5576,18 @@ begin
     end;
     if not AllHandled then
       raise EJclCompressionError.CreateRes(@RsCompressionReplaceError);
+  end
+  else begin
+    // Remove temporary files
+    for Index := 0 to FVolumes.Count - 1 do
+    begin
+      AVolume := TJclCompressionVolume(FVolumes.Items[Index]);
+      if AVolume.OwnsTmpStream then
+      begin
+        FreeAndNil(AVolume.FTmpStream);
+        FileDelete(AVolume.TmpFileName);
+      end;
+    end;
   end;
 end;

@@ -5791,6 +5835,8 @@ begin
   FItemIndex := AItemIndex;
   FStream := nil;
   FOwnsStream := False;
+
+  NeedStream;
 end;

 constructor TJclSevenzipInStream.Create(AStream: TStream; AOwnsStream: Boolean);
@@ -6117,6 +6163,8 @@ end;

 procedure SetSevenzipArchiveCompressionProperties(AJclArchive: IInterface; ASevenzipArchive: IInterface);
 var
+  Index: Integer;
+  JclArchive: TJclCompressionArchive;
   PropertySetter: Sevenzip.ISetProperties;
   InArchive, OutArchive: Boolean;
   Unused: IInterface;
@@ -6254,9 +6302,18 @@ begin
         else
           AddWideStringProperty('S', IntToStr(Solid.SolidBlockSize) + 'F');
       end;
+
+      JclArchive := AJclArchive as TJclCompressionArchive;
+      for Index := Low(JclArchive.PropNames) to High(JclArchive.PropNames) do
+      begin
+        AddProperty(PWideChar(JclArchive.PropNames[Index]), JclArchive.PropValues[Index]);
+      end;
     end;
     if Length(PropNames) > 0 then
+    begin
       SevenZipCheck(PropertySetter.SetProperties(@PropNames[0], @PropValues[0], Length(PropNames)));
+      SetLength(JclArchive.PropNames, 0); SetLength(JclArchive.PropValues, 0);
+    end;
   end;
 end;

@@ -6510,7 +6567,10 @@ begin
     // kpidCharacts: ;
     // kpidVa: ;
     // kpidId: ;
-    // kpidShortName: ;
+    kpidShortName:
+      begin
+        Value.vt := VT_EMPTY;
+      end;
     // kpidCreatorApp: ;
     // kpidSectorSize: ;
     kpidPosixAttrib:
@@ -6525,6 +6585,11 @@ begin
     // kpidLocalName: ;
     // kpidProvider: ;
     // kpidUserDefined: ;
+    kpidIsAltStream:
+      begin
+        Value.vt := VT_BOOL;
+        Value.bool := False;
+      end;
   else
     Value.vt := VT_EMPTY;
     Result := S_FALSE;
@@ -6534,9 +6599,27 @@ end;
 function TJclSevenzipUpdateCallback.GetStream(Index: Cardinal;
   out InStream: ISequentialInStream): HRESULT;
 begin
+  Result := E_FAIL;
   FLastStream := Index;
-  InStream := TJclSevenzipInStream.Create(FArchive, Index);
-  Result := S_OK;
+  repeat
+    try
+      InStream := TJclSevenzipInStream.Create(FArchive, Index);
+      Result := S_OK;
+    except
+      on E: Exception do
+      begin
+        case MessageBox(0, PAnsiChar(E.Message), nil, MB_ABORTRETRYIGNORE or MB_ICONERROR) of
+          IDABORT: Exit(E_ABORT);
+          IDIGNORE:
+            begin
+              FArchive.Items[Index].OperationSuccess := osNoOperation;
+              FLastStream := MAXDWORD;
+              Exit(S_FALSE);
+            end;
+        end;
+      end;
+    end;
+  until Result = S_OK;
 end;

 function TJclSevenzipUpdateCallback.GetUpdateItemInfo(Index: Cardinal; NewData,
@@ -6595,17 +6678,20 @@ end;
 function TJclSevenzipUpdateCallback.SetOperationResult(
   OperationResult: Integer): HRESULT;
 begin
-  case OperationResult of
-    kOK:
-      FArchive.Items[FLastStream].OperationSuccess := osOK;
-    kUnSupportedMethod:
-      FArchive.Items[FLastStream].OperationSuccess := osUnsupportedMethod;
-    kDataError:
-      FArchive.Items[FLastStream].OperationSuccess := osDataError;
-    kCRCError:
-      FArchive.Items[FLastStream].OperationSuccess := osCRCError;
-  else
-    FArchive.Items[FLastStream].OperationSuccess := osUnknownError;
+  if FLastStream < MAXDWORD then
+  begin
+    case OperationResult of
+      kOK:
+        FArchive.Items[FLastStream].OperationSuccess := osOK;
+      kUnSupportedMethod:
+        FArchive.Items[FLastStream].OperationSuccess := osUnsupportedMethod;
+      kDataError:
+        FArchive.Items[FLastStream].OperationSuccess := osDataError;
+      kCRCError:
+        FArchive.Items[FLastStream].OperationSuccess := osCRCError;
+    else
+      FArchive.Items[FLastStream].OperationSuccess := osUnknownError;
+    end;
   end;

   Result := S_OK;
@@ -6681,7 +6767,10 @@ end;

 procedure TJclSevenzipCompressArchive.Compress;
 var
+  Value: HRESULT;
+  Index: Integer;
   OutStream: IOutStream;
+  AVolume: TJclCompressionVolume;
   UpdateCallback: IArchiveUpdateCallback;
   SplitStream: TJclDynamicSplitStream;
 begin
@@ -6692,12 +6781,32 @@ begin
     SplitStream := TJclDynamicSplitStream.Create(False);
     SplitStream.OnVolume := NeedStream;
     SplitStream.OnVolumeMaxSize := NeedStreamMaxSize;
-    OutStream := TJclSevenzipOutStream.Create(SplitStream, True, False);
+    if Length(FSfxModule) > 0 then
+      OutStream := TSfxSevenzipOutStream.Create(SplitStream, FSfxModule)
+    else begin
+      OutStream := TJclSevenzipOutStream.Create(SplitStream, True, False);
+    end;
     UpdateCallback := TJclSevenzipUpdateCallback.Create(Self);

     SetSevenzipArchiveCompressionProperties(Self, OutArchive);

-    SevenzipCheck(OutArchive.UpdateItems(OutStream, ItemCount, UpdateCallback));
+    Value:= OutArchive.UpdateItems(OutStream, ItemCount, UpdateCallback);
+
+    if Value <> S_OK then
+    begin
+      // Remove partial archives
+      for Index := 0 to FVolumes.Count - 1 do
+      begin
+        AVolume := TJclCompressionVolume(FVolumes.Items[Index]);
+        if AVolume.OwnsStream then
+        begin
+          FreeAndNil(AVolume.FStream);
+          FileDelete(AVolume.FileName);
+        end;
+      end;
+    end;
+
+    SevenzipCheck(Value);
   finally
     FCompressing := False;
     // release volumes and other finalizations
@@ -7422,7 +7531,14 @@ function TJclSevenzipOpenCallback.CryptoGetTextPassword(
   password: PBStr): HRESULT;
 begin
   if Assigned(password) then
+  begin
+    if Length(FArchive.FPassword) = 0 then
+    begin
+      if Assigned(FArchive.OnPassword) then
+        FArchive.OnPassword(FArchive, FArchive.FPassword);
+    end;
     password^ := SysAllocString(PWideChar(FArchive.Password));
+  end;
   Result := S_OK;
 end;

@@ -7456,7 +7572,14 @@ function TJclSevenzipExtractCallback.CryptoGetTextPassword(
   password: PBStr): HRESULT;
 begin
   if Assigned(password) then
+  begin
+    if Length(FArchive.FPassword) = 0 then
+    begin
+      if Assigned(FArchive.OnPassword) then
+        FArchive.OnPassword(FArchive, FArchive.FPassword);
+    end;
     password^ := SysAllocString(PWideChar(FArchive.Password));
+  end;
   Result := S_OK;
 end;

@@ -8807,6 +8930,7 @@ end;

 procedure TJclSevenzipUpdateArchive.Compress;
 var
+  Value: HRESULT;
   OutStream: IOutStream;
   UpdateCallback: IArchiveUpdateCallback;
   SplitStream: TJclDynamicSplitStream;
@@ -8824,7 +8948,13 @@ begin

     SetSevenzipArchiveCompressionProperties(Self, OutArchive);

-    SevenzipCheck(OutArchive.UpdateItems(OutStream, ItemCount, UpdateCallback));
+    Value:= OutArchive.UpdateItems(OutStream, ItemCount, UpdateCallback);
+
+    if Value <> S_OK then
+    begin
+      FReplaceVolumes:= False;
+      SevenzipCheck(Value);
+    end;
   finally
     FCompressing := False;
     // release reference to volume streams
diff --git a/jcl/source/windows/sevenzip.pas b/jcl/source/windows/sevenzip.pas
index 06fb94f..68f4ae2 100644
--- a/jcl/source/windows/sevenzip.pas
+++ b/jcl/source/windows/sevenzip.pas
@@ -53,10 +53,11 @@

 unit sevenzip;

+{$mode delphi}
+
 interface

-{$I jcl.inc}
-{$I windowsonly.inc}
+{$DEFINE 7ZIP_LINKONREQUEST}

 uses
   {$IFDEF HAS_UNITSCOPE}
@@ -67,8 +68,7 @@ uses
   {$IFDEF UNITVERSIONING}
   JclUnitVersioning,
   {$ENDIF UNITVERSIONING}
-  JclBase,
-  JclSysUtils;
+  DCJclAlternative;

 //DOM-IGNORE-BEGIN

@@ -251,6 +251,8 @@ const
   kpidPosixAttrib = 53;
   kpidLink = 54;

+  kpidIsAltStream = 63;
+
   kpidTotalSize = $1100;
   kpidFreeSpace = $1101;
   kpidClusterSize = $1102;
