Home Page

A Smarter 404 page not found solution using ASP!

This is great way to retain users when they follow dead links or to help search engines find pages that have change URLS. This script will attempt to find pages that are either the exact match or close to what the user was looking for when they encountered the page not found. The script uses a "difference distant" type algo to compute how close a page is to what the user type in or followed in a hyper link.

Copy and paste the code below making the needed changes to:

strFilesTypesToSearch - What file extensions you want this script to look at.
strBarredFolders -What folders are off limits, not to be included in the results
strBarredFiles - What files are off limits, not to be included in the results

Save the file as 404.asp in the root of your web.

<%
Response.Status="404 Page Not Found"
%>
<HTML>
<HEAD>
<TITLE>404 Page Not Found</title>
<META http-equiv="Content-Type" content="text/html; charset=windows-1252">
<META NAME="description" content="Smart Page Not Found">
<META NAME="abstract" content="Smart Page Not Found, will attempt to findthe page you are looking for.">
<META NAME="SECURITY" content="public">
<META NAME="robots" content="index, follow">
<META http-equiv="Content-Language" content="en-us">
</HEAD>
<table border="1" cellpadding="2" cellspacing="0" style="border-collapse: collapse" bordercolor="#111111" width="100%" id="AutoNumber1">
<tr>
<td width="100%">That page was not found.</td>
</tr>
<tr>
<td width="100%">
Sorry, but that page was not found.
<table border="0" width="100%" cellpadding=10>
<tr>
<td>
<% 
strFilesTypesToSearch = "htm,html,asp,shtml" 
strBarredFolders = "cgi_bin,_bin,admin,_fpclass,_private,_vti_cnf,_vti_log,_vti_pvt,_vti_script,_vti_txt,fpdb,images" 
strBarredFiles = "adminstation.htm,no_allowed.asp" 
blnEnglishLanguage = True 'True = HTML Encode best for English sites \ False = no Emcoding best for non English sites
siteurl = Request.ServerVariables("SERVER_NAME") 'get the domain name

'Create the file system object
Set fsoObject = Server.CreateObject("Scripting.FileSystemObject")

'Get the path and the root folder to be searched
Set fldObject = fsoObject.GetFolder(Server.MapPath("./"))
	
'Read in the server path to this ASP script
strServerPath = fldObject.Path & "\"

strSearch = trim(replace(request.servervariables("query_string"),"404;",""))

if len(strSearch) = instrrev(strSearch, "/") then 'hack of the trailing slash
strSearch = left(strSearch, len(strSearch)-1)
end if

strSearch = mid(strSearch, instrrev(strSearch, "/")+1)

if instr(strSearch, ".")<> 0 then
strSearch = left(strSearch, instr(strSearch, ".")-1) 
end if

OutPut = SearchFileNames(strSearch)
OutPut = replace(replace(OutPut, "%=Sitetitle%", ""), "<>", Sitetitle)

if OutPut <> "" then
response.write("We did not find the page you are looking for however, we did find these similiar pages:<hr>" & OutPut)
end if

Set fsoObject = Nothing
Set fldObject = Nothing

function SearchFileNames(strSearch)

'check the root directory first
OutPut = OutPut & SearchFile(fldObject, strSearch)

'Loop to search through the sub folders within the site
For Each subFldObject In FldObject.SubFolders										
'Check to make sure the folder about to be searched is not a barred folder if it is then don't search
If NOT InStr(1, strBarredFolders, subFldObject.Name, vbTextCompare) > 0 Then		
		
'check th sub folder name to see if it matches
subfoldername = subFldObject.Name						
		
if LD(subfoldername, strSearch) <= 1 then
url = "http://" & siteurl &"/"& subfoldername			
output = output & "<a href="""&URL&""">"&URL&"</a><br>"					
end if
		
'Call the search sub prcedure to search the rest of the web site		
output = output & SearchFile(subFldObject, strSearch)
End If
Next

SearchFileNames = OutPut
end function

Function SearchFile(fldObject, strSearch)

'Loop to search each file in the folder
For Each filObject in fldObject.Files
		
If NOT InStr(1, strBarredFiles, filObject.Name, vbTextCompare) > 0 Then	
				
If InStr(1, strFilesTypesToSearch, fsoObject.GetExtensionName(filObject.Name), vbTextCompare) > 0 Then
	 		
If NOT InStr(1, strBarredFiles, filObject.Name, vbTextCompare) > 0 Then		  	
	 				
'strip of the ext to see if we find a file name match
filename = filObject.Name
filename = replace(filObject.Name, fsoObject.GetExtensionName(filObject.Name), "")
filename = replace(filename, ".", "")
	 				
'Open the file 					
Set tsObject = filObject.OpenAsTextStream
			
if NOT tsObject.AtEndofStream then
						
'Read in the contents of the file
strFileContents = tsObject.ReadAll		
		
'Read in the title of the file
strPageTitle = GetFileMetaTag("<title>", "</title>", strFileContents)
						
'Read in the description meta tag of the file
strPageDescription = GetFileMetaTag("<meta name=""description"" content=""", """>", strFileContents)
			 	
'Read in the keywords of the file
strPageKeywords = GetFileMetaTag("<meta name=""keywords"" content=""", """>", strFileContents)
			 			
'Get the server path to the file
strFileURL = fldObject.Path & "\"
			
'Turn the server path to the file into a URL path to the file
strFileURL = Replace(strFileURL, strServerPath, "")
				
'Replace the NT backslash with the internet forward slash in the URL to the file
strFileURL = Replace(strFileURL, "\", "/")
			
'Encode the file name and path into the URL code method
strFileURL = Server.URLEncode(strFileURL)
			
'Just incase it's encoded any backslashes
strFileURL = Replace(strFileURL, "%2F", "/")
						
if LD(filename, strSearch) <= 1 then
url = "http://" & siteurl &"/"& strFileURL & filObject.Name
if trim(strPageTitle) <> "" then
output = output & "<a href="""&URL&""">"&strPageTitle&"</a><br>"
else
output = output & "<a href="""&URL&""">"&URL&"</a><br>"
end if
end if
			 			
end if
				
end if			
	 	
end if
			
end if
next

SearchFile = output
end function

'Reset server variables
Set filObject = Nothing
Set tsObject = Nothing
Set subFldObject = Nothing

'Function to read in the files meta tags
Private Function GetFileMetaTag(ByRef strStartValue, ByRef strEndValue, ByVal strFileContents)

'Dimension Variables
Dim intStartPositionInFile	'Holds the start position in the file
Dim intEndPositionInFile	'Holds the end position in the file
	
	
'Get the start position in the file of the meta tag
intStartPositionInFile = InStr(1, LCase(strFileContents), strStartValue, 1)
	
	
'If no description or keywords are found then you may be using http-equiv= instead of name= in your meta tags
If intStartPositionInFile = 0 And InStr(strStartValue, "name=") Then
		
'Swap name= for http-equiv= 
strStartValue = Replace(strStartValue, "name=", "http-equiv=")
		
'Check again for keywords or description
intStartPositionInFile = InStr(1, LCase(strFileContents), strStartValue, 1)		
End If
	
				    	
'If there is a description then the position in file will be over 0
If NOT intStartPositionInFile = 0 Then
					
'Get the end position of the HTML meta tag
intStartPositionInFile = intStartPositionInFile + Len(strStartValue)
						
'Get the position in file of the closing tag for the meta tag
intEndPositionInFile = InStr(intStartPositionInFile, LCase(strFileContents), strEndValue, 1)
	
'Read in the meta tag from the file for the function to return
GetFileMetaTag = Trim(Mid(strFileContents, intStartPositionInFile, (intEndPositionInFile - intStartPositionInFile)))
					
'If the is no meta tag then the GetFileMetaTag function returns a null value
Else
GetFileMetaTag = ""
		       		
End If

End Function

Private Function Minimum(a,b,c)
mi = a
If b < mi Then
mi = b
End If
If c < mi Then
mi = c
End If
Minimum = mi
End Function

'********************************
'*** Compute Levenshtein Distance
'********************************

Public Function LD(s, t)

' Step 1
  
n = Len(s)
m = Len(t)
If n = 0 Then
LD = m
Exit Function
End If 
If m = 0 Then
LD = n
Exit Function
End If 
ReDim d(n,m) 
  
' Step 2
  
   
For i = 0 To n
'd(i, 0) = i
Next 
  
For j = 0 To m
'd(0, j) = j
Next

' Step 3

For i = 1 To n
    
s_i = Mid(s, i, 1)
    
' Step 4
    
For j = 1 To m
      
t_j = Mid(t, j, 1)
      
' Step 5
      
If s_i = t_j Then
cost = 0
Else
cost = 1
End If
      
' Step 6
      
d(i, j) = Minimum(d(i - 1, j) + 1, d(i, j - 1) + 1, d(i - 1, j - 1) + cost)
    
Next
    
Next
  
' Step 7
  
LD = d(n, m)
Erase d

End Function
%>
</td>
</tr>
</table>
</td>
</tr>
</table>
</body>
</html>

You have 3 options to make this script run when the 404 error is detected.

Now you can either set your 404 error page via your hosts control panel if you have access to it.
Request the host to make this page your 404 error page
Make the changes IIS f you have access:

Note, if you get a permission denied error then one of your folders is set to not allow access, just add it to the strBarredFolders variable at the top of this script.