abgztyp.pas

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

  FState    := gsGzip;
  FGZStream  := FStream;  { save reference to opened file stream }
  FGZItem    := FItemList;
  FTarStream := TAbVirtualMemoryStream.Create;
  FTarList   := TAbArchiveList.Create;
end;

procedure TAbGzipArchive.SwapToTar;
begin
  FStream := FTarStream;
  FItemList := FTarList;
  FState := gsTar;
end;

procedure TAbGzipArchive.SwapToGzip;
begin
  FStream := FGzStream;
  FItemList := FGzItem;
  FState := gsGzip;
end;

function TAbGzipArchive.CreateItem(const FileSpec: string): TAbArchiveItem;
var
  Buff : array [0..511] of Char;
  GzItem : TAbGzipItem;
begin
  if IsGZippedTar and TarAutoHandle then begin
    if FState <> gsTar then
      SwapToTar;
    Result := inherited CreateItem(FileSpec);
  end
  else begin
    SwapToGzip;
    GzItem := TAbGzipItem.Create;
    try
      GzItem.CompressedSize := 0;
      GzItem.CRC32 := 0;
      StrPCopy(Buff, ExpandFileName(FileSpec));
      GzItem.DiskFileName := StrPas(Buff);
      StrPCopy(Buff, FixName(FileSpec));
      GzItem.FileName := StrPas(Buff);
      Result := GzItem;
    except
      Result := nil;
    end;
  end;
end;

destructor TAbGzipArchive.Destroy;
begin
  SwapToGzip;
  FTarList.Free;
  FTarStream.Free;
  inherited Destroy;
end;


procedure TAbGzipArchive.ExtractItemAt(Index: Integer;
  const NewName: string);
var
  OutStream : TFileStream;
  UseName : string;
  CurItem : TAbGzipItem;
{$IFDEF LINUX}                                                           {!!.01}
  FileDateTime  : TDateTime;                                             {!!.01}
  LinuxFileTime : LongInt;                                               {!!.01}
{$ENDIF LINUX}                                                           {!!.01}
begin
  if IsGZippedTar and TarAutoHandle then begin
    SwapToTar;
    inherited ExtractItemAt(Index, NewName);
  end
  else begin
    SwapToGzip;
    if Index > 0 then Index := 0; { only one item in a GZip}

    UseName := NewName;
    CurItem := TAbGzipItem(ItemList[Index]);

    { check if path to save to is okay }
    if AbConfirmPath(BaseDirectory, UseName, ExtractOptions, FOnConfirmOverwrite) then
    begin
      OutStream := TFileStream.Create(UseName, fmCreate or fmShareDenyNone);

      try
        try {OutStream}
          ExtractItemToStreamAt(Index, OutStream);
          {$IFDEF MSWINDOWS}
          FileSetDate(OutStream.Handle, (Longint(CurItem.LastModFileDate) shl 16)
            + CurItem.LastModFileTime);
          AbFileSetAttr(UseName, 0); {normal file}                       {!!.01}
          {$ENDIF}
          {$IFDEF LINUX}
          FileDateTime := AbDosFileDateToDateTime(CurItem.LastModFileDate,  {!!.01}
            CurItem.LastModFileTime);                                    {!!.01}
          LinuxFileTime := AbDateTimeToUnixTime(FileDateTime);           {!!.01}
//!! MVC not yet implemented          FileSetDate(UseName, LinuxFileTime);                           {!!.01}
          AbFileSetAttr(UseName, AB_FPERMISSION_GENERIC);                {!!.01}
          {$ENDIF}
        finally {OutStream}
          OutStream.Free;
        end; {OutStream}

      except
        on E : EAbUserAbort do begin
          FStatus := asInvalid;
          if FileExists(UseName) then
            DeleteFile(UseName);
          raise;
        end else begin
          if FileExists(UseName) then
            DeleteFile(UseName);
          raise;
        end;
      end;
    end;
  end;
end;

procedure TAbGzipArchive.ExtractItemToStreamAt(Index: Integer;
  aStream: TStream);
var
  GzHelp  : TAbGzipStreamHelper;
begin
  if IsGzippedTar and TarAutoHandle then begin
    SwapToTar;
    inherited ExtractItemToStreamAt(Index, aStream);
  end
  else begin
    SwapToGzip;
    { note Index ignored as there's only one item in a GZip }

    GZHelp := TAbGzipStreamHelper.Create(FGzStream);
    try
      { read GZip Header }
      GzHelp.ReadHeader;

      { extract copy data from GZip}
      GzHelp.ExtractItemData(aStream);

      { Get validation data }
      GzHelp.ReadTail;

      { validate against CRC }
      if GzHelp.FItem.Crc32 <> GzHelp.TailCRC then
        raise EAbGzipBadCRC.Create;

      { validate against file size }
      if GzHelp.FItem.UncompressedSize <> GZHelp.TailSize then
        raise EAbGzipBadFileSize.Create;
    finally
      GzHelp.Free;
    end;
  end;
end;

function TAbGzipArchive.FixName(Value: string): string;
{ fix up fileaname for storage }
begin
  {GZip files Always strip the file path}
  StoreOptions := StoreOptions + [soStripDrive, soStripPath];
  Result := '';
  if Value <> '' then
    Result := ExtractFileName(Value);
end;

function TAbGzipArchive.GetIsGzippedTar: Boolean;
begin
  Result := FIsGzippedTar;
end;

{!!.03 -- Added }
function TAbGzipArchive.GetItem(Index: Integer): TAbGzipItem;
begin
  Result := nil;
  if Index = 0 then
    Result := TAbGzipItem(FItemList.Items[Index]);
end;
{!!.03 -- End Added }

procedure TAbGzipArchive.LoadArchive;
var
  GzHelp       : TAbGzipStreamHelper;
  Item         : TAbGzipItem;
  ItemFound    : Boolean;
  Abort        : Boolean;
  TotalEntries : Integer;
  i            : Integer;
  Progress     : Byte;
begin
  if FGzStream.Size = 0 then
    Exit;

  if IsGzippedTar and TarAutoHandle then begin
    { extract Tar and set stream up }

    GzHelp := TAbGzipStreamHelper.Create(FGzStream);
    try
      if not FTarLoaded then begin
        GzHelp.SeekToItemData;
        GzHelp.ExtractItemData(FTarStream);
        SwapToTar;
        inherited LoadArchive;
        FTarLoaded := True;
      end;
    finally
      GzHelp.Free;
    end;
  end
  else begin
    SwapToGzip;

    { create helper }
    GzHelp := TAbGzipStreamHelper.Create(FGzStream);
    try
      TotalEntries := GzHelp.GetItemCount;

      {build Items list from tar header records}
      i := 0;

      { reset Tar }
      ItemFound := GzHelp.FindFirstItem;

      { while more data in Tar }

      if ItemFound then begin
        Item := TAbGzipItem.Create;
        Item.LoadGzHeaderFromStream(FGzStream);

        FGzStream.Seek(-SizeOf(TAbGzTailRec), soFromEnd);
        GZHelp.ReadTail;
        Item.FCRC32 := GZHelp.FItem.FCRC32;
        Item.UncompressedSize := 
          GZHelp.FItem.UncompressedSize;

        Item.Action := aaNone;
        FItemList.Clear;
        FItemList.Add(Item);
        Inc(i);

        { show progress and allow for aborting }
        Progress := (i * 100) div TotalEntries;
        DoArchiveProgress(Progress, Abort);
        if Abort then begin
          FStatus := asInvalid;
          raise EAbUserAbort.Create;
        end;

        { get the next item }
      end;

      DoArchiveProgress(100, Abort);
      FIsDirty := False;
    finally
      { Clean Up }
      GzHelp.Free;
    end;
  end;
end;

{!!.03 -- Added }
procedure TAbGzipArchive.PutItem(Index: Integer; const Value: TAbGzipItem);
begin
  if Index = 0 then
    FItemList.Items[Index] := Value;
end;
{!!.03 -- End Added }

procedure TAbGzipArchive.SaveArchive;
var
  InGzHelp, OutGzHelp : TAbGzipStreamHelper;
  Abort               : Boolean;
  i                   : Integer;
  NewStream           : TAbVirtualMemoryStream;
  WorkingStream       : TAbVirtualMemoryStream;
  UncompressedStream  : TStream;
  DateTime            : LongInt;
  SaveDir             : string;
  CurItem             : TAbGzipItem;
begin
  {prepare for the try..finally}
  OutGzHelp := nil;
  NewStream := nil;
  WorkingStream := nil;

  try
    InGzHelp := TAbGzipStreamHelper.Create(FGzStream);

    try
      if IsGzippedTar and TarAutoHandle then begin
        { save the Tar data first }
        SwapToTar;
        inherited SaveArchive;

        { update contents of GZip Stream with new Tar }
        FGZStream.Position := 0;
        InGzHelp.ReadHeader;
        FGZStream.Size := 0;
        InGzHelp.WriteArchiveHeader;
        InGzHelp.WriteArchiveItem(FTarStream);
        InGzHelp.WriteArchiveTail;
      end;

      SwapToGzip;

      {init new archive stream}
      NewStream := TAbVirtualMemoryStream.Create;
      OutGzHelp := TAbGzipStreamHelper.Create(NewStream);

      { create helper }
      NewStream.SwapFileDirectory := ExtractFilePath(AbGetTempFile(FTempDir, False));

      {build new archive from existing archive}
      for i := 0 to pred(Count) do begin
        FCurrentItem := ItemList[i];
        CurItem      := TAbGzipItem(ItemList[i]);
        InGzHelp.SeekToItemData;

        case CurItem.Action of
          aaNone, aaMove : begin
          {just copy the file to new stream}
            WorkingStream := TAbVirtualMemoryStream.Create;
            InGzHelp.SeekToItemData;
            InGzHelp.ExtractItemData(WorkingStream);
            WorkingStream.Position := 0;
            CurItem.SaveGzHeaderToStream(NewStream);
            OutGzHelp.WriteArchiveItem(WorkingStream);
          end;

          aaDelete: {doing nothing omits file from new stream} ;

          aaAdd, aaFreshen, aaReplace, aaStreamAdd: begin
            try
              if (CurItem.Action = aaStreamAdd) then begin
              { adding from a stream }
                CurItem.SaveGzHeaderToStream(NewStream);
                CurItem.UncompressedSize := InStream.Size;
                OutGzHelp.WriteArchiveItem(InStream);
              end
              else begin
              { it's coming from a file }
                UncompressedStream := TFileStream.Create(CurItem.DiskFileName,
                    fmOpenRead or fmShareDenyWrite );
                try
                  GetDir(0, SaveDir);
                  try {SaveDir}
                    if (BaseDirectory <> '') then
                      ChDir(BaseDirectory);

                    {Now get the file's attributes}
                    CurItem.ExternalFileAttributes := AbFileGetAttr(CurItem.DiskFileName);

                    CurItem.UncompressedSize := UncompressedStream.Size;
                  finally {SaveDir}
                    ChDir( SaveDir );
                  end; {SaveDir}

                  DateTime := FileAge(CurItem.DiskFileName);
                  CurItem.LastModFileTime := LongRec(DateTime).Lo;
                  CurItem.LastModFileDate := LongRec(DateTime).Hi;

                  CurItem.SaveGzHeaderToStream(NewStream);
                  OutGzHelp.WriteArchiveItem(UncompressedStream);

                finally {UncompressedStream}
                  UncompressedStream.Free;
                end; {UncompressedStream}

              end;
            except
              ItemList[i].Action := aaDelete;
              DoProcessItemFailure(ItemList[i], ptAdd, ecFileOpenError, 0);
            end;
          end;
        end; {case}
      end; { for }
    finally
      InGzHelp.Free;
    end;

    {copy new stream to FStream}
    OutGzHelp.WriteArchiveTail;
    NewStream.Position := 0;
    if (FStream is TMemoryStream) then
      TMemoryStream(FStream).LoadFromStream(NewStream)
    else begin
      { need new stream to write }
      FStream.Free;
      FStream := TAbSpanStream.Create(FArchiveName, fmOpenWrite or fmShareDenyWrite, mtLocal, FSpanningThreshold);
      TAbSpanStream(FStream).OnRequestImage := DoSpanningMediaRequest;   {!!.01}
      TAbSpanStream(FStream).OnArchiveProgress := DoArchiveSaveProgress; {!!.04}
      try
        FStream.CopyFrom(NewStream, NewStream.Size);
        FGZStream := FStream;
      except
        raise EAbException.Create('Unable to create new Spanned stream');
      end;
    end;

    {update Items list}
    for i := pred( Count ) downto 0 do begin
      if ItemList[i].Action = aaDelete then
        FItemList.Delete( i )
      else if ItemList[i].Action <> aaFailed then
        ItemList[i].Action := aaNone;
    end;

    DoArchiveSaveProgress( 100, Abort );                               {!!.04}
    DoArchiveProgress( 100, Abort );
  finally {NewStream}
    WorkingStream.Free;
    OutGzHelp.Free;
    NewStream.Free;
  end;
end;

procedure TAbGzipArchive.SetTarAutoHandle(const Value: Boolean);
begin
  case Value of
    True  : begin
      SwapToTar;
    end;

    False : begin
      SwapToGzip;
    end;
  end;
  FTarAutoHandle := Value;
end;

procedure TAbGzipArchive.TestItemAt(Index: Integer);
var
  SavePos   : LongInt;
  GZType    : TAbArchiveType;
  BitBucket : TAbBitBucketStream;
  GZHelp    : TAbGzipStreamHelper;
begin
  if IsGzippedTar and TarAutoHandle then begin
    inherited TestItemAt(Index);
  end
  else begin
    { note Index ignored as there's only one item in a GZip }
    SavePos := FGzStream.Position;
    GZType := VerifyGZip(FGZStream);
    if not (GZType in [atGZip, atGZippedTar]) then
      raise EAbGzipInvalid.Create;

    BitBucket := nil;
    GZHelp := nil;
    try
      BitBucket := TAbBitBucketStream.Create(1024);
      GZHelp := TAbGzipStreamHelper.Create(FGZStream);

      GZHelp.ExtractItemData(BitBucket);
      GZHelp.ReadTail;

      { validate against CRC }
      if GzHelp.FItem.Crc32 <> GZHelp.TailCRC then
        raise EAbGzipBadCRC.Create;

      { validate against file size }
      if GzHelp.FItem.UncompressedSize <> GZHelp.TailSize then
        raise EAbGzipBadFileSize.Create;

    finally
      GZHelp.Free;
      BitBucket.Free;
    end;

    FGzStream.Position := SavePos;
  end;
end;

procedure TAbGzipArchive.DoSpanningMediaRequest(Sender: TObject;
  ImageNumber: Integer; var ImageName: string; var Abort: Boolean);
begin
  Abort := False;
end;

end.