Foro de elhacker.net

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

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

'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