反SPAM新思路—换Z-BLOG的验证码！

最近我们一些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

%>





<%

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

%>

时间： 2024-10-13 16:15:41

反SPAM新思路—换Z-BLOG的验证码！

反SPAM新思路—换Z-BLOG的验证码！的相关文章

反SPAM新思路—换Z-BLOG的验证码！_应用技巧

反spam与spam间的较量

闲话：spam、帖吧、网摘、其他

用 Flask 来写个轻博客 (20) — 实现注册表单与应用 reCAPTCHA 来实现验证码

wordpress广告垃圾评论过滤(验证码、关键词)

Google是如何决定blog搜索结果排名的？

Blog个性域名

反垃圾网站是全球性重任关键在于积极协作

反垃圾网站是全球性重任关键在于积极协作_IT 业界