用Canvas做的ASP无组件生成图片验证码

王朝asp·作者佚名  2006-11-24
宽屏版  字体: |||超大  

点击这里下载源码

相关图片如下:

Dim objCanvas

Dim PointX,PointY,PointColor

Dim iTemp

Dim SafeCode

Dim R,G,B,cc,kk

Const cAmount = 36 ' 文字数量

Const cCode = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"

cc=80

kk=30

SafeCode = ""

Session("SafeCode") = ""

BGColor = "FFFFFF"

R = Mid(BGColor,1,2)

G = Mid(BGColor,3,2)

B = Mid(BGColor,5,2)

R = DecHex(R)

G = DecHex(G)

B = DecHex(B)

Set objCanvas = New Canvas

objCanvas.GlobalColourTable(0) = RGB(255,255,255) ' White

objCanvas.GlobalColourTable(1) = RGB(0,0,0) ' Black

objCanvas.GlobalColourTable(2) = RGB(255,0,0) ' Red

objCanvas.GlobalColourTable(3) = RGB(0,255,0) ' Green

objCanvas.GlobalColourTable(4) = RGB(0,0,255) ' Blue

objCanvas.GlobalColourTable(5) = RGB(128,0,0)

objCanvas.GlobalColourTable(6) = RGB(0,128,0)

objCanvas.GlobalColourTable(7) = RGB(0,0,128)

objCanvas.GlobalColourTable(8) = RGB(128,128,0)

objCanvas.GlobalColourTable(9) = RGB(0,128,128)

objCanvas.GlobalColourTable(10) = RGB(128,0,128)

objCanvas.GlobalColourTable(11) = RGB(R,G,B)

objCanvas.BackgroundColourIndex = 11

objCanvas.Resize cc,kk,false

'Randomize timer

'SafeCode = cint(8999*Rnd+1000)

Randomize

For i = 0 To 3

SafeCode = SafeCode &" "& Mid(cCode, Int(Rnd * cAmount) + 1, 1)

Next

'杂点

For iTemp = 0 To 30

Randomize timer

PointX = Int(Rnd * cc)

PointY = Int(Rnd * kk)

PointColor = Int(Rnd * 3)+2

objCanvas.ForegroundColourIndex = PointColor

objCanvas.Line PointX,PointY,PointX,PointY

next

'边框

objCanvas.ForegroundColourIndex = 1

objCanvas.Line 1,1,cc,1

objCanvas.Line 1,kk,1,1

objCanvas.Line 1,kk,cc,kk

objCanvas.Line cc,1,cc,kk

Session("SafeCode") = SafeCode

dim sc,sk

'文字

Randomize timer

sc = cint(3*Rnd)

sk = cint(3*Rnd)

objCanvas.DrawTextWE sc,sk,SafeCode

objCanvas.Write

Function DecHex (HStr)

Dim Result

Dim i,L

Result = 0

L = Len(Hstr)

For i = L-1 To 0 Step -1

Result = Result + (16 ^ i)*GetDecBit(Mid(HStr,i+1,1))

Next

DecHex = Result

End Function

Function GetDecBit (HStr)

Dim Result

Dim R(16)

Dim i

Result = 0

R(0) = "0"

R(1) = "1"

R(2) = "2"

R(3) = "3"

R(4) = "4"

R(5) = "5"

R(6) = "6"

R(7) = "7"

R(8) = "8"

R(9) = "9"

R(10) = "A"

R(11) = "B"

R(12) = "C"

R(13) = "D"

R(14) = "E"

R(15) = "F"

For i = 0 To 15

if HStr=R(i) Then Result = i : Exit For

Next

GetDecBit = Result

End Function

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
© 2005- 王朝网络 版权所有