% '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 %>
|
Drew's Parrot Head Page |
|
'SUMMERZCOOL' Tour Las Vegas 2009. Click Here.
![]() |
Orange County Parrot Head Club |
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 and a concert in Las Vegas in 2002. The story keeps on going ...
To learn more about Homebrewing or brewing your own beer visit my Homebrew Website at:
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