abtartyp.pas

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

  DevMinor := 0;
end;


function TAbTarItem.GetCompressedSize: LongInt;
{ TAR includes no internal compression, returns same value as GetUncompressedSize }
begin
  Result := OctalToInt(FTarHeader.Size, SizeOf(FTarHeader.Size));
end;

function TAbTarItem.GetDevMajor: Integer;
begin
  Result := OctalToInt(FTarHeader.DevMajor, SizeOf(FTarHeader.DevMajor));
end;

function TAbTarItem.GetDevMinor: Integer;
begin
  Result := OctalToInt(FTarHeader.DevMinor, SizeOf(FTarHeader.DevMinor));
end;

function TAbTarItem.GetExternalFileAttributes: LongInt;
begin
  Result := OctalToInt(FTarHeader.Mode, SizeOf(FTarHeader.Mode));
end;

function TAbTarItem.GetFileName: string;
begin
  Result := FTarHeader.Name;
end;

function TAbTarItem.GetGroupID: Integer;
begin
  Result := OctalToInt(FTarHeader.gid, sizeof(FTarHeader.gid));
end;

function TAbTarItem.GetGroupName: string;
begin
  Result := FTarHeader.GrpName;
end;

function TAbTarItem.GetIsEncrypted: Boolean;
begin
  { TAR has no native encryption }
  Result := False;
end;

function TAbTarItem.GetLastModFileDate: Word;
var
  UnixDate : Integer;
  D : TDateTime;
begin
  { convert octal string date to unix style integer date }
  UnixDate := OctalToInt(FTarHeader.ModTime, sizeof(FTarHeader.ModTime));

  { convert to TDateTime }
  D := AbUnixTimeToDateTime(UnixDate);

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

function TAbTarItem.GetLastModFileTime: Word;
var
  UnixDate : Integer;
  D : TDateTime;
begin
  { convert octal string to unix style integer date }
  UnixDate := OctalToInt(FTarHeader.ModTime, sizeof(FTarHeader.ModTime));

  { convert to TDateTime }
  D := AbUnixTimeToDateTime(UnixDate);

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

function TAbTarItem.GetLinkName: string;
begin
  Result := FTarHeader.LinkName;
end;


function TAbTarItem.GetMagic: string;
begin
  Result := FTarHeader.Magic;
end;

function TAbTarItem.GetUncompressedSize: LongInt;
{ TAR includes no internal compression, returns same value as GetCompressedSize }
begin
  Result := OctalToInt(FTarHeader.Size, sizeof(FTarHeader.Size));
end;

function TAbTarItem.GetUserID: Integer;
begin
  Result := OctalToInt(FTarHeader.uid, sizeof(FTarHeader.uid));
end;

function TAbTarItem.GetUserName: string;
begin
  Result := FTarHeader.UsrName;
end;

procedure TAbTarItem.LoadTarHeaderFromStream(AStream: TStream);
begin
  AStream.Read(FTarHeader, SizeOf(TAbTarHeaderRec));
  AStream.Seek(-SizeOf(TAbTarHeaderRec), soFromCurrent);
  FFileName := FTarHeader.Name;
  DiskFileName := FileName;
  AbUnfixName(FDiskFileName);
  Action := aaNone;
  Tagged := False;
end;

procedure TAbTarItem.SaveTarHeaderToStream(AStream: TStream);
var
  j : Integer;
  HdrChkSum : Integer;
  HdrChkStr : string;
  HdrBuffer : PAnsiChar;
  PadSize : Integer;
  PadBuff : array [0..AB_TAR_RECORDSIZE - 1] of byte;
begin
  { TAR says ChkSum field itself is blanked for calc purposes }
  FTarHeader.ChkSum := AB_TAR_CHKBLANKS;

  { prepare for the checksum calculation }
  HdrBuffer := PAnsiChar(@FTarHeader);                                   {!!.02}
  HdrChkSum := 0;

  {calculate the checksum, a simple sum of the bytes in the header}
  for j := 0 to Pred(SizeOf(TAbTarHeaderRec)) do
    HdrChkSum := HdrChkSum + Ord(HdrBuffer[j]);

  {set the checksum in the header}
  HdrChkStr := PadString(IntToOctal(HdrChkSum), SizeOf(Arr8));
  Move(HdrChkStr[1], FTarHeader.ChkSum, Length(HdrChkStr));

  { write header data }
  AStream.Write(FTarHeader, SizeOf(TAbTarHeaderRec));

  { Pad to Next block with zero bytes }
  PadSize := AB_TAR_RECORDSIZE - SizeOf(TAbTarHeaderRec);
  FillChar(PadBuff, PadSize, 0);
  AStream.Write(PadBuff, PadSize);
end;

procedure TAbTarItem.SetCompressedSize(const Value: Integer);
var
  S : string;
begin
  S := PadString(IntToOctal(Value), SizeOf(Arr12));
  Move(S[1], FTarHeader.Size, Length(S));
end;

procedure TAbTarItem.SetDevMajor(const Value: Integer);
var
  S : string;
begin
  S := PadString(IntToOctal(Value), SizeOf(Arr8));
  Move(S[1], FTarHeader.DevMajor, Length(S));
end;

procedure TAbTarItem.SetDevMinor(const Value: Integer);
var
  S : string;
begin
  S := PadString(IntToOctal(Value), SizeOf(Arr8));
  Move(S[1], FTarHeader.DevMinor, Length(S));
end;

procedure TAbTarItem.SetExternalFileAttributes(Value: Integer);
var
  S : string;
begin
  S := PadString(IntToOctal(Value), SizeOf(Arr8));
  Move(S[1], FTarHeader.Mode, Length(S));
end;

procedure TAbTarItem.SetFileName(Value: string);
begin
  StrPCopy(FTarHeader.Name, Value);
end;

procedure TAbTarItem.SetGroupID(const Value: Integer);
var
  S : string;
begin
  S := PadString(IntToOctal(Value), SizeOf(Arr8));
  Move(S[1], FTarHeader.gid, Length(S));
end;

procedure TAbTarItem.SetGroupName(const Value: string);
begin
  StrPCopy(FTarHeader.GrpName, Value);
end;

procedure TAbTarItem.SetIsEncrypted(Value: Boolean);
begin
  { do nothing, TAR has no native encryption }
end;

procedure TAbTarItem.SetLastModFileDate(const Value: Word);
var
  D : TDateTime;
  UT : LongInt;
  DStr : string;
begin
  { get current date from header record }
  UT := OctalToInt(FTarHeader.ModTime, sizeof(FTarHeader.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 octal string }
  DStr := PadString(IntToOctal(UT), SizeOf(Arr12));
  Move(DStr[1], FTarHeader.ModTime, Length(DStr));
end;

procedure TAbTarItem.SetLastModFileTime(const Value: Word);
var
  T : TDateTime;
  UT : LongInt;
  TStr : string;
begin
  { get current date from header record }
  UT := OctalToInt(FTarHeader.ModTime, sizeof(FTarHeader.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 octal string }
  TStr := PadString(IntToOctal(UT), SizeOf(Arr12));
  Move(TStr[1], FTarHeader.ModTime, Length(TStr));
end;

procedure TAbTarItem.SetLinkName(const Value: string);
begin
  StrPCopy(FTarHeader.LinkName, Value);
end;

procedure TAbTarItem.SetUncompressedSize(const Value: Integer);
var
  S : string;
begin
  S := PadString(IntToOctal(Value), SizeOf(Arr12));
  Move(S[1], FTarHeader.Size, Length(S));
end;

procedure TAbTarItem.SetUserID(const Value: Integer);
var
  S : string;
begin
  S := PadString(IntToOctal(Value), SizeOf(Arr8));
  Move(S[1], FTarHeader.uid, Length(S));
end;

procedure TAbTarItem.SetUserName(const Value: string);
begin
  StrPCopy(FTarHeader.UsrName, Value);
end;

{ TAbTarStreamHelper }

destructor TAbTarStreamHelper.Destroy;
begin
  inherited Destroy;
end;

procedure TAbTarStreamHelper.ExtractItemData(AStream: TStream);
var
  Len : Integer;
begin
  {assumption: the internal stream is positioned at the start of the
               header for the current item}

  { get size of stored data }
  Len := OctalToInt(FTarHeader.Size, sizeof(FTarHeader.Size));

  { locate start of stored data }
  FStream.Seek(SizeOf(TAbTarHeaderRec), soFromCurrent);

  { copy stored data to output }
  AStream.CopyFrom(FStream, Len);

  {reset the stream to the start of the item}
  FStream.Seek(-(SizeOf(TAbTarHeaderRec) + Len), soFromCurrent);
end;


function TAbTarStreamHelper.FindFirstItem: Boolean;
var
  DataRead : LongInt;
  Len: Integer;
begin

  {the first item is found at the start of the stream}
  FStream.Seek(0, soFromBeginning);
  DataRead := FStream.Read(FTarHeader, SizeOf(TAbTarHeaderRec));

  { keep looking til find ordinary file }
  while (DataRead = SizeOf(TAbTarHeaderRec)) and
    not (FTarHeader.LinkFlag in [AB_TAR_LF_OLDNORMAL, AB_TAR_LF_NORMAL]) do begin
    FStream.Seek(-SizeOf(TAbTarHeaderRec), soFromCurrent);

    { advance to next record }
    { find length of current item, rounded up to the TAR block size }
    Len := RoundToTarBlock(OctalToInt(FTarHeader.Size, sizeof(FTarHeader.Size)));

    { seek past file to next header }
    FStream.Seek(AB_TAR_RECORDSIZE + Len, soFromCurrent);
    DataRead := FStream.Read(FTarHeader, SizeOf(TAbTarHeaderRec));
  end;

  FStream.Seek(-SizeOf(TAbTarHeaderRec), soFromCurrent);
  Result := (DataRead = SizeOf(TAbTarHeaderRec)) {and VerifyHeader(FTarHeader)};
end;

function TAbTarStreamHelper.FindNextItem: Boolean;
var
  DataRead : LongInt;
  Len: Integer;
begin
  { find length of current item, rounded up to the TAR block size }
  Len := RoundToTarBlock(OctalToInt(FTarHeader.Size, sizeof(FTarHeader.Size)));

  { seek past file to next header }
  FStream.Seek(AB_TAR_RECORDSIZE + Len, soFromCurrent);
  DataRead := FStream.Read(FTarHeader, SizeOf(TAbTarHeaderRec));

  while (DataRead = SizeOf(TAbTarHeaderRec)) and (StrLen(FTarHeader.Name) > 0) and
    not (FTarHeader.LinkFlag in [AB_TAR_LF_OLDNORMAL, AB_TAR_LF_NORMAL]) do begin
    FStream.Seek(-SizeOf(TAbTarHeaderRec), soFromCurrent);

    { advance to next record }
    { find length of current item, rounded up to the TAR block size }
    Len := RoundToTarBlock(OctalToInt(FTarHeader.Size, sizeof(FTarHeader.Size)));

    { seek past file to next header }
    FStream.Seek(AB_TAR_RECORDSIZE + Len, soFromCurrent);
    DataRead := FStream.Read(FTarHeader, SizeOf(TAbTarHeaderRec));
  end;

  { reset to start of header }
  if (DataRead = SizeOf(TAbTarHeaderRec)) and (StrLen(FTarHeader.Name) > 0) and
    (FTarHeader.LinkFlag in [AB_TAR_LF_OLDNORMAL, AB_TAR_LF_NORMAL]) then
  begin
    FStream.Seek(-SizeOf(TAbTarHeaderRec), soFromCurrent);
    Result := True;
  end else
    Result := False;
end;


function TAbTarStreamHelper.GetItemCount : Integer;
var
  Found : Boolean;
begin
  Result := 0;
  Found := FindFirstItem;
  while Found do begin
    Inc(Result);
    Found := FindNextItem;
  end;
end;


procedure TAbTarStreamHelper.ReadHeader;
begin
  { do nothing }
  { Tar archives have no overall header data }
end;

procedure TAbTarStreamHelper.ReadTail;
begin
  { do nothing }
  { Tar archives have no overall tail data }
end;

function TAbTarStreamHelper.SeekItem(Index: Integer): Boolean;
var
  i : Integer;
begin
  Result := FindFirstItem; { see if can get to first item }
  i := 1;
  while Result and (i < Index) do begin
    Result := FindNextItem;
    Inc(i);
  end;
end;

function TAbTarStreamHelper.SeekItemData(Index: Integer): Boolean;
var
  i : Integer;
begin
  Result := FindFirstItem; { see if can get to first item }
  i := 0;
  while Result and (i < Index) do begin
    Result := FindNextItem;
    Inc(i);
  end;

  { locate start of stored data }
  FStream.Seek(AB_TAR_RECORDSIZE - SizeOf(TAbTarHeaderRec), soFromCurrent);
end;

procedure TAbTarStreamHelper.WriteArchiveHeader;
begin
  { do nothing }