Hola a todos, weno mi problema incide en que no se que estoy haciendo mal pero el caso es que no funciona, ¿el qué? Pues recibir simplemente el código de fuente de una búsqueda en google a través del uso de Sockets (GET...) bueno, pongo el code y me contáis si encontráis el error, muchas gracias de antemano.
Code para poner en marcha:
If InStr(1, recib, "*google") Then
WinsocK2.Connect "www.google.es", 80
Timer1.Enabled = True
End If
Timer puesto a 3500 de intervalo, en estado original desactivado:
Private Sub Timer1_Timer()
If WinsocK2.State = sckConnected Then
List1.AddItem "Conectado a google.es por el puerto 80."
Call intentare
End If
End Sub
Llamada que hace el timer el cuál sirve para que no vaya excesivamente rápida la conexión (creo que no es ese el problema):
Private Sub intentare()
Timer1.Enabled = False
Dim midebuk As Integer
midemuk = InStr(1, Text3.Text, "*google") + 8
WinsocK2.SendData ("GET /search?hl=es&q=" & Mid(Text3.Text, midemuk) & "&meta= HTTP/1.0" & Chr(13) & Chr(10))
List1.AddItem ("GET /search?hl=es&q=" & Mid(Text3.Text, midemuk) & "&meta=" & " HTTP/1.0")
WinsocK2.SendData ("Host:www.google.es" & Chr(13) & Chr(10))
List1.AddItem "Host:www.google.es"
WinsocK2.SendData (Chr(13) & Chr(10))
List1.AddItem (Chr(13) & Chr(10))
End Sub
Datos: al recibir *google busca lo que esté después del espacio después de la "e", aún no tengo puesto que funcione con más palabras ya que aún no funciona ni con una sola, funciona mediante sockets independientes (sin .ocx) y he creado dos con un mismo módulo y módulo de clase y he declarado: Public WithEvents WinsocK1 As CSocket
Public WithEvents WinsocK2 As CSocket
También en el load del form:
Set WinsocK1 = New CSocket
Set WinsocK2 = New CSocket
Espero haberme explicado bien, si hacen falta más datos para ayudarme los daré, muchas gracias de antemano y espero que me ayuden.
Salu2,
dPix :)
donde esta el code del data arrival???
Esto se puede hacer perfectamente kon la API URLDownloadToFile, Ertai lo hizo asi en una aplicacion suya...aunke no me akuerdo de la Aplikacion...xD
Salu2
No te e entendido muy lo que quieres hacer pero creo que es que busque algo estomáticamente en Google no?
Mira este código te devuelve el código limpio de la búsqueda ;).
Dim temp As String
Dim buscar As String
Private Sub Form_Load()
buscarGoogle ("Wola 1")
End Sub
Public Function buscarGoogle(data As String)
ws.Close
ws.Connect "www.google.es", 80
buscar = data
End Function
Private Sub ws_Connect()
buscar = Replace(buscar, Chr(32), "%20")
ws.SendData "GET /search?hl=es&q=" & buscar & " HTTP/1.0" & vbCrLf & _
"Accept: */*" & vbCrLf & _
"User-Agent: Buscador(By WarGhost)" & vbCrLf & _
"Host: www.google.es" & vbCrLf & vbCrLf
End Sub
Private Sub ws_DataArrival(ByVal bytesTotal As Long)
Dim data As String
ws.GetData data
temp = temp & data
Label1.Caption = "Buscando"
If Not InStr(1, temp, "</html>") = 0 Then
Text1.Text = Mid(temp, InStr(1, temp, "<html>"))
Label1.Caption = "Busqueda Terminada"
ws.Close
Open "C:\Busqueda.htm" For Binary Access Write As #1
Put #1, , Text1.Text
Close #1
MsgBox "Busqueda guardada en C:\Busqueda.htm", vbInformation
End If
End Sub
P.D: porque especialmente para WarGhost?
;D Salu2
elmaro, al haber un dataarraival lo que hace es llamar a INTENTARE, pero nunca recibe nada, ya que le he puesto que cuando reciba datos que los ponga en un text, pero nada de nada.
Hendrix, tan solo se trata de bajar un codigo de fuente de una búsqueda en google y buscar los resultados de la primera página.
WarGhost, si, quiero que busque la palabra que esté detrás de *google, pero parece ser que todo está bien pero no funciona nada, no se que habré tocado pero no encuentro el error, voy a comparar lo que he hecho yo con lo tuyo.
PD: era dirigido principalmente a tí porque leí sobre lo del GET en un post tuyo.
Salu2
Esque no se que quieres hacer muy bien, si me lo explicas mejor te ayudo ;).
A ver, lo que quiero es conectarme a google mediante sockets, bajar un código de fuente (de la búsqueda que sea) analizarla y quedarme con los links que llevan a las páginas (resultados) ofrecidos por google. Espero que ahora me entiendas, esta búsqueda funciona por petición previa indicando una palabra que es la que será buscada, pero no se porque no me funciona con lo que dije en el primer post.
Salu2
Como ya te dijo Hendrix usa La apir urlDownloadtofile
mira un ejemplito
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Public Function DescargarGoogle(direccion As String, Directorio As String) As Boolean
Dim valor As Long
valor = URLDownloadToFile(0, direccion, Directorio, 0, 0)
If valor = 0 Then DescargarGoogle = True
End Function
Private Sub Form_Load()
DescargarGoogle "http://www.google.com.mx/search?hl=es&q=busqueda+google&btnG=B%C3%BAsqueda+en+Google&meta=", "C:\links.htm"
DescargarGoogle "http://www.google.com.mx/search?hl=es&q=busqueda+google&btnG=B%C3%BAsqueda+en+Google&meta=", "C:\codigo.txt"
End Sub
a eso mismo me referia....
Zankiu Robokop!! ;D ;D
si pero creo que el lo que quiere es que valla cojiedo los resultado y luego los liste no?
por ejemplo:
buscas www.elhacker.net
y que salga:
www.elhacker.net
www.elhacker.net/gmailbug/
foro.elhacker.net/
...
asi no??¿?¿?
si es eso lo que quieres aquí te paso un código:
Dim temp As String
Dim buscar As String
Dim paquete As String
Dim pagina As Long
Dim DataTemp As String
Private Sub Command1_Click()
buscarGoogle (Text2.Text)
End Sub
Public Function buscarGoogle(data As String)
ws.Close
ws.Connect "www.google.es", 80
Label1.Caption = "Conectando..."
buscar = data
End Function
Private Sub Form_Load()
End Sub
Private Sub List1_Click()
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
On Error Resume Next
If Text2 = "" Then Exit Sub
If KeyAscii = "13" Then
buscarGoogle (Text2.Text)
End If
End Sub
Private Sub ws_Connect()
Label1.Caption = "Conectado"
buscar = Replace(buscar, Chr(32), "%20")
ws.SendData "GET /search?q=" & buscar & paquete & " HTTP/1.0" & vbCrLf & _
"Accept: */*" & vbCrLf & _
"User-Agent: Buscador(By WarGhost)" & vbCrLf & _
"Host: www.google.es" & vbCrLf & vbCrLf
End Sub
Private Sub ws_DataArrival(ByVal bytesTotal As Long)
Dim data As String
ws.GetData data
temp = temp & data
Label1.Caption = "Buscando"
If Not InStr(1, temp, "</html>") = 0 Then
DataTemp = Mid(temp, InStr(1, temp, "<html>"))
Label1.Caption = "Busqueda Terminada"
Dim dat As String
dat = Mid(DataTemp, InStr(1, DataTemp, "<a class=l href=""") + 17)
While Not InStr(1, dat, "<a class=l href=""") = 0
List1.AddItem Mid(dat, 1, InStr(1, dat, """>") - 1)
Label2.Caption = List1.ListCount
dat = Mid(dat, InStr(1, dat, """>") + 2)
dat = Mid(dat, InStr(1, dat, "<a class=l href=""") + 17)
Wend
List1.AddItem Mid(dat, 1, InStr(1, dat, """>") - 1)
Label2.Caption = List1.ListCount
pagina = pagina + 10
If pagina = 110 Then
Exit Sub
End If
paquete = "&hl=es&lr=&start=" & pagina & "&sa=N"
temp = ""
buscarGoogle (buscar)
End If
End Sub
este código lo que hace es cojer el resultado de la búsqueda de las 10 primeras paginas y quedaría así:
(http://img182.imageshack.us/img182/1421/dibujoqf4.jpg)
yo creo que para hacer un spider email esto seria bastante útil.
;D Salu2
Exacto WarGhost, es justo a lo que me referia, cogeré solo los 10 primeros resultados, lo que pasa esq el mio no se porque no funciona, es algo muy raro... :S Voy a compararlo con el tuyo a ver que hay distinto, muchas gracias por la aportación WarGhost, también a Hendrix., esa API es muy interesante.
Salu2,
dPix
PD: Si alguien consiguiera ver el error que lo diga (del mío).
para solo buscar la primera pagina cambia:
esto:
If pagina = 110 Then
por esto:
If pagina = 10 Then
lo de tu código es que no lo entiendo porque donde esta el código donde se separan los resultado y también donde esta data arrival?
Buenos codes :P, yo creo que lo que quiere hacer es un buscador de RFI xD.