当前位置: 首页 > 图文教程 > 网络编程 > ASP > 反SPAM新思路—换Z-BLOG的验证码!

ASP
asp实现取得数组中的最大值的代码
asp 将日期格式化为需要的格式
asp 下产生任意位数随机密码的代码
asp下返回以千分位显示数字格式化的数值
asp重定向页面的方法总结
asp下去除数组中重复的项的方法
asp下实现 重新排序数字数组的代码
asp 验证输入网址是否有效并可以访问 与正则验证输入网址
asp验证Ip格式的函数
asp实现生成由数字,大写字母,小写字母指定位数的随机数
asp 格式化sql中的like字符串
asp 实现显示所有的服务器变量值的函数
asp 取得用户真实IP,对代理地址仍然有效的函数
asp 通用数据库连接过程函数
asp 字符串截取函数
asp下实现格式化文件大小以MB显示的函数
asp 下用正则表达式检测邮箱格式的函数
asp 实现检测字符串是否为纯字母和数字组合的函数
asp代码实现检测组件是否安装的函数
asp通过JMAIL实现通用发送函数

ASP 中的 反SPAM新思路—换Z-BLOG的验证码!


出处:互联网   整理: 软晨网(RuanChen.com)   发布: 2009-09-13   浏览: 48 ::
收藏到网摘: n/a

最近我们一些Z-BLOGGER都在想做个什么插件拦住SPAM,当然解决方法也不是没有,就是弄个超强的服务器,可惜搞不起。那……我们只好从SPAMMER的角度来想了。
  懂一些的人可能知道,SPAM软件的基本原理是[搜索目标]-进入网站-扫描验证码-OCR-[填写表单]-POST。每一步我们都可以加以防范,比较现实的是防止SPAM软件成功的OCR出验证码。Z-BLOG自带的验证码实在有点弱,干扰点等于没有,感觉可以轻易的分析出验证码里的数字。解决方法就是——换一个验证码程序。
  这个验证码程序(就是我现在用的)是从月光留言本里挖出来的,稍加修改,以便适应Z-BLOG。个人认为要编出软件OCR这个验证码是有点难度的,应该可以换取片刻的安宁。当然,这只是权宜之计,如果广泛使用,势必还会有高手来破解的。所以啊……最好官方能弄个服务器,有时候,我觉得商业化或是适当引进投资也是不错的~
目前还在测试效果,3-28晚开始。到目前(07-03-30)为止共收到1个SPAM(包括被拦截的。),内容和别的SPAM不一样,应该不是那个垃圾SEO网站的作品(很大胆的加了2个链接),而且不是提交在在一般搜索引擎搜索进来的《google加了一个网页恶意软件检测?》,而是在我的留言本。根据REFERER的结果应该是从主页过去的(也不排除从别的地方进去而没有执行脚本或提交refer信息),怀疑为人工SPAM(UPDATE:Haphic也收到了一个同样的。到底是不是人工的?他用的验证码是原版的……),换验证码的效果还需继续观察……
c_validcode.asp代码
复制代码 代码如下:

<%@ CODEPAGE=65001 %>
<% Option Explicit %>
<%
'On Error Resume Next
%>
<!-- #include file="../c_option.asp" -->
<!-- #include file="../function/c_function.asp" -->
<%
Response.buffer=true
Call Com_CreatValidCode("CheckCode")
Rem 生成验证码图片
Sub Com_CreatValidCode(pSN)
Const codeLenMin = 5 '验证码位数范围
Const codeLenMax = 5 '验证码位数范围
Const cOdds = 2 '杂点出现的机率
Const dbtTimes = 1 '干扰次数
Const posX = 3 '位置随机范围X
Const posY = 2 '位置随机范围Y
ImgWidth = 60 '图像宽(要为4的倍数)
ImgHeight = 20 '图像高
Const cAmount = 10 '字库数量
Const cCode = "0123456789" '字库对应的字符
Const UnitWidth = 16 '字宽(要为4的倍数)
Const UnitHeight = 15 '字高
Const DotsLimit = 10 '每次删除有效点的上限(避免无法人为识别)
Const tryCount = 5 '避免删除有效点超过上限的尝试次数限制
'-----------
Randomize
Dim i,ii,iii,flag,ActUnitWidth,ImgYuWidth,codeLen,ImgWidth,ImgHeight
codeLen = codeLenMin + cint(Rnd*(codeLenMax-codeLenMin))
If ImgWidth Mod 4 <> 0 Or ImgWidth < codeLen*UnitWidth Then ImgWidth = codeLen*UnitWidth
If ImgHeight < UnitHeight Then ImgHeight = UnitHeight
' 禁止缓存
Response.Expires = -9999
Response.AddHeader "Pragma","no-cache"
Response.AddHeader "cache-ctrol","no-cache"
Response.ContentType = "Image/BMP"
' 颜色的数据(字符,背景)
Dim vColorData(1)
vColorData(0) = ChrB(0) & ChrB(0) & ChrB(0) ' 蓝0,绿0,红0(黑色)前景色
vColorData(1) = ChrB(255) & ChrB(255) & ChrB(255) ' 蓝250,绿236,红211(浅蓝色)背景色
' 字符的数据(可以自己修改,如果修改了尺寸,记得把前面的设定也改了)
Dim vNumberData(9)
vNumberData(0) = "111111111111111111110000000011111110000000000111111001111110011111100111111001111110011111100111111001111110011111100111111001111110011111100111111001111110011111100111111001111110011111100111111000000000011111110000000011111111111111111111"
vNumberData(1) = "111111111111111111111100011111111111000001111111111000000111111111001100011111111111110001111111111111000111111111111100011111111111110001111111111111000111111111111100011111111111110001111111111000000000111111100000000011111111111111111111"
vNumberData(2) = "111111111111111111111100000111111111100000001111111100011100111111100011110011111111111110011111111111110011111111111110011111111111110011111111111110011111111111110011110011111110011111001111111000000000111111100000000011111111111111111111"
vNumberData(3) = "111111111111111111111000000111111111000000001111111001111110011111100111110011111111111110011111111111100011111111111110001111111111111110011111111111111100111111100111111001111110011111100111111100000000111111111000000111111111111111111111"
vNumberData(4) = "111111111111111111111111001111111111101100111111111100110011111111110011001111111110011100111111110011110011111110000000000000111000000000000011111111110011111111111111001111111111111100111111111111110011111111111111001111111111111111111111"
vNumberData(5) = "111111111111111111100000000001111100000000000111110011111111111111001111111111111100111111111111110011000000111111000001111001111111111111100111111111111110011111111111111001111100111111100111110011111110011111100000000011111111111111111111"
vNumberData(6) = "111111111111111111111100000111111111100000001111111100111110011111100111111111111110011111111111111001000001111111100000000011111110001111100111111001111110011111100111111001111110011111100111111100000000111111111000000111111111111111111111"
vNumberData(7) = "111111111111111111100000000001111110000000000111111001111110011111100111111001111111111111001111111111111100111111111111100111111111111100111111111111110011111111111111001111111111111100111111111111110011111111111111001111111111111111111111"
vNumberData(8) = "111111111111111111111000000111111111000000001111111001111110011111100111111001111110011111100111111100000000111111110000000011111111001111001111111001111110011111100111111001111110011111100111111100000000111111111000000111111111111111111111"
vNumberData(9) = "111111111111111111111000000111111111000000001111111001111110011111100111111001111110011111100111111100000000011111110000001001111111111111100111111111111110011111111111111001111110011111001111111100000000111111111000000111111111111111111111"
' 随机产生字符
Dim vCode(), vCodes
ReDim vCode(codeLen-1)
vCodes = GetVerifyNumber
For i = 0 To 4
vCode(i) = cint(mid(vCodes,i+1,1))
vCode(i) = pcd_doubter(vNumberData(vCode(i)),UnitWidth,UnitHeight,DotsLimit,tryCount,dbtTimes)
Next
' 随机产生字符
'Dim vCodes
'ReDim vCode(codeLen-1)
'For i = 0 To codeLen-1
' vCode(i) = Int(Rnd * cAmount)
' vCodes = vCodes & Mid(cCode, vCode(i) + 1, 1)
' vCode(i) = pcd_doubter(vNumberData(vCode(i)),UnitWidth,UnitHeight,DotsLimit,tryCount,dbtTimes)
'Next
'Session(pSN) = vCodes '记录入Session
' 输出图像文件头
Response.BinaryWrite ChrB(66) & ChrB(77) & Num2ChrB(54+ImgWidth*ImgHeight*3,4) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(54) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(40) & ChrB(0) & ChrB(0) & ChrB(0) & Num2ChrB(ImgWidth,4) & Num2ChrB(ImgHeight,4) & ChrB(1) & ChrB(0)
' 输出图像信息头
Response.BinaryWrite ChrB(24) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & Num2ChrB(ImgWidth*ImgHeight*3,4) & ChrB(18) & ChrB(11) & ChrB(0) & ChrB(0) & ChrB(18) & ChrB(11) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0)
' 生成干扰线
ReDim noiseLine(1,-1)
Call makeNoise(noiseLine,ImgWidth,ImgHeight)
Call makeNoise(noiseLine,ImgWidth,ImgHeight)
' 如果想多画几条直接复制就可以
' Call makeNoise(noiseLine,ImgWidth,ImgHeight)
' 位置随机
ActUnitWidth = Int(ImgWidth / codeLen)
ImgYuWidth = ImgWidth - ActUnitWidth * codeLen
ReDim posAry(1,codeLen-1)
posAry(0,0) = Int((Rnd)*(posX+(ActUnitWidth-UnitWidth)/2))
posAry(1,0) = Int((ImgHeight-UnitHeight)/2+(1-2*Rnd)*posY)
For i=1 To codeLen-2
posAry(0,i) = Int((1-2*Rnd)*(posX+(ActUnitWidth-UnitWidth)/2))
posAry(1,i) = Int((ImgHeight-UnitHeight)/2+(1-2*Rnd)*posY)
Next
If codeLen > 1 Then
posAry(0,codeLen-1) = Int((Rnd)*(posX+(ActUnitWidth-UnitWidth)/2))
posAry(1,codeLen-1) = Int((ImgHeight-UnitHeight)/2+(-Rnd)*posY)
End If
' 输出图像数据
For i = ImgHeight-1 To 0 Step -1 '行
For ii = 0 To codeLen-1 '字
For iii = 0 To ActUnitWidth-1 '字宽
flag = 0
If onNoiseLine(noiseLine,ii*ActUnitWidth+iii,i) Then ' 干扰线
flag = 1
ElseIf getUnitDot(posAry,vCode,ii,iii,i,UnitWidth,UnitHeight) = "0" Then
flag = 1
ElseIf getUnitDot(posAry,vCode,ii-1,iii+ActUnitWidth,i,UnitWidth,UnitHeight) = "0" Then
flag = 1
ElseIf getUnitDot(posAry,vCode,ii+1,iii-ActUnitWidth,i,UnitWidth,UnitHeight) = "0" Then
flag = 1
End If
' 随机生成杂点
If Rnd * 99 + 1 < cOdds Then flag = 1 - flag
Response.BinaryWrite vColorData(1-flag)
Next
Next
For ii = 0 To ImgYuWidth-1
Response.BinaryWrite vColorData(1)
Next
Next
End Sub
Rem 获取单元的点(考虑位移)
Function getUnitDot(ByRef posAry,ByRef vCode,i,ByVal x,ByVal y,UnitWidth,UnitHeight)
getUnitDot = "1"
If i < 0 Or i > UBound(vCode) Then Exit Function
x = x - posAry(0,i)
If x < 0 Or x >= UnitWidth Then Exit Function
y = y - posAry(1,i)
If y < 0 Or y >= UnitHeight Then Exit Function
getUnitDot = Mid(vCode(i),y*UnitWidth+x+1,1)
End Function
Rem 生成干扰线
Sub makeNoise(ByRef nl,imgW,UnitHeight)
Dim i,l,x1,y1,x2,y2,dx,dy,deltaT
x1 = Int(Rnd*imgW)
y1 = Int(Rnd*UnitHeight)
x2 = Int(Rnd*imgW)
y2 = Int(Rnd*UnitHeight)
dx = X2 - X1
dy = Y2 - Y1
If Abs(dx) > Abs(dy) Then deltaT = Abs(dx) Else deltaT = Abs(dy)
If deltaT = 0 Then Exit Sub
l = UBound(nl,2)
ReDim Preserve nl(1,l+deltaT+1)
l = l + 1
For i = 0 To deltaT
nl(0,l+i) = x1 + dx * i \ deltaT
nl(1,l+i) = y1 + dy * i \ deltaT
Next
End Sub
Rem 判断是否为干扰线上的点
Function onNoiseLine(ByRef nl,x,y)
onNoiseLine = False
Dim i
For i=0 To UBound(nl,2)
If x = nl(0,i) And y = nl(1,i) Then
onNoiseLine = True
Exit For
End If
Next
End Function
Rem 对单个字的点阵进行干扰
Rem 干扰思想:在点阵范围内随机产生2个端点,进行连线,以位移较大的一方做横轴,先将连线上的点删除,再将被删除点的纵轴方向上方或下方的点(随机确定)移向被删除点,移动后的空白用背景色补充
Function pcd_doubter(ByVal str,UnitWidth,UnitHeight,DotsLimit,tryCount,dbtTimes)
Randomize
Dim x1,x2,y1,y2,dx,dy,deltaT,i,ii,way,f1,f2
For f1=1 To dbtTimes '干扰次数
For f2=1 To tryCount '避免删除有效点超过上限的尝试次数限制
'随机确定2个端点
x1 = int(Rnd*UnitWidth)
x2 = int(Rnd*UnitWidth)
y1 = int(Rnd*UnitHeight)
y2 = int(Rnd*UnitHeight)
dx = X2 - X1
dy = Y2 - Y1
If Abs(dx) > Abs(dy) Then deltaT = Abs(dx) Else deltaT = Abs(dy)
ReDim ary(1,deltaT) '存储连线的点
If deltaT = 0 Then
ary(0,0) = x1
ary(1,0) = y1
Else
ii = 0
For i = 0 To deltaT
ary(0,i) = x1 + dx * i \ deltaT
ary(1,i) = y1 + dy * i \ deltaT
If pcd_getDot(ary(0,i),ary(1,i),str,UnitWidth) = "0" Then ii = ii + 1
Next
' 统计连线上有效点的数量,如未超过有效点上限则跳出循环,执行干扰
If ii <= DotsLimit Then Exit For
End If
Next
' 执行干扰(dx,dy改作不同的方向标记用)
If Abs(dx) > Abs(dy) Then dx = 1 Else dx = 0
If dx = 1 Then
If Int(Rnd*10) > 4 Then
dy = 1
way = -1
Else
dy = UnitHeight - 2
way = 1
End If
Else
If Int(Rnd*10) > 4 Then
dy = 1
way = -1
Else
dy = UnitWidth - 2
way = 1
End If
End If
For i=0 To deltaT
For ii=ary(dx,i) To dy Step way
Call pcd_setDot(ary(0,i)*dx+ii*(1-dx),ary(1,i)*(1-dx)+ii*(dx),str,pcd_getDot(ary(0,i)*dx+(ii+way)*(1-dx),ary(1,i)*(1-dx)+(ii+way)*(dx),str,UnitWidth),UnitWidth)
Next
'添补空白
Call pcd_setDot(ary(0,i)*dx+(dy+way)*(1-dx),ary(1,i)*(1-dx)+(dy+way)*(dx),str,"1",UnitWidth)
Next
Next
pcd_doubter = str
End Function
Rem 得到某点的字符
Function pcd_getDot(x,y,str,UnitWidth)
pcd_getDot = Mid(str,x+1+y*UnitWidth,1)
End Function
Rem 设置某点的字符
Sub pcd_setDot(x,y,ByRef str,newDot,UnitWidth)
str = Left(str,x+y*UnitWidth) & newDot & Right(str,Len(str)-x-y*UnitWidth-1)
End Sub
Rem 将数字转为bmp需要的格式 lens是目标字节长度
Function Num2ChrB(ByVal num,lens)
Dim ret,i
ret = ""
While (num>0)
ret = ret & ChrB(num mod 256)
num = num \ 256
WEnd
For i=Lenb(ret) To lens-1
ret = ret & chrB(0)
Next
Num2ChrB = ret
End Function
%>