Compactar com Zlib e mostrar progresso

[Renanbg 1]

Olá amigos.

Como compactar com a zlib eu ja sei, mas para mostrar o andamento não tenho ideia de como fazer.

 

Abaixo está todo o codigo que tenho para fazer compactação e descompactação.

 

procedure EnumFiles(szPath, szAllowedExt: String; iAttributes: Integer;
  Buffer: TStrings; bClear, bIncludePath: Boolean); StdCall;
var
  res: TSearchRec;
  szBuff: String;
begin
  if (bClear) then Buffer.Clear;
  szPath := IncludeTrailingBackslash(szPath);
  if (FindFirst(szPath + szAllowedExt, iAttributes, res) = 0) then
  begin
    repeat
      szBuff := res.Name;
      if ((szBuff <> '.') and (szBuff <> '..')) then
      if (bIncludePath) then
      Buffer.Add(szPath + szBuff) else
      Buffer.Add(szBuff);
    until FindNext(res) <> 0;
    FindClose(res);
  end;
end;

procedure CompressFiles(Files: TStrings; const Filename: String);
var
  infile, outfile, tmpFile : TFileStream;
  compr : TCompressionStream;
  i,l : Integer;
  s : String;
begin
  if Files.Count > 0 then
  begin
    outFile := TFileStream.Create(Filename,fmCreate);
    try
      { the number of files }
      l := Files.Count;
      outfile.Write(l,SizeOf(l));
      for i := 0 to Files.Count-1 do
      begin
        infile := TFileStream.Create(Files[i],fmOpenRead);
        try
          { the original filename }
          s := ExtractFilename(Files[i]);
          l := Length(s);
          outfile.Write(l,SizeOf(l));
          outfile.Write(s[1],l);
          { the original filesize }
          l := infile.Size;
          outfile.Write(l,SizeOf(l));
          { compress and store the file temporary}
          tmpFile := TFileStream.Create('tmp',fmCreate);
          compr := TCompressionStream.Create(clMax,tmpfile);
          try
            compr.CopyFrom(infile,l);
          finally
            compr.Free;
            tmpFile.Free;
          end;
          { append the compressed file to the destination file }
          tmpFile := TFileStream.Create('tmp',fmOpenRead);
          try
            outfile.CopyFrom(tmpFile,0);
          finally
            tmpFile.Free;
          end;
        finally
          infile.Free;
        end;
      end;
    finally
      outfile.Free;
    end;
    DeleteFile('tmp');
  end;
end;

procedure DecompressFiles(const Filename, DestDirectory : String);
var
  dest,s : String;
  decompr : TDecompressionStream;
  infile, outfile : TFilestream;
  i,l,c : Integer;
begin
  // IncludeTrailingPathDelimiter (D6/D7 only)
  dest := IncludeTrailingPathDelimiter(DestDirectory);

  ForceDirectories(Dest);

  infile := TFileStream.Create(Filename,fmOpenRead);
  try
    { number of files }
    infile.Read(c,SizeOf(c));
    for i := 1 to c do
    begin
      { read filename }
      infile.Read(l,SizeOf(l));
      SetLength(s,l);
      infile.Read(s[1],l);
      { read filesize }
      infile.Read(l,SizeOf(l));
      { decompress the files and store it }
      s := dest+s; //include the path
      outfile := TFileStream.Create(s,fmCreate);
      decompr := TDecompressionStream.Create(infile);
      try
        outfile.CopyFrom(decompr,l);
      finally
        outfile.Free;
        decompr.Free;
      end;
    end;
  finally
    infile.Free;
  end;
end;

procedure TForm1.btn1Click(Sender: TObject);
var
  slFiles: TStringList;
begin
  slFiles := TStringList.Create;
  EnumFiles('C:\Backup\', '*', faAnyFile - faDirectory, slFiles, True, True);
  CompressFiles(slFiles, 'C:\Dia-' + FormatDateTime('ddmmyyyy', Date) +'-' + FormatDateTime('HHmm', Time) + '.bkp');
  slFiles.Free;
end;

procedure TForm1.btn2Click(Sender: TObject);
begin
 DecompressFiles('C:\Dia-22062010-1408.bkp', 'C:\Sistema\BD');
end;

Neste link abaixo, mostra como fazer com labels, mas ao compilar os labels não são reconhecidos não sei porque.

 

Link

 

Alguma sugestão?

[Renanbg 1]

Bom, consegui adaptar os labels.

Agora faltaria apenas colocar a progressbar. Olhei no evento de progress e tentei colocar lá, mas da erro no momento que inicia a compactação.

 

segue codigo com os labels que funciona super bem.

 

procedure TForm1.CompressionProgress(Sender: TObject);
begin
  Label2.Caption := 'Leitura Atual: '+IntToStr((Sender as TCompressionStream).Position) +
                    ' / Taxa de Compressão: ' + CurrToStrF(100 - (Sender as TCompressionStream).CompressionRate, ffNumber, 2);
  Application.ProcessMessages;
end;

Alguma luz?