首页 / 网页编程 / ASP / 反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
 %>
<！-- #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
%>