Título: [Ayuda] Leer texto web
Publicado por: Psyke1 en 29 Mayo 2010, 16:33 pm
Hola a todos, a ver os cuento un poco lo que me pasa... Estoy haciendo un bot utilizando wininet, Lo que necesito es ver el contenido de un label de la web en un label en mi Form, actualmente hago esto: Option Explicit Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer Public Function GET_(hURL As String) As String Dim hBuffer As String * 1000 Dim hInternet As Long Dim hFile As Long Dim hRead As Long hInternet = InternetOpen(0, 1, vbNullString, vbNullString, 0): DoEvents If hInternet <> 0 Then hFile = InternetOpenUrl(hInternet, hURL, vbNullString, ByVal 0&, &H80000000, ByVal 0&): DoEvents If hFile <> 0 Then Do Call InternetReadFile(hFile, hBuffer, 1000, hRead): DoEvents GET_ = GET_ & Left$(hBuffer, hRead) If hRead = 0 Then Exit Do: DoEvents Loop End If End If If hInternet <> 0 Then Call InternetCloseHandle(hInternet) If hFile <> 0 Then Call InternetCloseHandle(hFile) End Function Public Function GetUserName(Optional ID As Long) As String Dim Buffer As String Dim UserName As String If ID > 0 Then MyProfileData = GET_(urlotroperfildemipagina & Str(ID)) Else MyProfileData = GET_(urlmiperfil) End If 'Buscamos "Ver perfil de " For x = 1 To Len(MyProfileData) Buffer = Mid(MyProfileData, x, 14) If Buffer = "Ver perfil de " Then Exit For Next 'Buscamos el nombre For x = x + 14 To Len(MyProfileData) Buffer = Mid(MyProfileData, x, 1) If Buffer <> Chr(34) Then UserName = UserName & Buffer Else Exit For Next GetUserName = UserName End Function
No estoy seguro de que sea una buena forma de hacerlo, por ello os pido consejo, asi como si en vez de wininet me recomendais otro metodo... :silbar: Gracias!
Título: Re: [Ayuda] Leer texto web
Publicado por: seba123neo en 29 Mayo 2010, 16:34 pm
si decis que web es y que parte de la pagina queres leer.
Título: Re: [Ayuda] Leer texto web
Publicado por: Psyke1 en 29 Mayo 2010, 16:37 pm
Es un foro de este tipo hecho con SMF, quiero que me salga en un label los usuarios conectados, y cosas asi... :)
Salu2! ;)
Título: Re: [Ayuda] Leer texto web
Publicado por: seba123neo en 29 Mayo 2010, 17:17 pm
mira si se puede, el tema que por ejemplo esta pagina lo tiene bloqueado, por lo menos yo no he podido sacar el codigo fuente de esta web en la pagina de estadisticas, ni en la pagina principal que es donde estan los conectados (pero en reliadad si encontre donde se puede, pero no lo digo :xD). pero supongamos que esta habilitado como el foro SMF de simplemachines, fijate este link: Simple Machines Community Forum - Statistics Center (http://www.simplemachines.org/community/index.php?action=stats) ese es el centro de estadisticas y suponete que yo quiero sacar los que mas postearon, yo habia hecho algo asi, ni idea si es la mejor forma o no, pero puede funcionar bien. en un formulario pone un textbox multilinea, en realidad podes omitirlo, pero para que veas como funciona. Option Explicit Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal sURL As String, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer Private Const IF_FROM_CACHE = &H1000000 Private Const IF_MAKE_PERSISTENT = &H2000000 Private Const IF_NO_CACHE_WRITE = &H4000000 Private Const BUFFER_LEN = 256 Private Function ExtraerLinks(ByVal pTexto As String) As Object Dim vExpresion As Object Set vExpresion = CreateObject("VBScript.RegExp") vExpresion.Pattern = "<a href=\s*([^\s]*)\s*>" vExpresion.IgnoreCase = True vExpresion.Global = True Set ExtraerLinks = vExpresion.Execute(pTexto) End Function Public Function CodigoFuenteWeb(Pagina As String) As String Dim sBuffer As String * BUFFER_LEN, iResult As Integer, sData As String Dim hInternet As Long, hSession As Long, lReturn As Long hSession = InternetOpen("vb wininet", 1, vbNullString, vbNullString, 0) If hSession Then hInternet = InternetOpenUrl(hSession, Pagina, vbNullString, 0, IF_NO_CACHE_WRITE, 0) If hInternet Then iResult = InternetReadFile(hInternet, sBuffer, BUFFER_LEN, lReturn) sData = sBuffer Do While lReturn <> 0 iResult = InternetReadFile(hInternet, sBuffer, BUFFER_LEN, lReturn) sData = sData + Mid(sBuffer, 1, lReturn) Loop End If iResult = InternetCloseHandle(hInternet) CodigoFuenteWeb = sData End Function Private Sub Form_Load() Text1.Text = Replace(CodigoFuenteWeb("http://www.simplemachines.org/community/index.php?action=stats"), Chr(10), vbNewLine) Text1.Text = TextoEntreMedio(Text1.Text, "Top 10 Posters", "<div id=""top_boards"">") Dim vLinks As Object Dim i As Long Set vLinks = ExtraerLinks(Text1.Text) For i = 0 To vLinks.Count - 1 MsgBox vLinks(i) Next End Sub Private Function TextoEntreMedio(Texto As String, Palabra1 As String, Palabra2 As String) TextoEntreMedio = Left$(Mid$(Texto, InStr(Texto, Palabra1) + Len(Palabra1)), InStr(Mid$(Texto, InStr(Texto, Palabra1) + Len(Palabra1)), Palabra2) - 1) End Function
lo que hago simplemente es traerme todo el codigo fuente de la pagina web, y deppues comienzo por asi decirlo a parsearlo, se que no es parseo 100% pero bueno..es como empezar a sacar las cosas que no sirven y dejar las que si. 1 - primero me traigo el codgo fuente entero. 2 - despues con una simple funcion saco solo el texto que esta entre las cadenas "Top 10 Posters" y <div id=""top_boards"">" que es digamos cuando termina los 10 mas posteadores...el tema que por ejemplo si te cambian el texto esto no funciona mas, pero podes buscar dentro del fuente algo que sea fijo y no cambie, esto es solo un ejemplo. 3 - una vez que me quedo la sección de los 10 mas posteadores, lo que hago es con expresiones regulares (esto es un ejemplo de Leandro, simplemente que este es para links y no para mails) saco los links de los usuarios posteadores y el nombre. una vez que tenes el link del perfil y el nombre, ya veras vos que hacer, pero ahi te queda bien y te trae los 10. saludos.
Título: Re: [Ayuda] Leer texto web
Publicado por: Psyke1 en 29 Mayo 2010, 17:25 pm
:o Muchisimas gracias seba123neo! ;-) Te has molestado en explicarmelo y te he entiendido a la perfeccion! ;) Voy a probar, en unos dias subire el source del bot! ;) Salu2! :)
|