Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: th3y en Septiembre 14, 2012, 07:42:54 am
-
Les muestro este proyecto, se trata de que captura el link directo de Mediafire
+ Carga la pagina
+ Extrae Codigo html
+ Busca la Palabra "kNO" (tal vez esta palabra y el codigo sea cambiado de forma futura, el problema no es este)
+ Extrae el valor que sigue, este seria el link directo
El Proyecto usa el Webbrowser Control,
Todo estaba bien, hasta que me pidio el Gran Adorado Captcha y todo se fue a la basura
Como sabran el webbroswer control es el motor de Internet Explorer, Yo pensaba que el limite de descargas te detectaba por IP, pero parece no ser asi, ya que cuando fui a Chrome, O.O no me salia ningun Captcha y podia descargar el Link
A lo que quiero llegar, si no detecta por IP, lo detectara por Navegador, Asi que pregunto, Ustedes creen que sea por el User Agent de Registro o por alguna otra cosa?, No es por Cookies porque ya lo eh comprobado, Saludos!
EDITADO: Mediafire registra el nombre del explorador, no es por User Agent del Explorador. Mozilla e Internet Explorer llevan el mismo navigator.appName parece, por el cual en Chrome este tira "Netscape" (diferente al de Mozilla e IE)
-
Hola me parece que deve tomar en cuenta las descargas simultaneas de una misma ip, no creo que sea el user agent, mira me puse a jugar un rato pero igual lo de la captcha no tengo ni idea como se podria resolver solo pude buscar la imagen pero no sirve de nada porque cuando leas el script que la contiene esta cambia.
Option Explicit
Private Sub Form_Load()
MsgBox GetMediaFireLink("http://www.mediafire.com/download.php?x5nt3ancdgk552z")
'Debug.Print GetMediaFireLink("http://www.mediafire.com/?mkmyhgnznnw")
'Debug.Print GetMediaFireLink("http://www.mediafire.com/?yjzknntnemz")
'Debug.Print GetMediaFireLink("http://www.mediafire.com/?tdihdzimywo")
End Sub
Private Function GetMediaFireLink(ByVal sUrl As String) As String
On Error GoTo Fail:
Dim m_Inet As Object
Dim lPos As Long
Dim sLink As String
Const Delimitador As String = "kNO = "
If Left(sUrl, 7) <> "http://" Then sUrl = "http://" & sUrl
Set m_Inet = CreateObject("WinHttp.WinHttpRequest.5.1")
m_Inet.Option(0) = "Ie6" & Rnd() 'UserAgent
m_Inet.Open "GET", sUrl, False
m_Inet.send
If m_Inet.Status = 200 Then
lPos = InStr(m_Inet.responseText, Delimitador)
If lPos <> 0 Then
sLink = Mid$(m_Inet.responseText, lPos + Len(Delimitador))
lPos = InStr(sLink, ";")
If lPos <> 0 Then
sLink = Left$(sLink, lPos - 1)
GetMediaFireLink = Replace(sLink, Chr$(34), vbNullString)
End If
Else
'CAPTCHA-----------------------------------------------------------------------------------------------------
Dim sScript As String
Dim sCaptcha As String
lPos = InStr(m_Inet.responseText, "http://www.google.com/recaptcha/api/challenge?")
If lPos <> 0 Then
sScript = Mid$(m_Inet.responseText, lPos)
lPos = InStr(sScript, Chr(34))
If lPos <> 0 Then
sScript = Left$(sScript, lPos - 1)
m_Inet.Open "GET", sScript, False
m_Inet.send
If m_Inet.Status = 200 Then
lPos = InStr(m_Inet.responseText, "challenge : '")
If lPos <> 0 Then
sCaptcha = Mid$(m_Inet.responseText, lPos + 13)
lPos = InStr(sCaptcha, "'")
If lPos <> 0 Then
sCaptcha = "http://www.google.com/recaptcha/api/image?c=" & Left$(sCaptcha, lPos - 1)
Debug.Print sCaptcha
End If
End If
End If
End If
End If
'-------------------------------------------------------------------------------------------------------------
End If
End If
Exit Function
Fail:
Debug.Print "Error"
End Function
-
Mira, yo tengo Internet Explorer 8, y la ultima version de Chrome
Internet Explorer tiene como UserAgent Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 6.1; Win64; x64; Trident/4.0; .NET CLR 2.0.50727; SLCC2; .NET CLR 3.5.30729; .NET CLR 3.0.30729; Media Center PC 6.0; InfoPath.3; Tablet PC 2.0; .NET4.0C; .NET4.0E)*
Chrome : Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.1 (KHTML, like Gecko) Chrome/21.0.1180.89 Safari/537.1
Lo que hize fue, abrir tantas descargas en Chrome, hasta que me salga captcha, entonces me voy hasta al Internet Explorer pongo un link, y no me lo pide D:
Yo hize un codigo asi para coger el link, es algo mas arcaico a mi parecer
Dim pos, pos1, pos2, pos3 As Long
Dim Linkhtml As String
pos = InStr(Text1, "kNO")
If pos > 0 Then
Linkhtml = Mid(Text1, pos + 6, 300)
pos1 = InStr(Linkhtml, """")
pos2 = InStr(pos1 + 1, Linkhtml, """")
Text2 = Mid(Linkhtml, pos1 + 1, (pos2 - pos1) - 1)
pos3 = InStr(Text2, "http")
If pos3 > 0 Then
'Call ShellExecute(Me.hwnd, vbNullString, Text2.Text, vbNullString, vbNullString, SW_SHOWNORMAL)
end if