返回列表 发帖

[LeadBBS相关] 古诗验证码(ASP)

xxx.asp ——这是需要验证的页面,比如在这里用户填写自己的注册资料或者内容等等
  1. <%
  2. Function answer_re(k_answer)   '这个函数将??符号转换为可供填写的文本框
  3.                                '该段函数可以嵌入在ASP程序任何位置
  4.      if k_answer<>"" then
  5.      k_answer=replace(k_answer,"??","<input type='text' size='1' maxlength='1' name='k_session' />")
  6.      end if
  7. answer_re=k_answer
  8. End Function

  9. Sub check_theom    '主过程
  10.                    '该段过程可以嵌入在ASP程序任何位置
  11.      Dim num,k,k_session,k_answer
  12.      randomize
  13.      num=cint(rnd*3)  '3为验证诗句的总数,自定义了多少题目,就写上相应的数字
  14.      if num=0 then    '容错
  15.            num=num+1
  16.      end if

  17.      Select Case num
  18.      Case 1
  19.      k="野火烧不尽"         '提示题目,可以自行修改提问
  20.      k_answer="春风??又生"  '用??代替需要用户填写的文本框
  21.      k_session="吹"         '正确答案

  22.      Case 2
  23.      k="床前明月光"
  24.      k_answer="疑是??上霜"
  25.      k_session="地"

  26.      Case 3
  27.      k="不识庐山真面目"
  28.      k_answer="只??身在此山中"
  29.      k_session="缘"

  30.      [COLOR=blue]'Case n...  按照上段的格式,你也可以自己增加题目,使得验证复杂些[/COLOR]

  31.      Case Else               '容错
  32.      k="验证出错"&num:k_answer="验证出错":k_session=""
  33.      End Select

  34.      k_answer=answer_re(k_answer)   '执行转换函数
  35.      session("check_theom")=k_session    '通过session记录正确答案

  36.      With Response     '输出文字和格式到前台
  37.            .Write "<form method='post' name='check_form' action='test.asp'>"  '测试form,实际使用时应去掉
  38.            .Write "验证,请填入汉字使得诗句通顺(输完回车):<br />"&vbCrlf
  39.            .Write k&"<br />"&vbCrlf
  40.            .Write k_answer&vbCrlf
  41.            .Write "</form>"
  42.      End With
  43. End Sub
  44. %>

  45. <%
  46. Call check_theom    '调用主过程,此句放置在需要显示验证码的位置
  47. %>
复制代码
test.asp ——提交页面,诸如发表文章向数据库写入记录的执行页面
  1. <%
  2. Sub Go_History(str1)   '容错过程,出错即返回上一页
  3.                        '此过程可以嵌入ASP程序的任何位置
  4.      Response.Write "<script Language=Javascript>alert('"&str1&"');location.href = 'javascript:history.go(-1)';</script>"
  5.      Response.End
  6. End Sub
  7. %>

  8. <%
  9. '以下语句放置在你认为适当的位置中

  10. Dim k_post
  11. k_post=Trim(Request.Form("k_session"))   '获取用户填写的内容
  12. if k_post<>session("check_theom") or k_post="" then  '与session中存储的正确答案比对
  13.      Go_History("验证码不符!")
  14. end if

  15. Response.Write "验证码正确!"            '此句在测试中使用的,在实际使用中可以删掉
  16. session.abandon     '程序结束时将session释放

  17. '如果其他插件使用了session,建议将session.abandon改为session("check_theom")=Empty
  18. %>
复制代码
验证的题目不止限于诗句,使用者可发挥主观能动性自行修改~

转自:http://www.leadbbs.com/a/a.asp?B=200&ID=2449170
欢迎光临:逐梦论坛

例子(蓝雨程序留言本book.asp)

Sub Add_New()%>
<table width="520" border="0" cellspacing="1" cellpadding="0" align="center"><tr><td>
<table width="450" cellpadding="1" cellspacing="0" align="center" >
<form name="new" method="post" action="book.asp?Add_New_Execute">
<tr>
<td width="80">您的姓名:</td>
<td width="300"><input type="text" name="name" maxlength="255" size="20" class='lanyu'>   <font color=red>*</font></td>
</tr>
<!--添加汉字验证输入框开始-->
<tr>
<td>汉字验证:</td>
<td>
<%
Call check_theom   '调用主过程,此句放置在需要显示验证码的位置
%>
</td>
</tr>
<!--添加汉字验证输入框结束-->

<tr>
<td>您的性别:</td>
<td><input type="radio" name="SEX" value="0" checked>人妖 <input type="radio" name="SEX" value="1">亚当 <input type="radio" name="SEX" value="2">夏娃</td>
</tr>
<tr>
<td>电子邮箱:</td>
<td><input type="text" name="email" maxlength="255" size="20" class='lanyu'></td>
</tr>
<tr>
<td>腾迅 QQ:</td>
<td><input type="text" name="qq" maxlength="255" size="20" class='lanyu'></td>
</tr>
<tr>
<td>个人主页:</td>
<td><input type="text" name="web" maxlength="255" size="20" class='lanyu'></td>
</tr>
<tr> <td>来自哪里:</td>
<td><input type="text" name="city" maxlength="255" size="20" class='lanyu'></td>
</tr>
<tr><td>类型选择:</td>
<td><input type="radio" name="title" value="1" checked><font color=#0000FF>留言</font> <input type="radio" name="title" value="2"><font color=#FF00FF>建议</font> <input type="radio" name="title" value="3"><font color=#FF7F50>报错</font> <input type="radio" name="title" value="4"><font color=#228B22>连接</font> <input type="radio" name="title" value="5"><font color=#1E90FF>其它</font></td>
</tr>
<tr>
<td valign="middle">留言内容: <br></td>
<td  valign="top"><textarea name="words" cols="40" rows="6" class='lanyu'></textarea></td>
</tr>
<tr>
<td valign="middle">是否隐藏:</td>
<td valign="top">
<input type="radio" name="admin" value="0" checked> 否 <input type="radio" name="admin" value="1"> 是&nbsp;&nbsp;<font color=#009900>*</font> 选择隐藏后,此留言只有管理员可以看到。</td>
</tr><tr>
<td align="center"  height="40" colspan="2">
<input type="hidden" name="action_e" value="Add_New"> <input type="submit"  class='button' name="Submit" value="提交" >
        <input type="reset" name="Submit2" value="重写"  class='button'>
</td>
</tr>
</form>
</table>
</td>
</tr>
</table>
</td>
</tr>
</table>
<% End Sub
----------------------------------------------------------------------------------------------

<%
'添加新留言到数据库
Sub Add_New_Execute()
        If Request.Form("name")="" Then
        Response.Write "<script language=javascript>alert('姓名不能为空!');javascript:history.back();</script>"
        Response.End
        End If
        If Len(Request.Form("name"))>20 Then
        Response.Write "<script language=javascript>alert('姓名不能太长!');javascript:history.back();</script>"
        Response.End
        End If
        If Request.Form("email")<>"" Then
        If instr(Request.Form("email"),"@")=0 or instr(Request.Form("email"),"@")=1 or         instr(Request.Form("email"),"@")=len(email) then
        Response.Write "<script language=javascript>alert('电子信箱格式填写不正确!');javascript:history.back();</script>"
        Response.End
        End If
        End If
        If Request.Form("words")="" Then
        Response.Write "<script language=javascript>alert('留言不能为空!');javascript:history.back();</script>"
        Response.End
        End If
        '添加汉字验证开始
        Dim k_post
        k_post=Trim(Request.Form("k_session"))   '获取用户填写的内容
        if k_post<>session("check_theom") or k_post="" then   '与session中存储的正确答案比对
        Go_History("验证码不符!")
        end if

        'Response.Write "验证码正确!"           '此句在测试中使用的,在实际使用中可以删掉
        session.abandon     '程序结束时将session释放

        '如果其他插件使用了session,建议将session.abandon改为session("check_theom")=Empty
        '添加汉字验证结束

        Set Rs = Server.CreateObject("ADODB.RecordSet")
        Sql="Select * From words"
        Rs.Open Sql,Conn,2,3
        Rs.AddNew
        Rs("name")=Server.HTMLEncode(Request.Form("name"))
        Rs("sex")=Server.HTMLEncode(Request.Form("sex"))
        Rs("qq")=Server.HTMLEncode(Request.Form("qq"))
        Rs("uc")=Server.HTMLEncode(Request.Form("uc"))
        Rs("city")=Server.HTMLEncode(Request.Form("city"))
        Rs("web")=Server.HTMLEncode(Request.Form("web"))
        Rs("email")=Server.HTMLEncode(Request.Form("email"))
        Rs("admin")=Server.HTMLEncode(Request.Form("admin"))
        Rs("title")=Server.HTMLEncode(Request.Form("title"))
        Rs("words")=Server.HTMLEncode(Request.Form("words"))
        Rs("date")=Now()
        Rs("ip")=request.servervariables("remote_addr")
        Rs.Update
        Rs.Close
        Set Rs = Nothing
Response.write "<script language = 'javascript'>alert('发表成功!');"
Response.write "window.document.location.href='book.asp';</script>"
End Sub
......
%>
----------------------------------------------------------------------------------------------

<!--添加汉字验证开始-->
<%
Function answer_re(k_answer)   '这个函数将??符号转换为可供填写的文本框
                               '该段函数可以嵌入在ASP程序任何位置
     if k_answer<>"" then
     k_answer=replace(k_answer,"??","<input type='text' size='1' maxlength='1' name='k_session' />")
     end if
answer_re=k_answer
End Function

Sub check_theom    '主过程
                   '该段过程可以嵌入在ASP程序任何位置
     Dim num,k,k_session,k_answer
     randomize
     num=cint(rnd*3)  '3为验证诗句的总数,产生随机数字以便抽取题目
     if num=0 then    '容错
           num=num+1
     end if

     Select Case num
     Case 1
     k="野火烧不尽,"         '提示题目,可以自行修改提问
     k_answer="春风??又生。"  '用??代替需要用户填写的文本框
     k_session="吹"         '正确答案

     Case 2
     k="床前明月光,"
     k_answer="疑是??上霜。"
     k_session="地"

     Case 3
     k="不识庐山真面目,"
     k_answer="只??身在此山中。"
     k_session="缘"

     Case Else               '容错
     k="验证出错"&num:k_answer="验证出错":k_session=""
     End Select

     k_answer=answer_re(k_answer)   '执行转换函数
     session("check_theom")=k_session    '通过session记录正确答案

     With Response     '输出文字和格式到前台
           '.Write "<form method='post' name='check_form' action='test.asp'>"  '测试form,实际使用时应去掉
           .Write k&vbCrlf
           .Write k_answer&vbCrlf
           .Write "<br>(验证,请填入汉字使得诗句通顺)"&vbCrlf
           '.Write "</form>"
           .Write "<font color=red>*</font>"
     End With
End Sub

Sub Go_History(str1)   '容错过程,出错即返回上一页
                       '此过程可以嵌入ASP程序的任何位置
     Response.Write "<script Language=Javascript>alert('"&str1&"');location.href = 'javascript:history.go(-1)';</script>"
     Response.End
End Sub
%>
<!--添加汉字验证结束-->

----------------------------------------------------------------------------------------------
欢迎光临:逐梦论坛

TOP

能发这么好的帖子,太谢谢了

TOP

xiexie!!

TOP

谢谢啦,很有用!

TOP

会被破解吗?

TOP

谢谢楼主啊,受益匪浅啊!

TOP

有空一起交流一下

TOP

选个好的 才有保证 这话没错

TOP

返回列表

Powered by Discuz! 7.2   论坛QQ群:逐梦论坛群

© 2001-2021 Comsenz Inc. 鲁公网安备 37120302000001号