<%
'============================================================
' 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?
'============================================================
' ROUTINES:
' - Function CreateCAPTCHA()
' - Sub InitArrays()
' - Sub CreateStyleSheet()
' - Sub CreateJavascript()
' - Function RandomizeArrayUnique(arr, arrNew)
' - Function RandomizeArray(arr, arrNew)
' - Function RandomizeArray2(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 = 6 '// How many characters in our CAPTCHA?
Const NUMBER_OF_EXISTING_QUESTION_TYPES = 3 '// How many types of questions in our CAPTCHA?
Const MAX_LENGTH_CSS_CLASSES = 12 '// How many characters in the CSS class names?
Const CAPTCHA_CHARACTER_FACTOR = 10 '// How many pixels are we moving each new character from left?
Const CAPTCHA_BOX_BORDER = "border: 1px dashed #ccc;" '// Style the div box holding the CAPTCHA.
Const CAPTCHA_BOX_WIDTH = 80 '// Width. This value should balance the number of characters and size.
Const CAPTCHA_BOX_HEIGHT = 35 '// Same as above.
Const NAME_OF_CAPTCHA_TEXTBOX = "P_chavevisual" '// Name of CAPTCHA text box. Rename this!!
Dim m_arrCaptcha() '// Array holding our CAPTCHA characters. 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_sChar1
'// Holds random character 1
Dim m_sChar2
'// Holds random character 2
Dim m_nChar1Index
'// Holds random character 1 index
Dim m_nChar2Index
'// Holds random character 2 index
Dim m_sAux
'// Holds auxiliary strings
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_arrQuestionTypes(2)
'// Array of types of questions
Dim m_lngQuestionTypesIndex '// This number defines what type question to ask the human visitor
Dim m_lngQuestionIndex '// This number defines what question to ask the human visitor within the selected type
Dim m_arrCaptchaColor(5) '// 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
' This array has been altered and is now an array of arrays (nested array?)
' This allows us to have a color to apply in CSS and a correspondent one to use in session variables (for non-english users)
m_arrColor(0) = array("green","verde")
m_arrColor(1) = array("blue","azul")
m_arrColor(2) = array("red","vermelho")
m_arrColor(3) = array("black","preto")
m_arrColor(4) = array("orange","laranja")
m_arrFontFamily(0) = "Verdana"
m_arrFontFamily(1) = "Arial"
m_arrFontFamily(2) = "Tahoma"
m_arrFontFamily(3) = "Courier"
m_arrFontFamily(4) = "Georgia"
m_arrFontSize(0) = 10
m_arrFontSize(1) = 12
m_arrFontSize(2) = 15
m_arrFontSize(3) = 10
m_arrFontSize(4) = 17
m_arrTopPosition(0) = 5
m_arrTopPosition(1) = 10
m_arrTopPosition(2) = 15
m_arrTopPosition(3) = 5
m_arrTopPosition(4) = 10
' This new array separates questions in types so we know what functions/procedures should
' be applied to each of the available questions
' This allow for some new types of human questions, hopefully increasing even more the scripts BOT unfriendliness :-)
'
' Type 0 will ask the user to write down all the characters shown
m_arrQuestionTypes(0) = Array("Indique todos os caracteres apresentados:")
' Type 1 will ask the user to write down a (randomly selected) character's color
' The number of questions must match MAX_NUMBER_OF_CHARACTERS
m_arrQuestionTypes(1) = Array("Indique a côr do primeiro caracter:","Indique a côr do segundo caracter:","Indique a côr do terceiro caracter:","Indique a côr do quarto caracter:","Indique a côr do quinto caracter:","Indique a côr do sexto caracter:")
' Type 2 will ask the user to write down 2 (randomly selected) characters
m_arrQuestionTypes(2) = Array("Indique os caracteres nas posições")
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 type of question will we ask the human visitor ?
m_lngQuestionTypesIndex = RandomNumber(NUMBER_OF_EXISTING_QUESTION_TYPES)
'---------------------------- Within the selected type, what question will we ask the human visitor ?
m_lngQuestionIndex = RandomNumber( Ubound(m_arrQuestionTypes(m_lngQuestionTypesIndex))+1 )
'---------------------------- 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!"
' Else
' m_sUserResult = "You typed " & Request.Form(NAME_OF_CAPTCHA_TEXTBOX) & " which was wrong!" & _
' "<br />(Support for cookies must be enabled in your web browser.)"
' End If
'End If
'---------------------------- Create CSS
Call CreateStyleSheet
'// Depending on the type of question, do the appropriate thing...
select case m_lngQuestionTypesIndex
case 0
' asks for all characters
Session("CAPTCHA") = Replace(Join(m_arrCaptcha), " ", "")
case 1
' asks for a character's color
Session("CAPTCHA") = m_arrCaptchaColor(m_lngQuestionIndex)(1)
case 2
' asks for 2 random characters
m_nChar1Index = RandomNumber( Ubound(m_arrCaptcha)+1 )
m_sChar1 = m_arrCaptcha(m_nChar1Index)
m_nChar2Index = RandomNumber( Ubound(m_arrCaptcha)+1 )
m_sChar2 = m_arrCaptcha(m_nChar2Index)
m_sAux = m_arrQuestionTypes(m_lngQuestionTypesIndex)(m_lngQuestionIndex)
m_arrQuestionTypes(2) = Array( m_sAux & " " & m_nChar1Index+1 & " e " & m_nChar2Index+1 & ":")
Session("CAPTCHA") = m_sChar1 & m_sChar2
end select
'---------------------------- Create javascript
Call CreateJavascript
'---------------------------- debug junk (comment it out or delete when not needed!)
'response.write("--" & Session("CAPTCHA") & "++" & m_lngQuestionTypesIndex & "--" & m_lngQuestionIndex & "<br>")
'response.write("tipo de pergunta=" & m_lngQuestionTypesIndex & "<br>" )
'response.write("ubound=" & Ubound(m_arrQuestionTypes(m_lngQuestionTypesIndex)) & "<br>" )
'response.write("random=" & m_lngQuestionIndex & "<br>" )
'For xxx = LBound(m_arrColorNew) To UBound(m_arrColorNew)
'
response.write(xxx & "=" & m_arrColorNew(xxx)(0) & "," & m_arrColorNew(xxx)(1) & "<br>")
'Next
'For i = LBound(m_arrCaptchaColor) To UBound(m_arrCaptchaColor)
'
response.write(i & "=" & m_arrCaptchaColor(i)(0) & "," & m_arrCaptchaColor(i)(1) & "<br>")
'Next
'---------------------------- 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
'// This array will be randomly sorted separately from the others because it's a nested one
Call RandomizeArray2(m_arrColor, m_arrColorNew)
'// These 3 arrays are randomly sorted meaning that all characters might have the same color.
Call RandomizeArray(m_arrFontFamily, m_arrFontFamilyNew)
Call RandomizeArray(m_arrFontSize, m_arrFontSizeNew)
Call RandomizeArray(m_arrTopPosition, m_arrTopPositionNew)
'// This array will be randomly sorted separately from the others because all values must be unique
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 = "<style type=""text/css"">" & vbCrLf
sCSS = sCSS & "#" & m_sNameOfWrapperDiv & " {" & vbCrLf
sCSS = sCSS & CAPTCHA_BOX_BORDER & vbCrLf
sCSS = sCSS & "position: relative;" & vbCrLf
sCSS = sCSS & "width: " & CAPTCHA_BOX_WIDTH & "px;" & vbCrLf
sCSS = sCSS & "height: " & CAPTCHA_BOX_HEIGHT & "px;" & vbCrLf
sCSS = sCSS & "}" & vbCrLf
'// Array holding the class names we will produce in the next loop
ReDim m_arrClassNames(MAX_NUMBER_OF_CHARACTERS - 1)
'// Remember the characters left position. Increase this value in every loop.
iLeft = 10
'---------------------------- Build the CSS for our CAPTCHA
For i = 0 To (MAX_NUMBER_OF_CHARACTERS - 1)
'// Initialize our module arrays. We are randomizing them every time we get here.
Call InitArrays
sTmpClassName = RandomString(MAX_LENGTH_CSS_CLASSES)
sCSS = sCSS & "." & sTmpClassName & " {" & vbCrLf
'---------------------------- Loop the 5 CSS strings and fill them with values
For l = 0 To 4
sTmp = m_arrCSSStringsNew(l)
If InStr(sTmp, "color") > 0 Then
sTmp = sTmp & m_arrColorNew(l)(0) & ";" & vbCrLf
'// We need to remember the colors when asking the visitors to type them so put them in an array.
If Not i > UBound(m_arrCaptchaColor) Then
m_arrCaptchaColor(i) = m_arrColorNew(l)
end if
End If
If InStr(sTmp, "font") > 0 Then sTmp = sTmp & m_arrFontSizeNew(l) & "px " & _
m_arrFontFamilyNew(l) & ";" & vbCrLf
If InStr(sTmp, "top") > 0 Then sTmp = sTmp & m_arrTopPositionNew(l) & "px;" & vbCrLf
If InStr(sTmp, "left") > 0 Then sTmp = sTmp & iLeft & "px;" & vbCrLf
If InStr(sTmp, "position") > 0 Then sTmp = sTmp & vbCrLf
sCSS = sCSS & sTmp
Next
'// Store the CSS class names in array
m_arrClassNames(i) = sTmpClassName
'// Calculate the new left position for next CAPTCHA character
iLeft = (iLeft + CAPTCHA_CHARACTER_FACTOR)
sCSS = sCSS & "}" & vbCrLf
Next
m_sCSS = sCSS & "</style>"
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 = "<script type=""text/javascript"">" & vbCrLf
sJScript = sJScript & "document.write('<div id=""" & m_sNameOfWrapperDiv & """>');" & vbCrLf
For i = 0 To (MAX_NUMBER_OF_CHARACTERS - 1)
sJScript = sJScript & "document.write('<span class=""" & m_arrClassNames(i) & """>" & _
m_arrCaptchaScreen(i) & "</span>');" & vbCrLf
Next
sJScript = sJScript & "document.write('</div>');" & vbCrLf
sJScript = sJScript & "</script>" & vbCrLf
sJScript = sJScript & "<p>" & m_arrQuestionTypes(m_lngQuestionTypesIndex)(m_lngQuestionIndex) & "</p>" & 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: Randomize our module arrays holding the CSS. One value might appear several times.
' New function needed because color related arrays are now nested
'------------------------------------------------------------------------------------------------------------
Function RandomizeArray2(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
'<html>
'<head>
'<title>A CAPTCHA Solution For Classic ASP</title>
'</head>
'<body>
'<h3>A CAPTCHA Solution Built With Classic ASP, CSS And Javascript.</h3>
'<form method="post" action="" name="form1">
'<Response.Write CreateCAPTCHA>
'<input type="text" name="CaptchaBox" />
'<input type="submit" value="Submit" />
'</form>
'<p style="font-weight: bold; color: red;"><=m_sUserResult> </p>
'</body>
'</html>
%>
