<% '============================================================ ' MODULE: Captcha.asp ' AUTHOR: © www.u229.no ' CREATED: July 2005 ' HOME PAGE: http://www.u229.no/stuff/Captcha/ ' LICENSE: http://www.u229.no/stuff/license/ '============================================================ ' COMMENT: This is a CAPTCHA made with Classic ASP, some CSS and some javascript. ' You may want to move the user checking to other parts of your own code. See ' info somewhere near line 150. ' Save this file as Captcha.asp '============================================================ ' TODO: ' 1) Include numbers? ' 2) If above = True Then: Add more human questions like doing some basic math on the numbers? ' 3) Limit the number of log in attemps based on the visitors IP Number? ' 4) The yellow color might be hard to read. It could have been gray instead. '============================================================ ' ROUTINES: ' - Function CreateCAPTCHA() ' - Sub InitArrays() ' - Sub CreateStyleSheet() ' - Sub CreateJavascript() ' - Function RandomizeArrayUnique(arr, arrNew) ' - Function RandomizeArray(arr, arrNew) ' - Function RandomNumber(iMax) ' - Function RandomString(iMax) '============================================================ 'Option Explicit On Error Resume Next Response.CacheControl = "no-cache" Response.AddHeader "Pragma", "no-cache" Response.Expires = -1 '// YOUR PREFERENCES Const MAX_NUMBER_OF_CHARACTERS = 3 '// How many characters in our CAPTCHA? Const MAX_LENGTH_CSS_CLASSES = 12 '// How many characters in the CSS class names? Const CAPTCHA_CHARACTER_FACTOR = 40 '// How many pixels are we moving each new character from left? Const CAPTCHA_BOX_BORDER = "border: 2px solid #ccc;" '// Style the div box holding the CAPTCHA. Const CAPTCHA_BOX_WIDTH = 160 '// Width. This value should balance the number of characters and size. Const CAPTCHA_BOX_HEIGHT = 80 '// Same as above. Const NAME_OF_CAPTCHA_TEXTBOX = "DACSCaptchaBox" '// Name of CAPTCHA text box. Rename this!! Dim m_arrCaptcha() '// Array holding our CAPTCHA charaters. Hold in session variable. Dim m_arrCaptchaScreen() '// Parallell array where some items migth be hex/decimal encoded for display on screen. Dim m_sCSS '// Our CSS Dim m_sJavascript '// Our Javascript Dim m_sUserResult '// Return a response to client/demo if success or failure Dim m_sNameOfWrapperDiv '// Holding the id name attribute for the div wrapping the CAPTCHA? Dim m_arrColor(4) '// Array of colors for the characters Dim m_arrColorNew(4) '// Same colors randomized Dim m_arrFontFamily(4) '// Array of font family strings Dim m_arrFontFamilyNew(4) '// Same fonts randomized Dim m_arrFontSize(4) '// Array of font sizes Dim m_arrFontSizeNew(4) '// Same font sizes now randomized Dim m_arrTopPosition(4) '// Array of top position values Dim m_arrTopPositionNew(4) '// Same values randomized Dim m_arrClassNames() '// Array of names for the CSS classes Dim m_arrQuestions(3) '// Array of questions for the human visitor Dim m_lngQuestionIndex '// This number between 0 - 3 defines what question to ask the human visitor Dim m_arrCaptchaColor(2) '// Array holding the color of the character we are asking the visitor for Dim m_arrCSSStrings(4) '// Array holding our CSS elements/strings Dim m_arrCSSStringsNew(4) '// Same strings now randomly and uniquely sorted '// START UP THE MODULE ARRAYS m_arrColor(0) = "green" m_arrColor(1) = "blue" m_arrColor(2) = "red" m_arrColor(3) = "black" m_arrColor(4) = "yellow" m_arrFontFamily(0) = "Verdana" m_arrFontFamily(1) = "Arial" m_arrFontFamily(2) = "Tahoma" m_arrFontFamily(3) = "Courier" m_arrFontFamily(4) = "Georgia" m_arrFontSize(0) = 24 m_arrFontSize(1) = 50 m_arrFontSize(2) = 60 m_arrFontSize(3) = 40 m_arrFontSize(4) = 70 m_arrTopPosition(0) = 5 m_arrTopPosition(1) = 10 m_arrTopPosition(2) = 15 m_arrTopPosition(3) = 5 m_arrTopPosition(4) = 10 m_arrQuestions(0) = "Before submitting this form, please type the characters displayed above:" m_arrQuestions(1) = "Before submitting this form, please type the color of the first character:" m_arrQuestions(2) = "Before submitting this form, please type the color of the second character:" m_arrQuestions(3) = "Before submitting this form, please type the color of the third character:" m_arrCSSStrings(0) = "position: absolute;" m_arrCSSStrings(1) = "top: " m_arrCSSStrings(2) = "left: " m_arrCSSStrings(3) = "color: " m_arrCSSStrings(4) = "font: bold " '------------------------------------------------------------------------------------------------------------ ' Comment: Call this function from where you want to include the CAPTCHA. '------------------------------------------------------------------------------------------------------------ Function CreateCAPTCHA() On Error Resume Next Dim i, iTmp, sTmp '---------------------------- Create our CAPTCHA! '// This holds plain text characters. They are stored in a session variable and compared with the user input. ReDim m_arrCaptcha(MAX_NUMBER_OF_CHARACTERS - 1) '// This holds the decimal and hexified characters displayed on screen. ReDim m_arrCaptchaScreen(MAX_NUMBER_OF_CHARACTERS - 1) For i = 0 To (MAX_NUMBER_OF_CHARACTERS - 1) sTmp = UCase(RandomString(1)) iTmp = RandomNumber(101) m_arrCaptcha(i) = sTmp If iTmp < 33 Then m_arrCaptchaScreen(i) = "&#" & Asc(UCase(sTmp)) & ";" '// Decimal If iTmp > 66 Then m_arrCaptchaScreen(i) = "&#x" & Hex(Asc(UCase(sTmp))) & ";" '// Hexify If iTmp < 67 And iTmp > 32 Then m_arrCaptchaScreen(i) = UCase(sTmp) '// Plain Ascii Next '---------------------------- What question will we ask the human visitor? m_lngQuestionIndex = RandomNumber(MAX_NUMBER_OF_CHARACTERS + 1) '// Default max number of questions is 4 If m_lngQuestionIndex > 4 Then m_lngQuestionIndex = RandomNumber(4) '---------------------------- Create CSS and javascript Call CreateStyleSheet Call CreateJavascript '---------------------------- Check to see if someone submitted CAPTCHA, machine or human '// You may want to move this code to another part of your own application and do the testing there. If Len(Request.Form(NAME_OF_CAPTCHA_TEXTBOX)) > 0 Then If UCase(Request.Form(NAME_OF_CAPTCHA_TEXTBOX)) = UCase(Session("CAPTCHA")) Then m_sUserResult = "You typed " & Request.Form(NAME_OF_CAPTCHA_TEXTBOX) & " which was correct!" Server.Transfer("/HDWForm2Mail/Form2Mail.asp") Else m_sUserResult = "You typed " & Request.Form(NAME_OF_CAPTCHA_TEXTBOX) & " which was wrong!" & _ "
(Support for cookies must be enabled in your web browser.)" Server.Transfer("/feedback/nogo.asp") End If End If '// Nothing was submitted, so just set a new session value which is our CAPTCHA characters or a color Session("CAPTCHA") = Replace(Join(m_arrCaptcha), " ", "") '// We will ask visitor for a color! Reduce m_lngQuestionIndex by 1 to match the m_arrCaptchaColor array If (m_lngQuestionIndex > 0) Then Session("CAPTCHA") = m_arrCaptchaColor(m_lngQuestionIndex - 1) '---------------------------- Return the html CreateCAPTCHA = m_sCSS & m_sJavascript End Function '------------------------------------------------------------------------------------------------------------ ' Comment: Randomize our module arrays holding the CSS values. '------------------------------------------------------------------------------------------------------------ Sub InitArrays() On Error Resume Next '// First 4 arrays are randomly sorted meaning that all characters might have the same color. Call RandomizeArray(m_arrColor, m_arrColorNew) Call RandomizeArray(m_arrFontFamily, m_arrFontFamilyNew) Call RandomizeArray(m_arrFontSize, m_arrFontSizeNew) Call RandomizeArray(m_arrTopPosition, m_arrTopPositionNew) Call RandomizeArrayUnique(m_arrCSSStrings, m_arrCSSStringsNew) End Sub '------------------------------------------------------------------------------------------------------------ ' Comment: Build the CSS. '------------------------------------------------------------------------------------------------------------ Sub CreateStyleSheet() On Error Resume Next Dim sCSS, i, l, iLeft, sTmp, sTmpClassName '---------------------------- Create the CSS for the div box '// First create a random name for the wrapper div. m_sNameOfWrapperDiv = RandomString(MAX_LENGTH_CSS_CLASSES) sCSS = "" End Sub '------------------------------------------------------------------------------------------------------------ ' Comment: Create the javascript with our unique css class names and the CAPTCHA characters. '------------------------------------------------------------------------------------------------------------ Sub CreateJavascript() On Error Resume Next Dim i, sJScript sJScript = "" & vbCrLf sJScript = sJScript & "

" & m_arrQuestions(m_lngQuestionIndex) & "

" & vbCrLf m_sJavascript = sJScript End Sub '------------------------------------------------------------------------------------------------------------ ' Comment: Randomize array but make sure all values are present in the new array. '------------------------------------------------------------------------------------------------------------ Function RandomizeArrayUnique(arr, arrNew) On Error Resume Next Dim i, l, sBuf, sTmp, iMax iMax = UBound(arr) ReDim arrNew(iMax) For i = 0 To iMax '// This should be enough looping For l = 1 To (iMax * 20) sTmp = arr(RandomNumber(iMax + 1)) If InStr(sBuf, sTmp) = 0 Then sBuf = (sBuf & sTmp) arrNew(i) = sTmp Exit For End If Next Next End Function '------------------------------------------------------------------------------------------------------------ ' Comment: Randomize our module arrays holding the CSS. One value might appear several times. '------------------------------------------------------------------------------------------------------------ Function RandomizeArray(arr, arrNew) On Error Resume Next Dim i ReDim arrNew(UBound(arr)) For i = LBound(arr) To UBound(arr) arrNew(i) = arr(RandomNumber(UBound(arr) + 1)) Next End Function '------------------------------------------------------------------------------------------------------------ ' Comment: Return a random number not bigger than the input parameter. '------------------------------------------------------------------------------------------------------------ Function RandomNumber(iMax) On Error Resume Next Randomize RandomNumber = Int(iMax * Rnd) End Function '------------------------------------------------------------------------------------------------------------ ' Comment: Create a random string of lower case letters [a-z] for the css class names. '------------------------------------------------------------------------------------------------------------ Function RandomString(iMax) On Error Resume Next Dim i, sTmp For i = 1 To iMax sTmp = sTmp & Chr(97 + RandomNumber(26)) '// Return a random number between 97 and 122, ascii values for [a-z] Next RandomString = sTmp End Function '============================================================ END OF ASP CODE %>

DACS welcomes your feedback and suggestions

A note from the DACS Board:

We would love to hear from you!
DACS is available to help our community of members, and in order to give us the information to better serve YOU, take a moment to send us your suggestions.

Name
Email
Your message to DACS:

Feel free to send us any ideas you have to improve the DACS organization. We want to hear what our members have to say!
Have you, or do you attend any of the DACS SIG meetings?:
ASP.net Digital Imaging Drupal
Linux Mac Open Source
PC Maintenance Server Network
Tech Projects Virtual Computing
Web Design Windows
Do you read the
DACS.doc newsletter:		 The print version
Online
Which newsletter articles do
you find most interesting:
Would you like to moderate
a SIG and if so, on what topic:
Do you have a
General Meeting topic suggestion:
i.e.: What subject would interest you?
Do you know anyone who'd
like to present a topic of interest to the DACS members:


Name of person:

Email of person:
I am a DACS member:



<%Response.Write CreateCAPTCHA%>
 

Thank you for your feedback.

Your privacy is important to us, please be assured the information submitted will be kept confidential, and we will never sell or distribute your email address to any third party. The information collected is only used to suggest improvements to the DACS organization and/or our website content.