Página 1 de 1

Pegar conteudo de um site

Enviado: 24 Jun 2015 15:07
por h1e1
Olá a todos!

Tem como abrir um link com harbour e fazer ele retornar o textos que tem no link?

Pegar conteudo de um site

Enviado: 24 Jun 2015 19:13
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.

Pegar conteudo de um site

Enviado: 27 Jul 2015 10:49
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.

Pegar conteudo de um site

Enviado: 28 Jul 2015 10:07
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.

Pegar conteudo de um site

Enviado: 28 Jul 2015 12:37
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.