sevenzipvcl.pas

TSevenZipVCL v.0.73 By Rainer Geigenberger. Component / Wrapper to use the 7zip dll. Easy to us

begin
  Result := inherited NewInstance;
  TInterfacedObject( Result ).FRefCount := 1;
end;

constructor TMyArchiveUpdateCallback.Create( Owner: TSevenZip );
begin
  inherited Create;
  FSevenzip := Owner;
// Shadow 29.11.2006
  if Assigned( FSevenzip ) then
    FPassword := FSevenzip.Password
  else FPassword := '';
end;

function TMyArchiveUpdateCallback.GetUpdateItemInfo( index: DWORD;
  newData: PInteger; // 1 - new data, 0 - old data
  newProperties: PInteger; // 1 - new properties, 0 - old properties
  indexInArchive: PDWORD // -1 if there is no in archive, or if doesn't matter
  ): Integer; stdcall;
begin
{$IFDEF UseLog}
  Log( Format( 'TMyArchiveUpdateCallback.GetUpdateItemInfo( %d )', [ index ] ) );
{$ENDIF}
  if newData <> nil then newData^ := 1;
  if newProperties <> nil then newProperties^ := 1;
  if indexInArchive <> nil then indexInArchive^ := DWORD( -1 );
  Result := S_OK;
end;

function TMyArchiveUpdateCallback.CryptoGetTextPassword2( passwordIsDefined: PInteger; var Password: PWideChar ): Integer;
begin
  if Length( FPassword ) > 0 then begin
    passwordIsDefined^ := Integer( Bool( TRUE ) );
    Password := SysAllocString( @FPassword[ 1 ] );
    Result := S_OK;
  end else begin
    passwordIsDefined^ := Integer( Bool( FALSE ) );
    Result := S_OK;
  end;
end;

function TMyArchiveUpdateCallback.GetProperty( index: DWORD; propID: PROPID; value: PPROPVARIANT ): Integer; stdcall;
var
  sz: WideString;
begin
{$IFDEF UseLog}
  Log( Format( 'TMyArchiveUpdateCallback.GetProperty( %d, %s ( %d ), %.8x )', [ index, PropIDToString( propID ), propID, Integer( value ) ] ) );
{$ENDIF}
  Result := S_OK;
  case propID of
    //kpidPath ( 3 ) VT_BSTR ( 8 )
    kpidPath:
    begin
      value^.vt := VT_BSTR;

//get relative path if wanted
      sz := Files[ index ];
      if rootdir <> '' then
      begin
        if Uppercasew_( copy( sz,1,length( rootdir ) ) ) = rootdir then
          delete( sz,1,length( rootdir ) );
      end;

//User set filename in archive if wanted
      if assigned( Fsevenzip.OnSetAddName ) then
        Fsevenzip.OnSetAddName( Fsevenzip, Index, sz );

//remove drive / Include drive if wanted
      if sz[ 2 ] = ':' then
        begin
         if char( sz[ 1 ] ) in [ 'A'..'Z','a'..'z' ] then
           if ( AddIncludeDriveLetter in Fsevenzip.FAddOptions ) then //include
            delete( sz,2,1 )
           else
             delete( sz,1,3 );
        end;

//just store filename
      if ( AddStoreOnlyFilename in Fsevenzip.FAddOptions ) then
        sz := ExtractFileNameW( sz );

//rg 07.11.2006 StringToOleStr( )
      value^.bstrVal := Pwidechar( sz );
    end;
    //kpidAttributes ( 9 ) VT_UI4 ( 19 )
    kpidAttributes:
    begin
      value^.vt := VT_UI4;
      value^.ulVal := Files_Attr[ index ];//filegetattr( files[ index ] );
    end;
    kpidCreationTime:
    begin
      value^.vt := VT_FILETIME;

      value^.filetime.dwLowDateTime := 0;
      value^.filetime.dwHighDateTime := 0;
    end;
    kpidLastAccessTime:
    begin
      value^.vt := VT_FILETIME;
      value^.filetime.dwLowDateTime := 0;
      value^.filetime.dwHighDateTime := 0;
    end;
    //kpidLastWriteTime ( 12 ) VT_FILETIME ( 64 )
    kpidLastWriteTime:
    begin
      value^.vt := VT_FILETIME;
      value^.filetime.dwLowDateTime := Files_Date[ index ].dwLowDateTime;;
      value^.filetime.dwHighDateTime := Files_Date[ index ].dwHighDateTime;
    end;
    kpidIsFolder:
    begin
      value^.vt := VT_BOOL;
      value^.boolVal := ( Files_Attr[ index ] and faDirectory ) <> 0; //false
    end;
    kpidIsAnti:
    begin
      value^.vt := VT_BOOL;
      value^.boolVal := False;
    end;
    //kpidSize ( 7 ) VT_UI8 ( 21 )
    kpidSize:
    begin
      value^.vt := VT_UI8;
      value^.uhVal.QuadPart := Files_size[ index ];
    end;
  else
{$IFDEF UseLog}
    Log( 'Asking for unknown property' );
{$ENDIF}
    Result := S_FALSE;
  end;
end;

function TMyArchiveUpdateCallback.GetStream( index: DWORD; var inStream: ISequentialInStream ): Integer; stdcall;
begin
{$IFDEF UseLog}
  Log( 'TMyArchiveUpdateCallback.GetStream' );
{$ENDIF}
  Fprogressfile := files[ index ];
  Fprogressfilesize := files_size[ index ];
  Fprogressfilepos := 0;
  inStream := TMyStreamReader.Create( FSevenZip, Files[ index ], FALSE );
  Result := S_OK;
end;

function TMyArchiveUpdateCallback.SetOperationResult( operationResult: Integer ): Integer; stdcall;
begin
{$IFDEF UseLog}
  Log( Format( 'TMyArchiveUpdateCallback.SetOperationResult( %d )', [ operationResult ] ) );
{$ENDIF}
  Result := S_OK;
end;

function TMyArchiveUpdateCallback.SetTotal( total: Int64 ): Integer; stdcall;
begin
{$IFDEF UseLog}
  Log( Format( 'TMyArchiveUpdateCallback.SetTotal( %d )', [ total ] ) );
{$ENDIF}
  Result := S_OK;
end;

function TMyArchiveUpdateCallback.SetCompleted( const completeValue: PInt64 ): Integer; stdcall;
begin
/// Progressfile - Newfile
/// Do it here because it works with Multithreaded 7za interaction.
{$IFDEF UseLog}
  Log( Format( 'TMyArchiveUpdateCallback.SetCompleted( %d )', [ completeValue^ ] ) );
{$ENDIF}

//fileprogress
   if ( FProgressFilePos = 0 ) then
      if assigned( Fsevenzip.OnAddFile ) then Fsevenzip.onAddFile( Fsevenzip,FProgressFile,FProgressFileSize );
   FProgressFilePos := FProgressFilePos + ( completeValue^ - FLastPos );
   FLastPos := completeValue^;

//full and file progress position
   if assigned( Fsevenzip.OnProgress ) then Fsevenzip.OnProgress( Fsevenzip,FProgressFile,completeValue^,FProgressFilePos );

  Result := S_OK;
//rg 24.06
//User cancel operation
  if FSevenzip.FMainCancel then
   begin
     FSevenZip.ErrCode:=FUsercancel;                           //FHO 21.01.2007
     if assigned( Fsevenzip.onMessage ) then
       Fsevenzip.OnMessage( Fsevenzip,FUsercancel,c7zipResMsg[FUsercancel], FProgressFile );  //FHO 21.01.2007
     Result := S_FALSE;
   end;
end;


constructor TMyArchiveExtractCallback.Create( Owner: TSevenZip );
begin
  inherited Create;
  FSevenzip := Owner;
// Shadow 29.11.2006
  if Assigned( FSevenzip ) then
    FPassword := FSevenzip.Password
  else FPassword := '';
end;

function TMyArchiveExtractCallback.GetStream( index: DWORD;
  out outStream: ISequentialOutStream; askExtractMode: DWORD ): Integer; stdcall;
var
 path: Propvariant;
 size: Propvariant;
 date: Propvariant;
 attr: Propvariant;
   sz, origName: Widestring;
   fe,DoOverwrite: boolean;
//   fHnd: Integer;
  MyLastError:Integer;                                           //FHO 22.01.2007
begin
{$IFDEF UseLog}
  Log( Format( '__TMyArchiveExtractCallback.GetStream( %d, %.8x, %d )', [ index, Integer( outStream ), askExtractMode ] ) );
{$ENDIF}
  DoOverwrite := ExtractOverwrite in FsevenZip.FExtractOptions;
  path.vt := VT_EMPTY;
  size.vt := VT_EMPTY;
  date.vt := VT_EMPTY;
  attr.vt := VT_EMPTY;

//Cancel Operation
  if self.FSevenzip.FMainCancel then
   begin
    outStream := nil;
    result := S_FALSE;
    exit;
   end;

  Case askExtractMode of
    kExtract:  begin

                 FSevenzip.inA.GetProperty( index, kpidPath, path );
                 FSevenzip.inA.GetProperty( index, kpidSize, size );
                 FSevenzip.inA.GetProperty( index, kpidattributes, attr );
                 FSevenzip.inA.GetProperty( index, kpidLastWriteTime, date );

//rg 23.8.06
                 if ExtractNoPath in FSevenzip.FExtractOptions then
                   sz := FExtractDirectory + extractfilenameW( path.bstrVal )
                  else
                   sz := FExtractDirectory + path.bstrVal;

                 origName := sz;

                 if assigned( Fsevenzip.OnSetExtractName ) then
                   Fsevenzip.OnSetExtractName( Fsevenzip,index, sz );


                 if not DoOverwrite then
                  if FileExists_( sz ) then
                   begin
                     if assigned( Fsevenzip.OnExtractOverwrite ) then
                         Fsevenzip.OnExtractOverwrite( Fsevenzip, sz, DoOverwrite );

                     if not DoOverwrite then
                      begin
                       Result := S_OK;
                       outStream := nil;
                       exit;
                      end;
                     end;

                    FProgressFile := sz;
                    FProgressFilePos := 0;
                    FprogressFileSize := size.uhVal.QuadPart;

                 if ( attr.uiVal and ( 1 shl 4 ) ) <> 0 then
                  begin
                   if isUnicode then
                     ForceDirectoriesW( sz, attr.uiVal )
                    else
                     ForceDirectories(String(sz));
                  end
                 else
                  begin
                    FFilestoextract := FFilestoextract - 1;
                    if FFilestoextract = 0 then FLastFileToExt := true;
                    outStream := nil;
                    fe := FileExists_( sz );

                    if ( not fe ) or ( fe and DoOverwrite ) then begin
                      if isUnicode then
                        ForceDirectoriesW( ExtractFilePathW( sz ), attr.uiVal )
                       else
                        ForceDirectories(extractfilepath( String( sz ) ) );
                    try
                      outStream := TMyStreamWriter.Create(@MyLastError ,sz,  
                                                               //FHO 22.01.2007
                                     FileTimeToDateTime( date.filetime, 2 ), attr.lVal );
                    except
                      outStream := nil;
                      Result := S_FALSE;
                      FSevenzip.LastError:=MyLastError;         //FHO 22.01.2007
                      FSevenzip.ErrCode:=FNoFileCreated;
                      if assigned( FsevenZip.onmessage ) then
                        FsevenZip.onmessage( FsevenZip, FNoFileCreated, c7zipResMsg[FNoFileCreated],origName);
                      Exit;
// did not work here need another place !
// if assigned( FsevenZip.onmessage ) then FsevenZip.onmessage( FsevenZip, 2, 'Could not create file', origName );
                    end;
                  end;
              end;
             end;
    ktest   : begin
                 FSevenzip.inA.GetProperty( index, kpidPath, path );
                 FSevenzip.inA.GetProperty( index, kpidSize, size );
                 FProgressFile := path.bstrVal;
                 FProgressFilePos := 0;
                 FprogressFileSize := size.uhVal.QuadPart ;
               end;
    kskip   : begin
               end;
  end;
  Result := S_OK;
end;
// GetStream OUT: S_OK - OK, S_FALSE - skeep this file

function TMyArchiveExtractCallback.PrepareOperation( askExtractMode: Integer ): Integer; stdcall;
begin
{$IFDEF UseLog}
  Log( Format( 'TMyArchiveExtractCallback.PrepareOperation( %d )', [ askExtractMode ] ) );
{$ENDIF}
  Result := S_OK;
end;

function TMyArchiveExtractCallback.SetOperationResult( resultEOperationResult: Integer ): Integer; stdcall;
begin
  Result := S_OK;
{$IFDEF UseLog}
  Log( Format( 'TMyArchiveExtractCallback.SetOperationResult( %d )', [ resultEOperationResult ] ) );
{$ENDIF}
  case resultEOperationResult of
    kOK               : FSevenzip.ErrCode:=FNoError;
    kUnSupportedMethod: begin                                  //FHO 21.01.2007
                          FSevenzip.ErrCode:=FUnsupportedMethod;
                          if assigned( Fsevenzip.onmessage ) then
                            Fsevenzip.onmessage( Fsevenzip, FUnsupportedMethod, c7zipResMsg[FUnsupportedMethod], FProgressFile );
                        end;
    kDataError        : begin                                  //FHO 21.01.2007
                          FSevenzip.ErrCode:=FDataError;