quinta-feira, 17 de fevereiro de 2011

Download com pausa e resume com Indy

Olá Pessoal,


vamos exemplificar com um pequeno aplicativo completo e funcional para baixar um programa da internet possibilitando parar e continuar mais tarde.

Esta rotina tem partes de outros exemplos tirados da própria Web, mas aqui foram juntadas, e adaptadas para tornar-se fácil de ser implementada em seu aplicativo. É comum encontrar exemplos falhos, incompletos ou difíceis de reaproveitar, muitas vezes por falta de um pequeno esforço de quem os está publicando, que com um pouco mais de zê-lo torna-los-iam muito mais úteis.

Precisei desta rotina recentemente, para possibilitar um live-update na minha aplicação, e tive aí uma semana de muita procura na web com pouco sucesso, então segue minha pequena contribuição. :)

Utilizaremos o componente TidHTTP do Indy, mas não será preciso arrasta-lo, pois vamos declará-lo em uma Thread que não tem formulário.

O projeto consta de duas Units, uma com o Form e a outra com a Thread citada, foi compilado com a versão do Delphi 2007.


Link para os fontes.

Inicie um novo projeto no Delphi, e no form1 coloque:
2 Edit
2 Button
3 Label
1 Gauge

Renomeie os componentes como segue, e mantenha sua ordem no form:

Label1 - Caption= Endereço web do arquivo a ser baixado
Edit1 - Edt_web

Label2 - Caption= Endereço no HD Local para salvar o arquivo
Edit2 - Edt_local

Button1 - Btn_baixar
Button2 - Btn_parar

Gauge1

Label3 - renomeie para Lbl_Status e seu Caption= Status


Na cláusula Uses coloque:

Uses  
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,Math,
  StdCtrls, ComCtrls, Gauges,unit2;

E antes do implementation:

var
  Form1: TForm1;
  ThreadBaixar: TBaixar;
  parar:boolean=false;


Dê dois cliques no Btn_Baixar e cole o código:

//=======================================================
procedure TForm1.Btn_baixarClick(Sender: TObject);
begin

  btn_parar.enabled:=true;
  btn_baixar.Enabled:=false;
  parar:=false;

  ThreadBaixar := TBaixar.Create (true);
  ThreadBaixar.FreeOnTerminate := True;
  ThreadBaixar.Resume;

  Application.ProcessMessages;
end;
//=========================================================

Faça o mesmo para o Btn_Parar:

//========================================================
procedure TForm1.Btn_PararClick(Sender: TObject);
begin
  btn_parar.enabled:=false;
  btn_baixar.Enabled:=true;
  parar:=true;
end;
//===========================================================

Vamos agora acrescentar ao projeto uma nova Unit:
Vá em File / New Unit for Delphi Win32

A nova unit (Unit2) está agora disponível para receber a nossa thread.

O código completo da Unit2 segue:

//========================================================
unit Unit2;
interface
uses Classes,IdBaseComponent, IdComponent, IdTCPConnection,Dialogs,
  IdTCPClient, IdHTTP,SysUtils,Math;

type
  TBaixar=class(TThread)
  Http: TIdHTTP;
  fFileStream: TFileStream;
  Tam_Tot_arq: Integer;
  quant_baixada_arq: Integer;
  ja_baixado: integer;

  protected
  procedure Execute; override;
  procedure HTTPWork(ASender: TObject; AWorkMode: TWorkMode;
            AWorkCount: Integer);
  procedure HTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
            AWorkCountMax: Integer);
  procedure HTTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);

end;

implementation

uses
  unit1;


procedure TBaixar.Execute;
var
  terminado:Boolean;
begin
  Http  := TIdHTTP.Create(nil);
  fFileStream:=nil;
  try
    try
      Http.OnWorkBegin := HTTPWorkBegin;
      Http.OnWork:= HTTPWork;
      Http.OnWorkEnd := HTTPWorkEnd;


      // * * * * * * * * * * * * * *  NOVO * * * * * * * * * * * * * *
      //dava erro 403 forbidden, porque haviam mudado de 'Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 6.0; SLCC1';
      HTTP.Request.UserAgent :='Mozilla/5.0 (Windows NT 6.1; WOW64; rv:12.0) Gecko/20100101 Firefox/12.0';
      Http.Request.CacheControl := 'no-cache'; //Para não utilizar o cache, sempre baixar do site
  // * * * * * * * * * * * * * *  FIM  * * * * * * * * * * * * * *


      Http.Head(Form1.Edt_web.Text); //Arquivo à baixar
      Tam_Tot_arq := Http.Response.ContentLength;//tamanho total do arquivo
      terminado:=false;
      repeat //Vai continuar tentando... ( until abaixo )
        if Unit1.parar then
          Http.Free;

        if not FileExists(Form1.Edt_local.Text) then begin
          fFileStream := TFileStream.Create(Form1.Edt_local.Text, fmCreate);
        end
        else begin
          fFileStream := TFileStream.Create(Form1.Edt_local.Text, fmOpenReadWrite);
          terminado:= fFileStream.Size >= Tam_Tot_arq; //se quantidade baixada = tam do arquivo do serv
          ja_baixado:=fFileStream.Size;
          if not terminado then
            fFileStream.Seek(Max(0, fFileStream.Size-4096), soFromBeginning);
        end;
        try
          quant_baixada_arq:=fFileStream.Size + 50000;//Acrescido em 50kb para garantir chegar ao fim
          if quant_baixada_arq < Tam_Tot_arq then begin
            Http.Request.Range := IntToStr(fFileStream.Position) + '-'+  IntToStr(quant_baixada_arq);
          end
          else begin
            Http.Request.Range := IntToStr(fFileStream.Position) + '-';
            terminado:=true;
          end;
          Http.Get(Form1.Edt_web.Text, fFileStream);//Ajusta nome do arquivo à baixar
        finally
          fFileStream.Free;
        end;
     until terminado; //Até que a variável Exit seja true (veja variavel exit acima)
     Http.Disconnect;
    except
      on E : Exception do
      Begin
       //AddLog(E.Message);  //Você pode criar uma rotina de arquivo.log e colocar os erros
      end;
    end;
  finally
    Http.Free;
  end;
end;


procedure TBaixar.HTTPWork(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Integer);
begin
   //101 para compensar o trunc que corta a parte decimal
   Form1.Gauge1.Progress:= Trunc((ja_baixado/Tam_Tot_arq)*101);
   //se quiser representar em MB (MiB) basta dividir por 1024*1024 =  1048576
   form1.lbl_status.caption:=inttostr(trunc(ja_baixado/1024))+' de '+inttostr(trunc(Tam_Tot_arq/1024))+' kb';
   form1.lbl_status.Refresh;
end;

procedure TBaixar.HTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCountMax: Integer);
begin
   form1.Lbl_Status.Caption:='Iniciando Download';
end;

procedure TBaixar.HTTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
   if Form1.Gauge1.Progress=100 then
     form1.Lbl_Status.Caption:='Download Completo.';

   if unit1.parar then
     form1.Lbl_Status.Caption:='Download pausado...'
end;


end.

//==================================================================

// * * * * * * * * * * * * * * NOVO
Havia sido mudado a string o que ocasionava erro de download
// * * * * * * * * * * * * * *

Há alguns comentários no código, e procurou-se nomear variáveis em portugues que talvez possam ajudar na compreenção do mesmo.

Bem é isso. Espero ter sido útil com essa humilde iniciativa. Desejo a todos felicidades e bons retornos com seus sistemas.

Lembrando que se for útil pra você, coloque links em outras foruns para que mais gente se beneficie.

Grato pela companhia.

Até mais.

Claudio Segura