abunzprc.pas

Lazarus is a free and open source development tool for the FreePascal Compiler. The purpose of the p

  SizeToRead := SizeOf(Buffer);
  if SizeToRead > Remaining then
    SizeToRead := Remaining;


  { if Item is not encrypted }
  if not Item.IsEncrypted then begin
    try

      { just extract it }

      { get first bufferful }
      DataRead := Archive.FStream.Read(Buffer, SizeToRead);
      { while more data has been read and we're not told to bail }
      while (DataRead > 0) and (Total < Item.UncompressedSize) and not Abort do begin
        { report progress }
        if Assigned(Archive.OnProgress) then begin
          Total := Total + DataRead;
          Remaining := Remaining - DataRead;
          Percent := Round((100.0 * Total) / Item.UncompressedSize);
          if (LastPercent <> Percent) then
            Archive.OnProgress(Percent, Abort);
          LastPercent := Percent;
        end;

        { update CRC }
        AbUpdateCRCBuffer(CRC32, Buffer, DataRead);

        { write data }
        OutStream.WriteBuffer(Buffer, DataRead);

        { get next bufferful }
        SizeToRead := SizeOf(Buffer);
        if SizeToRead > Remaining then
          SizeToRead := Remaining;
        DataRead := Archive.FStream.Read(Buffer, SizeToRead);
      end;
    except
      on EAbUserAbort do
        Abort := True;
    end;

  end
  else begin
    try
      { need to decrypt }
      Tries := 0;
      Abort := False;

      CheckPassword(Archive, Tries, Abort);
      if Abort then
        raise EAbUserAbort.Create;

      { check for valid password }
      DecryptStream := TAbDfDecryptStream.Create(Archive.FStream, TheCRC, Archive.Password);
      while not Abort and not DecryptStream.IsValid and (Tries < Archive.PasswordRetries) do begin
        RequestPassword(Archive, Abort);
        if Abort then
          raise EAbUserAbort.Create;
        DecryptStream.Free;
        DecryptStream := TAbDfDecryptStream.Create(Archive.FStream, TheCRC, Archive.Password);
        Inc(Tries);
      end;
      if (Tries > Archive.PasswordRetries) then
        raise EAbZipInvalidPassword.Create;

      { got good Password, so extract }
      { get first bufferful (decrypting) }
      {  DecryptStream.Position := 0;                            }{!!.01}{!!.02}
      DataRead := DecryptStream.Read(Buffer, SizeToRead);
      { while more data has been read and we're not told to bail }
      while (DataRead > 0) and not Abort do begin
        { report progress }
        if Assigned(Archive.OnProgress) then begin
          Total := Total + DataRead;
          Remaining := Remaining - DataRead;                             {!!.01}
          Percent := Round((100.0 * Total) / Item.UncompressedSize);
          if (LastPercent <> Percent) then
            Archive.OnProgress(Percent, Abort);
          LastPercent := Percent;
        end;

        { update CRC }
        AbUpdateCRCBuffer(CRC32, Buffer, DataRead);

        { write data }
        OutStream.WriteBuffer(Buffer, DataRead);

        { get next bufferful (decrypting) }
        SizeToRead := SizeOf(Buffer);
        if SizeToRead > Remaining then
          SizeToRead := Remaining;
        DataRead := DecryptStream.Read(Buffer, SizeToRead);
      end;
    except
      on EAbUserAbort do
        Abort := True;
    end;
  end;


  { finish CRC calculation }
  Result := not CRC32;

  { show final progress increment }
  if (Percent < 100) and Assigned(Archive.OnProgress) then
    Archive.OnProgress(100, Abort);

  { User wants to bail }
  if Abort then begin
    raise EAbUserAbort.Create;
  end;
end;
{ -------------------------------------------------------------------------- }
function DoOtherUnzip(Archive : TAbZipArchive; Item : TAbZipItem; OutStream : TStream; TheCRC : LongInt) : LongInt;
var
  Decoder    : TAbZDecoder;
  Helper     : TAbUnzipHelper;

begin
  Decoder := nil;
  if Item.IsEncrypted then
    Decoder := TAbZDecoder.Create(Archive.Password, Archive.FStream, TheCRC, True);

  if Assigned(Decoder) then begin
    Decoder.OnNeedPassword := Archive.OnNeedPassword;
    Decoder.Password := Archive.Password;
    Decoder.Retries := Archive.PasswordRetries;
  end;

  Helper := TAbUnzipHelper.Create(Archive.FStream, OutStream, Decoder);
  try {Helper}
    Helper.DictionarySize       := Item.DictionarySize;
    Helper.CompressedSize       := Item.CompressedSize;
    Helper.UnCompressedSize     := Item.UncompressedSize;
    Helper.CompressionMethod    := Item.CompressionMethod;
    Helper.ShannonFanoTreeCount := Item.ShannonFanoTreeCount;
    Helper.OnProgress           := Archive.OnProgress;
    Helper.OnRequestNthDisk     := Archive.OnRequestNthDisk;
    Helper.Archive              := Archive;
    if Archive.Spanned then
      with Archive do begin
        Helper.ArchiveName := ArchiveName;
        Helper.CurrentDisk := CurrentDisk;
        Helper.Spanned := True;
        Helper.Mode := Mode;
      end;
    Result := Helper.Execute;
  finally
    Helper.Free;
  end;
end;
{ -------------------------------------------------------------------------- }
procedure AbUnzipToStream( Sender : TObject; Item : TAbZipItem; OutStream : TStream);
var
  LFH         : TAbZipLocalFileHeader;
  TheCRC      : LongInt;
  OutCRC      : LongInt;
  Abort       : Boolean;
  ZipArchive  : TAbZipArchive;

  procedure Validate;
  begin
    if not Assigned(OutStream) then
      raise EAbBadStream.Create;
    if (Lo(Item.VersionNeededToExtract) > Ab_ZipVersion) then
      raise EAbZipVersion.Create;
  end;

  procedure CheckForSpanning;
  begin
    if ZipArchive.Spanned then begin                                 {!!.02}
      if (ZipArchive.CurrentDisk <> Item.DiskNumberStart) then begin {!!.02}
        ZipArchive.CurrentDisk := Item.DiskNumberStart;
        if not (ZipArchive.FStream is TAbSpanStream) then
          raise EAbZipBadSpanStream.Create;
        if not TAbSpanStream(ZipArchive.FStream).SpanStreamInCharge then begin {!!.02}
          ZipArchive.DoRequestNthImage(ZipArchive.CurrentDisk,
            ZipArchive.FStream, Abort );
          if Abort then
            raise EAbUserAbort.Create;
        end;                                                         {!!.02}
      end;
    end;                                                             {!!.02}
  end;

  procedure GetHeader;
  begin
    {get past the item's local file header}
    ZipArchive.FStream.Seek(Item.RelativeOffset, soFromBeginning);

    { select appropriate CRC value based on General Purpose Bit Flag }
    { also get whether the file is stored, while we've got the local file header }
    LFH.LoadFromStream(ZipArchive.FStream);
    if (LFH.GeneralPurposeBitFlag and AbHasDataDescriptorFlag = AbHasDataDescriptorFlag) then
    { if bit 3 is set, then the data descriptor record is appended
      to the compressed data }
      TheCRC := LFH.LastModFileTime shl $10
    else
      TheCRC := Item.CRC32;
  end;
begin
  ZipArchive := Sender as TAbZipArchive;
  LFH := TAbZipLocalFileHeader.Create;

  try     {LFH}
    Validate;
    CheckForSpanning;

    { get local header info for Item}
    GetHeader;

    { determine storage type }
    case LFH.CompressionMethod of
     cmStored: begin
      { unstore item }
      OutCRC := DoExtractStored(ZipArchive, Item, OutStream, TheCRC);
     end;
     cmDeflated, cmEnhancedDeflated: begin
      { inflate Item }
      OutCRC := DoInflate(ZipArchive, Item, OutStream, TheCRC);
     end;
     else begin { Shrunk, Imploded, or Reduced }
       OutCrc := DoOtherUnzip(ZipArchive, Item, OutStream, TheCrc);
     end;
    end;

    { check CRC }
    if (OutCRC <> TheCRC) and (OutCRC <> Item.CRC32) then                {!!.01}
      if Assigned(ZipArchive.OnProcessItemFailure) then                  {!!.01}
        ZipArchive.OnProcessItemFailure(ZipArchive, Item, ptExtract,     {!!.01}
          ecAbbrevia, AbZipBadCRC)                                       {!!.01}
      else                                                               {!!.01}
        raise EAbZipBadCRC.Create;                                       {!!.01}

{!!.01 -- removed}
    { set spanning info }
//    if ZipArchive.Spanned then
//      ZipArchive.CurrentDisk := TAbSpanStream(ZipArchive.FStream).SpanNumber;
{!!.01 -- end removed}

  finally {LFH}
    LFH.Free;
  end;    {LFH}
end;
{ -------------------------------------------------------------------------- }
procedure AbUnzip(Sender : TObject; Item : TAbZipItem; NewName : string);
  {create the output filestream and pass it to AbUnzipToStream}
var
  Confirm    : Boolean;
  OutStream  : TFileStream;
  ZipArchive : TAbZipArchive;
{$IFDEF LINUX}                                                           {!!.01}
  FileDateTime  : TDateTime;                                             {!!.01}
  LinuxFileTime : LongInt;                                               {!!.01}
{$ENDIF LINUX}                                                           {!!.01}
begin
  ZipArchive := TAbZipArchive(Sender);

  {BaseDirectory is the drive:\directory\sub where we currently want files}
  {NewName is the optionalpath\sub\filename.ext where we want the file}
  Confirm := AbConfirmPath(ZipArchive.BaseDirectory, NewName,
    ZipArchive.ExtractOptions, ZipArchive.OnConfirmOverwrite);

  if not Confirm then
    Exit;
  OutStream := TFileStream.Create(NewName, fmCreate or fmShareDenyWrite); {!!.01}
  try
    try    {OutStream}
      AbUnZipToStream(Sender, Item, OutStream);
      {$IFDEF MSWINDOWS}
      FileSetDate(OutStream.Handle, (Longint(Item.LastModFileDate) shl 16)
        + Item.LastModFileTime);
      {$ENDIF}
      {$IFDEF LINUX}
      FileDateTime := AbDosFileDateToDateTime(Item.LastModFileDate,      {!!.01}
        Item.LastModFileTime);                                           {!!.01}
      LinuxFileTime := AbDateTimeToUnixTime(FileDateTime);               {!!.01}
//!! MVC not implemented      FileSetDate(NewName, LinuxFileTime);                               {!!.01}
      {$ENDIF}
      AbFileSetAttr(NewName, Item.ExternalFileAttributes);
   finally {OutStream}
      OutStream.Free;
    end;   {OutStream}

  except
    on E : EAbUserAbort do begin
      ZipArchive.FStatus := asInvalid;
      if FileExists(NewName) then
        DeleteFile(NewName);
      raise;
    end else begin
      if FileExists(NewName) then
        DeleteFile(NewName);
      raise;
    end;
  end;
end;
{ -------------------------------------------------------------------------- }
procedure AbTestZipItem(Sender : TObject; Item : TAbZipItem);
  {extract item to bit bucket and verify its local file header}
var
  BitBucket  : TAbBitBucketStream;
  LFH        : TAbZipLocalFileHeader;
  ZipArchive : TAbZipArchive;
  Abort : Boolean;
begin
  ZipArchive := TAbZipArchive(Sender);

  if (Lo(Item.VersionNeededToExtract) > Ab_ZipVersion) then
    raise EAbZipVersion.Create;

  if ZipArchive.Spanned and (ZipArchive.CurrentDisk <> Item.DiskNumberStart) then
  begin
    ZipArchive.CurrentDisk := Item.DiskNumberStart;
//    if not (ZipArchive.FStream is TFileStream) then                  {!!.04}
    if not (ZipArchive.FStream is TAbSpanStream) then                  {!!.04}
      raise EAbZipBadSpanStream.Create;
    ZipArchive.DoRequestNthImage(ZipArchive.CurrentDisk,
      ZipArchive.FStream, Abort );
    if Abort then
      raise EAbUserAbort.Create;
  end;

  BitBucket := nil;
  LFH := nil;
  try
    BitBucket := TAbBitBucketStream.Create(0);
    LFH := TAbZipLocalFileHeader.Create;
      {get the item's local file header}
    ZipArchive.FStream.Seek(Item.RelativeOffset, soFromBeginning);
    LFH.LoadFromStream(ZipArchive.FStream);
    ZipArchive.FStream.Seek(Item.RelativeOffset, soFromBeginning);

      {currently a single exception is raised for any LFH error}
    if (LFH.VersionNeededToExtract <> Item.VersionNeededToExtract) then
      raise EAbZipInvalidLFH.Create;
    if (LFH.GeneralPurposeBitFlag <> Item.GeneralPurposeBitFlag) then
      raise EAbZipInvalidLFH.Create;
    if (LFH.LastModFileTime <> Item.LastModFileTime) then
      raise EAbZipInvalidLFH.Create;
    if (LFH.LastModFileDate <> Item.LastModFileDate) then
      raise EAbZipInvalidLFH.Create;
    if (LFH.CRC32 <> Item.CRC32) then
      raise EAbZipInvalidLFH.Create;
    if (LFH.CompressedSize <> Item.CompressedSize) then
      raise EAbZipInvalidLFH.Create;
    if (LFH.UncompressedSize <> Item.UncompressedSize) then
      raise EAbZipInvalidLFH.Create;
    if (CompareStr(StrPas(LFH.FileName), Item.FileName) <> 0) then
      raise EAbZipInvalidLFH.Create;
    if (CompareStr(StrPas(LFH.ExtraField), Item.ExtraField) <> 0) then
      raise EAbZipInvalidLFH.Create;

      {any CRC errors will raise exception during extraction}
    AbUnZipToStream(Sender, Item, BitBucket);
  finally
    BitBucket.Free;
    LFH.Free;
  end;

end;
{ -------------------------------------------------------------------------- }
procedure InflateStream( CompressedStream, UnCompressedStream : TStream );
  {-Inflates everything in CompressedStream to UncompressedStream
    no encryption is tried, no check on CRC is done, uses the whole
    compressedstream - no Progress events - no Frills!}
begin
  Inflate(CompressedStream, UncompressedStream, nil);
end;

end.