Enter the characters in the field below and click the submit button.
The Code
<% option explicit %>
<!--#include file="humanTestClass.asp"-->
<!--#include virtual="include/thisPageClass.asp"-->
<%
Randomize
Dim hr, HTMLout
Set hr = new clsHumanReader
hr.length = 6
hr.fieldName = "theEntry"
if hr.validate then
HTMLout = "<strong>Thank You. You appear to be human.</strong>"
else
HTMLout = hr.html
end if
set hr = nothing
%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<meta name="author" content="Roderick Divilbiss">
<meta name="copyright" content="? 2005 Roderick Divilbiss">
<title>Human Tester</title>
</head>
<body>
<strong>Prove You Are Human.</strong><br>Enter the characters in the field below and click the submit button.<br><br>
<%=HTMLout%>
<form name="frm" action="humanTest.asp" method="post">
<input type="text" name="theEntry" value="">
<input type="submit" name="submit" value="submit">
</form>
</body>
</html>
humanTestClass.asp <% ' ? Coyright 2000-2005, Roderick W. Divilbiss. Some rights reserved. ' This code is licensed under a Creative Commons License. ' No part of this code may be used for commercial purposes without ' prior written permission from the author, Roderick W. Divilbiss ' of Overland Park, Kansas, United States of America. ' http://www.rodsdot.com/ ' rod@rodsdot.com ' You are free to copy, distribute, display, and perform the work ' or to make derivative works under the conditions that you must give ' the original author credit and you may not use this work for ' commercial purposes. ' ' For any reuse or distribution, you must make clear to others ' the license terms of this work. Any of these conditions can be ' waived if you get permission from the copyright holder. ' class clsHumanReader Public length ' number of characters Public imagePath ' path to images Public fieldName ' form field name Private theChars Private theImages Private theTestString Public Function HTML session("humanReader") = Replace(theTestString,",","") Dim tmpStr Dim tmpArr Dim idx tmpArr = Split(theTestString,",") for idx = 0 to UBound(tmpArr) tmpStr = tmpStr & "<img src=" & chr(34) & imagePath & chr2img(tmpArr(idx)) & chr(34) & ">" next HTML = tmpStr End Function Private Function chr2img(chr) Dim idx For idx = 0 to 31 if theChars(idx)=UCase(chr) then chr2img = theImages(idx) exit for ' once it is found we are done end if Next End Function Public Function validate validate = false if UCase(request.form(fieldName)) = session("humanReader") and thisPage.isPost and thisPage.fromSelf then validate = true else Dim tmpVal, done theTestString = "" done = false do while not done tmpVal = Chr(Int((50 - 91) * Rnd + 91)) select case tmpVal case "0","O","1","I",":",";","<",">","@","?","=" tmpVal = "" case else theTestString = theTestString & tmpVal & "," end select if len(theTestString) > (length -1)*2 then done=true end if loop theTestString = Left(theTestString, len(theTestString)-1) end if end function Private Sub Class_Initialize length = 6 imagePath = "images/hr/" theChars = Split("2,3,4,5,6,7,8,9,A,B,C,D,E,F,G,H,J,K,L,M,N,P,Q,R,S,T,U,V,W,X,Y,Z",",") theImages = Split("FXQHCY.gif,JDRXNM.gif,SVRYUG.gif,BSYZYW.gif,ATDEPR.gif,NHWDTA.gif,OQNQZF.gif,RAIEIR.gif,XUCOZH.gif,STRPEC.gif,MHOUGF.gif,KPNYLO.gif,SVNDOZ.gif,UZIWAC.gif,PUTERO.gif,RUBPOM.gif,OFSBHK.gif,GAQBGF.gif,YJZQOZ.gif,OLOQHK.gif,GKDRGZ.gif,WDRMOG.gif,KXGGAN.gif,DTEEWD.gif,DJPRGL.gif,PUUJRJ.gif,RJFRUM.gif,HWHSDB.gif,ZALMHW.gif,VFFTOU.gif,GRXUAP.gif,USDOEH.gif",",") End Sub end class %>
thisPageClass.asp <SCRIPT RUNAT="Server" Language="VBScript"> Dim thisPageClassVersion thisPageClassVersion = "2.0 02-20-2005 14:30:00 PM" ' ? Coyright 2000-2005, Roderick W. Divilbiss. Some rights reserved. ' This code is licensed under a Creative Commons License. ' No part of this code may be used for commercial purposes without ' prior written permission from the author, Roderick W. Divilbiss ' of Overland Park, Kansas, United States of America. ' http://www.rodsdot.com/ ' rod@rodsdot.com ' You are free to copy, distribute, display, and perform the work ' or to make derivative works under the conditions that you must give ' the original author credit and you may not use this work for ' commercial purposes. ' ' For any reuse or distribution, you must make clear to others ' the license terms of this work. Any of these conditions can be ' waived if you get permission from the copyright holder. class clsPage ' Public forbidden sub see below Public forbiddenRedirect Public forbiddenRedirectPath Public fromSelf Public fromServer Public hostEmail Public hostName Public isGet Public isPost Public localAddress 'Public makeSecure - sub below Public method Public name Public path Public queryString Public referer Public remoteAddress Public scriptName Public secureServerName Public self Public serverName Public ssl Public version Private Sub Class_Initialize() forbiddenRedirect = true forbiddenRedirectPath = "http://" & serverName & "/" & "forbidden.asp" ' fromSelf depends on referer, see below ' fromServer depends on referer, see below hostName = LCase(Trim(request.servervariables("HTTP_HOST"))) ' This will not work for domain.anotherdomain.host.tld or IP addresses hostEmail = "webmaster@" & Replace(hostName, "www.", "") 'isGet depends on method, see below 'isPost depends on method, see below localAddress = LCase(Trim(request.servervariables("LOCAL_ADDR"))) method = LCase(Trim(request.servervariables("REQUEST_METHOD"))) if method = "get" then isGet = true isPost = false elseif method = "post" then isGet = false isPost = true else isGet = false isPost = false end if ' name depends on scriptName, see below path = request.servervariables("PATH_TRANSLATED") queryString = request.querystring referer = LCase(Trim(request.servervariables("HTTP_REFERER"))) if InStrRev(referer, "?") > 0 then referer = Trim(Mid(referer, 1, InStrRev(referer, "?")-1)) end if remoteAddress = LCase(Trim(request.servervariables("REMOTE_ADDR"))) scriptName = LCase(Trim(request.servervariables("SCRIPT_NAME"))) ' ************************** ' begin scriptName dependent ' ************************** name = Trim(Mid(scriptName, InStrRev(scriptName, "/")+1)) ' ************************** ' end scriptName dependent ' ************************** ' self dependent on serverName, scriptName and SSL, see below serverName = LCase(Trim(request.servervariables("SERVER_NAME"))) ' ************************** ' begin serverName dependent ' ************************** on error resume next ' A page may define secureCertificateServerName outside (before) ' this page is included. So, secureCertificateServerName may or ' may not exist, and we will get a variable undefined error. if secureCertificateServerName & "x" = "x" then if err then secureServerName = serverName end if secureServerName = secureCertificateServerName else secureServerName = serverName end if on error goto 0 ' ************************** ' end servernName dependent ' ************************** ' SSL & Self if request.servervariables("SERVER_PORT_SECURE") = 1 then ssl = true self = "https://" & secureServerName & scriptName else ssl = false self = "http://" & serverName & scriptName end if ' ************************** ' begin referer dependent ' ************************** if referer = self then fromSelf = true else fromSelf = false end if if InStr(serverName, referer) < 1 then fromServer = false else fromServer = true end if ' ************************** ' end referer dependent ' ************************** version = thisPageClassVersion End Sub Public Sub enumerate Response.write "PAGE CLASS ENUMERATE<BR><BR>" Response.write "Page.version: " & version & "<BR>" & vbLF Response.write "Page.forbiddenRedirect: " & forbiddenRedirect & "<BR>" & vbLF Response.write "Page.forbiddenRedirectPath: " & forbiddenRedirectPath & "<BR>" & vbLF Response.write "Page.fromSelf: " & fromSelf & "<BR>" & vbLF Response.write "Page.fromServer: " & fromServer & "<BR>" & vbLF Response.write "Page.hostEmail: " & hostEmail & "<BR>" & vbLF Response.write "Page.hostName: " & hostName & "<BR>" & vbLF Response.write "Page.isGet: " & isGet & "<BR>" & vbLF Response.write "Page.isPost: " & isPost & "<BR>" & vbLF Response.write "Page.localAddress: " & localAddress & "<BR>" & vbLF Response.write "Page.method: " & method & "<BR>" & vbLF Response.write "Page.name: " & name & "<BR>" & vbLF Response.write "Page.path: " & path & "<BR>" & vbLF Response.write "Page.queryString: " & queryString & "<BR>" & vbLF Response.write "Page.referer: " & referer & "<BR>" & vbLF Response.write "Page.remoteAddress: " & remoteAddress & "<BR>" & vbLF Response.write "Page.scriptName: " & scriptName & "<BR>" & vbLF Response.write "Page.secureServerName: " & secureServerName & "<BR>" & vbLF Response.write "Page.self: " & self & "<BR>" & vbLF Response.write "Page.serverName: " & serverName & "<BR>" & vbLF Response.write "Page.ssl: " & ssl & "<BR>" & vbLF End Sub Public Sub forbidden if forbiddenRedirectPath & "x" <> "x" then response.redirect(forbiddenRedirectPath) else response.write("Problem: "& forbiddenRedirectPath & "<br>") end if End Sub Public Sub makeSecure response.redirect("https://" & secureServerName & scriptName & "?" & queryString) End Sub End Class </script> <% Dim thisPage Set thisPage = new clsPage ' -------------------------- End Class ----------------------- %>
