Delphi Artigos
quarta-feira, 9 de abril de 2014
Não é possível abrir o arquivo de informações de grupo de trabalho do mecanismo do Microsoft Jet.
Antivirus Kaspersky causando erro de acesso a base de dados pelo Delphi com ADO
Nesta manhã de Quarta- feira 09 de abril de 2014, uma nova atualização do anti virus kaspersky estava fazendo os programas em Delphi que acessam arquivos MDB (banco de dados Access) através do ADO apresentarem a mensagem acima.
A solução inicialmente foi desinstalar o antivirus kaspersky, e apagar o arquivo System.MDB que estava sendo criado por ele dentro da pasta do meu programa.
No forum da kaspersky foi relatado o problema e muitos usuários que produzem programas em Delphi foram atingidos.
Agora é só aguardar uns dias até que eles se dignem a lançar uma correção.
No meu caso sempre sugiro ao clientes usarem um antivirus gratuito como AVG, AVAST, AVIRA, que pelo menos são gratuitos e podem ser trocados facilmente em casos assim, e funcionam razoavelmente, mesmo porque, a infecção por virus e afins, está muito ligada a distração do usuário que acaba clicando em botões mal identificados e com isso instalam os dito cujos.
Resumo da Solução:
Desinstalar o kaspersky
Apagar o arquivo System.MDB da pasta de seu programa.
segunda-feira, 2 de julho de 2012
Funções MultiByte, acentuação no PHP para todos.
Tentando converter dados de um formulário HTML em upper case para gravar em um banco MYSQL,
passei horas de muito aperto lidando strtoupper.
Com pesar descobri que os caracteres acentuados permaneciam da mesma forma, e assim conseguia algo do tipo:
transformação -> TRANSFORMAçãO (note o 'çã' minúsculo)
Procurando, cheguei à informação de que era necessário ajustar o local com a função setlocale().
Outro tempo gasto, muitos testes e nada.
Por fim encontrei as Funções MultiByte, que consideram os caracteres acentuados em vários idiomas.
Dessa forma, podemos simplesmente escrever:
<?php
$letras= 'á é í ó ú ç ã õ â ê ô ü à è ò';
echo mb_strtoupper($letras,'utf-8');
?>
Resultado: Á É Í Ó Ú Ç Ã Õ Â Ê Ô Ü À È Ò
Estas funções diferem pelo sufixo mb_ no nome. Existe equivalente para muitas funções que trabalham com
strings.
Por exemplo:
mb_strlen — Comprimento da string
mb_strpos — Acha a POSIÇÃO da primeira ocorrência de uma string em outra
mb_strrpos — Acha a posição da ultima ocorrência de uma string em outra
mb_strstr — Acha a primeira OCORRÊNCIA de uma string em outra
mb_strtolower — transforma uma string em minúsculas
mb_strtoupper — Transforma em maiúsculas
mb_substr — Pega uma parte da string
mb_substr_count — Conta o numero de ocorrências de uma substring em uma string
Para uma lista mais abrangente olhe em Multibyte String Functions
Então atéa próxima.
Tentando converter dados de um formulário HTML em upper case para gravar em um banco MYSQL,
passei horas de muito aperto lidando strtoupper.
Com pesar descobri que os caracteres acentuados permaneciam da mesma forma, e assim conseguia algo do tipo:
transformação -> TRANSFORMAçãO (note o 'çã' minúsculo)
Procurando, cheguei à informação de que era necessário ajustar o local com a função setlocale().
Outro tempo gasto, muitos testes e nada.
Por fim encontrei as Funções MultiByte, que consideram os caracteres acentuados em vários idiomas.
Dessa forma, podemos simplesmente escrever:
<?php
$letras= 'á é í ó ú ç ã õ â ê ô ü à è ò';
echo mb_strtoupper($letras,'utf-8');
?>
Resultado: Á É Í Ó Ú Ç Ã Õ Â Ê Ô Ü À È Ò
Estas funções diferem pelo sufixo mb_ no nome. Existe equivalente para muitas funções que trabalham com
strings.
Por exemplo:
mb_strlen — Comprimento da string
mb_strpos — Acha a POSIÇÃO da primeira ocorrência de uma string em outra
mb_strrpos — Acha a posição da ultima ocorrência de uma string em outra
mb_strstr — Acha a primeira OCORRÊNCIA de uma string em outra
mb_strtolower — transforma uma string em minúsculas
mb_strtoupper — Transforma em maiúsculas
mb_substr — Pega uma parte da string
mb_substr_count — Conta o numero de ocorrências de uma substring em uma string
Para uma lista mais abrangente olhe em Multibyte String Functions
Então atéa próxima.
sexta-feira, 8 de junho de 2012
Validador PHP de Expressões Regulares
Olá o assunto hoje é Expressão Regular no PHP.
Talvez você, assim como eu, já quis facilitar seu trabalho de programação na hora de validar um campo, seja ele CPF, CNPJ entre outros. O caminho, via de regra, é "if s intemináveis", aquele monte de comparação, para cada tipo de caracter, etc. Ou aquelas equações cheias de {}[]()/.\/ entre outros símbolos que assustam.
Bom, me assustei bastante, mas continuei, insisti e vi que era legal. Então vou tentar compartilhar um pouco do apreendido com as experiências, e mais, acabei por construir um simples, mas útil Validador de Expressões Regulares.
Expressão Regular é algo que lhe permite diminuir para uma linha uma dezena de IFs. Pra compreender o que é, existe o EXCELENTE LIVRO DO AURÉLIO MARINHO gratuito e online.
O Projeto é bastante simples e consiste de duas páginas php.
Aqui você pode testá-lo: Projeto no Ar
Pra executar em modo local, na sua máquina, é necessário ter o PHP e o Apache configurados, e pra quem ainda não tem recomendo o WAMPSERVER, que instala e configura tudo pra você.
Como editor de texto você pode usar até o bloco de notas, mas existem alguns que lhe facilitam demais a vida. O que costumo usar é o Notepad++ que além de permitir a sintaxe PHP, também é gratuito. Outra característica muito interessante pra quem faz sites compatíveis com UTF-8 é a opção de formatar e salvar o arquivo já nesse formato, para que as palavras com acento apareçam corretamente.
Links:
FONTES DO PROJETO
Você já deve ter procurado muito sobre esse assunto na internet, de forma que serei breve e passarei ao código fonte.
Para utilizar, abra o Notepad++, menu Formatar e marque "Codificação em UTF-8 (sem BOM)", com isso as palavras sairão acentuadas corretamente. Isso é necessário porque estou especificando no < head > esse charset.
Cole o conteúdo do arquivo abaixo e salve-o como INDEX.PHP. Repita para o EXP_REG.PHP.
Salve ambos na pasta www que o WAMPSERVER criou pra você, ela deve estar em: C:\wamp\www\
Agora, entre no seu navegador e digite: LOCALHOST/INDEX.PHP
Este arquivo é o INDEX.PHP
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<meta name="title" content="Validador de Expressões Regulares">
<meta name="description" content="Valida expressões regulares">
<meta name="keywords" content="validador,expressões regulares,php">
<meta name="autor" content="Claudio Segura">
<meta name="revisit-after" content="15">
<style type="text/css">
#formulario {
background-color: #61B5D4;
float:left;
}
#formulario h1{
font: bold 20px Trebuchet Ms, Verdana, Arial, Tahoma, Sans-Serif;
color: #426B00;
text-transform:uppercase;
text-align: center;
margin-top: 7px;
}
#corpo {
clear:both;
background-color: #AAAA77;
}
#corpo h3{
font: bold 14px Trebuchet Ms, Verdana, Arial, Tahoma, Sans-Serif;
color: #426B00;
text-transform:uppercase;
}
#corpo p{
font: 14px/20px Arial,Tahoma, Sans-Serif;
color: #164348;
margin-botton:0px;
}
#exemplo1{
float:left;
margin-left: 20px;
}
#exemplo2{
float:left;
margin-left: 20px;
}
</style>
</head>
<body>
<div id="formulario">
<table border=1><tr><td>
<h1>Validador PHP de Experessões Regulares</h1>
<form method="post" action="exp_reg.php">
<fieldset>
<p><label><Input type = 'Radio' Name ='tipo' value= 'match'>Preg_match (Encontrar uma coincidência no texto)</label></p>
<p><label><Input type = 'Radio' Name ='tipo' value= 'replace'>Preg_replace (Encontrar no texto e substituir pelo conteúdo)</label></p>
Escolha do menu a Expressão Regular
<select name="dropdown" value="options">
<option value="">Digitar uma expressão</option>
<option value="(^([\d]|1[0,1,2])/([0-9]|[0,1,2][0-9]|3[0,1])/\d{4}$)">Data</option>
<option value="(^([0-9a-zA-Z]+([_.-]?[0-9a-zA-Z]+)*@[0-9a-zA-Z]+[0-9,a-z,A-Z,.,-]*(.){1}[a-zA-Z]{2,4})+$)">Email</option>
<option value="(\b([0-9]{3}\.?){3}\-?[0-9]{2}\b)">CPF</option>
<option value="(\b([0-9]{2}\.?)([0-9]{3}\.?){2}\/?([0-9]{4})\-?([0-9]{2})\b)">CNPJ</option>
<option value="(\b[0-9]{2}\.?[0-9]{3}-[0-9]{3}\b)">CEP</option>
</select>
<p><label>ou digite uma Expressão: <input name="expressao" type="text" size="100"/></label></p>
<p><label>Conteudo: <input name="conteudo" type="text" size="100"/></label></p>
<p><label>Texto: <input name="texto" type="text" size="100"/></label>
</fieldset>
<p>
<input type="submit" value=" Enviar " name="submit">
<input type="reset" value=" Limpar " name="reset">
</form>
</td></tr></table>
</div>
<div id='corpo'>
<div id='Exemplo1'>
<p>Exemplo: preg_replace:</p>
<h3>Retirar formatação de um CPF ou CNPJ:</h3>
<p>Selecione: preg_replace</p>
<p>Expressão: ([\.\-\/\' '])</p>
<p>Conteúdo: deixe em branco equivale a ' '</p>
<p>texto:12.234.345/0002-23</p>
<hr>
<h3>Formatar CPF:</h3>
<p>Selecione: preg_replace</p>
<p>Expressão: (([0-9]{3})([0-9]{3})([0-9]{3})([0-9]{2}))</p>
<p>Conteúdo: $1.$2.$3-$4</p>
<p>texto:12234345023</p>
<hr>
<h3>Formatar CNPJ:</h3>
<p>Selecione: preg_replace</p>
<p>Expressão: (([0-9]{2})([0-9]{3})([0-9]{3})([0-9]{4})([0-9]{2}))</p>
<p>Conteúdo: $1.$2.$3/$4-$5</p>
<p>texto:12234345000134</p>
<hr>
</div>
<div id='Exemplo2'>
<p>exemplo: preg_match:</p>
<h3>Procurar CPF:</h3>
<p>Selecione: preg_match</p>
<p>Expressão: Selecione do menu CPF</p>
<p>Conteúdo: deixe em branco</p>
<p>texto:01.234.567-89</p>
<hr>
<h3>Procurar CNPJ:</h3>
<p>Selecione: preg_replace</p>
<p>Expressão: Selecione do menu CNPJ</p>
<p>Conteúdo: deixe em branco</p>
<p>texto:12.234.345/0002-23</p>
<hr>
</div>
</div>
</body>
</html>
Este outro é o EXP_REG.PHP
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<meta name="title" content="Validador de Expressões Regulares">
<meta name="description" content="Valida expressões regulares">
<meta name="keywords" content="validador,expressões regulares,php">
<meta name="autor" content="Claudio Segura">
<meta name="revisit-after" content="15">
</head>
<body>
<?php
$expressao=$_POST['dropdown'];
if ($expressao==""){
$expressao=$_POST['expressao'];
}
$conteudo=$_POST['conteudo'];
$texto=$_POST['texto'];
if ($_POST['tipo']=='match'){
if (preg_match($expressao,$texto,$resp)){
echo 'Expressão: '.$expressao;
echo '<p>';
echo 'Texto: '.$texto;
echo '<p>';
echo 'Resultado: [POSITIVO] - '.$resp[0].' encontrado';
}else{
echo 'Resultado: [NEGATIVO] - O texto não apresenta nada como a expressão sugere.';
}
}else{
$resp=preg_replace($expressao,$conteudo,$texto);
echo 'Expressão: '.$expressao;
echo '<p>';
echo 'Conteúdo: '.$conteudo;
echo '<p>';
echo 'Texto: '.$texto;
echo '<p>';
echo 'Resultado: '.$resp;
}
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<meta name="title" content="Validador de Expressões Regulares">
<meta name="description" content="Valida expressões regulares">
<meta name="keywords" content="validador,expressões regulares,php">
<meta name="autor" content="Claudio Segura">
<meta name="revisit-after" content="15">
</head>
<body>
<?php
$expressao=$_POST['dropdown'];
if ($expressao==""){
$expressao=$_POST['expressao'];
}
$conteudo=$_POST['conteudo'];
$texto=$_POST['texto'];
if ($_POST['tipo']=='match'){
if (preg_match($expressao,$texto,$resp)){
echo 'Expressão: '.$expressao;
echo '<p>';
echo 'Texto: '.$texto;
echo '<p>';
echo 'Resultado: [POSITIVO] - '.$resp[0].' encontrado';
}else{
echo 'Resultado: [NEGATIVO] - O texto não apresenta nada como a expressão sugere.';
}
}else{
$resp=preg_replace($expressao,$conteudo,$texto);
echo 'Expressão: '.$expressao;
echo '<p>';
echo 'Conteúdo: '.$conteudo;
echo '<p>';
echo 'Texto: '.$texto;
echo '<p>';
echo 'Resultado: '.$resp;
}
echo "<a href='index.php'>Retornar</a>";
?>
</body>
</html>
?>
</body>
</html>
Bom então é isso. Bom divertimento. :)
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
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
Assinar:
Postagens (Atom)