rc-Dev - The resource site for developers

Here you can find some FREE usefull Classic ASP / VBScript code snippets, class modules, etc.
I use then myself on most of my projects, so you can rest assured they were optimized over time and are very reliable.
You can use them on your personal or commercial projects.
If you find them usefull to you, please make a donation (nomatter how small) to help me keep this content online for free.

Class Recaptcha This is a ASP class I've written to simplify the implementation of the CAPTCHA challenge-response system using reCapcha (www.google.com/recaptcha).
It's very easy and straightforward to implement and use. If you don't know what a CAPTCHA system is about, please read this first. Properties and Methods Error Property Read-only. Returns error description, if any. Lang Property Returns or sets the language for the reCaptcha interface (not the challenge words!). Available values are "en","nl","fr","de","pt","ru","es" and "tr". You can also use index values from 0 to 7. Default value is "en" (english). TabIndex Property Returns or sets a tabindex for the reCAPTCHA text box. If other elements in the form use a tabindex, this should be set so that navigation is easier for the user. Default value is 0. Theme Property Returns or sets the display theme for the reCaptcha element. Available themes are "red","white","blackglass" and "clean". You can also use index values from 0 to 3. Default value is "red". Challenge Method Read-only. Returns a String with the CAPTCHA challenge to display. Init (public key, private key) Method Call this method to initialize the Class with your private and public recaptcha keys. Validate Method This method validates the CAPTCHA challenge returning True or False ValidationAvailable Method Checks if your server can display the reCaptcha challenge by testing it's connection to the reCaptcha server. It's a good idea to call this before presenting the challenge. Returns True or False

Step 1 - Displaying the challenge board

<%
dim r
const my_private_key = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
const my_public_key = "yyyyyyyyyyyyyyyyyyyyyyyyyyy"
set r = new Recaptcha
r.Init my_private_key, my_public_key
if r.ValidationAvailable() then
   ' display the reCaptcha challenge
   response.write r.Challenge()
   else
   ' reCaptcha not available. You decide what to do.
   end if
set r = Nothing
%>

Step 2 - Validating the user input

<%
dim r
const my_private_key = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
const my_public_key = "yyyyyyyyyyyyyyyyyyyyyyyyyyy"
set r = new Recaptcha
r.Init my_private_key, my_public_key
if r.ValidationAvailable() then
   ' validate reCaptcha challenge
   if r.Validate() then
      response.write "OK. The user typed the correct words!"
      else
      response.write "Oops... those are not the right words!
      end if
   else
   ' reCaptcha not available. You decide what to do.
   end if
set r = Nothing
%>

Source Code

<%
Class Recaptcha

dim iTheme, iTabIndex, iLang, iPublicKey, iPrivateKey, iError

public property Get Theme()
Theme=iTheme
end property

public property Let Theme(byval nv)
nv=lcase(trim(nv))
select case nv
case "red","white","blackglass","clean": iTheme=nv
case "0","1","2","3": iTheme=Split("red,white,blackglass,clean",",")(nv)
end select
end property

public property Get TabIndex()
TabIndex=iTabIndex
end property

public property Let TabIndex(byval nv)
nv=lcase(trim(nv))
if nv="" then nv="0"
if not isnumeric(nv) then exit property
iTabIndex=nv
end property

public property Get Lang()
Lang=iLang
end property

public property Let Lang(byval nv)
nv=lcase(trim(nv))
select case nv
case "en","nl","fr","de","pt","ru","es","tr": iLang=nv
case "0","1","2","3","4","5","6","7": iLang=Split("en,nl,fr,de,pt,ru,es,tr")(nv)
end select
end property

public property Get Error()
Error=iError
end property

private sub Class_Initialize()
iError=""
iTheme="red": iTabIndex="0": iLang="en" ' Defaults
end sub

public sub Init(byval pub_k, byval pvt_k)
iPublicKey=pub_k
iPrivateKey=pvt_k
end sub

public function Challenge()
Challenge="<script>var RecaptchaOptions = {theme:'" & iTheme & "', tabindex:" & _
   iTabIndex & ", lang:'" & iLang & "'};</script>" & vbcrlf & _
   "<script type=""text/javascript"" src=""http://api.recaptcha.net/challenge?k=" & _
   iPublicKey & """></script>" & vbcrlf & _
   "<noscript><iframe src=""http://api.recaptcha.net/noscript?k=" & _
   iPublicKey & """ height=""300"" width=""500"" frameborder=""0""></iframe><br>" & _
   "<textarea name=""recaptcha_challenge_field"" rows=""3"" cols=""40""></textarea>" & _
   "<input type=""hidden"" name=""recaptcha_response_field"" value=""manual_challenge"">" & _
   "</noscript>" & vbcrlf
end function

public function Validate()
Dim rChallenge, rResponse, rURL, xmlObj, ret, b
iError="": Validate=false
rChallenge=trim(request.form("recaptcha_challenge_field"))
rResponse=trim(request.form("recaptcha_response_field"))
if iPrivateKey="" then iError="Private key is missing!": exit function
if rChallenge="" then iError="Challenge form field is missing!": exit function
if rResponse="" then iError="Response form field is missing!": exit function
rURL="privatekey=" & iPrivateKey & _
   "&remoteip=" & Request.ServerVariables("REMOTE_ADDR") & _
   "&challenge=" & rChallenge & "&response=" & rResponse
on error resume next
Set xmlObj=server.createObject("MSXML2.SERVERXMLHTTP")
if err.number<>0 then
   iError="Unable to create XMLHTTP object!"
   else
   xmlObj.Open "POST", "http://api-verify.recaptcha.net/verify", False
   xmlObj.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
   xmlObj.Send rURL
   if err.number<>0 then iError="XMLHTTP Error: " & err.description else ret=xmlObj.ResponseText
   end if
on error goto 0
if iError="" then
   b=split(xmlObj.ResponseText, vbLf)
   if b(0)<>"true" then iError="reCAPTCHA error: " & b(1) else Validate=true
   end if
Set xmlObj=Nothing
end function

public function ValidationAvailable()
Dim rURL, xmlObj, ret, b
ValidationAvailable=false
on error resume next
Set xmlObj=server.createObject("MSXML2.SERVERXMLHTTP")
if err.number<>0 then
   iError="Unable to create XMLHTTP object!"
   else
   xmlObj.Open "POST", "http://api-verify.recaptcha.net/verify", False
   xmlObj.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
   xmlObj.Send rURL
   if err.number<>0 then iError="XMLHTTP Error: " & err.description else ret=xmlObj.ResponseText
   end if
on error goto 0
if iError="" then
   b=split(lcase(xmlObj.ResponseText), vbLf)
   if b(0)<>"false" then iError="Unable to get a valid response from reCAPTCHA server." else ValidationAvailable=true
   end if
Set xmlObj=Nothing
end function

End Class
%>