<% 'This ASP script originally lived at http://evolvedcode.net/ for the 'original version of this script and a wide variety of other 'scripts, please visit the site. ' 'Last update: 2003.04.27 13:52:46 Function SafeEMail( ByVal sInput ) 'Acts as a wrapper performing the simplified version of the tests SafeEMail = EMail_Protect( sInput, False ) End Function Function SafeEMailEx( ByVal sInput ) 'Acts as a wrapper performing the advanced version of the tests SafeEMailEx = EMail_Protect( sInput, True ) End Function Function EMail_Protect( ByVal sInput, ByVal bAdvCheck ) 'Code to modify an email address in such a way that it is still human readable, but not easily readable ' by a machine, hopefully capable of stopping or at least slowing spambots. Also performs a few checks ' on the user-agent to ensure that it is suitable Dim sUserAgent Const sEMail_Bad = "nospam@example.com" Const sEMail_Unsure = "filtered@example.com" bAdvCheck = CBool( bAdvCheck ) 'Do not output an address if they do not supply a user agent string or they supply ' one which is very heavily associated with home-made spam-bots sUserAgent = Trim( Request.ServerVariables("HTTP_USER_AGENT") ) If EmptyUA_Test( sUserAgent ) Then 'UA was blank sInput = "Non-Browser <" & sEMail_Bad & ">" ElseIf BadUA_Test( sUserAgent ) Then 'UA was in the list of bad crawlers sInput = "Non-Browser <" & sEMail_Bad & ">" ElseIf BrowserUA_Test( sUserAgent ) Then 'UA appears to belong to a browser of some description, to make sure this is not an ' attempt to use a fake UA we check the extended headers. If bAdvCheck And Not UA_Headers_Test() Then 'Extended headers check failed, potentially this is a bot using a fake UA to ' make it appear as a legitimate browser. Pass back an appropriate message. sInput = "Non-Browser <" & sEMail_Unsure & ">" End If ElseIf sEMail_Bad <> sEMail_Unsure Then 'UA is not obviously wrong but its not a browser either, since we have a filtered mailbox ' available to us lets use that. sInput = "Non-Browser <" & sEMail_Unsure & ">" Else 'UA is not obviously wrong but its not a browser either, since we have no filtered mailbox ' default to the bad mailbox. sInput = "Non-Browser <" & sEMail_Bad & ">" End If 'Additional manipulations should be installed here 'Return the sanitised e-mail address EMail_Protect = EMail_Armour( sInput ) End Function Function EMail_Armour( ByVal sInput ) 'Code to apply "armour" to an email address which makes it harder to ' detect than it normally would be 'Replace common characters - this alone stops less advanced spambots that just happen to be ' cloaking themselves with the user-agent from a real browser sInput = Replace(sInput, "@", "@") sInput = Replace(sInput, " ", " ") sInput = Replace(sInput, "<", "<") sInput = Replace(sInput, ">", ">") 'Strip any existing "mailto:" prefix and replace it with one far more likely ' to slow down a spambot If StrComp("mailto:", Left(sInput, 7), vbTextCompare) = 0 Then sInput = Right( sInput, Len( sInput ) - 7 ) End If sInput = "mailto:" & sInput EMail_Armour = sInput End Function Function TestRegExp( ByVal sInput, ByVal sRegExp ) 'Code to evaluate a regular expression Dim objRegular Set objRegular = New RegExp objRegular.Pattern = sRegExp objRegular.IgnoreCase = True TestRegExp = objRegular.Test( sInput ) Set objRegular = Nothing End Function Sub UA_Add( ByVal sNewUserAgent, ByRef sUserAgents ) 'Code to add an extra user-agent into a list suitable for ' parsing with a regular expression If sUserAgents = vbNullString Then sUserAgents = sNewUserAgent Else sUserAgents = sUserAgents & "|" & sNewUserAgent End If End Sub Function EmptyUA_Test( ByVal sUserAgent ) 'Code to check if a UA is an empty or v. small piece of text EmptyUA_Test = False sUserAgent = Trim( sUserAgent ) If sUserAgent = vbNullString Or Len( sUserAgent ) = 1 Then EmptyUA_Test = True End If End Function Function BadUA_Test( ByVal sUserAgent ) 'Code to check if UA appears to be in a list of badly behaved agents, e-mail harvesting ' robots, offline readers and other undesirable crawlers Dim sUserAgentList BadUA_Test = False 'Build up a list of spambots and other undesirable crawlers using a mix of ' both known bad crawlers and keyword matching to detect new crawlers and ' variations on a theme UA_Add "^Mozilla/\d\.\d\s\(compatible;\sAdvanced\sEmail\sExtractor\sv\d\.\d+\)$", sUserAgentList UA_Add "CherryPicker", sUserAgentList UA_Add "Crescent", sUserAgentList UA_Add "^DA\s\d\.\d+$", sUserAgentList UA_Add "^Mozilla/\d\.\d\s\(compatible;\sMSIE\s\d\.\d;\sWindows\sNT;\sDigExt;\sDTS\sAgent$", sUserAgentList UA_Add "EasyDL/\d\.\d+", sUserAgentList UA_Add "e-collector", sUserAgentList UA_Add "EmailCollector", sUserAgentList UA_Add "^EmailSiphon$", sUserAgentList UA_Add "EmailWolf", sUserAgentList UA_Add "ExtractorPro", sUserAgentList UA_Add "Go!Zilla", sUserAgentList UA_Add "GetRight/\d.\d", sUserAgentList UA_Add "^ia_archiver$", sUserAgentList UA_Add "Indy\sLibrary", sUserAgentList UA_Add "larbin", sUserAgentList UA_Add "MSIECrawler", sUserAgentList UA_Add "Microsoft\sURL\sControl", sUserAgentList UA_Add "NEWT\sActiveX", sUserAgentList UA_Add "NICErsPRO", sUserAgentList UA_Add "RealDownload/\d\.\d\.\d\.\d", sUserAgentList UA_Add "Teleport", sUserAgentList UA_Add "Telesoft", sUserAgentList UA_Add "UtilMind\sHTTPGet", sUserAgentList UA_Add "WebBandit", sUserAgentList UA_Add "webcollage/\d\.\d\d", sUserAgentList UA_Add "WebCopier\sv\d\.\d", sUserAgentList UA_Add "WebEMailExtrac", sUserAgentList UA_Add "WebZIP", sUserAgentList UA_Add "^WGet/\d\.\d", sUserAgentList UA_Add "WinHttp\.WinHttpRequest\.\d+", sUserAgentList UA_Add "Zeus\s*Webster", sUserAgentList UA_Add "^Mozilla/3\.Mozilla/2\.01\s\(Win95;\sI\)$", sUserAgentList UA_Add "^Internet\sExplorer\s?\d?\.?\d?$", sUserAgentList UA_Add "^IE\s\d\.\d\sCompatible.*Browser$", sUserAgentList UA_Add "^Microsoft\sInternet\sExplorer/4\.40\.426\s\(Windows\s95\)$", sUserAgentList UA_Add "^SurveyBot/\d\.\d\sWhois\sSource$", sUserAgentList UA_Add "^Mozilla/4\.0\s\(?hhjhj@yahoo\.com\)?$", sUserAgentList UA_Add "^MSIE", sUserAgentList UA_Add "^Mozilla$", sUserAgentList UA_Add "^Mozilla(\\|/)\?\?$", sUserAgentList UA_Add "^Internet\sExplore\s?\d?\.?[a-z0-9]+$", sUserAgentList UA_Add "^IAArchiver-\d\.\d$", sUserAgentList UA_Add "^NPBot-\d/\d\.\d$", sUserAgentList UA_Add "^Webclipping\.com$", sUserAgentList UA_Add "^Mozilla/\d\.\d\s\(X11;\sLinux\si686;\sen-US;\srv:\d.\d[a-z0-9]*;\sOBJR\)$", sUserAgentList UA_Add "^Sqworm/\d\.\d\.\d\d-BETA\s\(beta_release;\s\d{8}-\d{3};\si\d{3}-pc-linux-gnu\)$", sUserAgentList UA_Add "^Lickity_Split/\d\.\d$", sUserAgentList UA_Add "^Production\sBot\s\d+B$", sUserAgentList UA_Add "^amzn_assoc$", sUserAgentList UA_Add "^Harvest", sUserAgentList UA_Add "^Webdup/\d\.\d$", sUserAgentList UA_Add "^WebIndex/\d\.\d[a-z]$", sUserAgentList UA_Add "^NPBot-\d/\d\.\d\s\(http://www\.nameprotect\.com/botinfo\.html\)$", sUserAgentList UA_Add "(^|\s)RPT-HTTPClient/\d\.\d-\d$", sUserAgentList UA_Add "^sitecheck\.internetseer\.com\s\(For\smore\sinfo\ssee:\shttp://sitecheck\.internetseer\.com\)$", sUserAgentList UA_Add "^vspider$", sUserAgentList UA_Add "^k2spider$", sUserAgentList UA_Add "^Mac\sFinder\s", sUserAgentList UA_Add "^ICU\sv", sUserAgentList If sUserAgentList = vbNullString Then sUserAgentList = "^nulldata$" End If BadUA_Test = TestRegExp(sUserAgent, sUserAgentList) End Function Function UA_Headers_Test() 'Code to check for certain "questionable" referers which are known to be used ' by spambots. This is also the point where extra client-header checks need to be ' bolted on. Dim sReferList Dim sAccept, sAcceptLang Const csVia = "^1\.\d" UA_Headers_Test = True 'Construct a list of spambot referrers UA_Add "http://www\.iaea\.org", sReferList sAccept = Trim(Request.ServerVariables("HTTP_ACCEPT")) sAcceptLang = Trim(Request.ServerVariables("HTTP_ACCEPT_LANGUAGE")) 'Test request against out rules If sAccept = vbNullString Then 'Request includes either totally general accept details or no accept details UA_Headers_Test = False Else 'Check if accept is essentially blank default If sAccept = "*/*" And sAcceptLang = vbNullString Then 'Check if request may have been mangled by a proxy If Not UA_Proxy_Test() Then 'Request contains; '1) questionable accept header '2) questionable accept-language header '3) no sign of proxy pass-thru UA_Headers_Test = False End If ElseIf TestRegExp( Trim(Request.ServerVariables("HTTP_REFERER")), sReferList ) Then 'Request includes a referrer which is know to be used by spambots UA_Headers_Test = False ElseIf Request.ServerVariables("REQUEST_METHOD") <> "GET" And Request.ServerVariables("REQUEST_METHOD") <> "POST" Then 'Request type is something other than GET or POST which rules out the ' origin being most browsers UA_Headers_Test = False End If End If End Function Function UA_Proxy_Test() 'Code to check if a UA is routing through a proxy Dim sRawRequest Const csProxyHead = "\nforwarded:|\nx-forwarded-for:|\nclient-ip:|\nvia:" UA_Proxy_Test = False sRawRequest = LCase( Request.ServerVariables("ALL_RAW") ) If TestRegExp(sRawRequest, csProxyHead ) Then UA_Proxy_Test = True End If End Function Function BrowserUA_Test( ByVal sUserAgent ) 'Code to check if a UA appears to belong to browser in terms of structure Dim sUserAgentList BrowserUA_Test = False 'Build up a list of common/generic browser UAs UA_Add "^Mozilla/\d\.\d+$", sUserAgentList UA_Add "^Mozilla/\d\.0\s\(compatible\)$", sUserAgentList UA_Add "^Mozilla/\d\.\d+\s*.*\s*\(.+;.*\)\s*.*$", sUserAgentList UA_Add "^Opera/\d\.\d*\s\(.+;.*\)\s*.*$", sUserAgentList UA_Add "^Lynx/\d\.\d+", sUserAgentList UA_Add "Gecko/\d{8}$", sUserAgentList UA_Add "^.+/\d\.\d+\s\(.+;.*\)\s*.*$", sUserAgentList UA_Add "^Mozilla/\d\.\d+\s\[.+\]$", sUserAgentList UA_Add "^Dillo/\d\.\d\.\d$", sUserAgentList UA_Add "^WannaBe\s\(Macintosh;\s.+\)$", sUserAgentList UA_Add "\s\(Google\s(WAP|CHTML)\sProxy/\d\.\d\)$", sUserAgentList UA_Add "^w3m/\d\.\d\.\d+$", sUserAgentList If sUserAgentList = vbNullString Then sUserAgentList = "^nulldata$" End If BrowserUA_Test = TestRegExp( sUserAgent, sUserAgentList ) End Function %> Parrothead Page


Drew's Parrot Head Page

'A Salty Piece of Land' Tour Las Vegas 2005. Click Here.

Migration Irvine 2005. Click Here.

Club builds a playground. Click Here.

'A Salty Piece of Land' Tour Anaheim 2005. Click Here.

Puerto Vallarta 2005. Click Here.

'Tiki Time' Tour Las Vegas 2003. Click Here.

Migration Long Beach 2003. Click Here.

'Far Side Of The World' Las Vegas Tour 2002. Click Here.

OCPHC Logo

 Orange County Parrot Head Club

Jimmy Buffett Sheet Music

Jimmy Buffett Books

Jimmy Buffett Music CDs and Tapes

JB Links

JB Trivia

Concert Dates

Music Magazines

My brother turned me on to Jimmy Buffett back in 1976. I listened to "God's Own Drunk" a hundred times. The PHirst time I saw Jimmy was in the summer of 1978. He played in Greeenville, NC at East Carolina University. He, at the time, had a broken leg. The next time I saw Jimmy was at the Irvine Ampetheatre in 1996. I had tickets PHor his 1998 concert, but had to go out on a business trip and gave the tickets away. I joined the Orange County Parrothead Club in 2002. Went to several parties an a concert in Las Vegas in 2002.

 

To learn more about Homebrewing or brewing your own beer visit my Homebrew Website at:

Drew's Brew


Drew's Adventures


My Personal Linksinks

My Money Making Ventures

 

This Parrot Head Webring Site
is owned by
Drew.
Click for the
[Previous] [Random]
[Next 5] [Next Site]
Go here for information
.

 




Return to DREW'S Page