abgztyp.pas

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

  GZH : TAbGzHeader;
  DataRead : Integer;
begin
  Result := False;
  FStream.Seek(0, soFromBeginning);
  DataRead := FStream.Read(GZH, SizeOf(TAbGzHeader));
  if (DataRead = SizeOf(TAbGzHeader)) and VerifyHeader(GZH) then begin
    FItem.GZHeader := GZH;
    Result := True;
  end;
  FStream.Seek(0, soFromBeginning);
end;

function TAbGzipStreamHelper.FindNextItem: Boolean;
begin
  { only one item in a GZip }
  Result := False;
end;

function TAbGzipStreamHelper.SeekItem(Index: Integer): Boolean;
begin
  if Index > 0 then
    Result := False
  else
    Result := FindFirstItem;
end;

procedure TAbGzipStreamHelper.WriteArchiveHeader;
begin
  FItem.SaveGzHeaderToStream(FStream);
end;

procedure TAbGzipStreamHelper.WriteArchiveItem(AStream: TStream);
var
  Helper : TAbDeflateHelper;
begin
  Helper := TAbDeflateHelper.Create;
  try
    FItem.CRC32 := Deflate(AStream, FStream, Helper);
    FItem.UncompressedSize := AStream.Size;                              {!!.02}
//    FItem.UncompressedSize := FStream.Size{Helper.NormalSize};         {!!.02}
  finally
    Helper.Free;
  end;
end;

procedure TAbGzipStreamHelper.WriteArchiveTail;
var
  Tail : TAbGzTailRec;
begin
  Tail.CRC32 := FItem.CRC32;
  Tail.ISize := FItem.UncompressedSize;
  FStream.Write(Tail, SizeOf(TAbGzTailRec));
end;

function TAbGzipStreamHelper.GetItemCount: Integer;
begin
  { only one item in a gzip }
  Result := 1;
end;

procedure TAbGzipStreamHelper.ReadHeader;
begin
  FItem.LoadGzHeaderFromStream(FStream);
end;

procedure TAbGzipStreamHelper.ReadTail;
begin
  FStream.Read(FTail, SizeOf(TAbGzTailRec));
end;

function TAbGzipStreamHelper.GetGzCRC: LongInt;
begin
  Result := FItem.CRC32;
end;

function TAbGzipStreamHelper.GetFileSize: LongInt;
begin
  Result := FItem.UncompressedSize;
end;

{ TAbGzipItem }

constructor TAbGzipItem.Create;
begin
{ set defaults }
  { Maxium Compression }
  FGzHeader.XtraFlags := 2;

  FFileName := '';
  FFileComment := '';
  FExtraField := '';

  { source OS ID }
{$IFDEF LINUX } {assume EXT2 system }
  FGzHeader.OS := AB_GZ_OS_ID_Unix;
{$ENDIF LINUX }
{$IFDEF MSWINDOWS } {assume FAT system }
  FGzHeader.OS := AB_GZ_OS_ID_FAT;
{$ENDIF MSWINDOWS }

  FIncludeHeaderCrc := False;
end;

function TAbGzipItem.GetCompressedSize: LongInt;
begin
  Result := FCompressedSize;
end;

function TAbGzipItem.GetExternalFileAttributes: LongInt;
begin
  { GZip has no provision for storing attributes }
  Result := 0;
end;

function TAbGzipItem.GetExtraField: string;
begin
  Result := '';
  if HasExtraField then begin
    SetLength(Result, FXLen);
    Move(FExtraField, Result[1], FXLen);
  end;
end;

function TAbGzipItem.GetFileComment: string;
begin
  Result := '';
  if HasFileComment then
    Result := FFileComment;
end;


function TAbGzipItem.GetFileSystem: TAbGzFileSystem;
begin
  case FGzHeader.OS of
    0..13: Result := TAbGzFileSystem(FGzHeader.OS);
    255:   Result := osUnknown;
    else
      Result := osUndefined;
  end; { case }
end;

function TAbGzipItem.GetHeaderCRC: Word;
begin
  Result := 0;
  if HasHeaderCRC then
    Result := FCRC16;
end;

function TAbGzipItem.GetIsEncrypted: Boolean;
begin
{ GZip doesn't support any native encryption }
  Result := False;
end;

function TAbGzipItem.GetHasExtraField: Boolean;
begin
  Result := (FGZHeader.Flags and AB_GZ_FLAG_FEXTRA) = AB_GZ_FLAG_FEXTRA;
end;

function TAbGzipItem.GetHasFileComment: Boolean;
begin
  Result := (FGZHeader.Flags and AB_GZ_FLAG_FCOMMENT) = AB_GZ_FLAG_FCOMMENT;
end;

function TAbGzipItem.GetHasFileName: Boolean;
begin
  Result := (FGZHeader.Flags and AB_GZ_FLAG_FNAME) = AB_GZ_FLAG_FNAME;
end;

function TAbGzipItem.GetHasHeaderCRC: Boolean;
begin
  Result := (FGZHeader.Flags and AB_GZ_FLAG_FHCRC) = AB_GZ_FLAG_FHCRC;
end;

function TAbGzipItem.GetIsText: Boolean;
begin
  Result := (FGZHeader.Flags and AB_GZ_FLAG_FTEXT) = AB_GZ_FLAG_FTEXT;
end;

function TAbGzipItem.GetLastModFileDate: Word;
var
  Rslt : LongInt;
  D : TDateTime;
begin
  { convert to TDateTime }
  D := AbUnixTimeToDateTime(FGZHeader.ModTime);

  { convert to DOS file Date }
  Rslt := DateTimeToFileDate(D);
  Result := LongRec(Rslt).Hi;
end;

function TAbGzipItem.GetLastModFileTime: Word;
var
  Rslt : LongInt;
  D : TDateTime;
begin
  { convert to TDateTime }
  D := AbUnixTimeToDateTime(FGZHeader.ModTime);

  { convert to DOS file Time }
  Rslt := DateTimeToFileDate(D);
  Result := LongRec(Rslt).Lo;
end;

function TAbGzipItem.GetUncompressedSize: LongInt;
begin
  Result := FUncompressedSize;
end;

procedure TAbGzipItem.LoadGzHeaderFromStream(AStream: TStream);
var
  StartPos : LongInt;
  Len      : LongInt;
  LenW     : Word;
  CRC16    : ShortInt;
begin
  AStream.Read(FGzHeader, SizeOf(TAbGzHeader));

  if HasExtraField then begin
    { get length of extra data }
    AStream.Read(LenW, SizeOf(Word));
    SetLength(FExtraField, LenW);
    AStream.Read(FExtraField[1], LenW);
  end
  else
    FExtraField := '';

  { Get Filename, if any }
  if HasFileName then begin
    StartPos := AStream.Position;
    SeekToStringEndInStream(AStream);
    Len := AStream.Position - StartPos - 1;
    AStream.Seek(StartPos, soFromBeginning);
    SetLength(FFileName, Len);
    AStream.Read(FFileName[1], Len + 1);
  end
  else
    FFileName := 'unknown'; 

  { any comment present? }
  if HasFileComment then begin
    StartPos := AStream.Position;
    SeekToStringEndInStream(AStream);
    Len := AStream.Position - StartPos - 1;
    AStream.Position := StartPos;
    SetLength(FFileComment, Len);
    AStream.Read(FFileComment[1], Len + 1);
  end
  else
    FFileComment := '';

  { any 16-bit CRC for header present? }
  if HasHeaderCRC then begin
    AStream.Read(CRC16, SizeOf(CRC16));
    FCRC16 := CRC16;
  end;

  {Assert: stream should now be located at start of compressed data }

  FCompressedSize := AStream.Size - AStream.Position - SizeOf(TAbGzTailRec);

  DiskFileName := FileName;
  AbUnfixName(FDiskFileName);
  Action := aaNone;
  Tagged := False;
end;

procedure TAbGzipItem.SaveGzHeaderToStream(AStream: TStream);
var
  HBuff, HPtr : PAnsiChar;
  HSize, I32 : LongInt;
  I16 : ShortInt;
  LenW  : Word;
begin
  { start with basic header record }
  HSize := SizeOf(TAbGzHeader);

  { default ID fields }
  FGzHeader.ID1 := AB_GZ_HDR_ID1;
  FGzHeader.ID2 := AB_GZ_HDR_ID2;

  { compression method }
  FGzHeader.CompMethod := 8;  { deflate }

  { flags }
  FGzHeader.Flags := 0;

  { provide for the header CRC }
  if IncludeHeaderCRC then begin
    FGzHeader.Flags := AB_GZ_FLAG_FHCRC;
    Inc(HSize, 2);
  end;

  { add Text flag if user has set it }
  if IsText then
    FGzHeader.Flags := FGzHeader.Flags or AB_GZ_FLAG_FTEXT;

  { any Extra Field Present? }
  if FExtraField > '' then begin
    FGzHeader.Flags := FGZHeader.Flags or AB_GZ_FLAG_FEXTRA;
    HSize := HSize + 2 + Length(FExtraField);
  end;

  { any File Name present? }
  if FFileName > '' then begin
    FGzHeader.Flags := FGZHeader.Flags or AB_GZ_FLAG_FNAME;
    HSize := HSize + Length(FFileName) + 1;
  end;

  { any File Comment present? }
  if FFileComment > '' then begin
    FGzHeader.Flags := FGZHeader.Flags or AB_GZ_FLAG_FCOMMENT;
    HSize := HSize + Length(FFileComment) + 1;
  end;

  { build the header plus extra info }
  GetMem(HBuff, HSize);
  try
    HPtr := HBuff;

    { main header data }
    Move(FGzHeader, HPtr^, SizeOf(TAbGzHeader));
    Inc(HPtr, SizeOf(TAbGzHeader));

    { add extra field if any }
    if HasExtraField then begin
      LenW := Length(FExtraField);
      Move(LenW, HPtr^, SizeOf(Word));
      Inc(HPtr, SizeOf(Word));
      Move(FExtraField[1], HPtr^, LenW);
      Inc(HPtr, LenW);
    end;

    { add filename if any (and include final #0 from string) }
    if HasFileName then begin
      Move(FFileName[1], HPtr^, succ(length(FFileName)));
      Inc(HPtr, succ(length(FFileName)));
    end;

    { add file comment if any (and include final #0 from string) }
    if HasFileComment then begin
      Move(FFileComment[1], HPtr^, succ(length(FFileComment)));
      Inc(HPtr, succ(length(FFileComment)));
    end;

    if IncludeHeaderCRC then begin
      { calculate and write the header CRC }
      I16 := LongRec(I32).Lo;
      Move(I16, HPtr^, sizeof(I16));
    end;

    { dump it all to the stream }
    AStream.Write(HBuff^, HSize);
  finally
    FreeMem(HBuff);
  end;
end;

procedure TAbGzipItem.SetCompressedSize(const Value: LongInt);
begin
  FCompressedSize := Value;
end;

procedure TAbGzipItem.SetExternalFileAttributes(Value: LongInt);
begin
  { do nothing }
end;

procedure TAbGzipItem.SetExtraField(const Value: string);
begin
  FExtraField := '';

  if Value > '' then begin
    FExtraField := Value;
    FGzHeader.Flags := FGzHeader.Flags or AB_GZ_FLAG_FEXTRA;
  end
  else begin
    FGzHeader.Flags := FGzHeader.Flags and not AB_GZ_FLAG_FEXTRA;
  end;
end;

procedure TAbGzipItem.SetFileComment(Value: string);
begin
  FFileComment := '';

  if Value > '' then begin
    FFileComment := Value;
    FGzHeader.Flags := FGzHeader.Flags or AB_GZ_FLAG_FCOMMENT;
  end
  else begin
    FGzHeader.Flags := FGzHeader.Flags and not AB_GZ_FLAG_FCOMMENT;
  end;
end;

procedure TAbGzipItem.SetFileName(Value: string);
begin
  if FFileName <> '' then
     FFileName := '';

  if Value > '' then begin
    FFileName := Value { + #0};
    FGzHeader.Flags := FGzHeader.Flags or AB_GZ_FLAG_FNAME;
  end
  else begin
    FGzHeader.Flags := FGzHeader.Flags and not AB_GZ_FLAG_FNAME;
  end;
end;

procedure TAbGzipItem.SetFileSystem(const Value: TAbGzFileSystem);
begin
  if Value = osUnknown then
    FGzHeader.OS := 255
  else
    FGzHeader.OS := Ord(Value);
end;

procedure TAbGzipItem.SetIsEncrypted(Value: Boolean);
begin
  { do nothing }
end;

procedure TAbGzipItem.SetIsText(const Value: Boolean);
begin
  FIsText := Value;
  case FIsText of
    True  : FGzHeader.Flags := FGzHeader.Flags or AB_GZ_FLAG_FTEXT;
    False : FGzHeader.Flags := FGzHeader.Flags and not AB_GZ_FLAG_FTEXT;
  end;
end;

procedure TAbGzipItem.SetLastModFileDate(const Value: Word);
var
  D : TDateTime;
  UT : LongInt;
begin
  UT := FGZHeader.ModTime;

  { keep seconds in current day, discard date's seconds }
  UT := UT mod SecondsInDay;

  { build new date }
  D := EncodeDate(Value shr 9 + 1980, Value shr 5 and 15, Value and 31);

  { add to unix second count }
  UT :=  UT + AbDateTimeToUnixTime(D);

  { store back in header }
  FGZHeader.ModTime := UT;
end;

procedure TAbGzipItem.SetLastModFileTime(const Value: Word);
var
  T : TDateTime;
  UT : LongInt;
begin
  UT := FGZHeader.ModTime;

  { keep seconds in current date, discard day's seconds }
  UT := UT - (UT mod SecondsInDay);

  { build new time }
  T := EncodeTime(Value shr 11, Value shr 5 and 63, Value and 31 shl 1, 0);

  { add to unix second count }
  UT := UT + AbDateTimeToUnixTime(T);

  { store back in header }
  FGZHeader.ModTime := UT;
end;

procedure TAbGzipItem.SetUncompressedSize(const Value: Integer);
begin
  FUncompressedSize := Value;
end;

{ TAbGzipArchive }

constructor TAbGzipArchive.Create(FileName: string; Mode: Word);
begin
  inherited Create(FileName, Mode);
  FTarLoaded := False;