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
Tentei utilizar esse seu sistema mas está dando erros.
ResponderExcluirÉ questão de verificar a digitação do código e tentar novamente.
Excluir