<%
'============================================================
' 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 = 5 '// How many characters in our CAPTCHA?
Const MAX_LENGTH_CSS_CLASSES = 12 '// How many characters in the CSS class names?
Const CAPTCHA_CHARACTER_FACTOR = 20 '// 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 = 150 '// Width. This value should balance the number of characters and size.
Const CAPTCHA_BOX_HEIGHT = 40 '// Same as above.
Const NAME_OF_CAPTCHA_TEXTBOX = "CaptchaBox" '// 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
Dim TestColor , newstemp,spliter
dim sJScript123
dim colorval
'// START UP THE MODULE ARRAYS
m_arrColor(0) = "red"
m_arrColor(1) = "red"
m_arrColor(2) = "red"
m_arrColor(3) = "red"
m_arrColor(4) = "red"
'm_arrFontFamily(0) = "Verdana"
'm_arrFontFamily(1) = "Arial"
'm_arrFontFamily(2) = "Tahoma"
'm_arrFontFamily(3) = "Courier"
'm_arrFontFamily(4) = "Georgia"
m_arrFontFamily(0) = "Comic Sans MS"' "Matura MT Script Capitals"
m_arrFontFamily(1) = "Comic Sans MS"
m_arrFontFamily(2) = "Comic Sans MS"
m_arrFontFamily(3) = "Comic Sans MS"
m_arrFontFamily(4) = "Comic Sans MS"
m_arrFontSize(0) = 25
m_arrFontSize(1) = 25
m_arrFontSize(2) = 25
m_arrFontSize(3) = 25
m_arrFontSize(4) = 25
m_arrTopPosition(0) = 10
m_arrTopPosition(1) = 10
m_arrTopPosition(2) = 10
m_arrTopPosition(3) = 10
m_arrTopPosition(4) = 10
m_arrQuestions(0) = "Type the characters you see in the picture above:"
m_arrQuestions(1) = "Type the characters you see in the picture above:"
m_arrQuestions(2) = "Type the characters you see in the picture above:"
m_arrQuestions(3) = "Type the characters you see in the picture above:"
m_arrCSSStrings(0) = "position: absolute;"
m_arrCSSStrings(1) = "top: "
m_arrCSSStrings(2) = "left: "
m_arrCSSStrings(3) = "color: "
m_arrCSSStrings(4) = "font: Bold Italic "
'------------------------------------------------------------------------------------------------------------
' 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)
'Response.Write "Max "& MAX_NUMBER_OF_CHARACTERS
For i = 0 To (MAX_NUMBER_OF_CHARACTERS - 1)
sTmp = UCase(RandomString(1))
iTmp = RandomNumber(101)
m_arrCaptcha(0) = 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.
'// Nothing was submitted, so just set a new session value which is our CAPTCHA characters or a color
Session("CAPTCHA1") = Replace(Join(m_arrCaptcha), " ", "")
' response.Write "Cap :" & Session("CAPTCHA1")
'// We will ask visitor for a color! Reduce m_lngQuestionIndex by 1 to match the m_arrCaptchaColor array
If (m_lngQuestionIndex > 0) Then Session("CAPTCHA1") = 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.
' response.Write "m_arrColor: "& m_arrCSSStringsNew &"" & m_arrQuestions(i) & "
" & vbCrLf
m_sJavascript = sJScript
'response.Write "JS: " &TextVal1 &TextVal2&TextVal3&TextVal4&TextVal5
session("NewCaptcha") = TextVal1 &TextVal2&TextVal3&TextVal4&TextVal5
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)
'response.Write "sBuf & sTmp : " & sBuf & sTmp &"