Pegar conteudo de um site
Enviado: 24 Jun 2015 15:07
Olá a todos!
Tem como abrir um link com harbour e fazer ele retornar o textos que tem no link?
Tem como abrir um link com harbour e fazer ele retornar o textos que tem no link?
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
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