[Ayuda] Leer texto web

[Psyke1]

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:

Código (vb) [Seleccionar] Expandir


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...

Gracias!

[seba123neo]

si decis que web es y que parte de la pagina queres leer.

[Psyke1]

Es un foro de este tipo hecho con SMF, quiero que me salga en un label los usuarios conectados, y cosas asi...

Salu2!

[seba123neo]

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  ).

pero supongamos que esta habilitado como el foro SMF de simplemachines, fijate este link:

Simple Machines Community Forum - Statistics Center

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.

Código (vb) [Seleccionar] Expandir

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.

[Psyke1]

 
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!