D:\Temp\找图片图标\验证码\Code_22.asp 编码GB2312   函数中有无用变量[1]
<% 
'************************************************************ 
'作者：云端 
'版权：源代码公开，各种用途均可免费使用。 
'创建：2013-11-16 
'联系：QQ313801120  交流群35915100    邮箱313801120@qq.com 
'*                                    Powered By 云端 
'************************************************************ 
Option Explicit 
Call Com_CreatValidCode("VerCode3") 
Sub Com_CreatValidCode(codeName)
    Const codeLen = 4    '验证码位数 
    Const cOdds = 4    '杂点出现的机率 
    Const dbtTimes = 3    '干扰次数（安全考虑，最好不要小于2） 
    Const cAmount = 10    '字库数量 
    Const cCode = "0123456789"    '字库对应的字符 
    Const UnitWidth = 16    '字宽(要为4的倍数) 
    Const UnitHeight = 13    '字高 
    Const DotsLimit = 5    '每次删除有效点的上限(避免无法人为识别) 
    Const tryCount = 5    '避免删除有效点超过上限的尝试次数限制 
    Randomize 
    Dim I, II, III 
    '禁止缓存
    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) = "1111000000001111111000000000011111100111111001111110011111100111111001111110011111100111111001111110011111100111111001111110011111100111111001111110011111100111111001111110011111100000000001111111000000001111" 
    vNumberData(1) = "1111110001111111111100000111111111100000011111111100110001111111111111000111111111111100011111111111110001111111111111000111111111111100011111111111110001111111111111000111111111100000000011111110000000001111" 
    vNumberData(2) = "1111110000011111111110000000111111110001110011111110001111001111111111111001111111111111001111111111111001111111111111001111111111111001111111111111001111001111111001111100111111100000000011111110000000001111" 
    vNumberData(3) = "1111100000011111111100000000111111100111111001111110011111001111111111111001111111111110001111111111111000111111111111111001111111111111110011111110011111100111111001111110011111110000000011111111100000011111" 
    vNumberData(4) = "1111111100111111111110110011111111110011001111111111001100111111111001110011111111001111001111111000000000000011100000000000001111111111001111111111111100111111111111110011111111111111001111111111111100111111" 
    vNumberData(5) = "1110000000000111110011111111111111001111111111111100111111111111110011111111111111001100000011111100000111100111111111111110011111111111111001111111111111100111110011111110011111001111111001111110000000001111" 
    vNumberData(6) = "1111110000011111111110000000111111110011111001111110011111111111111001111111111111100100000111111110000000001111111000111110011111100111111001111110011111100111111001111110011111110000000011111111100000011111" 
    vNumberData(7) = "1110000000000111111000000000011111100111111001111110011111100111111111111100111111111111110011111111111110011111111111110011111111111111001111111111111100111111111111110011111111111111001111111111111100111111" 
    vNumberData(8) = "1111100000011111111100000000111111100111111001111110011111100111111001111110011111110000000011111111000000001111111100111100111111100111111001111110011111100111111001111110011111110000000011111111100000011111" 
    vNumberData(9) = "1111100000011111111100000000111111100111111001111110011111100111111001111110011111110000000001111111000000100111111111111110011111111111111001111111111111100111111001111100111111110000000011111111100000011111" 
    '随机产生字符
    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(codeName) = vCodes    '记录入Session 
    '输出图像文件头
    Response.BinaryWrite ChrB(66) & ChrB(77) & Num2ChrB(54 + UnitWidth * UnitHeight * codeLen * 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(UnitWidth * codeLen, 4) & Num2ChrB(UnitHeight, 4) & _ 
    ChrB(1) & ChrB(0) 
    '输出图像信息头
    Response.BinaryWrite ChrB(24) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & Num2ChrB(UnitWidth * UnitHeight * codeLen * 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) 
    For I = UnitHeight - 1 To 0 Step - 1    '历经所有行
        For II = 0 To codeLen - 1    '历经所有字
            For III = 1 To UnitWidth    '历经所有像素
                If Rnd * 99 + 1 >= cOdds Then    '逐行、逐字、逐像素地输出图像数据
                    Response.BinaryWrite vColorData(Mid(vCode(II), I * UnitWidth + III, 1)) 
                Else    '随机生成杂点
                    Response.BinaryWrite vColorData(1 - CInt(Mid(vCode(II), I * UnitWidth + III, 1))) 
                End If 
            Next 
        Next 
    Next 
End Sub
 
Rem 对单个字的点阵进行干扰 
Rem 干扰思想：在点阵范围内随机产生2个端点，进行连线，以位移较大的一方做横轴，先将连线上的点删除，再将被删除点的纵轴方向上方或下方的点（随机确定）移向被删除点，移动后的空白用背景色补充 
Function pcd_doubter(ByVal Str, UnitWidth, UnitHeight, DotsLimit, tryCount, dbtTimes)
    Randomize 
    Dim x1, x2, y1, y2, xOffSet, yOffSet, direction, Flag, rows, Step, yu, yuStr, I, II, III, 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) 
            'x,y位移量
            xOffSet = Abs(x2 - x1) 
            yOffSet = Abs(y2 - y1) 
            If xOffSet >= yOffSet Then    '以位移量较大方做横轴
                direction = "x" 
                ReDim ary(xOffSet)    '用来记录连线各点y值 
                'x2,y2存储x值较大的点
                If x2 < x1 Then
                    I = x1 
                    x1 = x2 
                    x2 = I 
                    I = y1 
                    y1 = y2 
                    y2 = I 
                End If 
                '判断从x1->x2在纵轴方向上是增是减
                If y2 >= y1 Then
                    Flag = 1 
                Else
                    Flag = -1 
                End If 
                '下面计算连线上点的分布（先是平均分配各行的点，然后随机分配剩余的点到各行）
                rows = yOffSet + 1    '所占行数 
                Step =(xOffSet + 1) \ rows    '各行平均分配的点 
                yu =(xOffSet + 1) Mod rows    '剩余的点数 
                ReDim ary2(rows - 1)    '用来记录剩余点的随机分配 
                While yu > 0
                    I = Int(Rnd * rows) 
                    ary2(I) = ary2(I) & "."    '被分配到的行则加一个字符"." 
                    yu = yu - 1 
                Wend 
                III = 0 
                '将连线的点信息记录到数组
                For I = 0 To rows - 1
                    For II = 1 To Step + Len(ary2(I))
                        ary(III) = y1 + I * Flag 
                        III = III + 1 
                    Next 
                Next 
                II = 0 
                '统计连线上有效点的数量
                For I = 0 To xOffSet
                    If pcd_getDot(x1 + I, ary(I), Str, UnitWidth) = "0" Then II = II + 1 
                Next 
            Else
                '这里是以y为横轴，原理与x时相同
                direction = "y" 
                ReDim ary(yOffSet) 
                If y2 < y1 Then
                    I = x1 
                    x1 = x2 
                    x2 = I 
                    I = y1 
                    y1 = y2 
                    y2 = I 
                End If 
                If x2 >= x1 Then
                    Flag = 1 
                Else
                    Flag = -1 
                End If 
                rows = xOffSet + 1 
                Step =(yOffSet + 1) \ rows 
                yu =(yOffSet + 1) Mod rows 
                ReDim ary2(rows - 1) 
                While yu > 0
                    I = Int(Rnd * 10) 
                    If I < rows Then
                        ary2(I) = ary2(I) & "." 
                        yu = yu - 1 
                    End If 
                Wend 
                III = 0 
                For I = 0 To rows - 1
                    For II = 1 To Step + Len(ary2(I))
                        ary(III) = x1 + I * Flag 
                        III = III + 1 
                    Next 
                Next 
                II = 0 
                For I = 0 To yOffSet
                    If pcd_getDot(ary(I), y1 + I, Str, UnitWidth) = "0" Then II = II + 1 
                Next 
            End If 
            '如未超过有效点上限则跳出循环，执行干扰
            If II <= DotsLimit Then Exit For 
        Next 
        If direction = "x" Then
            '随机确定在纵轴方向上或下进行移动
            If Int(Rnd * 10) > 4 Then
                '变量连线上的点
                For I = 0 To xOffSet
                    '遍历移动
                    For II = ary(I) To 1 Step - 1
                        Call pcd_setDot(x1 + I, II, Str, pcd_getDot(x1 + I, II - 1, Str, UnitWidth), UnitWidth) 
                    Next 
                    '添补空白
                    Call pcd_setDot(x1 + I, 0, Str, "1", UnitWidth) 
                Next 
            Else
                For I = 0 To xOffSet
                    For II = ary(I) To UnitHeight - 2
                        Call pcd_setDot(x1 + I, II, Str, pcd_getDot(x1 + I, II + 1, Str, UnitWidth), UnitWidth) 
                    Next 
                    Call pcd_setDot(x1 + I, UnitHeight - 1, Str, "1", UnitWidth) 
                Next 
            End If 
        Else
            If Int(Rnd * 10) > 4 Then
                For I = 0 To yOffSet
                    For II = ary(I) To 1 Step - 1
                        Call pcd_setDot(II, y1 + I, Str, pcd_getDot(II - 1, y1 + I, Str, UnitWidth), UnitWidth) 
                    Next 
                    Call pcd_setDot(0, y1 + I, Str, "1", UnitWidth) 
                Next 
            Else
                For I = 0 To yOffSet
                    For II = ary(I) To UnitWidth - 2
                        Call pcd_setDot(II, y1 + I, Str, pcd_getDot(II + 1, y1 + I, Str, UnitWidth), UnitWidth) 
                    Next 
                    Call pcd_setDot(UnitWidth - 1, y1 + I, Str, "1", UnitWidth) 
                Next 
            End If 
        End If 
    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(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
 
%>