ASP CAPTCHA: LanapBotDetectHandler.asp (BotDetect v2.0; deprecated)

This is the ASP script used for BotDetect ASP CAPTCHA image and audio request processing. It can be used to easily add CAPTCHA protection to your ASP forms.

By default, it is installed in the
C:\Program Files\Lanapsoft\BotDetect\ASP\v2.0\Modules\ folder.

Full Source Code Listing

<%
Dim code, codeKey, codeHash, codeHashKey, captchaId, comCaptcha, _ 
  index, appCodeKey, captchaSessionIdKey

'the Captcha code is kept in Session state with this key
codeKey = "LanapBotDetectCode"
codeHashKey = "LanapBotDetectCodeHash"
captchaSessionIdKey = "LanapBotDetectID"

Function createGuid()
  Set TypeLib = Server.CreateObject("Scriptlet.TypeLib")
  tg = TypeLib.Guid
  guid = Left(tg, len(tg)-2)
  set regEx = New RegExp
  regEx.IgnoreCase = False
  regEx.Global = True
  regEx.Pattern = "[{}-]"
  createGuid = regEx.Replace(guid, "")
  Set TypeLib = Nothing
End Function

Function getCaptchaSessionID()
  Dim captchaSessionID
  If (Session(captchaSessionIdKey) <> "") Then
    captchaSessionID = Session(captchaSessionIdKey)
  Else
    captchaSessionID = createGuid()
    Session(captchaSessionIdKey) = captchaSessionID
  End If
  getCaptchaSessionID = captchaSessionID
End Function

'if there are multiple Captchas on tn the site, a Captcha id is 
'required to distinguish between them; otherwise, it can be ignored
captchaId = Request("CaptchaId")
If(captchaId<>"") Then
  codeKey = codeKey & "_" & captchaId
End If

If (Request("Command")="CreateImage") Then
'Captcha image generation

  'create the Captcha component instance
  Set comCaptcha = CreateObject("Lanap.BotDetect")

  'process Captcha properties
  If (Request("TextStyle")<>"") Then 'set Captcha algorithm
    On Error Resume Next
    comCaptcha.TextStyle = CLng(Request("TextStyle"))
    Err.Clear
  End If
  If (Request("ImageWidth")<>"") Then 'set Captcha image width
    On Error Resume Next
    comCaptcha.ImageWidth = CLng(Request("ImageWidth"))
    Err.Clear
  End If
  If (Request("ImageHeight")<>"") Then 'set Captcha image height
    On Error Resume Next
    comCaptcha.ImageHeight = CLng(Request("ImageHeight"))
    Err.Clear
  End If
  If (Request("CodeLength")<>"") Then 'set Captcha code length
    On Error Resume Next
    comCaptcha.CodeLength = CLng(Request("CodeLength"))
    Err.Clear
  End If
  If (Request("CodeType")<>"") Then 'set Captcha code type
    On Error Resume Next
    comCaptcha.CodeType = CLng(Request("CodeType"))
    Err.Clear
  End If
  If (Request("Format")<>"") Then 'set Captcha image format
    On Error Resume Next
    comCaptcha.Format = Request("Format")
    Err.Clear
  End If

  'set Captcha image Http response headers
  Response.Buffer = True
  Response.CacheControl = "no-cache, no-store, must-revalidate"
  Response.AddHeader "Pragma", "no-cache"
  Response.Expires = -1
  If (comCaptcha.Format="JPEG") Then
    Response.ContentType = "image/jpeg"
  ElseIf (comCaptcha.Format="PNG") Then
    Response.ContentType = "image/png"
  ElseIf (comCaptcha.Format="GIF") Then
    Response.ContentType = "image/gif"
  ElseIf (comCaptcha.Format="BMP") Then
    Response.ContentType = "image/bmp"
  End If

  'generate the Captcha image binary data
  Dim varPicture
  varPicture = comCaptcha.CreateImage

  'save the Captcha code for sound generation and validation
  code = comCaptcha.GetValue
  Session(codeKey) = code
  'save the code hash for backward compatibility with older validation 
  'code
  codeHash = comCaptcha.GetHashValue
  Session(codeHashKey) = codeHash

  'Chrome workaround
  index = InStr(Request.ServerVariables("HTTP_USER_AGENT"), "Chrome")
  If (index > 0) Then
    appCodeKey = getCaptchaSessionID() & codeKey
    Application.Lock
    Application(appCodeKey) = code
    Application.UnLock
    Response.Cookies(captchaSessionIdKey) = getCaptchaSessionID()
    Response.Cookies(captchaSessionIdKey).Expires = DateAdd("H", 1, Now)
    Response.Cookies(captchaSessionIdKey).Path = "/"
  End If

  'send Captcha image binary data to the client
  Response.BinaryWrite varPicture
  Set comCaptcha = Nothing 'dispose of the Captcha component instance
  Response.End
'end Captcha image generation

ElseIf (Request("Command")="CreateSound") Then
'audio Captcha generation

  'create the Captcha component instance
  Set comCaptcha = CreateObject("Lanap.BotDetect")

  'set Http response headers
  If ((Request.ServerVariables("HTTPS")="off") Or Request("e")="") Then
    Response.CacheControl = "no-cache"
    Response.AddHeader "Pragma", "no-cache"
    Response.Expires = -1
  End If
  Response.Buffer = True
  Response.ContentType = "audio/x-wav"
  If (Request("d") = "") Then
  Response.AddHeader "content-disposition", _
    "attachment; filename=captcha.wav"
  End If
  Response.AddHeader "Content-Transfer-Encoding", "binary"
  Response.AddHeader "Connection", "Close"

  'generate the audio Captcha binary data from the saved code
  code = Session(codeKey)
  If (Request("s") <> "") Then 'Chrome workaround
    appCodeKey = Request("s") & codeKey
    code = Application(appCodeKey)
  End If
  varSound = comCaptcha.CreateSoundFromCode(code)

  'send audio Captcha binary data to the client
  Response.BinaryWrite varSound
  Set comCaptcha = Nothing 'dispose of the Captcha component instance
  Response.End
'end audio Captcha generation

ElseIf (Request("Command")="Validate") Then
'Ajax Captcha validation

  Dim result
  result = False

  If (Session(codeKey)<>"") Then
    Dim inputCode
    inputCode = Request("Code")
    code = Session(codeKey)
    result = (0 = StrComp(inputCode, code, 1))
    'Ajax validation shouldn't remove the code if successful, so both 
    'client- and server-side validation can be performed and pass
    If (Not result) Then
      Session(codeKey) = ""
    End If
  End If

  'Http response headers
  Response.Buffer = True
  Response.ContentType = "text/javascript"
  Response.CacheControl = "no-cache, no-store, must-revalidate"
  Response.AddHeader "Pragma", "no-cache"
  Response.Expires = -1
  Response.AddHeader "Connection", "Close"

  'send the JSON validation result to the client
  Response.Write "{ 'result': " & LCase(CStr(result)) & " }"
  Response.End

'end Ajax Captcha validation
End If

'If neither of the above conditions was met
Response.Status = "400 Bad Request"
Response.End
%>