 |
ActiveDelphi
.: O site do programador Delphi! :.
|
| Exibir mensagem anterior :: Exibir próxima mensagem |
| Autor |
Mensagem |
anderbelluno
Colaborador
Registrado: Quarta-Feira, 23 de Novembro de 2011
Mensagens: 1030
Localização: Cianorte-PR
|
 Enviada: Ter Nov 03, 2015 6:02 pm Assunto: Extrair texto de m site[RESOLVIDO] |
 |
|
Olá pessoal,
estou precisando retirar um texto de um específico site.
estou testando dois métodos para fazer a extração, mas em todos estou encontrando problemas:
1° método
| Código: |
function TH.LerSite(ASite: string): String;
var
WebBrowser1: TWebBrowser;
begin
WebBrowser1:= TWebBrowser.Create(nil);
try
if InternetCheckConnection('http://www.google.com/', 1, 0) then
begin
WebBrowser1.HandleNeeded;
WebBrowser1.Visible:= False;
WebBrowser1.Navigate(ASite);
WebBrowser1.SendToBack;
Application.ProcessMessages;
try
while (WebBrowser1.ReadyState <> READYSTATE_COMPLETE) do
//if not WebBrowser1.OnDocumentComplete then
begin
Application.ProcessMessages;
Sleep(1000);
end;
finally
ResultSite:= WebBrowser1.OleObject.Document.documentElement.innerText;
end;
end;
finally
FreeAndNil(WebBrowser1);
Application.ProcessMessages;
end;
end;
|
com esse pego todo o site, depois faço a extração que preciso:
| Código: |
function TH.ExtractText(aText, OpenTag, CloseTag: String): String;
var
iAux, kAux : Integer;
begin
Result := '';
if (Pos(CloseTag, aText) <> 0) and (Pos(OpenTag, aText) <> 0) then
begin
iAux := Pos(OpenTag, aText) + Length(OpenTag);
kAux := Pos(CloseTag, aText);
Result := Copy(aText, iAux, kAux-iAux);
end;
Application.ProcessMessages;
end;
|
| Código: |
function TH.LerVersiculo(AVersiculo, AFim: string): string;
var src:string;
begin
Application.ProcessMessages;
ResultVersiculo := ExtractText(ResultSite,AVersiculo,AFim);
Application.ProcessMessages;
end;
|
e chamo assim:
| Código: |
S:='https://www.bibliaonline.com.br';
LerSite(S);
LerVersiculo('Versículos do Dia','Publicidade');
|
em sintesi crio o webbrowser e extraio texto que esta entre as tags.
mas acontece que ele tbm abre o IExplorer no site em questão, e isso não seira correto, mas não sei pq isso acontece.
2° método:
| Código: |
function TH.downloadSrc(var aUrl: ansiString): ansiString;
var
IdSSLIOHandler:TIdSSLIOHandlerSocketOpenSSL;
begin
try
IdSSLIOHandler:= TIdSSLIOHandlerSocketOpenSSL.Create(nil);
with tIdHttp.create(nil) do begin //Create Indy http object
request.userAgent:=INET_USERAGENT; //Custom user agent string
redirectMaximum:=INET_REDIRECT_MAX; //Maximum redirects
handleRedirects:=INET_REDIRECT_MAX<>0; //Handle redirects
readTimeOut:=INET_TIMEOUT_SECS*1000; //Read timeout msec
IOHandler:=IdSSLIOHandler;
try
Application.ProcessMessages; //Catch errors
result:=get(aUrl);
Application.ProcessMessages; //Do the request
if url.port='80' then url.port:=''; //Remove port 80 from final URL
aUrl:=url.getFullURI //Return final URL
except result:='error' end; //Return an error message if failed
free //Free the http object
end
finally
IdSSLIOHandler.Free;
end;
end; |
| Código: |
function TH.RemoveTags(const s: string): string;
var
i: Integer;
InTag: Boolean;
begin
Result := '';
InTag := False;
for i := 1 to Length(s) do
begin
if s[i] = '<' then
inTag := True
else
if s[i] = '>' then
inTag := False
else
if not InTag then
Result := Result + s[i];
end;
Application.ProcessMessages;
end;
|
| Código: |
function TH.LerVersiculo(AVersiculo, AFim: string): string;
var src:string;
begin
Application.ProcessMessages;
ResultVersiculo := ExtractText(ResultSite,AVersiculo,AFim);
src:= ResultVersiculo;
ResultVersiculo:= RemoveTags(src);
Application.ProcessMessages;
end;
|
Com o IdHHTP tbm funciona, mas ao remover as tags HTML o texto fica sem o devido espaçamento entre as frases deixando o texto todo atacado. Nesse caso tbm não sei como poderia fazer para remover as tags HTML e deixar o texto com os espaços.
Se alguém tiver uma ideia de como resolver (seria melhor se fosse com o IdHTTP).
Antecipadamente Obrigado.
Anderson.
Editado pela última vez por anderbelluno em Seg Nov 09, 2015 2:45 pm, num total de 1 vez |
|
| Voltar ao Topo |
|
 |
viox
Colaborador
Registrado: Sábado, 22 de Outubro de 2011
Mensagens: 1090
Localização: SINOP - MT
|
| Enviada: Qua Nov 04, 2015 9:19 am Assunto: |
|
|
Olá amigos não conheço nenhum método dessa classe que possua tal função mas você pode fazer o seguinte...
Incremente seu método RemoveTags para verificar o ultimo carácter que está sendo adicionado no Result, se for . , ! ? e o que mais você imaginar bastar dar um espaço...
_________________
Just another Delphi guy.
http://www.soft42.com
http://www.nortaonegocios.com.br |
|
| Voltar ao Topo |
|
|
matteusin
Aprendiz
Registrado: Terça-Feira, 28 de Fevereiro de 2012
Mensagens: 156
|
| Enviada: Qua Nov 04, 2015 10:46 am Assunto: |
|
|
Boa tarde!
Montei aqui um exemplo com o idHTTP! Percebi que são informados 2 versículos, eu fiz pra pegar apenas um, mas se precisar dos dois, é fácil adaptar.
Outra coisa, eu usei o Indy 9 do Delphi 7 pq fiz correndo aqui na empresa onde trabalho, mas tbm acredito que seja simples a troca.
Segue o código:
| Código: | function ExtractText(aText, OpenTag, CloseTag : String) : String;
var
iAux, kAux : Integer;
begin
Result := '';
if (Pos(CloseTag, aText) <> 0) and (Pos(OpenTag, aText) <> 0) then
begin
iAux := Pos(OpenTag, aText) + Length(OpenTag);
kAux := Pos(CloseTag, aText);
Result := Copy(aText, iAux, kAux-iAux);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var HTTP: TIdHTTP;
SSLIOHandlerSocket: TIdSSLIOHandlerSocket;
xSource, xVersiculo: String;
begin
HTTP := TIdHTTP.Create(nil);
SSLIOHandlerSocket:= TIdSSLIOHandlerSocket.Create(Nil);
SSLIOHandlerSocket.SSLOptions.Method:= sslvTLSv1;
SSLIOHandlerSocket.SSLOptions.Mode:= sslmUnassigned;
HTTP.IOHandler:= SSLIOHandlerSocket;
HTTP.Request.Accept := 'text/html, */*';
HTTP.Request.UserAgent := 'Mozilla/3.0 (compatible; IndyLibrary)';
HTTP.Request.ContentType := 'application/x-www-form-urlencoded';
HTTP.HandleRedirects := True;
xSource:= UTF8Decode(HTTP.Get('https://www.bibliaonline.com.br/'));
xSource:= Copy(xSource, Pos('Versículos do Dia', xSource), Length(xSource) );
xVersiculo:= ExtractText(xSource, '">', '</span>');
xSource:= Copy(xSource, Pos('</span>', xSource), Length(xSource));
xVersiculo:= xVersiculo+#13#10+'- '+ExtractText(xSource, '">', '</a>');
HTTP.Free;
SSLIOHandlerSocket.Free;
Memo1.Text := xVersiculo;
end; |
Resultado:
Obs: As tags de localização do html que utilizei acho que são fixas.
Boa sorte!
_________________
Visite meu blog: http://devsistem.blogspot.com.br |
|
| Voltar ao Topo |
|
|
anderbelluno
Colaborador
Registrado: Quarta-Feira, 23 de Novembro de 2011
Mensagens: 1030
Localização: Cianorte-PR
|
| Enviada: Qua Nov 04, 2015 1:05 pm Assunto: |
|
|
viox e matteusin,
obrigado por ajudar, assim que chegar em casa vou testar e posto o resultado. |
|
| Voltar ao Topo |
|
|
anderbelluno
Colaborador
Registrado: Quarta-Feira, 23 de Novembro de 2011
Mensagens: 1030
Localização: Cianorte-PR
|
| Enviada: Qua Nov 04, 2015 5:49 pm Assunto: |
|
|
E ai matteusin
seguinte, fiz aqui como vc descreveu, tive que alterar o TIdSSLIOHandlerSocket para TIdSSLIOHandlerSocketOpenSSL por questão de compatibilidade.
E foi a única coisa que fiz de diferente, ai me deu Connetion timeout no HTTP, coloque o HTTP.ConnetionTimeOut:= 3000, mas mesmo assim continua dando o mesmo erro. |
|
| Voltar ao Topo |
|
|
anderbelluno
Colaborador
Registrado: Quarta-Feira, 23 de Novembro de 2011
Mensagens: 1030
Localização: Cianorte-PR
|
| Enviada: Sex Nov 06, 2015 1:56 pm Assunto: |
|
|
Ainda não consegui fazer com o IdHTTP, e se fosse possível gostaria de extrair os 2 versículos como disse o amigo matteusin.
tava esquecendo uso o Delphi2010. |
|
| Voltar ao Topo |
|
|
natanbh1
Colaborador
Registrado: Terça-Feira, 15 de Março de 2011
Mensagens: 3093
Localização: Belo Horizonte - MG
|
| Enviada: Sex Nov 06, 2015 2:42 pm Assunto: |
|
|
Testei o código e após algumas modificações funcionou normalmente, extraindo primeiro versículo:
| Código: | var
HTTP: TIdHTTP;
SSLIOHandlerSocket: TIdSSLIOHandlerSocketOpenSSL;
xSource, xVersiculo: String;
begin
HTTP := TIdHTTP.Create(nil);
SSLIOHandlerSocket := TIdSSLIOHandlerSocketOpenSSL.Create(Nil);
SSLIOHandlerSocket.SSLOptions.Method := sslvTLSv1;
SSLIOHandlerSocket.SSLOptions.Mode := sslmUnassigned;
HTTP.IOHandler := SSLIOHandlerSocket;
HTTP.Request.Accept := 'text/html, */*';
HTTP.Request.UserAgent := 'Mozilla/3.0 (compatible; IndyLibrary)';
HTTP.Request.ContentType := 'application/x-www-form-urlencoded';
HTTP.HandleRedirects := True;
xSource := HTTP.Get('https://www.bibliaonline.com.br/');
xSource := Copy(xSource, Pos('Versículos do Dia', xSource), Length(xSource));
xVersiculo := ExtractText(xSource, '">', '</span>');
xSource := Copy(xSource, Pos('</span>', xSource), Length(xSource));
xVersiculo := xVersiculo + #13#10 + '- ' + ExtractText(xSource, '">', '</a>');
HTTP.Free;
SSLIOHandlerSocket.Free;
Memo1.Text := xVersiculo;
end; |
Testado com Delphi XE5 e Indy 10
_________________
''A persistência é o caminho para o êxito.''
Charlie Chaplin |
|
| Voltar ao Topo |
|
|
natanbh1
Colaborador
Registrado: Terça-Feira, 15 de Março de 2011
Mensagens: 3093
Localização: Belo Horizonte - MG
|
| Enviada: Sex Nov 06, 2015 3:44 pm Assunto: |
|
|
Segue código completo, extraindo os 2 versículos:
- Adicione IdHttp, IdSSLOpenSSL na uses do form.
| Código: | function ExtractText(aText, OpenTag, CloseTag: String): String;
var
iAux, kAux: Integer;
begin
Result := '';
if (Pos(CloseTag, aText) <> 0) and (Pos(OpenTag, aText) <> 0) then
begin
iAux := Pos(OpenTag, aText) + Length(OpenTag);
kAux := Pos(CloseTag, aText);
Result := Copy(aText, iAux, kAux - iAux);
end;
end;
function RemoveTags(const s: string): string;
var
i: Integer;
InTag: Boolean;
begin
Result := '';
InTag := False;
for i := 1 to Length(s) do
begin
if s[i] = '<' then
inTag := True
else
if s[i] = '>' then
inTag := False
else
if not InTag then
Result := Result + s[i];
end;
Application.ProcessMessages;
end; |
| Código: | procedure TForm7.Button1Click(Sender: TObject);
var
HTTP: TIdHTTP;
SSLIOHandlerSocket: TIdSSLIOHandlerSocketOpenSSL;
xSource, xVersiculo1, xVersiculo2: String;
begin
HTTP := TIdHTTP.Create(nil);
SSLIOHandlerSocket := TIdSSLIOHandlerSocketOpenSSL.Create(Nil);
SSLIOHandlerSocket.SSLOptions.Method := sslvTLSv1;
SSLIOHandlerSocket.SSLOptions.Mode := sslmUnassigned;
HTTP.IOHandler := SSLIOHandlerSocket;
HTTP.Request.Accept := 'text/html, */*';
HTTP.Request.UserAgent := 'Mozilla/3.0 (compatible; IndyLibrary)';
HTTP.Request.ContentType := 'application/x-www-form-urlencoded';
HTTP.HandleRedirects := True;
xSource := HTTP.Get('https://www.bibliaonline.com.br/');
xSource := Copy(xSource, Pos('Versículos do Dia', xSource), Length(xSource));
xVersiculo1:= ExtractText(xSource, '<p>', '</p>');
xVersiculo1:= RemoveTags(xVersiculo1);
xSource := Copy(xSource, Pos('</p>', xSource) + 4, Length(xSource));
xVersiculo2:= ExtractText(xSource, '<p>', '</p>');
xVersiculo2:= RemoveTags(xVersiculo2);
HTTP.Free;
SSLIOHandlerSocket.Free;
Memo1.Clear;
Memo1.Lines.Add('Versículo 1: ' + #13#10+ xVersiculo1 +#13#10);
Memo1.Lines.Add(' ');
Memo1.Lines.Add('Versículo 2: ' + #13#10+ xVersiculo2 +#13#10);
end; |
Link do exemplo acima:
http://www.4shared.com/zip/ys8PM6zrba/Versculo.html
_________________
''A persistência é o caminho para o êxito.''
Charlie Chaplin |
|
| Voltar ao Topo |
|
|
anderbelluno
Colaborador
Registrado: Quarta-Feira, 23 de Novembro de 2011
Mensagens: 1030
Localização: Cianorte-PR
|
| Enviada: Sex Nov 06, 2015 6:13 pm Assunto: |
|
|
E ai natanbh1, nesse ponto creio que seje um problema com a indy, pq continua da dar erro de Connection TimeOut. vou ver se existe atualizaçao pra ver se resolve.
Obrigado por enquanto pela força. |
|
| Voltar ao Topo |
|
|
anderbelluno
Colaborador
Registrado: Quarta-Feira, 23 de Novembro de 2011
Mensagens: 1030
Localização: Cianorte-PR
|
| Enviada: Sáb Nov 07, 2015 3:02 pm Assunto: |
|
|
natanbh1,
minha indy tbm é a 10 com delphi 2010.
pq será que continua dando erro de timeout? |
|
| Voltar ao Topo |
|
|
matteusin
Aprendiz
Registrado: Terça-Feira, 28 de Fevereiro de 2012
Mensagens: 156
|
| Enviada: Seg Nov 09, 2015 6:47 am Assunto: |
|
|
| anderbelluno escreveu: | natanbh1,
minha indy tbm é a 10 com delphi 2010.
pq será que continua dando erro de timeout? |
Bom dia! Pode ser talvez a versão das suas Dlls? Tenta uma versão mais atualizada
_________________
Visite meu blog: http://devsistem.blogspot.com.br |
|
| Voltar ao Topo |
|
|
anderbelluno
Colaborador
Registrado: Quarta-Feira, 23 de Novembro de 2011
Mensagens: 1030
Localização: Cianorte-PR
|
| Enviada: Seg Nov 09, 2015 12:19 pm Assunto: |
|
|
| matteusin escreveu: |
Bom dia! Pode ser talvez a versão das suas Dlls? Tenta uma versão mais atualizada |
E ai matteusin,
blz?
seguinte atualizei as dll's openssl, as quais possuem a versão 1.0.2d, mas infelizmente continua o bendito erro de timeout. gostaria muito de resolver esse problema.
Uso a indy para enviar e-mails sem problemas, não sei se tem algo em comum, mas funciona normalmente. |
|
| Voltar ao Topo |
|
|
natanbh1
Colaborador
Registrado: Terça-Feira, 15 de Março de 2011
Mensagens: 3093
Localização: Belo Horizonte - MG
|
| Enviada: Seg Nov 09, 2015 1:01 pm Assunto: |
|
|
Baixou o projeto exemplo que postei e testou?
http://www.4shared.com/zip/ys8PM6zrba/Versculo.html
Você está criando os componentes (IdHTTP e IdSSLIOHandlerSocketOpenSSL) em tempo de projeto (palheta) ou em runtime, como nos exemplos que passamos?
Verifique se você está dando o Get no site com https.
Errado (http):
| Código: | | xSource := HTTP.Get('http://www.bibliaonline.com.br/'); |
Certo (https):
| Código: | | xSource := HTTP.Get('https://www.bibliaonline.com.br/'); |
_________________
''A persistência é o caminho para o êxito.''
Charlie Chaplin |
|
| Voltar ao Topo |
|
|
anderbelluno
Colaborador
Registrado: Quarta-Feira, 23 de Novembro de 2011
Mensagens: 1030
Localização: Cianorte-PR
|
| Enviada: Seg Nov 09, 2015 2:05 pm Assunto: |
|
|
| natanbh1 escreveu: | Baixou o projeto exemplo que postei e testou?
http://www.4shared.com/zip/ys8PM6zrba/Versculo.html
Você está criando os componentes (IdHTTP e IdSSLIOHandlerSocketOpenSSL) em tempo de projeto (palheta) ou em runtime, como nos exemplos que passamos?
Verifique se você está dando o Get no site com https.
Errado (http):
| Código: | | xSource := HTTP.Get('http://www.bibliaonline.com.br/'); |
Certo (https):
| Código: | | xSource := HTTP.Get('https://www.bibliaonline.com.br/'); |
|
Opa, baixei sim e deu o mesmo erro de timeout.
estou criando em Runtime pq esta em uma thread.
verifiquei tbm o http.get, e esta da maneira correta como vc informou, com o https... |
|
| Voltar ao Topo |
|
|
natanbh1
Colaborador
Registrado: Terça-Feira, 15 de Março de 2011
Mensagens: 3093
Localização: Belo Horizonte - MG
|
| Enviada: Seg Nov 09, 2015 2:26 pm Assunto: |
|
|
Utiliza Proxy?
Desabilitou Firewall e Antivírus para teste?
_________________
''A persistência é o caminho para o êxito.''
Charlie Chaplin |
|
| Voltar ao Topo |
|
|
|
|
Enviar Mensagens Novas: Proibido.
Responder Tópicos Proibido
Editar Mensagens: Proibido.
Excluir Mensagens: Proibido.
Votar em Enquetes: Proibido.
|
|
FAQ
Pesquisar
Membros
Grupos
Registrar
Perfil
Entrar e ver Mensagens Particulares
Entrar
