Web Analytics Made Easy -
StatCounter Captcha Validation in ASP - CodingForum

Announcement

Collapse
No announcement yet.

Captcha Validation in ASP

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Captcha Validation in ASP

    I am trying to get this classic captcha to validate when the wrong code is entered into the form and submitted but it is not working.

    Here is the cpatcha code as implemented in my webform and the asp script that runs the form. All help appreciated.


    The form file
    Code:
    <script language="JavaScript" type="text/JavaScript">
    
    <!--
    function MM_findObj(n, d) { //v4.01
      var p,i,x;  if(!d) d=document; if((p=n.indexOf("?"))>0&&parent.frames.length) {
        d=parent.frames[n.substring(p+1)].document; n=n.substring(0,p);}
      if(!(x=d[n])&&d.all) x=d.all[n]; for (i=0;!x&&i<d.forms.length;i++) x=d.forms[i][n];
      for(i=0;!x&&d.layers&&i<d.layers.length;i++) x=MM_findObj(n,d.layers[i].document);
      if(!x && d.getElementById) x=d.getElementById(n); return x;
    }
    
    function MM_validateForm() { //v4.0
      var i,p,q,nm,test,num,min,max,errors='',args=MM_validateForm.arguments;
      for (i=0; i<(args.length-2); i+=3) { test=args[i+2]; val=MM_findObj(args[i]);
        if (val) { nm=val.name; if ((val=val.value)!="") {
          if (test.indexOf('isEmail')!=-1) { p=val.indexOf('@');
            if (p<1 || p==(val.length-1)) errors+='- '+nm+' must contain an e-mail address.\n';
          } else if (test!='R') { num = parseFloat(val);
            if (isNaN(val)) errors+='- '+nm+' must contain a number.\n';
            if (test.indexOf('inRange') != -1) { p=test.indexOf(':');
              min=test.substring(8,p); max=test.substring(p+1);
              if (num<min || max<num) errors+='- '+nm+' must contain a number between '+min+' and '+max+'.\n';
        } } } else if (test.charAt(0) == 'R') errors += '- '+nm+' is required.\n'; }
      } if (errors) alert('The following error(s) occurred:\n'+errors);
      document.MM_returnValue = (errors == '');
    }
    
    //-->
    </script>
    <script language="javascript">
    function RefreshImage(valImageId) {
    	var objImage = document.images[valImageId];
    	if (objImage == undefined) {
    		return;
    	}
    	var now = new Date();
    	objImage.src = objImage.src.split('?')[0] + '?x=' + now.toUTCString();
    }
    </script>
    
     <form method="POST" action="">
       <p>Fields marked (*) are required
      </p>
       <table width="642" border="0">
         <tr>
           <td width="155">Full Name: (*) </td>
           <td width="296"><input type="text" name="Name"></td>
           <td width="177" rowspan="15">&nbsp;</td>
         </tr>
         <tr>
           <td>Date of Birth: (*) </td>
           <td><input type="text" name="DateofBirth"></td>
         </tr>
         <tr>
           <td>Address:</td>
           <td><input type="text" name="Address"></td>
         </tr>
         <tr>
           <td>Address 2: </td>
           <td><input type="text" name="Address2"></td>
         </tr>
         <tr>
           <td>Parish:</td>
           <td><input type="text" name="Parish"></td>
         </tr>
         <tr>
           <td>Post Code: </td>
           <td><input type="text" name="PostCode"></td>
         </tr>
         <tr>
           <td>Telephone:</td>
           <td><input type="text" name="Telephone"></td>
         </tr>
         <tr>
           <td>Email: (*) </td>
           <td><input type="text" name="EmailFrom"></td>
         </tr>
         <tr>
           <td rowspan="2">testing: (*) </td>
           <td><p>
              <input name="testing" type="checkbox" value="">
               
              <input type="checkbox" name="testing" value="">
             
             <input type="checkbox" name="testing" value="">
             l </p>
           </td>
         </tr>
         <tr>
           <td><input type="checkbox" name="testing" value=" ">
    <input type="checkbox" name="testing" value="Other">
    Other </td>
         </tr>
         <tr>
           <td>If Other, please specify: (*) </td>
           <td><input type="text" name="IfOtherPleaseSpecify"></td>
         </tr>
         <tr>
           <td>Current Number: (*)</td>
           <td><input type="text" name="CurrentNumber"></td>
         </tr>
         <tr>
           <td>Additional Comment: </td>
           <td><textarea name="Comment"></textarea></td>
         </tr>
         <tr>
           <td>Test2:</td>
           <td><input type="url" name="test2" style="width: 250px" value="http://www.mysite/default.asp"></td>
         	 </tr>
    		 <tr>
          <td width="261">CAPTCHA Image</td>
          <td width="123"><img id="imgCaptcha" src="captcha.asp" /><br /><a href="javascript:void(0)" onclick="RefreshImage('imgCaptcha')">Change Image</a></td>
        </tr>
        <tr>
          <td>Write the characters in the image above</td>
          <td><input name="captchacode" type="text" id="captchacode" size="10" /></td>
        </tr>
        <tr>
         <tr>
           <td><input type="reset" name="Reset" value="Reset">       
           <input type="submit" name="btnTest" id="btnTest" onClick="MM_validateForm('Name','','R','DateofBirth','','R','EmailFrom','','R','CurrentNumber','','R');return document.MM_returnValue" value="Submit"></td>
           <td>&nbsp;</td>
         </tr>
       </table>
       <p>&nbsp;</p>
       
    <p></form>
    My ASP file
    Code:
    <%
    function TestCaptcha(byval valSession, byval valCaptcha)
    	dim tmpSession
    	valSession = Trim(valSession)
    	valCaptcha = Trim(valCaptcha)
    	if (valSession = vbNullString) or (valCaptcha = vbNullString) then
    		TestCaptcha = false
    	else
    		tmpSession = valSession
    		valSession = Trim(Session(valSession))
    		Session(tmpSession) = vbNullString
    		if valSession = vbNullString then
    			TestCaptcha = false
    		else
    			valCaptcha = Replace(valCaptcha,"i","I")
    			if StrComp(valSession,valCaptcha,1) = 0 then
    				TestCaptcha = true
    			else
    				TestCaptcha = false
    			end if
    		end if		
    	end if
    end function
    %>
    <%
    
    
    ' declare variables
    Dim EmailFrom
    Dim EmailTo
    Dim Subject
    Dim Name
    Dim Address
    Dim Telephone
    Dim test2
    Dim DateofBirth
    Dim Address2
    Dim Parish
    Dim PostCode
    Dim Testing
    Dim CurrentNumber
    Dim IfOtherPleaseSpecify
    Dim Comment
    
    
    ' get posted data into variables
    EmailFrom = Trim(Request.Form("EmailFrom")) 
    EmailTo = "[email protected]"
    Subject = "Please "
    Name = Trim(Request.Form("Name")) 
    Address = Trim(Request.Form("Address")) 
    Telephone = Trim(Request.Form("Telephone")) 
    test2 = Trim(Request.Form("test2"))
    DateofBirth = Trim(Request.Form("DateofBirth"))
    Address2 = Trim(Request.Form("Address2"))
    Parish = Trim(Request.Form("Parish"))
    PostCode = Trim(Request.Form("PostCode"))
    testing = Trim(Request.Form("testing"))
    CurrentNumber = Trim(Request.Form("CurrentNumber"))
    IfOtherPleaseSpecify = Trim(Request.Form("IfOtherPleaseSpecify"))
    Comment = Trim(Request.Form("Comment"))
    
    
    
    ' validation
    Dim validationOK
    validationOK=true
    If (Trim(EmailFrom)="") Then validationOK=false
    If (Trim(Name)="") Then validationOK=false
    If (validationOK=false) Then Response.Redirect("error.htm?" & EmailFrom)
    
    ' prepare email body text
    Dim Body
    Body = Body & "Full Name: " & Name & VbCrLf
    Body = Body & "Date of Birth: " & DateofBirth & VbCrLf
    Body = Body & "Address: " & Address & VbCrLf
    Body = Body & "Address2: " & Address2 & VbCrLf
    Body = Body & "Parish: " & Parish & VbCrLf
    Body = Body & "Post Code: " & PostCode & VbCrLf
    Body = Body & "Telephone: " & Telephone & VbCrLf
    Body = Body & "testong: " & testing & VbCrLf
    Body = Body & "If Other please specify: " & IfOtherPleaseSpecify & VbCrLf
    Body = Body & "Current Number: " & CurrentNumber & VbCrLf
    Body = Body & "Comment: " & Comment & VbCrLf
    Body = Body & "test2: " & test2 & VbCrLf
    
    
    
    ' send email 
    Dim mail
    Set mail = Server.CreateObject("CDONTS.NewMail") 
    mail.To = EmailTo
    mail.From = EmailFrom
    mail.Subject = Subject
    mail.Body = Body
    mail.Send 
    
    
    	if not IsEmpty(Request.Form("btnTest")) then
    		Response.Write("<tr><td colspan=""2"" align=""center"">")
    		if TestCaptcha("ASPCAPTCHA", Request.Form("captchacode")) then
    			Response.Write("<b style=""color:#00CC33"">The code you enter verified.</b>")
    		else
    			Response.Write("<b style=""color:#FF0000"">You entered the wrong code.</b>")
    		end if
    		Response.Write("</td></tr>" & vbCrLf)
    	end if
    	
    ' redirect to success page 
    Response.Redirect("thanks.asp?" )
    %>

    It does send the email but it won't validate even if someone enters the the wrong captcha code or no code.
    Last edited by Gtdonna; Aug 17, 2011, 10:51 AM. Reason: To request email notification of replies

  • #2
    Ummm...why are you surprised???

    (1) You send the email *BEFORE* you call the TestCaptcha function.
    (2) Even when you *do* call the TestCaptcha function, all you do is Response.Write a message saying whether the test passed or not. (And the message will never be seen by anyone, because no matter what the message is, you then do a Response.Redirect to "thanks.asp" which wipes out the message.)
    (3) When you call the TestCaptcha function, you are *ALWAYS* looking for the value "ASPCAPTCHA". A pretty worthless captcha if it uses the same word all the time.

    And, of course, you don't bother to show us the important part: The code for you file "captcha.asp", so we could maybe figure out how this particular captcha is supposed to work.

    Also, for what it is worth, your form validation is pretty worthless. All you are checking is if the name and email are blank or not. So a person could enter just "X" for both name and email and you'd accept it.
    Be yourself. No one else is as qualified.

    Comment


    • #3
      Old Pendant, thank you for your constructive reply...much appreciated. I do not know everything and I am open to learning from my mistakes...so again, thank you for the insights. Below is the captcha code....if you can kindly help me sort this out it will be much appreciated.

      Code:
      <%@LANGUAGE="VBSCRIPT"%>
      <%
      'ASP Security Image Generator v4.0 - 13/July/2008
      'Generate images to make a CAPTCHA test
      '© 2006-2007 Emir Tüzül. All rights reserved.
      'http://www.tipstricks.org
      
      'This program is free software; you can redistribute it and/or
      'modify it under the terms of the Common Public License
      'as published by the Open Source Initiative OSI; either version 1.0
      'of the License, or any later version.
      
      'This program is distributed in the hope that it will be useful,
      'but WITHOUT ANY WARRANTY; without even the implied warranty of
      'MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
      'Common Public License for more details.
      
      '*[null pixel]Numbers[repeat count], #[text]Numbers[repeat count], &[row reference]number[referenced row index]
      'First row [font height, chars...]
      'Following rows [char width, pixel maps...]
      FontMap = Array(_
      split("13,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,0,1,2,3,4,5,6,7,8,9",",") ,_
      split("14,*5#4*5,*4#6*4,&2,&2,*3#3*2#3*3,&5,*2#4*2#4*2,*2#3*4#3*2,*2#10*2,*1#12*1,*1#3*6#3*1,&11,#3*8#3",",") ,_
      split("11,#8*3,#10*1,#3*4#3*1,&3,&3,&1,&2,#3*4#4,#3*5#3,&9,&8,&2,#9*2",",") ,_
      split("11,*4#6*1,*2#9,*1#4*4#2,*1#3*6#1,#3*8,&5,&5,&5,&5,&4,&3,&2,&1",",") ,_
      split("12,#8*4,#10*2,#3*4#4*1,#3*5#3*1,#3*6#3,&5,&5,&5,&5,&4,&3,&2,&1",",") ,_
      split("9,#9,&1,#3*6,&3,&3,#8*1,&6,&3,&3,&3,&3,&1,&1",",") ,_
      split("9,#9,&1,#3*6,&3,&3,&1,&1,&3,&3,&3,&3,&3,&3",",") ,_
      split("13,*4#7,*2#11,*1#4*5#3,*1#3*8#1,#3,#3,#3*4#6,&7,#3*7#3,*1#3*6#3,*1#5*4#3,&2,&1",",") ,_
      split("11,#3*5#3,&1,&1,&1,&1,#11,&6,&1,&1,&1,&1,&1,&1",",") ,_
      split("7,#7,#7,*2#3,&3,&3,&3,&3,&3,&3,&3,&3,&1,&1",",") ,_
      split("8,*2#6,&1,*5#3,&3,&3,&3,&3,&3,&3,&3,*4#4,#7,#6",",") ,_
      split("12,#3*5#4,#3*4#4,#3*3#4,#3*2#4,#3*2#3,#3*1#3,#7,#8,&5,#3*3#3,#3*4#3,#3*5#3,&1",",") ,_
      split("9,#3,#3,#3,#3,#3,#3,#3,#3,#3,#3,#3,#9,#9",",") ,_
      split("13,#3*7#3,#4*5#4,&2,#5*3#5,&4,#6*1#6,#3*1#2*1#2*1#3,#3*1#5*1#3,#3*2#3*2#3,&9,#3*7#3,&11,&11",",") ,_
      split("11,#4*4#3,#5*3#3,&2,#6*2#3,&4,#3*1#3*1#3,&6,#3*2#6,&8,#3*3#5,&10,#3*4#4,#3*5#3",",") ,_
      split("13,*4#5,*2#9,*1#4*3#4,*1#3*5#3,#3*7#3,&5,&5,&5,&5,&4,&3,&2,&1",",") ,_
      split("10,#8,#9,#3*3#4,#3*4#3,&4,&4,&3,&2,#7,#3,#3,#3,#3",",") ,_
      split("13,*3#6,*2#8,*1#3*4#3,*1#2*6#2,#2*8#2,&5,&5,#2*4#1*3#2,#2*4#2*2#2,*1#2*4#4,&3,*2#10,*3#6*2#2",",") ,_
      split("12,#8,#9,#3*4#3,&3,&3,#3*3#4,&2,&1,#3*2#4,#3*3#3,&3,#3*4#4,#3*5#4",",") ,_
      split("11,*3#6,*1#9,#4*4#2,#3*6#1,#4,#8,&2,*3#8,*7#4,#1*7#3,#3*4#4,#10,*1#7",",") ,_
      split("11,#11,&1,*4#3,&3,&3,&3,&3,&3,&3,&3,&3,&3,&3,&3",",") ,_
      split("11,#3*5#3,&1,&1,&1,&1,&1,&1,&1,&1,&1,#4*3#4,*1#9,*3#5",",") ,_
      split("14,#3*8#3,*1#3*6#3,&2,*1#3*5#4,*2#3*4#3,&5,*3#3*2#3,&7,&7,*4#6,&10,&10,*5#4",",") ,_
      split("17,#3*4#3*4#3,&1,#3*3#5*3#3,*1#3*2#2*1#2*2#3,&4,*1#3*1#3*1#3*1#3,&6,*1#3*1#2*3#2*1#3,&8,*2#5*3#5,&10,*2#4*5#4,&12",",") ,_
      split("14,#4*6#4,*1#4*4#4,*2#4*2#4,*3#3*2#3,*3#8,*4#6,*5#4,&6,&5,&4,&3,&2,&1",",") ,_
      split("13,#4*5#4,*1#3*5#3,*2#3*3#3,*2#4*1#4,*3#3*1#3,*3#7,*4#5,*5#3,&8,&8,&8,&8,&8",",") ,_
      split("10,#10,&1,*6#4,*5#4,*5#3,*4#3,*3#4,*3#3,*2#3,*1#4,#4,&1,&1",",") ,_
      split("10,*3#4*3,*1#8*1,*1#3*2#3*1,#3*4#3,&4,&4,&4,&4,&4,&4,&3,&2,&1",",") ,_
      split("9,*3#3*3,&1,#6*3,&3,*3#3*3,&5,&5,&5,&5,&5,&5,#9,&12",",") ,_
      split("10,*1#6*3,#8*2,#2*3#4*1,#1*5#3*1,*6#3*1,&5,*5#3*2,*4#4*2,*3#4*3,*2#4*4,*1#4*5,#10,&12",",") ,_
      split("11,*1#8*2,#10*1,#3*5#3,#1*7#3,*7#3*1,*3#6*2,*3#7*1,*7#4,*8#3,&4,#3*4#4,&2,*1#7*3",",") ,_
      split("12,*6#4*2,*5#5*2,&2,*4#2*1#3*2,*3#3*1#3*2,*2#3*2#3*2,*1#3*3#3*2,#3*4#3*2,#12,&9,*7#3*2,&11,&11",",") ,_
      split("11,*1#10,&1,*1#3*7,&3,*1#8*2,*1#9*1,*7#4,*8#3,&8,#1*7#3,#3*4#3*1,#10*1,*1#7*3",",") ,_
      split("11,*4#6*1,*2#8*1,*1#4*6,*1#3*7,#3*1#5*2,#10*1,#3*4#4,#3*5#3,&8,&8,*1#3*3#3*1,*1#9*1,*3#5*3",",") ,_
      split("11,#11,&1,*7#4,*7#3*1,*6#4*1,*6#3*2,*5#3*3,*4#4*3,*4#3*4,*3#4*4,*3#3*5,*2#3*6,*1#4*6",",") ,_
      split("11,*2#7*2,*1#9*1,#3*4#4,#3*5#3,#4*3#3*1,*1#8*2,&1,*1#3*1#5*1,&4,&4,#4*3#4,&2,*2#6*3",",") ,_
      split("11,*3#5*3,*1#9*1,*1#3*3#3*1,#3*5#3,&4,&4,#4*4#3,*1#10,*2#5*1#3,*7#3*1,*6#4*1,*1#8*2,*1#6*4",",") _
      )'Previous row must end with _
      
      '#Begin ColorMap
      const BmpColorMap = "dffeff000c851700eceeee006c363600da644a00"
      
      ColorMap = Array(_
      split("00,01,01",",") ,_
      split("02,03,03",",") ,_
      split("00,04,04",",") _
      )'End ColorMap
      
      '#Auto calculated variables
      dim ImageWidth, ImageHeight, arrTextWidth(), TextHeight, LeftMargin, arrTopMargin(), CursorPos
      dim BmpEndLine, BColor, TColor, NColor
      dim i, j, k, x, y
      
      '#Editable consts and variables
      dim Bitmap(25,130) '[Height,Width]
      const CodeLength = 6 'Secure code length (Max:8)
      const CodeType = 0 '0[Random numbers], 1[Random chars and numbers], 2[Fake word]
      const CharTracking = 2 'Set the tracking between two characters
      const RndTopMargin = true 'Randomize top margin every character
      const NoiseEffect = 2 '0[none], 1[sketch], 2[random foreground lines], 3[random background lines], 4[1 and 3 (Recommed maximum NoiseLine=4)]
      const NoiseLine = 7 'Low values make easy OCR, high values decrease readability
      const MinLineLength = 6 'Minimum noise line length
      const SessionName = "ASPCAPTCHA" 'Where store your secure code
      
      '#Subroutines and functions
      function CreateGUID(valLength)
      	if CodeType = 1 then
      		strValid = "A0B1C2D3E4F5G6H7I8J9K8L7M6N5O4P3Q2R1S0T1U2V3W4X5Y6Z7"
      	else
      		strValid = "0516273849"
      	end if
      	tmpGUID = vbNullString
      	tmpChr = vbNullString
      	Randomize(Timer)
      	for cGUID=1 to valLength
      		do 
      			tmpChr = Mid(strValid, Int(Rnd(1) * Len(strValid)) + 1, 1)
      		loop while CStr(tmpChr) = CStr(Right(tmpGUID,1))
      		tmpGUID = tmpGUID & tmpChr
      	Next
      	CreateGUID = tmpGUID
      end function
      
      function FakeWord(valLength)
      	arrChars = Array("AEIOU", "BCDFGHJKLMNPQRSTVWXYZ")
      	cVowel = 0
      	cConsonant = 0
      	tmpWord = vbNullString
      	Randomize(Timer)
      	for cWord=1 to valLength
      		if (cWord=2) or ((valLength > 1) and (cWord = valLength)) then
      			ixChars = 1-ixChars
      		elseif (cVowel < 2) and (cConsonant < 2) then
      			ixChars = Int(Rnd(1) * 2)
      		elseif (cVowel < 2) then
      			ixChars = 0
      		elseif (cConsonant < 2) then
      			ixChars = 1
      		end if
      		Pattern = arrChars(ixChars)
      		tmpWord = tmpWord & Mid(Pattern, Int(Rnd(1) * Len(Pattern)) + 1, 1)
      		if ixChars = 0 then
      			cVowel = cVowel + 1
      			cConsonant = 0
      		else
      			cVowel = 0
      			cConsonant = cConsonant + 1
      		end if
      	next
      	FakeWord = tmpWord
      end function
      
      function RndInterval(valMin,valMax)
      	Randomize(Timer)
      	RndInterval = Int(((valMax - valMin + 1) * Rnd()) + valMin)
      end function
      
      function GetCharMap(valChr)
      	dim i, j
      	j = 0
      	for i=1 to UBound(FontMap(0))
      		if CStr(FontMap(0)(i)) = CStr(valChr) then
      			j = i
      			exit for
      		end if
      	next
      
      	if j > 0 then
      		GetCharMap = FontMap(j)
      	else
      		GetCharMap = Array(0)
      	end if
      end function
      
      sub WriteCanvas(byval valChr, byval valTopMargin)
      	dim i, j, k, curPos, tmpChr, arrChrMap, strPixMap, drawPixel, pixRepeat
      
      	'find char map
      	arrChrMap = GetCharMap(valChr)
      	if UBound(arrChrMap) < 1 then
      		exit sub
      	end if
      
      	'write char
      	for i=1 to UBound(arrChrMap)
      		'get pixel map active line
      		strPixMap = arrChrMap(i)
      		if Left(strPixMap,1) = "&" then
      			j = Mid(strPixMap,2)
      			if (IsNumeric(j) = true) then
      				strPixMap = arrChrMap(CInt(j))
      			else
      				strPixMap = vbNullString
      			end if
      		end if
      		strPixMap = Trim(strPixMap)
      
      		'drawing pixel
      		curPos = CursorPos
      		drawPixel = false
      		pixRepeat = vbNullString
      		for j=1 to Len(strPixMap)
      			tmpChr = Mid(strPixMap,j,1)
      			if (IsNumeric(tmpChr) = true) and (j < Len(strPixMap)) then
      				pixRepeat = pixRepeat & tmpChr
      			else
      				'end pixel map?
      				if IsNumeric(tmpChr) = true then
      					pixRepeat = pixRepeat & tmpChr
      				end if
      
      				'draw pixel
      				if (drawPixel = true) and (IsNumeric(pixRepeat) = true) then
      					for k=1 to CInt(pixRepeat)
      						curPos = curPos + 1
      						Bitmap((valTopMargin + i),curPos) = TColor
      					next
      				elseif IsNumeric(pixRepeat) = true then
      					curPos = curPos + CInt(pixRepeat)
      				end if
      
      				'what is new command?
      				if tmpChr = "#" then
      					drawPixel = true
      				else
      					drawPixel = false
      				end if
      				pixRepeat = vbNullString
      			end if
      		next
      	next
      end sub
      
      sub PrepareBitmap(valSecureCode)
      	dim i, j
      	'image dimensions
      	ImageWidth = UBound(Bitmap,2)
      	ImageHeight = UBound(Bitmap,1)
      
      	'char and text width
      	redim arrTextWidth(CodeLength)
      	arrTextWidth(0) = 0
      	for i=1 to CodeLength
      		arrTextWidth(i) = CInt(GetCharMap(Mid(secureCode,i,1))(0))
      		arrTextWidth(0) = arrTextWidth(0) + arrTextWidth(i)
      	next
      	arrTextWidth(0) = arrTextWidth(0) + ((CodeLength - 1) * CharTracking)
      
      	'text height
      	TextHeight = CInt(FontMap(0)(0))
      
      	'left margin
      	LeftMargin = Round((ImageWidth - arrTextWidth(0)) / 2)
      
      	'top margin
      	redim arrTopMargin(CodeLength)
      	arrTopMargin(0) = Round((ImageHeight - TextHeight) / 2)
      	if RndTopMargin = true then
      		for i=1 to CodeLength
      			arrTopMargin(i) = RndInterval(Int(arrTopMargin(0) / 2),(arrTopMargin(0) + Round(arrTopMargin(0) / 2)))
      		next
      	else
      		for i=1 to CodeLength
      			arrTopMargin(i) = arrTopMargin(0)
      		next
      	end if
      
      	'color selection
      	i = RndInterval(0,UBound(ColorMap))
      	BColor = ColorMap(i)(0)
      	NColor = ColorMap(i)(1)
      	TColor = ColorMap(i)(2)
      
      	'Apply background effect
      	if NoiseEffect = 3 then
      		AddNoise()
      	end if
      
      	'write text
      	for i=1 to CodeLength
      		'calculate cursor pos
      		CursorPos = 0
      		for j=(i-1) to 1 step -1
      			CursorPos = CursorPos + arrTextWidth(j) + CharTracking
      		next
      		CursorPos = LeftMargin + CursorPos
      
      		'write active char
      		WriteCanvas Mid(secureCode,i,1),arrTopMargin(i)
      	next
      end sub
      
      sub DrawLine(x0, y0, x1, y1, valClr)
      	'Reference from Donald Hearn and M. Pauline Baker, Computer Graphics C Version
      	dim m, b, dx, dy
      
      	if (NoiseEffect = 4) and (Bitmap(y0,x0) = TColor) then
      		clrNoise = vbNullString
      	else
      		clrNoise = valClr
      	end if
      	Bitmap(y0,x0) = clrNoise
      
      	dx = x1 - x0
      	dy = y1 - y0
      	if Abs(dx) > Abs(dy) then
      		m = (dy / dx)
      		b = y0 - (m * x0)
      
      		if dx < 0 then
      			dx = -1
      		else
      			dx = 1
      		end if
      
      		do while x0 <> x1
      			x0 = x0 + dx
      
      			if (NoiseEffect = 4) and (Bitmap(Round((m * x0) + b),x0) = TColor) then
      				clrNoise = vbNullString
      			else
      				clrNoise = valClr
      			end if
      			Bitmap(Round((m * x0) + b),x0) = clrNoise
      		loop
      	elseif dy <> 0 then
      		m = (dx / dy)
      		b = x0 - (m * y0)
      
      		if dy < 0 then
      			dy = -1
      		else
      			dy = 1
      		end if
      
      		do while y0 <> y1
      			y0 = y0 + dy
      
      			if (NoiseEffect = 4) and (Bitmap(y0,Round((m * y0) + b)) = TColor) then
      				clrNoise = vbNullString
      			else
      				clrNoise = valClr
      			end if
      			Bitmap(y0,Round((m * y0) + b)) = clrNoise
      		loop
      	end if
      end sub
      
      sub AddNoise()
      	dim median, i, j, x0, y0, x1, y1, dx, dy, dxy
      
      	if NoiseEffect = 1 then
      		clrNoise = vbNullString
      	else
      		clrNoise = NColor
      	end if
      
      	for i=1 to NoiseLine
      		x0 = RndInterval(1,ImageWidth)
      		y0 = RndInterval(1,ImageHeight)
      		x1 = RndInterval(1,ImageWidth)
      		y1 = RndInterval(1,ImageHeight)
      
      		'Check minimum line length
      		dx = Abs(x1 - x0)
      		dy = Abs(y1 - y0)
      		median = Round(Sqr((dx * dx) + (dy * dy))/2)
      		if median < MinLineLength then
      			dxy = MinLineLength - median
      
      			if x1 < x0 then
      				dx = -1
      			else
      				dx = 1
      			end if
      
      			if y1 < y0 then
      				dy = -1
      			else
      				dy = 1
      			end if
      
      			for j=1 to dxy
      				if ((x1 + dx) < 1) or ((x1 + dx) > ImageWidth) or ((y1 + dy) < 1) or ((y1 + dy) > ImageHeight) then
      					exit for
      				end if
      				x1 = x1 + dx
      				y1 = y1 + dy
      			next
      		end if
      
      		'Draw noise line
      		DrawLine x0,y0,x1,y1,clrNoise
      	next
      end sub
      
      function FormatHex(byval valHex,byval fixByte,fixDrctn,valReverse)
      	fixByte = fixByte * 2
      	tmpLen = Len(valHex)
      	if fixByte > tmpLen then
      		tmpFixHex = String((fixByte - tmpLen),"0")
      		if fixDrctn = 1 then
      			valHex = valHex & tmpFixHex
      		else
      			valHex = tmpFixHex & valHex
      		end if
      	end if
      
      	if valReverse = true then
      		tmpHex = vbNullString
      		for cFrmtHex=1 to Len(valHex) step 2
      			tmpHex = Mid(valHex,cFrmtHex,2) & tmpHex
      		next
      		FormatHex = tmpHex
      	else
      		FormatHex = CStr(valHex)
      	end if
      end function
      
      sub SendHex(valHex)
      	for cHex = 1 to Len(valHex) step 2
      		Response.BinaryWrite ChrB(CByte("&H" & Mid(valHex,cHex,2)))
      	next
      end sub
      
      sub SendBitmap()
      	if (ImageWidth mod 4) <> 0 then
      		BmpEndLine = String((4-(ImageWidth mod 4))*2,"0")
      	else
      		BmpEndLine = vbNullString
      	end if
      	BmpInfoHeader = Array("28000000","00000000","00000000","0100","0800","00000000","00000000","120B0000","120B0000","00000000","00000000")
      	BmpInfoHeader(1) = FormatHex(Hex(ImageWidth),4,0,true)
      	BmpInfoHeader(2) = FormatHex(Hex(ImageHeight),4,0,true)
      	BmpInfoHeader(6) = FormatHex(Hex((ImageHeight * ImageWidth) + (ImageHeight * (Len(BmpEndLine) / 2))),4,0,true)
      	BmpInfoHeader(9) = FormatHex(Hex(Len(BmpColorMap)/8),4,0,true)
      	BmpInfoHeader(10) = BmpInfoHeader(9)
      	BmpHeader = Array("424D","00000000","0000","0000","00000000")
      	BmpHeader(1) = FormatHex(Hex((Len(Join(BmpHeader,"")) / 2) + (Len(Join(BmpInfoHeader,"")) / 2) + (Len(BmpColorMap) / 2) + (ImageHeight * ImageWidth) + (ImageHeight * (Len(BmpEndLine) / 2))),4,0,true)
      	BmpHeader(4) = FormatHex(Hex((Len(Join(BmpHeader,"")) / 2) + (Len(Join(BmpInfoHeader,"")) / 2) + (Len(BmpColorMap) / 2)),4,0,true)
      
      	Response.Clear
      	Response.Buffer = True
      	Response.ContentType = "image/bmp"
      	Response.AddHeader "Content-Disposition", "inline; filename=captcha.bmp"
      	Response.CacheControl = "no-cache"
      	Response.AddHeader "Pragma", "no-cache"
      	Response.Expires = -1
      
      	SendHex(Join(BmpHeader,""))
      	SendHex(Join(BmpInfoHeader,""))
      	SendHex(BmpColorMap)
      	for y=ImageHeight to 1 step -1
      		for x=1 to ImageWidth
      			tmpHex = Bitmap(y,x)
      			if tmpHex = vbNullString then
      				SendHex(BColor)
      			else
      				SendHex(tmpHex)
      			end if
      		next
      		SendHex(BmpEndLine)
      	next
      	Response.Flush
      end sub
      %>
      
      <%
      '#Generate captcha
      if CodeType < 2 then
      	secureCode = CreateGUID(CodeLength)
      else
      	secureCode = FakeWord(CodeLength)
      end if
      Session(SessionName) = secureCode
      PrepareBitmap(secureCode)
      if (NoiseEffect > 0) and (NoiseEffect <> 3) then
      	AddNoise()
      end if
      SendBitmap()
      %>

      Comment


      • #4
        Okay, the clue to the whole thing is here in that "captcha.asp" code:
        Code:
        const SessionName = "ASPCAPTCHA" 'Where store your secure code
        ...
        Session(SessionName) = secureCode
        So when "captcha.asp" generates an image, it stores the *TEXT* of that image in that session variable. I kind of expected that, but needed to be sure.

        So then it's easy enough: You really don't need that way over-complicated TestCaptcha function in your main ASP file.
        Code:
        <%
        ' this should be more than adequate:
        ' First, get what the user entered as the captcha code:
        userCaptcha = Trim(Request.Form("captchacode"))
        If Len(userCaptcha) = 0 OR userCaptcha <> Session("ASPCAPTCHA") Then
            Response.Redirect "error.htm?Invalid+captcha+code"
        End IF
        
        ' then your email form processing is unchanged:
        ' get posted data into variables
        EmailFrom = Trim(Request.Form("EmailFrom")) 
        EmailTo = "[email protected]"
        ... etc. ...
        Set mail = Server.CreateObject("CDONTS.NewMail") 
        mail.To = EmailTo
        mail.From = EmailFrom
        mail.Subject = Subject
        mail.Body = Body
        mail.Send 
        ' redirect to success page 
        Response.Redirect("thanks.asp?" )
        %>
        Still think you should have better validation of the user input (email address, name, etc.) but this looks to be for a private web page? "Parish"? So it's probably okay.
        Be yourself. No one else is as qualified.

        Comment


        • #5
          Old Pendant thank you so much, really appreciate it. This worked great.

          Yes it is a private website so do not really need much bells and whistle and since the user field is small that is just one way to ensure that a name is entered.

          Thanks again!

          Comment

          Working...
          X