<%
'添加新留言到数据库
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
'如果其他插件使用了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
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
%>
<!--添加汉字验证结束-->
----------------------------------------------------------------------------------------------作者: 蘑菇花 时间: 2012-1-25 16:58
