Universal URL check

Universal URL check

--------------------------------------------------------------------------------

Description : If you let users add URLs to your site (for example links to their site) you want to check them first to make sure the URL is working. This code will do the trick! From your page the URL is posted and the result (including the URL) is posted back to the refering page.

'**************************************
' Name: Universal URL check
' Description:If you let users add URL's
' to your site (for example links to their
' site) you want to check them first to ma
' ke sure the URL is working.
'This code will Do the trick!
'From your page the URL is posted and the result (including the URL) is posted back To the refering page.
'
' Inputs:The checkpage will need just on
' e input value from a form. This input sh
' ould be named 'url';
'<INPUT type="text" name="url">
'
' Returns:After the check is done, the r
' efering page is displayed again, but now
' the original url and the result is poste
' d to this page (use request.form to get
' their values).
'
' Assumes:There are 3 pages:
'check.asp To post the url and receive the result of the check.
'checkurl.asp this page will Do the check
'checkdone.asp; this page will post the results back To the referer.
'
' Side Effects:In order to make this scr
' ipt work you server should have IE 5+ in
' stalled.
'

'****** check.asp ****
'part 1: the post form
'*********************
<%
strFrom=Request.Form("result")
strResult=Request.Form("url")
%>
<HTML>
<HEAD>
<TITLE>URL check</TITLE>
</HEAD>
<BODY>
<FORM method="post" action="checkurl.asp">
<P><Input Type="text" name="url"></P>
<P><Input Type="submit" value="submit" name="submit"></P>
</FORM>
<P><%= strFrom %></P>
<P><%= strResult %></P>
</BODY>
</HTML>
'****** checkurl.asp ****
'part 2: the actual check
'************************
<%
strURL=Request.Form("url")
If strURL<>"" Then
If Left(LCase(strURL),7)<>"http://" Then
strURL="http://" & strURL
End If
On Error Resume Next
Dim objHTTP
Dim sHTML
Set objHTTP = Server.CreateObject ("Microsoft.XMLHTTP")
objHTTP.open "GET", strURL, False
objHTTP.send
sHTML=objHTTP.statusText
If err Or sHTML<>"OK" Then
sTxt="fail"
Else
sTxt="ok"
End If
Set objHTTP=Nothing
Else
sTxt="fail"
End If
strFrom=Request.ServerVariables("HTTP_REFERER")
p=InStr(1,strFrom,"?")
If p>0 Then
strFrom=Left(strFrom,p-1)
End If
Response.Redirect "checkdone.asp?result=" & sTxt & "&ref=" & strURL & "&return=" & strFrom
%>
'****** checkdone.asp ****
'part 3: post the results back to the re
' ferer
'************************
<%
strRes=Request.QueryString("result")
strRef=Request.QueryString("ref")
strRet=Request.QueryString("return")
%>
<HTML>
<HEAD>
</HEAD>
<SCRIPT>
Function postit(){
myform.submit();
}
</SCRIPT>
<BODY onLoad="postit()">
<FORM method="post" action="<%= strRet %>" name="myform">
<Input Type="hidden" name="result" value="<%= strRes %>">
<Input Type="hidden" name="url" value="<%= strRef %>">
</FORM>
</BODY>
</HTML>