Pegar conteudo de um site

Projeto [x]Harbour - Compilador de código aberto compatível com o Clipper.

Moderador: Moderadores

Avatar do usuário
h1e1
Usuário Nível 1
Usuário Nível 1
Mensagens: 22
Registrado em: 11 Fev 2015 18:22
Localização: Santa Bárbara D'Oeste

Pegar conteudo de um site

Mensagem por h1e1 »

Olá a todos!

Tem como abrir um link com harbour e fazer ele retornar o textos que tem no link?
Avatar do usuário
Itamar M. Lins Jr.
Administrador
Administrador
Mensagens: 7928
Registrado em: 30 Mai 2007 11:31
Localização: Ilheus Bahia
Curtiu: 1 vez

Pegar conteudo de um site

Mensagem por Itamar M. Lins Jr. »

Ola!
Este exemplo está na pasta contrib\hbwin\tests\http_qry.prg do Harbour 3.4.
Para quem quiser, baixar os binários em:
https://bintray.com/artifact/download/v ... win.7z.exe

Código: Selecionar todos

/* Makes an Internet search and displays the links from the response HTML page */

#require "hbssl"
#require "hbtip"

#if ! defined( __HBSCRIPT__HBSHELL )
REQUEST __HBEXTERN__HBSSL__
#endif

PROCEDURE Main()

   LOCAL cURL := iif( tip_SSL(), "https://", "http://" ) + "duckduckgo.com/html/"
   LOCAL oHTTP := TIPClientHTTP():New( cURL )
   LOCAL cHtml, oNode, oDoc

   ? "URL:", cURL

   /* build the search query and add it to the TUrl object */
   oHTTP:oURL:addGetForm( { ;
      "q"  => "Harbour+Project", ;
      "kl" => "us-en" } )

   /* Connect to the HTTP server */
   IF ! oHTTP:Open()
      ? "Connection error:", oHTTP:lastErrorMessage()
      RETURN
   ENDIF

   /* download the response */
   cHtml := oHTTP:ReadAll()
   oHTTP:Close()
   ? hb_ntos( Len( cHtml ) ), "bytes received"
   ?

   oDoc := THtmlDocument():New( cHtml )

   oDoc:writeFile( "result.htm" )

   /* "aS" is the plural of "a" and returns all <a href="url"> tags */
   FOR EACH oNode IN oDoc:body:div( "links" ):aS
      IF oNode:class == "large"
         ? tip_HtmlToStr( oNode:getText( "" ) ), oNode:href
      ENDIF
   NEXT

   RETURN
Saudações,
Itamar M. Lins Jr.
Saudações,
Itamar M. Lins Jr.
Avatar do usuário
NiltonGM
Usuário Nível 3
Usuário Nível 3
Mensagens: 397
Registrado em: 05 Jun 2014 23:47
Localização: Caieiras/SP

Pegar conteudo de um site

Mensagem por NiltonGM »

Olá Itamar,

Precisava de algo parecido em Harbour HMG, estou precisando baixar um arquivo PDF através de um link na web. Como faço isso? Não achei nada na pasta SAMPLES do hmg, sempre me perco lá, não há nada sobre donwload a não ser via FTP e não é isso que procuro.

Abraços.
Nilton Medeiros
nilton@sistrom.com.br
Avatar do usuário
NiltonGM
Usuário Nível 3
Usuário Nível 3
Mensagens: 397
Registrado em: 05 Jun 2014 23:47
Localização: Caieiras/SP

Pegar conteudo de um site

Mensagem por NiltonGM »

Prezados,

Resolvi esse problema conversando com o responsável do Datacenter o qual me disponibilizou acesso via FTP, nesse caso usei as classes HBTIP que encontrei em C:\hmg.3.4.1\HARBOUR\contrib\hbtip\tests com ajuda dos amigos acima, pois na pasta SAMPLES não tem nada e sempre me perco por lá como diz nosso amigo Toledo. rs
Para usar essa classe não basta seguir só o exemplo, apanhei até descobrir como mudar o diretório remoto. Caso alguém aqui esteja interessado posteriormente posto aqui como fiz.

Abraços e uma boa semana a todos.
Nilton Medeiros
nilton@sistrom.com.br
Avatar do usuário
Itamar M. Lins Jr.
Administrador
Administrador
Mensagens: 7928
Registrado em: 30 Mai 2007 11:31
Localização: Ilheus Bahia
Curtiu: 1 vez

Pegar conteudo de um site

Mensagem por Itamar M. Lins Jr. »

Ola!
Exemplo em Hb 3.4, deve funcionar no 3.2, pega arquivo com qualquer protocolo. FTP/HTTP/POP/SMTP

Código: Selecionar todos

/* TEST of TIP libs (for higher level URI interface)
 *
 * Usage: This file is similar to a wget command
 *
 * Without the filename, tipwget will be in demo mode,
 * just demostrating it is working
 *
 * With the filename, data will be stored to the file or
 * retrieved from the file and sent to Internet.
 *
 * Usage of URI.
 * HTTP[S] Protocol
 *   http[s]://<sitename>/<path>?<query>
 *   - at the moment HTTP URI is not able to send data,
 *     (f.e. a form)
 *
 * POP[S] Protocol
 *    pop[s]://<username>:<password>@<popserver>/[-][MsgNum]
 *    - Without MsgNum, you get the list of messages
 *    - With MsgNum get Message MsgNum
 *    - With -MsgNum deletes message MsgNum
 *
 * SMTP[S] Protocol
 *    smtp[s]://<mail-from>@<server>/RCPT
 *    - (You have to provide a filename)
 *    - use &at; in mail-from message
 *    - Send the mail in filename (that must include
 *      headers) to RCPT f.e.
 *      stmp[s]://user&at;example.com@smtp.example.com/gian@niccolai.ws
 *
 *      NOTE: In Unix, to use '&' from command-line you have to surround
 *      the URL with "", f.e. "smtp[s]://...&at;...@server/dest"
 *
 * FTP[S] Protocol
 *    ftp[s]://user:passwd@<ftpserver>/[<path>]
 *    - without path, get the list of files (use path/ to get the list of
 *      files in a dir.
 *    - with path, get a file. If the target file (second param) starts with '+'
 *      it will be sent instead of being retrieved.
 */

#require "hbssl"
#require "hbtip"

#if ! defined( __HBSCRIPT__HBSHELL )
REQUEST __HBEXTERN__HBSSL__
#endif

#include "hbclass.ch"
#include "inkey.ch"
#include "tip.ch"

PROCEDURE Main( cURL, cFile )

   LOCAL bWrite := .F.
   LOCAL oURL, oClient
   LOCAL cData

   ? "Harbour - TIP (class based internet client protocol) test"

   IF ! HB_ISSTRING( cURL ) .OR. Empty( cURL )
      ? hb_StrFormat( "Usage: %1$s <URI> [dumpToOrFromFileName]", hb_ProgName() )
      RETURN
   ENDIF

   IF Empty( oURL := TUrl():New( cURL ) )
      ? "Invalid URL", cURL
      RETURN
   ENDIF

   SWITCH Lower( oURL:cProto )
   CASE "ftp"
      oClient := TIPClientFTP():New( oURL )
      EXIT
   CASE "http"
   CASE "https"
      oClient := TIPClientHTTP():New( oURL )
      EXIT
   CASE "pop"
   CASE "pops"
      oClient := TIPClientPOP():New( oURL )
      EXIT
   CASE "smtp"
   CASE "smtps"
      oClient := TIPClientSMTP():New( oURL )
      EXIT
   ENDSWITCH

   IF Empty( oClient )
      ? "Invalid URL", cURL
      RETURN
   ENDIF
   oClient:nConnTimeout := 2000 /* 20000 */

   oURL:cUserid := StrTran( oURL:cUserid, "&at;", "@" )

   ? "Connecting to", oURL:cProto + "://" + oURL:cServer
   IF oClient:Open()
      ? "Connection status:", iif( Empty( oClient:cReply ), "<connected>", oClient:cReply )

      IF HB_ISSTRING( cFile ) .AND. hb_LeftEq( cFile, "+" )
         cFile := SubStr( cFile, 2 )
         bWrite := .T.
      ENDIF

      ?
      oClient:exGauge := {| done, size | ShowGauge( done, size ) }
#if 0
      /* Can be also: */
      oClient:exGauge := {| done, size, oConnection | dothing( done, size, oConnection ) }
#endif

      IF oClient:nAccessMode == TIP_WO .OR. ( oClient:nAccessMode == TIP_RW .AND. bWrite )
         IF oClient:WriteFromFile( cFile )
            ? "Data successfully sent"
         ELSE
            ? "Error: Data not sent", oClient:lastErrorMessage()
         ENDIF
      ELSE
         IF HB_ISSTRING( cFile )
            cData := oClient:Read()
            IF hb_BLen( cData ) > 0
               ? "First 80 characters:", hb_ValToExp( hb_BLeft( cData, 80 ) ) )
            ELSE
               ? "Error: file could not be retrieved", oClient:lastErrorMessage()
            ENDIF
         ELSEIF oClient:ReadToFile( cFile )
            ? "File", cFile, "written."
            ? "Server replied", oClient:cReply
         ELSE
            ? "Error: Generic error in writing", cFile
         ENDIF
      ENDIF

      oClient:Close()
      ? "Done:", iif( Empty( oClient:cReply ), "(no goodbye message)", oClient:cReply )
   ELSE
      ? "Could not open URI", cURL
      IF ! Empty( oClient:cReply )
         ? oClient:cReply
      ENDIF
   ENDIF

   RETURN

STATIC FUNCTION ShowGauge( nSent, nSize )

   SetPos( Row(), 0 )
   ?? "Sending:", nSent, "/", nSize

   RETURN Inkey() != K_ESC
Saudações,
Itamar M. Lins Jr.
Saudações,
Itamar M. Lins Jr.
Responder