给我,好吗
<%@language="vbscript" codepage="936"%>
<%
Option Explicit
Call Com_CreatValidCode("SessionName")
Rem 生成验证码图片
Sub Com_CreatValidCode(pSN)
Const codeLen = 8'验证码位数
Const cOdds = 4 '杂点出现的机率
Const dbtTimes = 2'干扰次数(安全考虑,最好不要小于2)
Const cAmount = 8 '字库数量
Const cCode = "0123456789ABCDEFGHIJKLMNOPRSTUVWXYZ"'字库对应的字符
Const UnitWidth = 16'字宽(要为4的倍数)
Const UnitHeight = 13'字高
Const DotsLimit = 10'每次删除有效点的上限(避免无法人为识别)
Const tryCount = 5'避免删除有效点超过上限的尝试次数限制
Randomize
Dim i, ii, iii
Response.Expires = -1
Response.AddHeader "Pragma","no-cache"
Response.AddHeader "cache-ctrol","no-cache"
Response.ContentType = "Image/BMP"
'(字符,背景)
Dim vColorData(1)
vColorData(0) = ChrB(0) & ChrB(255) & ChrB(0) ' 蓝0,绿0,红0(黑色)
vColorData(1) = ChrB(0) & ChrB(0) & ChrB(0) ' 蓝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("cfm") = 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(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
%>
用你的代码试了一下,我怎么显示的是BM?6(
这段代码可以生成一个图片,比较不错
调用方法
<img src="sys_code.asp" alt="验证码,看不清楚?请点击刷新验证码" width="50" height="20" border="0" align="absmiddle" onclick="this.src='sys_code.asp'" />
sys_code.asp
<%
Rem 设置部分
Const nMaxSaturation = 70 ' 最大色彩饱和度
Const nBlankNoisyDotOdds = 0.00 ' 空白处噪点率
Const nColorNoisyDotOdds = 0.00 ' 有色处噪点率
Const nCharCount = 4 ' 产生的字符个数
Const nPixelWidth = 12 ' 单个字符位图的宽度
Const nPixelHeight = 14 ' 单个字符位图的高度
Const nColorHue = -2 ' 显示验证码的色调(-1表示随机色调, -2表示灰度色调)
Const nAngleRandom = 0 ' 角度随机量
Const nLengthRandom = 13 ' 长度随机量(百分比)
Const cCharSet = "0123456789"
' 构成验证码的字符集
' 如果扩充了下边的字母矢量库,则可以相应扩充这个字符集
Rem ---------------------
Dim Buf(), DigtalStr
Dim Lines(), LineCount
Dim CursorX, CursorY, DirX, DirY
Randomize
Call CreatValidCode("syscodes")
Sub CDGen_Reset()
' 复位矢量笔和环境变量
LineCount = 0
CursorX = 0
CursorY = 0
' 初始的光笔方向是垂直向下
DirX = 0
DirY = 1
End Sub
Sub CDGen_Clear()
' 清空位图阵列
Dim i, j
ReDim Buf(nPixelHeight - 1, nCharCount * nPixelWidth - 1)
For j = 0 To nPixelHeight - 1
For i = 0 To nCharCount * nPixelWidth - 1
Buf(j, i) = 0
Next
Next
End Sub
Sub CDGen_PSet(X, Y)
' 在位图阵列上画点
Buf(Y, X) = 1
End Sub
Sub CDGen_Line(X1, Y1, X2, Y2)
' 在位图阵列上画线
Dim DX, DY, DeltaT, i
DX = X2 - X1
DY = Y2 - Y1
If Abs(DX) > Abs(DY) Then DeltaT = Abs(DX) Else DeltaT = Abs(DY)
If DeltaT = 0 Then
CDGen_PSet X1,Y1
Else
For i = 0 To DeltaT
CDGen_PSet X1 + DX * i / DeltaT, Y1 + DY * i / DeltaT
Next
End If
End Sub
Sub CDGen_FowardDraw(nLength)
' 按当前光笔方向绘制指定长度并移动光笔,正数表示从左向右/从上向下绘制,负数表示从右向左/从下向上绘制
nLength = Sgn(nLength) * Abs(nLength) * (1 - nLengthRandom / 100 + Rnd * nLengthRandom * 2 / 100)
ReDim Preserve Lines(3, LineCount)
Lines(0, LineCount) = CursorX
Lines(1, LineCount) = CursorY
CursorX = CursorX + DirX * nLength
CursorY = CursorY + DirY * nLength
Lines(2, LineCount) = CursorX
Lines(3, LineCount) = CursorY
LineCount = LineCount + 1
End Sub
Sub CDGen_SetDirection(nAngle)
' 按指定角度设定画笔方向, 正数表示相对当前方向顺时针改变方向,负数表示相对当前方向逆时针改变方向
Dim DX, DY
nAngle = Sgn(nAngle) * (Abs(nAngle) - nAngleRandom + Rnd * nAngleRandom * 2) / 180 * 3.1415926
DX = DirX
DY = DirY
DirX = DX * Cos(nAngle) - DY * Sin(nAngle)
DirY = DX * Sin(nAngle) + DY * Cos(nAngle)
End Sub
Sub CDGen_MoveToMiddle(nActionIndex, nPercent)
' 将画笔光标移动到指定动作的中间点上,nPercent为中间位置的百分比
Dim DeltaX, DeltaY
DeltaX = Lines(2, nActionIndex) - Lines(0, nActionIndex)
DeltaY = Lines(3, nActionIndex) - Lines(1, nActionIndex)
CursorX = Lines(0, nActionIndex) + Sgn(DeltaX) * Abs(DeltaX) * nPercent / 100
CursorY = Lines(1, nActionIndex) + Sgn(DeltaY) * Abs(DeltaY) * nPercent / 100
End Sub
Sub CDGen_MoveCursor(nActionIndex)
' 将画笔光标移动到指定动作的起始点上
CursorX = Lines(0, nActionIndex)
CursorY = Lines(1, nActionIndex)
End Sub
Sub CDGen_Close(nActionIndex)
' 将当前光笔位置与指定动作的起始点闭合并移动光笔
ReDim Preserve Lines(3, LineCount)
Lines(0, LineCount) = CursorX
Lines(1, LineCount) = CursorY
CursorX = Lines(0, nActionIndex)
CursorY = Lines(1, nActionIndex)
Lines(2, LineCount) = CursorX
Lines(3, LineCount) = CursorY
LineCount = LineCount + 1
End Sub
Sub CDGen_CloseToMiddle(nActionIndex, nPercent)
' 将当前光笔位置与指定动作的中间点闭合并移动光笔,nPercent为中间位置的百分比
Dim DeltaX, DeltaY
ReDim Preserve Lines(3, LineCount)
Lines(0, LineCount) = CursorX
Lines(1, LineCount) = CursorY
DeltaX = Lines(2, nActionIndex) - Lines(0, nActionIndex)
DeltaY = Lines(3, nActionIndex) - Lines(1, nActionIndex)
CursorX = Lines(0, nActionIndex) + Sgn(DeltaX) * Abs(DeltaX) * nPercent / 100
CursorY = Lines(1, nActionIndex) + Sgn(DeltaY) * Abs(DeltaY) * nPercent / 100
Lines(2, LineCount) = CursorX
Lines(3, LineCount) = CursorY
LineCount = LineCount + 1
End Sub
Sub CDGen_Flush(X0, Y0)
' 按照当前的画笔动作序列绘制位图点阵
Dim MaxX, MinX, MaxY, MinY
Dim DeltaX, DeltaY, StepX, StepY, OffsetX, OffsetY
Dim i
MaxX = MinX = MaxY = MinY = 0
For i = 0 To LineCount - 1
If MaxX < Lines(0, i) Then MaxX = Lines(0, i)
If MaxX < Lines(2, i) Then MaxX = Lines(2, i)
If MinX > Lines(0, i) Then MinX = Lines(0, i)
If MinX > Lines(2, i) Then MinX = Lines(2, i)
If MaxY < Lines(1, i) Then MaxY = Lines(1, i)
If MaxY < Lines(3, i) Then MaxY = Lines(3, i)
If MinY > Lines(1, i) Then MinY = Lines(1, i)
If MinY > Lines(3, i) Then MinY = Lines(3, i)
Next
DeltaX = MaxX - MinX
DeltaY = MaxY - MinY
If DeltaX = 0 Then DeltaX = 1
If DeltaY = 0 Then DeltaY = 1
MaxX = MinX
MaxY = MinY
OffsetX = Rnd * nLengthRandom / 100
OffsetY = Rnd * nLengthRandom / 100
If DeltaX > DeltaY Then
DeltaX = DeltaX * (1 + Rnd * nLengthRandom / 100)
StepX = (nPixelWidth - 2) / DeltaX
StepY = (nPixelHeight - 2) / DeltaX
Else
DeltaY = DeltaY * (1 + Rnd * nLengthRandom / 100)
StepX = (nPixelWidth - 2) / DeltaY
StepY = (nPixelHeight - 2) / DeltaY
End If
For i = 0 To LineCount - 1
Lines(0, i) = Round((Lines(0, i) - MaxX + OffsetX) * StepX, 0)
If Lines(0, i) < 0 Then Lines(0, i) = 0
If Lines(0, i) >= nPixelWidth - 2 Then Lines(0, i) = nPixelWidth - 3
Lines(1, i) = Round((Lines(1, i) - MaxY + OffsetY) * StepY, 0)
If Lines(1, i) < 0 Then Lines(1, i) = 0
If Lines(1, i) >= nPixelHeight - 2 Then Lines(1, i) = nPixelHeight - 3
Lines(2, i) = Round((Lines(2, i) - MinX + OffsetX) * StepX, 0)
If Lines(2, i) < 0 Then Lines(2, i) = 0
If Lines(2, i) >= nPixelWidth - 2 Then Lines(2, i) = nPixelWidth - 3
Lines(3, i) = Round((Lines(3, i) - MinY + OffsetY) * StepY, 0)
If Lines(3, i) < 0 Then Lines(3, i) = 0
If Lines(3, i) >= nPixelHeight - 2 Then Lines(3, i) = nPixelHeight - 3
CDGen_Line Lines(0, i) + X0 + 1, Lines(1, i) + Y0 + 1, Lines(2, i) + X0 + 1, Lines(3, i) + Y0 + 1
Next
End Sub
Sub CDGen_Char(cChar, X0, Y0)
' 在指定坐标处生成指定字符的位图阵列
CDGen_Reset
Select Case cChar
Case "0"
CDGen_SetDirection -60 ' 逆时针60度(相对于垂直线)
CDGen_FowardDraw -0.7 ' 反方向绘制0.7个单位
CDGen_SetDirection -60 ' 逆时针60度
CDGen_FowardDraw -0.7 ' 反方向绘制0.7个单位
CDGen_SetDirection 120 ' 顺时针120度
CDGen_FowardDraw 1.5 ' 绘制1.5个单位
CDGen_SetDirection -60 ' 逆时针60度
CDGen_FowardDraw 0.7 ' 绘制0.7个单位
CDGen_SetDirection -60 ' 顺时针120度
CDGen_FowardDraw 0.7 ' 绘制0.7个单位
CDGen_Close 0 ' 封闭当前笔与第0笔(0开始)
Case "1"
CDGen_SetDirection -90 ' 逆时针90度(相对于垂直线)
CDGen_FowardDraw 0.5 ' 绘制0.5个单位
CDGen_MoveToMiddle 0, 50 ' 移动画笔的位置到第0笔(0开始)的50%处
CDGen_SetDirection 90 ' 逆时针90度
CDGen_FowardDraw -1.4 ' 反方向绘制1.4个单位
CDGen_SetDirection 30 ' 逆时针30度
CDGen_FowardDraw 0.4 ' 绘制0.4个单位
Case "2"
CDGen_SetDirection 45 ' 顺时针45度(相对于垂直线)
CDGen_FowardDraw -0.7 ' 反方向绘制0.7个单位
CDGen_SetDirection -120 ' 逆时针120度
CDGen_FowardDraw 0.4 ' 绘制0.4个单位
CDGen_SetDirection 60 ' 顺时针60度
CDGen_FowardDraw 0.6 ' 绘制0.6个单位
CDGen_SetDirection 60 ' 顺时针60度
CDGen_FowardDraw 1.6 ' 绘制1.6个单位
CDGen_SetDirection -135 ' 逆时针135度
CDGen_FowardDraw 1.0 ' 绘制1.0个单位
Case "3"
CDGen_SetDirection -90 ' 逆时针90度(相对于垂直线)
CDGen_FowardDraw 0.8 ' 绘制0.8个单位
CDGen_SetDirection 135 ' 顺时针135度
CDGen_FowardDraw 0.8 ' 绘制0.8个单位
CDGen_SetDirection -120 ' 逆时针120度
CDGen_FowardDraw 0.6 ' 绘制0.6个单位
CDGen_SetDirection 80 ' 顺时针80度
CDGen_FowardDraw 0.5 ' 绘制0.5个单位
CDGen_SetDirection 60 ' 顺时针60度
CDGen_FowardDraw 0.5 ' 绘制0.5个单位
CDGen_SetDirection 60 ' 顺时针60度
CDGen_FowardDraw 0.5 ' 绘制0.5个单位
Case "4"
CDGen_SetDirection 20 ' 顺时针20度(相对于垂直线)
CDGen_FowardDraw 0.8 ' 绘制0.8个单位
CDGen_SetDirection -110 ' 逆时针110度
CDGen_FowardDraw 1.2 ' 绘制1.2个单位
CDGen_MoveToMiddle 1, 60 ' 移动画笔的位置到第1笔(0开始)的60%处
CDGen_SetDirection 90 ' 顺时针90度
CDGen_FowardDraw 0.7 ' 绘制0.7个单位
CDGen_MoveCursor 2 ' 移动画笔到第2笔(0开始)的开始处
CDGen_FowardDraw -1.5 ' 反方向绘制1.5个单位
Case "5"
CDGen_SetDirection 90 ' 顺时针90度(相对于垂直线)
CDGen_FowardDraw 1.0 ' 绘制1.0个单位
CDGen_SetDirection -90 ' 逆时针90度
CDGen_FowardDraw 0.8 ' 绘制0.8个单位
CDGen_SetDirection -90 ' 逆时针90度
CDGen_FowardDraw 0.8 ' 绘制0.8个单位
CDGen_SetDirection 30 ' 顺时针30度
CDGen_FowardDraw 0.4 ' 绘制0.4个单位
CDGen_SetDirection 60 ' 顺时针60度
CDGen_FowardDraw 0.4 ' 绘制0.4个单位
CDGen_SetDirection 30 ' 顺时针30度
CDGen_FowardDraw 0.5 ' 绘制0.5个单位
CDGen_SetDirection 60 ' 顺时针60度
CDGen_FowardDraw 0.8 ' 绘制0.8个单位
Case "6"
CDGen_SetDirection -60 ' 逆时针60度(相对于垂直线)
CDGen_FowardDraw -0.7 ' 反方向绘制0.7个单位
CDGen_SetDirection -60 ' 逆时针60度
CDGen_FowardDraw -0.7 ' 反方向绘制0.7个单位
CDGen_SetDirection 120 ' 顺时针120度
CDGen_FowardDraw 1.5 ' 绘制1.5个单位
CDGen_SetDirection 120 ' 顺时针120度
CDGen_FowardDraw -0.7 ' 反方向绘制0.7个单位
CDGen_SetDirection 120 ' 顺时针120度
CDGen_FowardDraw 0.7 ' 绘制0.7个单位
CDGen_SetDirection 120 ' 顺时针120度
CDGen_FowardDraw -0.7 ' 反方向绘制0.7个单位
CDGen_SetDirection 120 ' 顺时针120度
CDGen_FowardDraw 0.5 ' 绘制0.5个单位
CDGen_CloseToMiddle 2, 50 ' 将当前画笔位置与第2笔(0开始)的50%处封闭
Case "7"
CDGen_SetDirection 180 ' 顺时针180度(相对于垂直线)
CDGen_FowardDraw 0.3 ' 绘制0.3个单位
CDGen_SetDirection 90 ' 顺时针90度
CDGen_FowardDraw 0.9 ' 绘制0.9个单位
CDGen_SetDirection 120 ' 顺时针120度
CDGen_FowardDraw 1.3 ' 绘制1.3个单位
Case "8"
CDGen_SetDirection -60 ' 逆时针60度(相对于垂直线)
CDGen_FowardDraw -0.8 ' 反方向绘制0.8个单位
CDGen_SetDirection -60 ' 逆时针60度
CDGen_FowardDraw -0.8 ' 反方向绘制0.8个单位
CDGen_SetDirection 120 ' 顺时针120度
CDGen_FowardDraw 0.8 ' 绘制0.8个单位
CDGen_SetDirection 110 ' 顺时针110度
CDGen_FowardDraw -1.5 ' 反方向绘制1.5个单位
CDGen_SetDirection -110 ' 逆时针110度
CDGen_FowardDraw 0.9 ' 绘制0.9个单位
CDGen_SetDirection 60 ' 顺时针60度
CDGen_FowardDraw 0.8 ' 绘制0.8个单位
CDGen_SetDirection 60 ' 顺时针60度
CDGen_FowardDraw 0.8 ' 绘制0.8个单位
CDGen_SetDirection 60 ' 顺时针60度
CDGen_FowardDraw 0.9 ' 绘制0.9个单位
CDGen_SetDirection 70 ' 顺时针70度
CDGen_FowardDraw 1.5 ' 绘制1.5个单位
CDGen_Close 0 ' 封闭当前笔与第0笔(0开始)
Case "9"
CDGen_SetDirection 120 ' 逆时针60度(相对于垂直线)
CDGen_FowardDraw -0.7 ' 反方向绘制0.7个单位
CDGen_SetDirection -60 ' 逆时针60度
CDGen_FowardDraw -0.7 ' 反方向绘制0.7个单位
CDGen_SetDirection -60 ' 顺时针120度
CDGen_FowardDraw -1.5 ' 绘制1.5个单位
CDGen_SetDirection -60 ' 顺时针120度
CDGen_FowardDraw -0.7 ' 反方向绘制0.7个单位
CDGen_SetDirection -60 ' 顺时针120度
CDGen_FowardDraw -0.7 ' 绘制0.7个单位
CDGen_SetDirection 120 ' 顺时针120度
CDGen_FowardDraw 0.7 ' 反方向绘制0.7个单位
CDGen_SetDirection -60 ' 顺时针120度
CDGen_FowardDraw 0.5 ' 绘制0.5个单位
CDGen_CloseToMiddle 2, 50 ' 将当前画笔位置与第2笔(0开始)的50%处封闭
' 以下为字母的矢量动作,有兴趣的可以继续
Case "A"
CDGen_SetDirection -(Rnd * 20 + 150) ' 逆时针150-170度(相对于垂直线)
CDGen_FowardDraw Rnd * 0.2 + 1.1 ' 绘制1.1-1.3个单位
CDGen_SetDirection Rnd * 20 + 140 ' 顺时针140-160度
CDGen_FowardDraw Rnd * 0.2 + 1.1 ' 绘制1.1-1.3个单位
CDGen_MoveToMiddle 0, 30 ' 移动画笔的位置到第1笔(0开始)的30%处
CDGen_CloseToMiddle 1, 70 ' 将当前画笔位置与第1笔(0开始)的70%处封闭
Case "B"
CDGen_SetDirection -(Rnd * 20 + 50) ' 逆时针50-70度(相对于垂直线)
CDGen_FowardDraw Rnd * 0.4 + 0.8 ' 绘制0.8-1.2个单位
CDGen_SetDirection Rnd * 20 + 110 ' 顺时针110-130度
CDGen_FowardDraw Rnd * 0.2 + 0.6 ' 绘制0.6-0.8个单位
CDGen_SetDirection -(Rnd * 20 + 110) ' 逆时针110-130度
CDGen_FowardDraw Rnd * 0.2 + 0.6 ' 绘制0.6-0.8个单位
CDGen_SetDirection Rnd * 20 + 110 ' 顺时针110-130度
CDGen_FowardDraw Rnd * 0.4 + 0.8 ' 绘制0.8-1.2个单位
CDGen_Close 0 ' 封闭当前笔与第1笔(0开始)
Case "C"
CDGen_SetDirection -60 ' 逆时针60度(相对于垂直线)
CDGen_FowardDraw -0.7 ' 反方向绘制0.7个单位
CDGen_SetDirection -60 ' 逆时针60度
CDGen_FowardDraw -0.7 ' 反方向绘制0.7个单位
CDGen_SetDirection 120 ' 顺时针120度
CDGen_FowardDraw 1.5 ' 绘制1.5个单位
CDGen_SetDirection 120 ' 顺时针120度
CDGen_FowardDraw -0.7 ' 反方向绘制0.7个单位
CDGen_SetDirection 120 ' 顺时针120度
CDGen_FowardDraw 0.7 ' 绘制0.7个单位
End Select
CDGen_Flush X0, Y0
End Sub
Sub CDGen_Blur()
' 对产生的位图进行柔化处理
Dim i, j
For j = 1 To nPixelHeight - 2
For i = 1 To nCharCount * nPixelWidth - 2
If Buf(j, i) = 0 Then
If ((Buf(j, i - 1) Or Buf(j + 1, i)) And 1) <> 0 Then
' 如果当前点是空白点,且上下左右四个点中有一个点是有色点,则该点做柔化处理
Buf(j, i) = 2
End If
End If
Next
Next
End Sub
Sub CDGen_NoisyDot()
' 对产生的位图进行噪点处理
Dim i, j, NoisyDot, CurDot
For j = 0 To nPixelHeight - 1
For i = 0 To nCharCount * nPixelWidth - 1
If Buf(j, i) <> 0 Then
NoisyDot = Int(Rnd * Rnd * nMaxSaturation)
Select Case nColorNoisyDotOdds
Case 0
CurDot = nMaxSaturation
Case 1
CurDot = 0
Case Else
CurDot = NoisyDot
End Select
If Rnd < nColorNoisyDotOdds Then Buf(j, i) = CurDot Else Buf(j, i) = nMaxSaturation
Else
NoisyDot = Int(Rnd * nMaxSaturation)
Select Case nBlankNoisyDotOdds
Case 0
CurDot = 0
Case 1
CurDot = nMaxSaturation
Case Else
CurDot = NoisyDot
End Select
If Rnd < nBlankNoisyDotOdds Then Buf(j, i) = CurDot Else Buf(j, i) = 0
End If
Next
Next
End Sub
Sub CDGen()
' 生成位图阵列
Dim i, Ch
DigtalStr = ""
CDGen_Clear
For i = 0 To nCharCount - 1
Ch = Mid(cCharSet, Int(Rnd * Len(cCharSet)) + 1, 1)
DigtalStr = DigtalStr + Ch
CDGen_Char Ch, i * nPixelWidth, 0
Next
CDGen_Blur
CDGen_NoisyDot
End Sub
Function HSBToRGB(vH, vS, vB)
' 将颜色值由HSB转换为RGB
Dim aRGB(3), RGB1st, RGB2nd, RGB3rd
Dim nH, nS, nB
Dim lH, nF, nP, nQ, nT
vH = (vH Mod 360)
If vS > 100 Then
vS = 100
ElseIf vS < 0 Then
vS = 0
End If
If vB > 100 Then
vB = 100
ElseIf vB < 0 Then
vB = 0
End If
If vS > 0 Then
nH = vH / 60
nS = vS / 100
nB = vB / 100
lH = Int(nH)
nF = nH - lH
nP = nB * (1 - nS)
nQ = nB * (1 - nS * nF)
nT = nB * (1 - nS * (1 - nF))
Select Case lH
Case 0
aRGB(0) = nB * 255
aRGB(1) = nT * 255
aRGB(2) = nP * 255
Case 1
aRGB(0) = nQ * 255
aRGB(1) = nB * 255
aRGB(2) = nP * 255
Case 2
aRGB(0) = nP * 255
aRGB(1) = nB * 255
aRGB(2) = nT * 255
Case 3
aRGB(0) = nP * 255
aRGB(1) = nQ * 255
aRGB(2) = nB * 255
Case 4
aRGB(0) = nT * 255
aRGB(1) = nP * 255
aRGB(2) = nB * 255
Case 5
aRGB(0) = nB * 255
aRGB(1) = nP * 255
aRGB(2) = nQ * 255
End Select
Else
aRGB(0) = (vB * 255) / 100
aRGB(1) = aRGB(0)
aRGB(2) = aRGB(0)
End If
HSBToRGB = ChrB(Round(aRGB(2), 0)) & ChrB(Round(aRGB(1), 0)) & ChrB(Round(aRGB(0), 0))
End Function
Sub CreatValidCode(pSN)
Dim i, j, CurColorHue
' 禁止缓存
Response.Expires = -9999
Response.AddHeader "pragma", "no-cache"
Response.AddHeader "cache-ctrol", "no-cache"
Response.ContentType = "image/bmp"
Call CDGen
Session(pSN) = DigtalStr '记录入Session
Dim PicWidth, PicHeight, FileSize, PicDataSize
PicWidth = nCharCount * nPixelWidth
PicHeight = nPixelHeight
PicDataSize = PicWidth * PicHeight * 3
FileSize = PicDataSize + 54
' 输出BMP文件信息头
Response.BinaryWrite ChrB(66) & ChrB(77) & _
ChrB(FileSize Mod 256) & ChrB((FileSize \ 256) Mod 256) & ChrB((FileSize \ 256 \ 256) Mod 256) & ChrB(FileSize \ 256 \ 256 \ 256) & _
ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & _
ChrB(54) & ChrB(0) & ChrB(0) & ChrB(0)
' 输出BMP位图信息头
Response.BinaryWrite ChrB(40) & ChrB(0) & ChrB(0) & ChrB(0) & _
ChrB(PicWidth Mod 256) & ChrB((PicWidth \ 256) Mod 256) & ChrB((PicWidth \ 256 \ 256) Mod 256) & ChrB(PicWidth \ 256 \ 256 \ 256) & _
ChrB(PicHeight Mod 256) & ChrB((PicHeight \ 256) Mod 256) & ChrB((PicHeight \ 256 \ 256) Mod 256) & ChrB(PicHeight \ 256 \ 256 \ 256) & _
ChrB(1) & ChrB(0) & _
ChrB(24) & ChrB(0) & _
ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & _
ChrB(PicDataSize Mod 256) & ChrB((PicDataSize \ 256) Mod 256) & ChrB((PicDataSize \ 256 \ 256) Mod 256) & ChrB(PicDataSize \ 256 \ 256 \ 256) & _
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)
' 逐点输出位图阵列
If nColorHue = -1 Then
CurColorHue = Int(Rnd * 360)
ElseIf nColorHue = -2 Then
CurColorHue = 0
Else
CurColorHue = nColorHue
End If
For j = 0 To nPixelHeight - 1
For i = 0 To Len(DigtalStr) * nPixelWidth - 1
If nColorHue = -2 Then
Response.BinaryWrite HSBToRGB(CurColorHue, 0, 100 - Buf(nPixelHeight - 1 - j, i))
Else
Response.BinaryWrite HSBToRGB(CurColorHue, Buf(nPixelHeight - 1 - j, i), 100)
End If
Next
Next
End Sub
%>
<%
'强制性刷新随机验证码
'让随机验证码每次按IE的后退按钮时,返回登录页面的随即码都自动刷新,
Response.expires=-1
Response.AddHeader"pragma","no-cache"
Response.AddHeader"cache-control","no-store"
%>