kazip.pas

Complete Zip Program

var
  Buffer: array[1..8192] of Byte;
  I, ReadCount: Integer;
  TempResult: Longword;
begin
  TempResult := $FFFFFFFF;
  while (Stream.Position <> Stream.Size) do begin
    ReadCount := Stream.Read(Buffer, SizeOf(Buffer));
    for I := 1 to ReadCount do
      TempResult := ((TempResult shr 8) and $FFFFFF) xor CRCTable[(TempResult xor Longword(Buffer[I])) and $FF];
  end;
  Result := not TempResult;
end;

Function TKAZipEntries.RemoveRootName(FileName, RootName : String):String;
Var
  P : Integer;
Begin
  Result := FileName;
  P      := Pos(AnsiLowerCase(RootName),AnsiLowerCase(FileName));
  if P=1 Then System.Delete(Result,1,Length(RootName));
End;

Procedure TKAZipEntries.SortList(List : TList);
Var
  X        : Integer;
  I1       : Cardinal;
  I2       : Cardinal;
  NoChange : Boolean;
Begin
  if List.Count=1 Then Exit;
  Repeat
    NoChange := True;
    For X := 0 To List.Count-2 Do
      Begin
        I1 := Integer(List.Items[X]);
        I2 := Integer(List.Items[X+1]);
        if I1 > I2 Then
           Begin
             List.Exchange(X,X+1);
             NoChange := False;
           End;
      End;
  Until NoChange;
End;




function TKAZipEntries.FileTime2DateTime(FileTime: TFileTime): TDateTime;
var
   LocalFileTime: TFileTime;
   SystemTime: TSystemTime;
begin
   FileTimeToLocalFileTime(FileTime, LocalFileTime) ;
   FileTimeToSystemTime(LocalFileTime, SystemTime) ;
   Result := SystemTimeToDateTime(SystemTime) ;
end;

function TKAZipEntries.GetHeaderEntry(Index: Integer): TKAZipEntriesEntry;
begin
  Result := TKAZipEntriesEntry(Inherited Items[Index]);
end;

procedure TKAZipEntries.SetHeaderEntry(Index: Integer; const Value: TKAZipEntriesEntry);
begin
  Inherited Items[Index] := TCollectionItem(Value);
end;

Function TKAZipEntries.ReadBA(MS: TStream; Sz, Poz:Integer): TBytes;
Begin
  SetLength(Result,SZ);
  MS.Position := Poz;
  MS.Read(Result[0],SZ);
End;

function TKAZipEntries.FindCentralDirectory(MS: TStream): Boolean;
Var
  SeekStart : Integer;
  Poz       : Integer;
  BR        : Integer;
  Byte_     : Array[0..3] of Byte;

begin
  Result     := False;
  if MS.Size < 22 Then Exit;
  if MS.Size < 256 Then
     SeekStart := MS.Size
  Else
     SeekStart := 256;
  Poz       := MS.Size-22;
  BR        := SeekStart;
  Repeat
    MS.Position := Poz;
    MS.Read(Byte_,4);
    If Byte_[0]=$50 Then
       Begin
         if  (Byte_[1]=$4B)
         And (Byte_[2]=$05)
         And (Byte_[3]=$06) Then
             Begin
               MS.Position                  := Poz;
               FParent.FEndOfCentralDirPos  := MS.Position;
               MS.Read(FParent.FEndOfCentralDir,SizeOf(FParent.FEndOfCentralDir));
               FParent.FZipCommentPos       := MS.Position;
               FParent.FZipComment.Clear;
               Result  := True;
             End
         Else
             Begin
               Dec(Poz,4);
               Dec(BR ,4);
             End;
       End
    Else
       Begin
         Dec(Poz);
         Dec(BR)
       End;
    if BR < 0 Then
       Begin
         Case SeekStart of
               256   : Begin
                        SeekStart := 1024;
                        Poz       := MS.Size-(256+22);
                        BR        := SeekStart;
                      End;
              1024  : Begin
                        SeekStart := 65536;
                        Poz       := MS.Size-(1024+22);
                        BR        := SeekStart;
                      End;
              65536 : Begin
                        SeekStart := -1;
                      End;
         End;
       End;
    if BR < 0              Then SeekStart := -1;
    if MS.Size < SeekStart Then SeekStart := -1;
  Until (Result) or (SeekStart=-1);
end;


function TKAZipEntries.ParseCentralHeaders(MS: TStream): Boolean;
Var
  X                 : Integer;
  Entry             : TKAZipEntriesEntry;
  CDFile            : TCentralDirectoryFile;
begin
  Result            := False;
  Try
    MS.Position     := FParent.FEndOfCentralDir.OffsetOfStartOfCentralDirectory;
    For X := 0 To FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk-1 do
        Begin
          FillChar(CDFile,SizeOf(TCentralDirectoryFile),0);
          MS.Read(CDFile,SizeOf(TCentralDirectoryFile)-3*SizeOf(String));
          Entry                       := TKAZipEntriesEntry.Create(Self);
          Entry.FDate                 := FileDateToDateTime(CDFile.LastModFileTimeDate);
          if (CDFile.GeneralPurposeBitFlag And 1) > 0 Then
              Entry.FIsEncrypted := True
          Else
              Entry.FIsEncrypted := False;
          If CDFile.FilenameLength > 0 Then
             Begin
               SetLength(CDFile.FileName,CDFile.FilenameLength);
               MS.Read(CDFile.FileName[1],   CDFile.FilenameLength)
             End;
          If CDFile.ExtraFieldLength > 0 Then
             Begin
               SetLength(CDFile.ExtraField,CDFile.ExtraFieldLength);
               MS.Read(CDFile.ExtraField[1], CDFile.ExtraFieldLength);
             End;
          If CDFile.FileCommentLength > 0 Then
             Begin
               SetLength(CDFile.FileComment,CDFile.FileCommentLength);
               MS.Read(CDFile.FileComment[1],CDFile.FileCommentLength);
             End;
          Entry.FIsFolder          := (CDFile.ExternalFileAttributes and faDirectory) > 0;

          Entry.FCompressionType   := ctUnknown;
          if (CDFile.CompressionMethod=8) or (CDFile.CompressionMethod=9) Then
             Begin
               Case CDFile.GeneralPurposeBitFlag AND 6 of
                    0 : Entry.FCompressionType := ctNormal;
                    2 : Entry.FCompressionType := ctMaximum;
                    4 : Entry.FCompressionType := ctFast;
                    6 : Entry.FCompressionType := ctSuperFast
               End;
             End;
          Entry.FCentralDirectoryFile := CDFile;
        End;
   Except
     Exit;
   End;
   Result := Count=FParent.FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk;
end;


procedure TKAZipEntries.ParseZip(MS: TStream);
begin
  FIsZipFile := False;
  Clear;
  if FindCentralDirectory(MS) Then
    Begin
      if ParseCentralHeaders(MS) Then
         Begin
           FIsZipFile := True;
           LoadLocalHeaders(MS);
         End;
    End;
end;


function TKAZipEntries.GetLocalEntry(MS: TStream; Offset : Integer; HeaderOnly : Boolean): TLocalFile;
Var
  Byte_             : Array[0..4] of Byte;
  DataDescriptor    : TDataDescriptor;
begin
  FillChar(Result,SizeOf(Result),0);
  MS.Position := Offset;
  MS.Read(Byte_,4);
  if  (Byte_[0]  = $50)
  And (Byte_[1]  = $4B)
  And (Byte_[2]  = $03)
  And (Byte_[3]  = $04) Then
    Begin
      MS.Position := Offset;
      MS.Read(Result,SizeOf(Result)-3*SizeOf(AnsiString));
      if Result.FilenameLength > 0 Then
         Begin
           SetLength(Result.FileName,Result.FilenameLength);
           MS.Read(Result.FileName[1],Result.FilenameLength);
         End;
      if Result.ExtraFieldLength > 0 Then
         Begin
           SetLength(Result.ExtraField,Result.ExtraFieldLength);
           MS.Read(Result.ExtraField[1],Result.ExtraFieldLength);
         End;
      if (Result.GeneralPurposeBitFlag And (1 SHL 3)) > 0 Then
         Begin
           MS.Read(DataDescriptor,SizeOf(TDataDescriptor));
           Result.Crc32            := DataDescriptor.Crc32;
           Result.CompressedSize   := DataDescriptor.CompressedSize;
           Result.UnCompressedSize := DataDescriptor.UnCompressedSize;
         End;
      if Not HeaderOnly Then
         Begin
           if Result.CompressedSize > 0 Then
              Begin
                SetLength(Result.CompressedData,Result.CompressedSize);
                MS.Read(Result.CompressedData[1],Result.CompressedSize);
              End;
         End;
    End;
end;

procedure TKAZipEntries.LoadLocalHeaders(MS: TStream);
Var
  X : Integer;
begin
  For X := 0 To Count-1 do
      Begin
        Items[X].FLocalFile := GetLocalEntry(MS,Items[X].FCentralDirectoryFile.RelativeOffsetOfLocalHeader,True);
      End;
end;

function TKAZipEntries.ParseLocalHeaders(MS: TStream): Boolean;
Var
  Poz               : Integer;
  Byte_             : Array[0..4] of Byte;
  LocalFile         : TLocalFile;
  DataDescriptor    : TDataDescriptor;
  NoMore            : Boolean;
begin
  Result := False;
  Try
      Poz    := 0;
      Repeat
        NoMore      := True;
        MS.Position := Poz;
        MS.Read(Byte_,4);
        if  (Byte_[0]  = $50)
        And (Byte_[1]  = $4B)
        And (Byte_[2]  = $03)
        And (Byte_[3]  = $04) Then
            Begin
              NoMore      := False;
              MS.Position := Poz;
              MS.Read(LocalFile,SizeOf(TLocalFile)-3*SizeOf(String));
              if LocalFile.FilenameLength > 0 Then
                 Begin
                   SetLength(LocalFile.FileName,LocalFile.FilenameLength);
                   MS.Read(LocalFile.FileName[1],LocalFile.FilenameLength);
                 End;
              if LocalFile.ExtraFieldLength > 0 Then
                 Begin
                   SetLength(LocalFile.ExtraField,LocalFile.ExtraFieldLength);
                   MS.Read(LocalFile.ExtraField[1],LocalFile.ExtraFieldLength);
                 End;
              if (LocalFile.GeneralPurposeBitFlag And (1 SHL 3)) > 0 Then
                 Begin
                   MS.Read(DataDescriptor,SizeOf(TDataDescriptor));
                   LocalFile.Crc32            := DataDescriptor.Crc32;
                   LocalFile.CompressedSize   := DataDescriptor.CompressedSize;
                   LocalFile.UncompressedSize := DataDescriptor.UncompressedSize;
                 End;
              MS.Position := MS.Position+LocalFile.CompressedSize;
              Poz         := MS.Position;
            End;
      Until NoMore;
  Except
    Exit;
  End;
  Result := True;
end;

procedure TKAZipEntries.Remove(ItemIndex: Integer);
Var
  TempStream          : TFileStream;
  TempFileName        : String;
  BUF                 : String;
  ZipComment          : String;
  OSL                 : Cardinal;
  //*********************************************
  X                   : Integer;
  TargetPos           : Cardinal;
  Border              : Cardinal;
begin
 TargetPos          := Items[ItemIndex].FCentralDirectoryFile.RelativeOffsetOfLocalHeader;
 Border             := TargetPos;
 Delete(ItemIndex);
 if (FParent.FZipSaveMethod=FastSave) And (Count > 0) Then
    Begin
       ZipComment := FParent.Comment.Text;
       For X := 0 to Count-1 do
           Begin
             if Items[X].FCentralDirectoryFile.RelativeOffsetOfLocalHeader > Border Then