Checks if URL is actually working.
Uses XMLHTTP object to see if that URL returns valid page or if it is invalid.
Found the core in an old abandoned code
' By: Kees Nobel
Function TestURL(strURL)
' Test if URL actually does have a page and it is working
' Returns 0 or 1
' 0 means no or fail
' 1 means pass
sTxt = 0 ' "fail"
if strURL < > "" Then
if left(lcase(strURL),7) < > "http://" Then
strURL = "http://" & strURL
End if
On Error Resume Next
Dim objHTTP, sHTML
Set objHTTP = Server.CreateObject ("Microsoft.XMLHTTP")
objHTTP.open "GET", strURL, False
objHTTP.send
sHTML = objHTTP.statusText
if err or sHTML < > "OK" Then
else
sTxt = 1 ' "ok"
End if
Set objHTTP = nothing
else
End if
TestURL = sTxt
End Function
' Test if URL actually does have a page and it is working
' Returns 0 or 1
' 0 means no or fail
' 1 means pass
sTxt = 0 ' "fail"
if strURL < > "" Then
if left(lcase(strURL),7) < > "http://" Then
strURL = "http://" & strURL
End if
On Error Resume Next
Dim objHTTP, sHTML
Set objHTTP = Server.CreateObject ("Microsoft.XMLHTTP")
objHTTP.open "GET", strURL, False
objHTTP.send
sHTML = objHTTP.statusText
if err or sHTML < > "OK" Then
else
sTxt = 1 ' "ok"
End if
Set objHTTP = nothing
else
End if
TestURL = sTxt
End Function
strURL
Views 3,353
Downloads 1,101
CodeID
DB ID
ANmarAmdeen
610
Revisions
v2.0
Sunday
December
9
2018