Imprimir Página - Comprobar si una web existe [reto?]

Título: Comprobar si una web existe [reto?]
Publicado por: Psyke1 en 6 Septiembre 2010, 11:04 am

Para comprobar si una web existe hago esto:

Código

Option Explicit
 
Function Check_Web_Exists(ByVal sURL As String) As Boolean
Dim oXHTTP                  As Object
Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
   If Not UCase$(sURL) Like "HTTP:*" Then sURL = "http://" & sURL
   On Error GoTo Error_
   With oXHTTP
       .Open "HEAD", sURL, False
       .Send
       If .Status = 200 Then Check_Web_Exists = True
   End With
   Set oXHTTP = Nothing
   Exit Function
Error_:
End Function

Ejemplo:

Código

Private Sub Form_Load()
    MsgBox Check_Web_Exists("www.google.es")
    MsgBox Check_Web_Exists("www.eljuaker.net")
End Sub

Devuelve:

Citar

Verdadero
Falso

Alguien lo sabe hacer más rapido?¿

DoEvents¡! :P

Título: Re: Comprobar si una web existe [reto?]
Publicado por: Karcrack en 6 Septiembre 2010, 14:37 pm

Código:

'WININET
Private Declare Function HttpQueryInfoW Lib "WININET" (ByVal hRequest As Long, ByVal dwInfoLevel As Long, ByRef lpBuffer As Any, ByRef lpdwBufferLength As Long, ByRef lpdwIndex As Long) As Long
Private Declare Function InternetCloseHandle Lib "WININET" (ByVal hInternet As Long) As Boolean
Private Declare Function InternetOpenW Lib "WININET" (ByVal lpszAgent As Long, ByVal dwAccessType As Long, ByVal lpszProxy As Long, ByVal lpszProxyBypass As Long, ByVal dwFlags As Long) As Long
Private Declare Function InternetOpenUrlW Lib "WININET" (ByVal hInternet As Long, ByVal lpszUrl As Long, ByVal lpszHeaders As Long, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByRef dwContext As Long) As Long

Private Const INTERNET_OPEN_TYPE_DIRECT As Long = 1
Private Const INTERNET_FLAG_RELOAD As Long = &H80000000
Private Const HTTP_QUERY_STATUS_CODE As Long = 19
Private Const HTTP_QUERY_FLAG_NUMBER As Long = &H20000000
Private Const HTTP_STATUS_OK As Long = 200
Private Const HTTP_STATUS_REDIRECT As Long = 302
Private Const STRING_AGENT As String = "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1)"

Código

Option Explicit
 
Public Function CheckWetherExists(ByVal sURL As String) As Boolean
    Dim hInet                           As Long
    Dim hURL                            As Long
    Dim lStatus                         As Long
 
    hInet = InternetOpenW(StrPtr(STRING_AGENT), INTERNET_OPEN_TYPE_DIRECT, 0&, 0&, 0&)
    If hInet = 0 Then GoTo Fail
 
    hURL = InternetOpenUrlW(hInet, StrPtr(sURL), 0&, 0&, INTERNET_FLAG_RELOAD, ByVal 0&)
    If hURL = 0 Then GoTo Fail
 
    If HttpQueryInfoW(hURL, HTTP_QUERY_FLAG_NUMBER Or HTTP_QUERY_STATUS_CODE, lStatus, &H4, ByVal 0&) Then
        CheckWetherExists = (lStatus = HTTP_STATUS_OK) Or (lStatus = HTTP_STATUS_REDIRECT)
    End If
 
Fail:
    Call InternetCloseHandle(hInet)
    Call InternetCloseHandle(hURL)
End Function

Yo lo hago mas guay :xD, aunque no se si mas rapido... :P

Atento al HTTP_STATUS_REDIRECT :)

Título: Re: Comprobar si una web existe [reto?]
Publicado por: Elemental Code en 6 Septiembre 2010, 23:03 pm

me temo a dejarlos como poco ideativos.

ping?

ping google.com

devuelve todo bien

ping www.yonoexistonidecasusalidad.com

no anda.

cuando tenga tiempo lo pongo mas "lindo" para uds.
Tengo examen parcial de ingles en 1 hora y no speak english >.<

Título: Re: Comprobar si una web existe [reto?]
Publicado por: bizco en 6 Septiembre 2010, 23:26 pm

un ping no serviria, entiendo que hay que verificar la existencia de un servidor http y algun index para determinar que es una web. que un dominio exista no quiere decir una web concretamente.

Foro de elhacker.net

Programación => Programación Visual Basic => Mensaje iniciado por: Psyke1 en 6 Septiembre 2010, 11:04 am