kazip.pas

Complete Zip Program

             CM               := 8;
           End;
        FCRC32                := CalcCRC32(S);
        FParent.FCurrentDFS   := UL;

        Level                 := clDefault;
        Case FParent.FZipCompressionType of
             ctNormal    : Level := clDefault;
             ctMaximum   : Level := clMax;
             ctFast      : Level := clFastest;
             ctSuperFast : Level := clFastest;
             ctNone      : Level := clNone;
        End;

        if CM=8 Then
           Begin
              Compressor            := TCompressionStream.Create(Level,CS);
              Try
                 Compressor.OnProgress := FParent.OnCompress;
                 Compressor.Write(S[1],UL);
              Finally
                 Compressor.Free;
              End;
              S                     := Copy(CS.DataString, 3, Length(CS.DataString)-6);
           End;
      Finally
        CS.Free;
      End;
      //************************************************************************
      CL := Length(S);
      //*********************************** FILL RECORDS
      Result := TKAZipEntriesEntry(Self.Add);
      With Result.FLocalFile do
        Begin
          LocalFileHeaderSignature := $04034B50;
          VersionNeededToExtract   := 20;
          GeneralPurposeBitFlag    := 0;
          CompressionMethod        := CM;
          LastModFileTimeDate      := DateTimeToFileDate(FileDate);
          Crc32                    := FCRC32;
          CompressedSize           := CL;
          UncompressedSize         := UL;
          FilenameLength           := Length(ItemName);
          ExtraFieldLength         := 0;
          FileName                 := ItemName;
          ExtraField               := '';
          CompressedData           := '';
        End;

      With Result.FCentralDirectoryFile Do
       Begin
          CentralFileHeaderSignature     := $02014B50;
          VersionMadeBy                  := 20;
          VersionNeededToExtract         := 20;
          GeneralPurposeBitFlag          := 0;
          CompressionMethod              := CM;
          LastModFileTimeDate            := DateTimeToFileDate(FileDate);
          Crc32                          := FCRC32;
          CompressedSize                 := CL;
          UncompressedSize               := UL;
          FilenameLength                 := Length(ItemName);
          ExtraFieldLength               := 0;
          FileCommentLength              := 0;
          DiskNumberStart                := 0;
          InternalFileAttributes         := 0;
          ExternalFileAttributes         := FileAttr;
          RelativeOffsetOfLocalHeader    := TempStream.Position;
          FileName                       := ItemName;
          ExtraField                     := '';
          FileComment                    := '';
       End;

     //************************************ SAVE LOCAL HEADER AND COMPRESSED DATA
     TempStream.Write(Result.FLocalFile,SizeOf(Result.FLocalFile)-3*SizeOf(String));
     if Result.FLocalFile.FilenameLength > 0 Then TempStream.Write(Result.FLocalFile.FileName[1],Result.FLocalFile.FilenameLength);
     if CL > 0 Then TempStream.Write(S[1],CL);
     //************************************
     FParent.NewLHOffsets[Count-1] := Result.FCentralDirectoryFile.RelativeOffsetOfLocalHeader;
     FParent.RebuildCentralDirectory(TempStream);
     FParent.RebuildEndOfCentralDirectory(TempStream);
     //************************************
     TempStream.Position := 0;
     OSL                 := FParent.FZipStream.Size;
     Try
       FParent.FZipStream.Size := TempStream.Size;
     Except
       FParent.FZipStream.Size := OSL;
       Raise;
     End;
     FParent.FZipStream.Position := 0;
     FParent.FZipStream.CopyFrom(TempStream,TempStream.Size);
 Finally
   TempStream.Free;
   DeleteFile(TempFileName)
 End;

  Result.FDate              := FileDateToDateTime(Result.FCentralDirectoryFile.LastModFileTimeDate);
  if (Result.FCentralDirectoryFile.GeneralPurposeBitFlag And 1) > 0 Then
      Result.FIsEncrypted := True
  Else
      Result.FIsEncrypted := False;
  Result.FIsFolder          := (Result.FCentralDirectoryFile.ExternalFileAttributes and faDirectory) > 0;
  Result.FCompressionType   := ctUnknown;
  if (Result.FCentralDirectoryFile.CompressionMethod=8) or (Result.FCentralDirectoryFile.CompressionMethod=9) Then
     Begin
       Case Result.FCentralDirectoryFile.GeneralPurposeBitFlag AND 6 of
            0 : Result.FCompressionType := ctNormal;
            2 : Result.FCompressionType := ctMaximum;
            4 : Result.FCompressionType := ctFast;
            6 : Result.FCompressionType := ctSuperFast
       End;
     End;
 if NOT FParent.FBatchMode Then
    Begin
      FParent.DoChange(FParent,2);
    End;
End;

function TKAZipEntries.AddStream(FileName : String; FileAttr : Word; FileDate : TDateTime; Stream : TStream):TKAZipEntriesEntry;
Begin
  Result := Nil;
  if FParent.FZipSaveMethod = FastSave Then
     Result := AddStreamFast(FileName,FileAttr,FileDate,Stream)
  Else
  if FParent.FZipSaveMethod = RebuildAll Then
     Result := AddStreamRebuild(FileName,FileAttr,FileDate,Stream);
End;

Function TKAZipEntries.AddStream(FileName: String; Stream : TStream):TKAZipEntriesEntry;
begin
  Result := AddStream(FileName,faArchive,Now,Stream);
end;

Function TKAZipEntries.AddFile(FileName, NewFileName: String):TKAZipEntriesEntry;
Var
 FS  : TFileStream;
 Dir : TSearchRec;
 Res : Integer;
begin
 Result := Nil;
 Res    := FindFirst(FileName,faAnyFile,Dir);
 if Res=0 Then
    Begin
      FS            := TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone);
      Try
        FS.Position := 0;
        if FParent.FZipSaveMethod = FastSave Then
           Result := AddStreamFast(NewFileName,Dir.Attr,FileDateToDateTime(Dir.Time),FS)
        Else
        if FParent.FZipSaveMethod = RebuildAll Then
           Result := AddStreamRebuild(NewFileName,Dir.Attr,FileDateToDateTime(Dir.Time),FS);
      Finally
        FS.Free;
      End;
    End;
 FindClose(Dir);
end;

Function TKAZipEntries.AddFile(FileName: String):TKAZipEntriesEntry;
begin
  Result := AddFile(FileName,FileName);
end;

function TKAZipEntries.AddFiles(FileNames: TStrings): Boolean;
Var
  X : Integer;
begin
  Result     := False;
  FParent.FBatchMode := True;
  Try
    For X := 0 To FileNames.Count-1 do AddFile(FileNames.Strings[X]);
  Except
    FParent.FBatchMode := False;
    FParent.DoChange(FParent,2);
    Exit;
  End;
  FParent.FBatchMode := False;
  FParent.DoChange(FParent,2);
  Result     := True;
end;

Function  TKAZipEntries.AddFolder(FolderName:String; RootFolder:String; WildCard : String; WithSubFolders : Boolean):Boolean;
Var
  Res : Integer;
  Dir : TSearchRec;
  FN  : String;
  MS  : TMemoryStream;
Begin
  Res := FindFirst(FolderName+'\*.*',faAnyFile,Dir);
  While Res=0 Do
     Begin
          if (Dir.Attr and faDirectory) > 0 Then
              Begin
                if (Dir.Name <> '..') And (Dir.Name <> '.') Then
                   Begin
                     FN          := FolderName+'\'+Dir.Name;
                     MS          := TMemoryStream.Create;
                     Try
                       MS.Position := 0;
                       MS.Size     := 0;
                       AddStream(RemoveRootName(FN+'\',RootFolder),Dir.Attr,FileDateToDateTime(Dir.Time),MS);
                     Finally
                       MS.Free;
                     End;
                     if WithSubFolders Then
                        Begin
                          AddFolder(FN, RootFolder, WildCard, WithSubFolders);
                        End;
                   End;
              End
          Else
              Begin
                FN := FolderName+'\'+Dir.Name;
                if MatchesMask(FN,WildCard) Then AddFile(FN,RemoveRootName(FN,RootFolder));
              End;
          Res := FindNext(Dir);
     End;
  FindClose(Dir);
  Result := True;
End;

Function TKAZipEntries.AddFilesAndFolders(FileNames:TStrings; RootFolder:String; WithSubFolders : Boolean):Boolean;
Var
  X   : Integer;
  Res : Integer;
  Dir : TSearchRec;
Begin
  For X := 0 To FileNames.Count-1 do
      Begin
         Res := FindFirst(FileNames.Strings[X],faAnyFile,Dir);
         if Res=0 Then
            Begin
              if (Dir.Attr and faDirectory) > 0 Then
                 Begin
                   AddFolder(FileNames.Strings[X],RootFolder,'*.*',WithSubFolders);
                 End
              Else
                 Begin
                   AddFile(FileNames.Strings[X],RemoveRootName(FileNames.Strings[X],RootFolder));
                 End;
            End;
         FindClose(Dir);
      End;
  Result := True;
End;


procedure TKAZipEntries.RemoveFiles(List: TList);
Var
  X : Integer;
begin
  if List.Count=1 Then
     Begin
       Remove(Integer(List.Items[0]));
     End
  Else
     Begin
       SortList(List);
       FParent.FBatchMode := True;
       Try
         For X := List.Count-1 downto 0 do
             Begin
               Remove(Integer(List.Items[X]));
             End;
       Finally
         FParent.FBatchMode := False;
       End;
       FParent.DoChange(Self,4);
     End;
end;


procedure TKAZipEntries.ExtractToStream(Item : TKAZipEntriesEntry; Stream: TStream);
 Var
  SFS             : TMemoryStream;
  TFS             : TStream;
  BUF             : String;
  NR              : Cardinal;
  Decompressor    : TDecompressionStream;
  {$IFDEF USE_BZIP2}
  DecompressorBZ2 : TBZDecompressionStream;
  {$ENDIF}
begin
  if  (
       (Item.CompressionMethod=8) or
       {$IFDEF USE_BZIP2}
       (Item.CompressionMethod=12) or
       {$ENDIF}
       (Item.CompressionMethod=0)
       )
  And (NOT Item.FIsEncrypted) Then
     Begin
        SFS := TMemoryStream.Create;
        TFS := Stream;
        Try
          if Item.GetCompressedData(SFS) > 0 Then
             Begin
                SFS.Position  := 0;
                FParent.FCurrentDFS   := Item.SizeUncompressed;
                //****************************************************** DEFLATE
                if (Item.CompressionMethod=8) Then
                   Begin
                      Decompressor  := TDecompressionStream.Create(SFS);
                      Decompressor.OnProgress := FParent.OnDecompress;
                      SetLength(BUF,FParent.FCurrentDFS);
                      Try
                        NR := Decompressor.Read(BUF[1],FParent.FCurrentDFS);
                        if NR=FParent.FCurrentDFS Then TFS.Write(BUF[1],FParent.FCurrentDFS);
                      Finally
                        Decompressor.Free;
                      End;
                   End
                //******************************************************* BZIP2
                {$IFDEF USE_BZIP2}
                Else
                If Item.CompressionMethod=12 Then
                   Begin
                      DecompressorBZ2  := TBZDecompressionStream.Create(SFS);
                      DecompressorBZ2.OnProgress := FParent.OnDecompress;
                      SetLength(BUF,FParent.FCurrentDFS);
                      Try
                        NR := DecompressorBZ2.Read(BUF[1],FParent.FCurrentDFS);
                        if NR=FParent.FCurrentDFS Then TFS.Write(BUF[1],FParent.FCurrentDFS);
                      Finally
                        DecompressorBZ2.Free;
                      End;
                   End
                {$ENDIF}
                //****************************************************** STORED
                Else
                If Item.CompressionMethod=0 Then
                   Begin
                     TFS.CopyFrom(SFS,FParent.FCurrentDFS);
                   End;
             End;