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