古诗验证码（ASP）
xxx.asp ——这是需要验证的页面，比如在这里用户填写自己的注册资料或者内容等等[code]<%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="缘"
[COLOR=blue]'Case n... 按照上段的格式,你也可以自己增加题目,使得验证复杂些[/COLOR]
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 "验证,请填入汉字使得诗句通顺(输完回车):<br />"&vbCrlf
.Write k&"<br />"&vbCrlf
.Write k_answer&vbCrlf
.Write "</form>"
End With
End Sub
%>
<%
Call check_theom '调用主过程,此句放置在需要显示验证码的位置
%> [/code]test.asp ——提交页面,诸如发表文章向数据库写入记录的执行页面[code]<%
Sub Go_History(str1) '容错过程,出错即返回上一页
'此过程可以嵌入ASP程序的任何位置
Response.Write "<script Language=Javascript>alert('"&str1&"');location.href = 'javascript:history.go(-1)';</script>"
Response.End
End Sub
%>
<%
'以下语句放置在你认为适当的位置中
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
%> [/code]验证的题目不止限于诗句，使用者可发挥主观能动性自行修改～
转自：[url]http://www.leadbbs.com/a/a.asp?B=200&ID=2449170[/url]
例子（蓝雨程序留言本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>
[color=Red]<!--添加汉字验证输入框开始-->
<tr>
<td>汉字验证：</td>
<td>
<%
Call check_theom '调用主过程,此句放置在需要显示验证码的位置
%>
</td>
</tr>
<!--添加汉字验证输入框结束-->[/color]
<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"> 是 <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
[color=Red] '添加汉字验证开始
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
'添加汉字验证结束[/color]
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
......
%>
----------------------------------------------------------------------------------------------
[color=Red]<!--添加汉字验证开始-->
<%
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
%>
<!--添加汉字验证结束-->[/color]
---------------------------------------------------------------------------------------------- 能发这么好的帖子，太谢谢了 xiexie！！ 谢谢啦，很有用! 会被破解吗？ 谢谢楼主啊，受益匪浅啊！ 有空一起交流一下 选个好的 才有保证 这话没错
页:
[1]