Test Foro de elhacker.net SMF 2.1

Para comprobar si una web existe hago esto:


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:
Private Sub Form_Load()
   MsgBox Check_Web_Exists("www.google.es")
   MsgBox Check_Web_Exists("www.eljuaker.net")
End Sub

Devuelve:

CitarVerdadero
Falso

Alguien lo sabe hacer más rapido?¿

DoEvents¡! :P

'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)"
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 :)

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

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.