abziptyp.pas

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

  leaves stream positioned at start of structure or at original
  position if not found }
const
  StartBufSize = 512;
  CMaxBufSize = 64 * 1024;                                               {!!.01}
var
  StartPos  : longint;
  TailRec : packed record
    trSig : longint;
    trMid : array [0..15] of byte;
    trLen : word;
  end;
  Buffer    : PAnsiChar;
  Offset    : longint;
  TestPos   : PAnsiChar;
  Done      : boolean;
  BytesRead : longint;
  BufSize   : integer;
  MaxBufSize: Integer;                                                   {!!.01}
  CommentLen: integer;
  SpanState : Boolean;                                                   {!!.01}
begin
  { if spanning stream, don't want stream to read past beginning of current span}
  MaxBufSize := CMaxBufSize;                                             {!!.01}
  SpanState := False;                                                    {!!.01}
  if aStream is TAbSpanStream then begin                                 {!!.01}
    if (TAbSpanStream(aStream).Size > 0) and                             {!!.01}
      (TAbSpanStream(aStream).Size < CMaxBufSize) then                   {!!.01}
      MaxBufSize := TAbSpanStream(aStream).Size;                         {!!.01}
    SpanState := TAbSpanStream(aStream).IgnoreSpanning;                  {!!.01}
    TAbSpanStream(aStream).IgnoreSpanning := True;                       {!!.01}
  end;                                                                   {!!.01}

  {save the starting position}
  StartPos := aStream.Seek(0, soFromCurrent);

  {start off with the majority case: no zip file comment, so the
   central directory tail is the last thing in the stream and it's a
   fixed size and doesn't indicate a zip file comment}
  Result := aStream.Seek(-sizeof(TailRec), soFromEnd);
  if (Result >= 0) then begin
    aStream.ReadBuffer(TailRec, sizeof(TailRec));
    if (TailRec.trSig = Ab_ZipEndCentralDirectorySignature) and
       (TailRec.trLen = 0) then begin
      aStream.Seek(Result, soFromBeginning);
      Exit;
    end;
  end;

  {the zip stream seems to have a comment, or it has null padding
   bytes from some flaky program, or it's not even a zip formatted
   stream; we need to search for the tail signature}

  {get a buffer}
  BufSize := StartBufSize;
  GetMem(Buffer, BufSize);
  try

    {start out searching backwards}
    Offset := -BufSize;

    {while there is still data to search ...}
    Done := false;
    while not Done do begin

      {seek to the search position}
      Result := aStream.Seek(Offset, soFromEnd);
      if (Result <= 0) then begin                                        {!!.01}
        Result := aStream.Seek(0, soFromBeginning);
        Done := true;
      end;

      {read a buffer full}
      BytesRead := aStream.Read(Buffer^, BufSize);

      {search backwards through the buffer looking for the signature}
      TestPos := Buffer + BytesRead - sizeof(TailRec);
      while (TestPos <> Buffer) and
            (PLongint(TestPos)^ <> Ab_ZipEndCentralDirectorySignature) do
        dec(TestPos);

      {if we found the signature...}
      if (PLongint(TestPos)^ = Ab_ZipEndCentralDirectorySignature) then begin

        {get the tail record at this position}
        Move(TestPos^, TailRec, sizeof(TailRec));

        {if it's as valid a tail as we can check here...}
        CommentLen := -Offset - (TestPos - Buffer + sizeof(TailRec));
        if (TailRec.trLen <= CommentLen) then begin

          {calculate its position and exit}
          Result := Result + (TestPos - Buffer);
          aStream.Seek(Result, soFromBeginning);
          Exit;
        end;
      end;

      {otherwise move back one step, doubling the buffer}
      if (BufSize < MaxBufSize) then begin                               {!!.01}
{        write('+');}                                                    {!!.01}
        FreeMem(Buffer);
        BufSize := BufSize * 2;
        if BufSize > MaxBufSize then                                     {!!.01}
          BufSize := MaxBufSize;                                         {!!.01}
        GetMem(Buffer, BufSize);
      end;
{      else}                                                             {!!.01}
{        write('.');}                                                    {!!.01}
      dec(Offset, BufSize - SizeOf(longint));
    end;

    {if we reach this point, the CD tail is not present}
    Result := -1;
    aStream.Seek(StartPos, soFromBeginning);
  finally
    FreeMem(Buffer);
  end;

  { put SpanStream back the way it was }
  if aStream is TAbSpanStream then                                       {!!.01}
    TAbSpanStream(aStream).IgnoreSpanning := SpanState;                  {!!.01}
end;
{============================================================================}

{ TAbZipDataDescriptor implementation ====================================== }
procedure TAbZipDataDescriptor.LoadFromStream( Stream : TStream );
begin
  Stream.Read( FCRC32, sizeof( FCRC32 ) );
  Stream.Read( FCompressedSize, sizeof( FCompressedSize ) );
  Stream.Read( FUncompressedSize, sizeof( FUncompressedSize ) );
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipDataDescriptor.SaveToStream( Stream : TStream );
begin
  {!!.01 -- rewritten}
  Stream.Write( FCRC32, sizeof( FCRC32 ) );
  Stream.Write( FCompressedSize, sizeof( FCompressedSize ) );
  Stream.Write( FUncompressedSize, sizeof( FUncompressedSize ) );
  {!!.01 -- end rewritten}
end;
{ -------------------------------------------------------------------------- }

{ TAbZipFileHeader implementation ========================================== }
constructor TAbZipFileHeader.Create;
begin
  inherited Create;
  FValidSignature := $0;
  FFileName := nil;
  FExtraField := nil;
end;
{ -------------------------------------------------------------------------- }
destructor TAbZipFileHeader.Destroy;
begin
  if Assigned( FFileName ) then
    StrDispose( FFileName );
  if Assigned( FExtraField ) then
    StrDispose( FExtraField );
  inherited Destroy;
end;
{ -------------------------------------------------------------------------- }
function TAbZipFileHeader.GetCompressionMethod : TAbZipCompressionMethod;
begin
  Result := TAbZipCompressionMethod( FCompressionMethod );
end;
{ -------------------------------------------------------------------------- }
function TAbZipFileHeader.GetDataDescriptor : Boolean;
begin
  Result := ( CompressionMethod = cmDeflated ) and
            ( ( FGeneralPurposeBitFlag and AbHasDataDescriptorFlag ) <> 0 );
end;
{ -------------------------------------------------------------------------- }
function TAbZipFileHeader.GetCompressionRatio : Double;
var
  CompSize : Longint;
begin
  {adjust for encrypted headers - ensures we never get negative compression
  ratios for stored, encrypted files - no guarantees about negative
  compression ratios in other cases}
  if isEncrypted then
    CompSize := CompressedSize - 12
  else
    CompSize := CompressedSize;
  if UncompressedSize > 0 then
    Result := 100.0 * ( 1 - ( ( 1.0 * CompSize ) / UncompressedSize ) )
  else
    Result := 0.0;
end;
{ -------------------------------------------------------------------------- }
function TAbZipFileHeader.GetDeflationOption : TAbZipDeflationOption;
begin
  if CompressionMethod = cmDeflated then
    if ( ( FGeneralPurposeBitFlag and $02 ) <> 0 ) then
      if ( ( FGeneralPurposeBitFlag and $04 ) <> 0 ) then
        Result := doSuperFast
      else
        Result := doMaximum
    else
      if ( ( FGeneralPurposeBitFlag and $04 ) <> 0 ) then
        Result := doFast
      else
        Result := doNormal
  else
    Result := doInvalid;
end;
{ -------------------------------------------------------------------------- }
function TAbZipFileHeader.GetDictionarySize : TAbZipDictionarySize;
begin
  if CompressionMethod = cmImploded  then
    if ( ( FGeneralPurposeBitFlag and $02 ) <> 0 ) then
      Result := ds8K
    else
      Result := ds4K
  else
    Result := dsInvalid;
end;
{ -------------------------------------------------------------------------- }
function TAbZipFileHeader.GetEncrypted : Boolean;
begin
  {bit 0 of the GeneralPurposeBitFlag}
  Result := ( ( FGeneralPurposeBitFlag and AbFileIsEncryptedFlag ) <> 0 );
end;
{ -------------------------------------------------------------------------- }
function TAbZipFileHeader.GetShannonFanoTreeCount : Byte;
begin
  if CompressionMethod = cmImploded then
    if ( ( FGeneralPurposeBitFlag and $04 ) <> 0 ) then
      Result := 3
    else
      Result := 2
  else
    Result := 0;
end;
{ -------------------------------------------------------------------------- }
function TAbZipFileHeader.GetValid : Boolean;
begin
  Result := ( FValidSignature = FSignature );
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipFileHeader.SetCompressionMethod( Value :
                                               TAbZipCompressionMethod );
begin
  FCompressionMethod := Ord( Value );
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipFileHeader.SetExtraField( Value : PChar );
begin
  if Assigned( FExtraField ) then
    StrDispose( FExtraField );
  FExtraField := nil;
  FExtraFieldLength := StrLen( Value );

  if FExtraFieldLength > 0 then begin
    FExtraField := StrAlloc( succ( FExtraFieldLength ) );
    StrCopy( FExtraField, Value );
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipFileHeader.SetFileName( Value : PChar );
begin
  if Assigned( FFileName ) then
    StrDispose( FFileName );
  FFileName := nil;
  FFileNameLength := StrLen( Value );
  FFileName := StrAlloc( succ( FFileNameLength ) );
  StrCopy( FFileName, Value );
end;
{ -------------------------------------------------------------------------- }

{ TAbZipLocalFileHeader implementation ===================================== }
constructor TAbZipLocalFileHeader.Create;
begin
  inherited Create;
  FValidSignature := Ab_ZipLocalFileHeaderSignature;
end;
{ -------------------------------------------------------------------------- }
destructor TAbZipLocalFileHeader.Destroy;
begin
  inherited Destroy;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipLocalFileHeader.LoadFromStream( Stream : TStream );
begin
  with Stream do begin
    Read( FSignature, sizeof( FSignature ) );
    Read( FVersionNeededToExtract, sizeof( FVersionNeededToExtract ) );
    Read( FGeneralPurposeBitFlag, sizeof( FGeneralPurposeBitFlag ) );
    Read( FCompressionMethod, sizeof( FCompressionMethod ) );
    Read( FLastModFileTime, sizeof( FLastModFileTime ) );
    Read( FLastModFileDate, sizeof( FLastModFileDate ) );
    Read( FCRC32, sizeof( FCRC32 ) );
    Read( FCompressedSize, sizeof( FCompressedSize ) );
    Read( FUncompressedSize, sizeof( FUncompressedSize ) );
    Read( FFileNameLength, sizeof( FFileNameLength ) );
    Read( FExtraFieldLength, sizeof( FExtraFieldLength ) );

    FFileName := StrAlloc( succ( FFileNameLength ) );
    Read( FFileName^, FFileNameLength );
    FFileName[FFileNameLength] := #0;

    if FExtraFieldLength > 0 then begin
      FExtraField := StrAlloc( succ( FExtraFieldLength ) );
      Read( FExtraField^, FExtraFieldLength );
      FExtraField[FExtraFieldLength] := #0;
    end;
  end;
  if not IsValid then
    raise EAbZipInvalid.Create;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipLocalFileHeader.SaveToStream( Stream : TStream );
begin
  with Stream do begin
    {write the valid signature from the constant}
    Write( FValidSignature, sizeof( FValidSignature ) );
    Write( FVersionNeededToExtract, sizeof( FVersionNeededToExtract ) );
    Write( FGeneralPurposeBitFlag, sizeof( FGeneralPurposeBitFlag ) );
    Write( FCompressionMethod, sizeof( FCompressionMethod ) );
    Write( FLastModFileTime, sizeof( FLastModFileTime ) );
    Write( FLastModFileDate, sizeof( FLastModFileDate ) );
    Write( FCRC32, sizeof( FCRC32 ) );
    Write( FCompressedSize, sizeof( FCompressedSize ) );
    Write( FUncompressedSize, sizeof( FUncompressedSize ) );
    Write( FFileNameLength, sizeof( FFileNameLength ) );
    Write( FExtraFieldLength, sizeof( FExtraFieldLength ) );

    Write( FFileName^, FFileNameLength );
    Write( FExtraField^, FExtraFieldLength );
  end;
end;
{ -------------------------------------------------------------------------- }

{ TAbZipDirectoryFileHeader implementation ================================= }
constructor TAbZipDirectoryFileHeader.Create;
begin
  inherited Create;
  FValidSignature := Ab_ZipCentralDirectoryFileHeaderSignature;
  FileComment := nil;
end;
{ -------------------------------------------------------------------------- }
destructor TAbZipDirectoryFileHeader.Destroy;
begin
  if Assigned( FFileComment ) then
    StrDispose( FileComment );
  inherited Destroy;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipDirectoryFileHeader.LoadFromStream( Stream : TStream );
begin
  with Stream do begin
    Read( FSignature, sizeof( FSignature ) );
    Read( FVersionMadeBy, sizeof( FVersionMadeBy ) );
    Read( FVersionNeededToExtract, sizeof( FVersionNeededToExtract ) );
    Read( FGeneralPurposeBitFlag, sizeof( FGeneralPurposeBitFlag ) );
    Read( FCompressionMethod, sizeof( FCompressionMethod ) );
    Read( FLastModFileTime, sizeof( FLastModFileTime ) );
    Read( FLastModFileDate, sizeof( FLastModFileDate ) );
    Read( FCRC32, sizeof( FCRC32 ) );
    Read( FCompressedSize, sizeof( FCompressedSize ) );
    Read( FUncompressedSize, sizeof( FUncompressedSize ) );
    Read( FFileNameLength, sizeof( FFileNameLength ) );